From c3b2c0830aa3a9e1332d3b06b6ed3159671454d4 Mon Sep 17 00:00:00 2001 From: Andreas Noack Jensen Date: Wed, 13 Feb 2013 17:59:34 +0100 Subject: [PATCH 01/29] First take on new design of linalg --- base/exports.jl | 5 +- base/lapack.jl | 222 ++++++------ base/linalg_dense.jl | 801 +++++++++++++++++++++++++------------------ extras/image.jl | 5 +- test/linalg.jl | 61 ++-- 5 files changed, 614 insertions(+), 480 deletions(-) diff --git a/base/exports.jl b/base/exports.jl index c8c4894b18dc6..8662ae98948f4 100644 --- a/base/exports.jl +++ b/base/exports.jl @@ -110,13 +110,16 @@ export BunchKaufman, CholeskyDense, CholeskyPivotedDense, + GSVDDense, + Hessenberg, LUDense, LUTridiagonal, LDLTTridiagonal, QRDense, QRPivotedDense, SVDDense, - GSVDDense, + Hermitian, + Triangular, InsertionSort, QuickSort, MergeSort, diff --git a/base/lapack.jl b/base/lapack.jl index cb3df8590b5b8..fd1b8ba10c521 100644 --- a/base/lapack.jl +++ b/base/lapack.jl @@ -8,7 +8,7 @@ import Base.BlasChar import Base.BlasInt import Base.blas_int -type LapackException <: Exception +type LAPACKException <: Exception info::BlasInt end @@ -24,7 +24,7 @@ type RankDeficientException <: Exception info::BlasInt end -type LapackDimMisMatch <: Exception +type DimensionMismatch <: Exception name::ASCIIString end @@ -64,7 +64,7 @@ for (gbtrf, gbtrs, elty) in (Ptr{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt}), &m, &n, &kl, &ku, AB, &stride(AB,2), ipiv, info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end AB, ipiv end # SUBROUTINE DGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO) @@ -80,14 +80,14 @@ for (gbtrf, gbtrs, elty) in chkstride1(AB, B) info = Array(BlasInt, 1) n = size(AB,2) - if m != n || m != size(B,1) throw(LapackDimMisMatch("gbtrs!")) end + if m != n || m != size(B,1) throw(DimensionMismatch("gbtrs!")) end ccall(($(string(gbtrs)),liblapack), Void, (Ptr{Uint8}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &trans, &n, &kl, &ku, &size(B,2), AB, &stride(AB,2), ipiv, B, &stride(B,2), info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end B end end @@ -118,7 +118,7 @@ for (gebal, gebak, elty, relty) in (Ptr{Uint8}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$relty}, Ptr{BlasInt}), &job, &n, A, &stride(A,2), ilo, ihi, scale, info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end ilo[1], ihi[1], scale end # SUBROUTINE DGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO ) @@ -137,7 +137,7 @@ for (gebal, gebak, elty, relty) in (Ptr{Uint8}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &job, &side, &size(V,1), &ilo, &ihi, scale, &n, V, &stride(V,2), info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end V end end @@ -182,7 +182,7 @@ for (gebrd, gelqf, geqlf, geqrf, geqp3, geqrt3, gerqf, getrf, elty, relty) in Ptr{$elty}, Ptr{$elty}, Ptr{$elty}, Ptr{$elty}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &m, &n, A, &stride(A,2), d, s, tauq, taup, work, &lwork, info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(real(work[1])) work = Array($elty, lwork) @@ -208,7 +208,7 @@ for (gebrd, gelqf, geqlf, geqrf, geqp3, geqrt3, gerqf, getrf, elty, relty) in (Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &m, &n, A, &lda, tau, work, &lwork, info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(real(work[1])) work = Array($elty, lwork) @@ -235,7 +235,7 @@ for (gebrd, gelqf, geqlf, geqrf, geqp3, geqrt3, gerqf, getrf, elty, relty) in (Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &m, &n, A, &lda, tau, work, &lwork, info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(real(work[1])) work = Array($elty, lwork) @@ -273,7 +273,7 @@ for (gebrd, gelqf, geqlf, geqrf, geqp3, geqrt3, gerqf, getrf, elty, relty) in Ptr{BlasInt}), &m, &n, A, &stride(A,2), jpvt, tau, work, &lwork, info) end - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(real(work[1])) work = Array($elty, lwork) @@ -314,7 +314,7 @@ for (gebrd, gelqf, geqlf, geqrf, geqp3, geqrt3, gerqf, getrf, elty, relty) in (Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &m, &n, A, &stride(A,2), tau, work, &lwork, info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(real(work[1])) work = Array($elty, lwork) @@ -339,7 +339,7 @@ for (gebrd, gelqf, geqlf, geqrf, geqp3, geqrt3, gerqf, getrf, elty, relty) in (Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &m, &n, A, &stride(A,2), tau, work, &lwork, info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(real(work[1])) work = Array($elty, lwork) @@ -363,7 +363,7 @@ for (gebrd, gelqf, geqlf, geqrf, geqp3, geqrt3, gerqf, getrf, elty, relty) in (Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt}), &m, &n, A, &lda, ipiv, info) - if info[1] < 0 throw(LapackException(info[1])) end + if info[1] < 0 throw(LAPACKException(info[1])) end A, ipiv, info[1] end end @@ -384,7 +384,7 @@ for (gels, gesv, getrs, getri, elty) in chkstride1(A, B) btrn = trans == 'T' m, n = size(A) - if size(B,1) != (btrn ? n : m) throw(LapackDimMisMatch("gels!")) end + if size(B,1) != (btrn ? n : m) throw(DimensionMismatch("gels!")) end info = Array(BlasInt, 1) work = Array($elty, 1) lwork = blas_int(-1) @@ -395,7 +395,7 @@ for (gels, gesv, getrs, getri, elty) in Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &(btrn?'T':'N'), &m, &n, &size(B,2), A, &stride(A,2), B, &stride(B,2), work, &lwork, info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(real(work[1])) work = Array($elty, lwork) @@ -416,14 +416,14 @@ for (gels, gesv, getrs, getri, elty) in chkstride1(A, B) chksquare(A) n = size(A,1) - if size(B,1) != n throw(LapackDimMisMatch("gesv!")) end + if size(B,1) != n throw(DimensionMismatch("gesv!")) end ipiv = Array(BlasInt, n) info = Array(BlasInt, 1) ccall(($(string(gesv)),liblapack), Void, (Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &n, &size(B,2), A, &stride(A,2), ipiv, B, &stride(B,2), info) - if info[1] < 0 throw(LapackException(info[1])) end + if info[1] < 0 throw(LAPACKException(info[1])) end B, A, ipiv, info[1] end # SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) @@ -443,7 +443,7 @@ for (gels, gesv, getrs, getri, elty) in (Ptr{Uint8}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &trans, &n, &size(B,2), A, &stride(A,2), ipiv, B, &stride(B,2), info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end B end # SUBROUTINE DGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) @@ -490,7 +490,7 @@ for (gelsd, elty) in ((:dgelsd_, :Float64), function gelsd!(A::StridedMatrix{$elty}, B::StridedVecOrMat{$elty}, rcond) LAPACK.chkstride1(A, B) m, n = size(A) - if size(B, 1) != m; throw(LAPACK.LapackDimMisMatch("gelsd!")); end + if size(B, 1) != m; throw(LAPACK.DimensionMismatch("gelsd!")); end if size(B, 1) < n newB = Array($elty, n, size(B, 2)) newB[1:size(B, 1), :] = B @@ -511,7 +511,7 @@ for (gelsd, elty) in ((:dgelsd_, :Float64), Ptr{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt}), &m, &n, &size(B,2), A, &max(1,stride(A,2)), newB, &max(1,stride(B,2),n), s, &rcond, rnk, work, &lwork, iwork, info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(real(work[1])) work = Array($elty, lwork) @@ -539,7 +539,7 @@ for (gelsd, elty, relty) in ((:zgelsd_, :Complex128, :Float64), function gelsd!(A::StridedMatrix{$elty}, B::StridedVecOrMat{$elty}, rcond) LAPACK.chkstride1(A, B) m, n = size(A) - if size(B,1) != m; throw(LAPACK.LapackDimMisMatch("gelsd!")); end + if size(B,1) != m; throw(LAPACK.DimensionMismatch("gelsd!")); end if size(B, 1) < n newB = Array($elty, n, size(B, 2)) newB[1:size(B, 1), :] = B @@ -561,7 +561,7 @@ for (gelsd, elty, relty) in ((:zgelsd_, :Complex128, :Float64), Ptr{$relty}, Ptr{BlasInt}, Ptr{BlasInt}), &m, &n, &size(B,2), A, &max(1,stride(A,2)), newB, &max(1,stride(B,2),n), s, &rcond, rnk, work, &lwork, rwork, iwork, info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(real(work[1])) work = Array($elty, lwork) @@ -627,13 +627,13 @@ for (geev, gesvd, gesdd, ggsvd, elty, relty) in &jobvl, &jobvr, &n, A, &stride(A,2), WR, WI, VL, &n, VR, &n, work, &lwork, info) end - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(real(work[1])) work = Array($elty, lwork) end end - cmplx ? (VL, W, VR) : (VL, WR, WI, VR) + cmplx ? (W, VL, VR) : (WR, WI, VL, VR) end # SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, # LWORK, IWORK, INFO ) @@ -689,7 +689,7 @@ for (geev, gesvd, gesdd, ggsvd, elty, relty) in &job, &m, &n, A, &stride(A,2), S, U, &max(1,stride(U,2)), VT, &max(1,stride(VT,2)), work, &lwork, iwork, info) end - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(real(work[1])) work = Array($elty, lwork) @@ -739,7 +739,7 @@ for (geev, gesvd, gesdd, ggsvd, elty, relty) in &jobu, &jobvt, &m, &n, A, &stride(A,2), S, U, &max(1,stride(U,2)), VT, &max(1,stride(VT,2)), work, &lwork, info) end - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(real(work[1])) work = Array($elty, lwork) @@ -763,7 +763,7 @@ for (geev, gesvd, gesdd, ggsvd, elty, relty) in # $ U( LDU, * ), V( LDV, * ), WORK( * ) function ggsvd!(jobu::BlasChar, jobv::BlasChar, jobq::BlasChar, A::Matrix{$elty}, B::Matrix{$elty}) m, n = size(A) - if size(B, 2) != n; throw(LapackDimMisMatch); end + if size(B, 2) != n; throw(DimensionMismatch); end p = size(B, 1) k = Array(BlasInt, 1) l = Array(BlasInt, 1) @@ -811,7 +811,7 @@ for (geev, gesvd, gesdd, ggsvd, elty, relty) in V, &ldv, Q, &ldq, work, iwork, info) end - if info[1] != 0; throw(LapackException(info[1])); end + if info[1] != 0; throw(LAPACKException(info[1])); end if m - k[1] - l[1] >= 0 R = triu(A[1:k[1] + l[1],n - k[1] - l[1] + 1:n]) else @@ -839,15 +839,15 @@ for (gtsv, gttrf, gttrs, elty) in chkstride1(B) n = length(d) if length(dl) != n - 1 || length(du) != n - 1 - throw(LapackDimMisMatch("gtsv!")) + throw(DimensionMismatch("gtsv!")) end - if n != size(B,1) throw(LapackDimMisMatch("gtsv!")) end + if n != size(B,1) throw(DimensionMismatch("gtsv!")) end info = Array(BlasInt, 1) ccall(($(string(gtsv)),liblapack), Void, (Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ptr{$elty}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &n, &size(B,2), dl, d, du, B, &stride(B,2), info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end B end # SUBROUTINE DGTTRF( N, DL, D, DU, DU2, IPIV, INFO ) @@ -859,7 +859,7 @@ for (gtsv, gttrf, gttrs, elty) in function gttrf!(dl::Vector{$elty}, d::Vector{$elty}, du::Vector{$elty}) n = length(d) if length(dl) != (n-1) || length(du) != (n-1) - throw(LapackDimMisMatch("gttrf!")) + throw(DimensionMismatch("gttrf!")) end du2 = Array($elty, n-2) ipiv = Array(BlasInt, n) @@ -868,7 +868,7 @@ for (gtsv, gttrf, gttrs, elty) in (Ptr{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ptr{$elty}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &n, dl, d, du, du2, ipiv, info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end dl, d, du, du2, ipiv end # SUBROUTINE DGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, INFO ) @@ -883,15 +883,15 @@ for (gtsv, gttrf, gttrs, elty) in B::StridedVecOrMat{$elty}) chkstride1(B) n = length(d) - if length(dl) != n - 1 || length(du) != n - 1 throw(LapackDimMisMatch("gttrs!")) end - if n != size(B,1) throw(LapackDimMisMatch("gttrs!")) end + if length(dl) != n - 1 || length(du) != n - 1 throw(DimensionMismatch("gttrs!")) end + if n != size(B,1) throw(DimensionMismatch("gttrs!")) end info = Array(BlasInt, 1) ccall(($(string(gttrs)),liblapack), Void, (Ptr{Uint8}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ptr{$elty}, Ptr{$elty}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &trans, &n, &size(B,2), dl, d, du, du2, ipiv, B, &stride(B,2), info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end B end end @@ -919,7 +919,7 @@ for (orglq, orgqr, ormlq, ormqr, gemqrt, elty) in (Ptr{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &size(A,1), &size(A,2), &k, A, &stride(A,2), tau, work, &lwork, info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(real(work[1])) work = Array($elty, lwork) @@ -932,8 +932,11 @@ for (orglq, orgqr, ormlq, ormqr, gemqrt, elty) in # INTEGER INFO, K, LDA, LWORK, M, N # * .. Array Arguments .. # DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) - function orgqr!(A::StridedMatrix{$elty}, tau::Vector{$elty}, k::Integer) + function orgqr!(A::StridedMatrix{$elty}, tau::Vector{$elty}) chkstride1(A) + m, n = size(A) + k = length(tau) + if k > n throw(DimensionMismatch("Wrong number of reflectors")) end work = Array($elty, 1) lwork = blas_int(-1) info = Array(BlasInt, 1) @@ -941,10 +944,12 @@ for (orglq, orgqr, ormlq, ormqr, gemqrt, elty) in ccall(($(string(orgqr)),liblapack), Void, (Ptr{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), - &size(A,1), &size(A,2), &k, A, &stride(A,2), tau, work, &lwork, info) - if info[1] != 0 throw(LapackException(info[1])) end + &m, &n, &k, A, + &max(1,stride(A,2)), tau, work, &lwork, + info) + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 - lwork = blas_int(real(work[1])) + lwork = blas_int(work[1]) work = Array($elty, lwork) end end @@ -972,7 +977,7 @@ for (orglq, orgqr, ormlq, ormqr, gemqrt, elty) in Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &side, &trans, &m, &n, &k, A, &stride(A,2), tau, C, &stride(C,2), work, &lwork, info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(real(work[1])) work = Array($elty, lwork) @@ -988,21 +993,29 @@ for (orglq, orgqr, ormlq, ormqr, gemqrt, elty) in # .. Array Arguments .. # DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) function ormqr!(side::BlasChar, trans::BlasChar, A::StridedMatrix{$elty}, - k::Integer, tau::Vector{$elty}, C::StridedVecOrMat{$elty}) + tau::Vector{$elty}, C::StridedVecOrMat{$elty}) chkstride1(A, C) m = size(C, 1) n = size(C, 2) # m, n = size(C) won't work if C is a Vector + mA = size(A, 1) + k = length(tau) + if side == 'L' && m != mA throw(DimensionMismatch("")) end + if side == 'R' && n != mA throw(DimensionMismatch("")) end + if (side == 'L' && k > m) || (side == 'R' && k > n) throw(DimensionMismatch("Wrong number of reflectors")) end work = Array($elty, 1) lwork = blas_int(-1) info = Array(BlasInt, 1) for i in 1:2 ccall(($(string(ormqr)),liblapack), Void, - (Ptr{Uint8}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt}, - Ptr{$elty}, Ptr{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ptr{BlasInt}, - Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), - &side, &trans, &m, &n, &k, A, &stride(A,2), tau, - C, &stride(C,2), work, &lwork, info) - if info[1] != 0 throw(LapackException(info[1])) end + (Ptr{Uint8}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{BlasInt}, + Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{$elty}, + Ptr{$elty}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, + Ptr{BlasInt}), + &side, &trans, &m, &n, + &k, A, &max(1,stride(A,2)), tau, + C, &max(1, stride(C,2)), work, &lwork, + info) + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(real(work[1])) work = Array($elty, lwork) @@ -1060,13 +1073,13 @@ for (posv, potrf, potri, potrs, pstrf, elty, rtyp) in chkstride1(A, B) chksquare(A) n = size(A,1) - if size(B,1) != n throw(LapackDimMisMatch("posv!")) end + if size(B,1) != n throw(DimensionMismatch("posv!")) end info = Array(BlasInt, 1) ccall(($(string(posv)),liblapack), Void, (Ptr{Uint8}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &uplo, &n, &size(B,2), A, &stride(A,2), B, &stride(B,2), info) - if info[1] < 0 throw(LapackException(info[1])) end + if info[1] < 0 throw(LAPACKException(info[1])) end A, B, info[1] end ## Caller should check if returned info[1] is zero, @@ -1084,7 +1097,7 @@ for (posv, potrf, potri, potrs, pstrf, elty, rtyp) in ccall(($(string(potrf)),liblapack), Void, (Ptr{Uint8}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &uplo, &size(A,1), A, &stride(A,2), info) - if info[1] < 0 throw(LapackException(info[1])) end + if info[1] < 0 throw(LAPACKException(info[1])) end A, info[1] end ## Caller should check if returned info[1] is zero, @@ -1101,7 +1114,7 @@ for (posv, potrf, potri, potrs, pstrf, elty, rtyp) in ccall(($(string(potri)),liblapack), Void, (Ptr{Uint8}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &uplo, &size(A,1), A, &stride(A,2), info) - if info[1] < 0 throw(LapackException(info[1])) end + if info[1] < 0 throw(LAPACKException(info[1])) end A, info[1] end # SUBROUTINE DPOTRS( UPLO, N, NRHS, A, LDA, B, LDB, INFO ) @@ -1120,7 +1133,7 @@ for (posv, potrf, potri, potrs, pstrf, elty, rtyp) in (Ptr{Uint8}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &uplo, &n, &size(B,2), A, &stride(A,2), B, &stride(B,2), info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end B end # SUBROUTINE DPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) @@ -1143,7 +1156,7 @@ for (posv, potrf, potri, potrs, pstrf, elty, rtyp) in (Ptr{Uint8}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$rtyp}, Ptr{$rtyp}, Ptr{BlasInt}), &uplo, &n, A, &stride(A,2), piv, rank, &tol, work, info) - if info[1] < 0 throw(LapackException(info[1])) end + if info[1] < 0 throw(LAPACKException(info[1])) end A, piv, rank[1], info[1] end end @@ -1165,13 +1178,13 @@ for (ptsv, pttrf, pttrs, elty, relty) in function ptsv!(D::Vector{$relty}, E::Vector{$elty}, B::StridedVecOrMat{$elty}) chkstride1(B) n = length(D) - if length(E) != n - 1 || n != size(B,1) throw(LapackDimMismatch("ptsv!")) end + if length(E) != n - 1 || n != size(B,1) throw(DimensionMismatch("ptsv!")) end info = Array(BlasInt, 1) ccall(($(string(ptsv)),liblapack), Void, (Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$relty}, Ptr{$elty}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &n, &size(B,2), D, E, B, &stride(B,2), info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end B end # SUBROUTINE DPTTRF( N, D, E, INFO ) @@ -1181,12 +1194,12 @@ for (ptsv, pttrf, pttrs, elty, relty) in # DOUBLE PRECISION D( * ), E( * ) function pttrf!(D::Vector{$relty}, E::Vector{$elty}) n = length(D) - if length(E) != (n-1) throw(LapackDimMisMatch("pttrf!")) end + if length(E) != (n-1) throw(DimensionMismatch("pttrf!")) end info = Array(BlasInt, 1) ccall(($(string(pttrf)),liblapack), Void, (Ptr{BlasInt}, Ptr{$relty}, Ptr{$elty}, Ptr{BlasInt}), &n, D, E, info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end D, E end end @@ -1203,13 +1216,13 @@ for (pttrs, elty, relty) in function pttrs!(D::Vector{$relty}, E::Vector{$elty}, B::StridedVecOrMat{$elty}) chkstride1(B) n = length(D) - if length(E) != (n-1) || size(B,1) != n throw(LapackDimMisMatch("pttrs!")) end + if length(E) != (n-1) || size(B,1) != n throw(DimensionMismatch("pttrs!")) end info = Array(BlasInt, 1) ccall(($(string(pttrs)),liblapack), Void, (Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$relty}, Ptr{$elty}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &n, &size(B,2), D, E, B, &stride(B,2), info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end B end end @@ -1229,13 +1242,13 @@ for (pttrs, elty, relty) in function pttrs!(uplo::BlasChar, D::Vector{$relty}, E::Vector{$elty}, B::StridedVecOrMat{$elty}) chkstride1(B) n = length(D) - if length(E) != (n-1) || size(B,1) != n throw(LapackDimMisMatch("pttrs!")) end + if length(E) != (n-1) || size(B,1) != n throw(DimensionMismatch("pttrs!")) end info = Array(BlasInt, 1) ccall(($(string(pttrs)),liblapack), Void, (Ptr{Uint8}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$relty}, Ptr{$elty}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &uplo, &n, &size(B,2), D, E, B, &stride(B,2), info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end B end end @@ -1257,10 +1270,10 @@ for (trtri, trtrs, elty) in function trtri!(uplo::BlasChar, diag::BlasChar, A::StridedMatrix{$elty}) chkstride1(A) m, n = size(A) - if m != n error("trtri!: dimension mismatch") end + if m != n throw(DimensionMismatch("")) end lda = stride(A, 2) info = Array(BlasInt, 1) - ccall(($trtri,liblapack), Void, + ccall(($(string(trtri)),liblapack), Void, (Ptr{Uint8}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &uplo, &diag, &n, A, &lda, info) @@ -1278,14 +1291,14 @@ for (trtri, trtrs, elty) in chkstride1(A) chksquare(A) n = size(A,2) - if size(B,1) != n throw(LapackDimMisMatch("trtrs!")) end + if size(B,1) != n throw(DimensionMismatch("trtrs!")) end info = Array(BlasInt, 1) ccall(($(string(trtrs)),liblapack), Void, (Ptr{Uint8}, Ptr{Uint8}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &uplo, &trans, &diag, &n, &size(B,2), A, &stride(A,2), B, &stride(B,2), info) - if info[1] < 0 throw(LapackException(info[1])) end + if info[1] < 0 throw(LAPACKException(info[1])) end B, info[1] end end @@ -1376,6 +1389,8 @@ for (stev, stebz, stegr, elty) in end end end +stegr!(jobz::BlasChar, dv::Vector, ev::Vector) = stegr!(jobz, 'A', dv, ev, 0.0, 0.0, 0, 0, -1.0) +stegr!(dv::Vector, ev::Vector) = stegr!('N', 'A', dv, ev, 0.0, 0.0, 0, 0, -1.0) ## (SY) symmetric matrices - eigendecomposition, Bunch-Kaufman decomposition, ## solvers (direct and factored) and inverse. @@ -1402,7 +1417,7 @@ for (syconv, syev, sysv, sytrf, sytri, sytrs, elty, relty) in (Ptr{Uint8}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}), &uplo, &'C', &n, A, &stride(A,2), ipiv, work, info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end A, work end # SUBROUTINE DSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO ) @@ -1435,7 +1450,7 @@ for (syconv, syev, sysv, sytrf, sytri, sytrs, elty, relty) in Ptr{$relty}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &jobz, &uplo, &n, A, &stride(A,2), W, work, &lwork, info) end - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(real(work[1])) work = Array($elty, lwork) @@ -1455,7 +1470,7 @@ for (syconv, syev, sysv, sytrf, sytri, sytrs, elty, relty) in chkstride1(A,B) chksquare(A) n = size(A,1) - if n != size(B,1) throw(LapackDimMismatch("sysv!")) end + if n != size(B,1) throw(DimensionMismatch("sysv!")) end ipiv = Array(BlasInt, n) work = Array($elty, 1) lwork = blas_int(-1) @@ -1466,7 +1481,7 @@ for (syconv, syev, sysv, sytrf, sytri, sytrs, elty, relty) in Ptr{$elty}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &uplo, &n, &size(B,2), A, &stride(A,2), ipiv, B, &stride(B,2), work, &lwork, info) - if info[1] < 0 throw(LapackException(info[1])) end + if info[1] < 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(real(work[1])) work = Array($elty, lwork) @@ -1494,7 +1509,7 @@ for (syconv, syev, sysv, sytrf, sytri, sytrs, elty, relty) in (Ptr{Uint8}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &uplo, &n, A, &stride(A,2), ipiv, work, &lwork, info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(real(work[1])) work = Array($elty, lwork) @@ -1521,7 +1536,7 @@ for (syconv, syev, sysv, sytrf, sytri, sytrs, elty, relty) in # (Ptr{Uint8}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, # Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), # &uplo, &n, A, &stride(A,2), ipiv, work, &lwork, info) -# if info[1] != 0 throw(LapackException(info[1])) end +# if info[1] != 0 throw(LAPACKException(info[1])) end # if lwork < 0 # lwork = blas_int(real(work[1])) # work = Array($elty, lwork) @@ -1546,7 +1561,7 @@ for (syconv, syev, sysv, sytrf, sytri, sytrs, elty, relty) in (Ptr{Uint8}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}), &uplo, &n, A, &stride(A,2), ipiv, work, info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end A end # SUBROUTINE DSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) @@ -1562,13 +1577,13 @@ for (syconv, syev, sysv, sytrf, sytri, sytrs, elty, relty) in chkstride1(A,B) chksquare(A) n = size(A,1) - if n != size(B,1) throw(LapackDimMismatch("sytrs!")) end + if n != size(B,1) throw(DimensionMismatch("sytrs!")) end info = Array(BlasInt, 1) ccall(($(string(sytrs)),liblapack), Void, (Ptr{Uint8}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &uplo, &n, &size(B,2), A, &stride(A,2), ipiv, B, &stride(B,2), info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end B end end @@ -1579,7 +1594,7 @@ for (syevr, elty) in ((:dsyevr_,:Float64), (:ssyevr_,:Float32)) @eval begin - function syevr!(jobz::BlasChar, range::BlasChar, uplo::BlasChar, A::StridedMatrix{$elty}, vl::FloatingPoint, vu::FloatingPoint, il::Integer, iu::Integer, Z::StridedMatrix{$elty}, abstol::FloatingPoint) + function syevr!(jobz::BlasChar, range::BlasChar, uplo::BlasChar, A::StridedMatrix{$elty}, vl::FloatingPoint, vu::FloatingPoint, il::Integer, iu::Integer, abstol::FloatingPoint) # SUBROUTINE DSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, # $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, # $ IWORK, LIWORK, INFO ) @@ -1591,20 +1606,20 @@ for (syevr, elty) in # * .. Array Arguments .. # INTEGER ISUPPZ( * ), IWORK( * ) # DOUBLE PRECISION A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * ) - chkstride1(A, Z) - chksquare(A) + chkstride1(A) + chksquare(A) n = size(A, 2) lda = max(1,stride(A,2)) m = Array(BlasInt, 1) w = Array($elty, n) if jobz == 'N' ldz = 1 + Z = Array($elty, ldz, 0) elseif jobz == 'V' - if stride(Z, 2) < n; error("Z has too few rows"); end - if size(Z, 2) < n; error("Z has too few columns"); end - ldz = max(1, stride(Z, 2)) + ldz = n + Z = Array($elty, ldz, n) else - error("joz must be 'N' of 'V'") + error("jobz must be 'N' of 'V'") end isuppz = Array(BlasInt, 2*n) work = Array($elty, 1) @@ -1626,7 +1641,7 @@ for (syevr, elty) in w, Z, &ldz, isuppz, work, &lwork, iwork, &liwork, info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(work[1]) work = Array($elty, lwork) @@ -1634,7 +1649,7 @@ for (syevr, elty) in iwork = Array(BlasInt, liwork) end end - return w[1:m[1]] + return w[1:m[1]], Z[:,1:(jobz == 'V' ? m[1] : 0)] end end end @@ -1642,7 +1657,7 @@ for (syevr, elty, relty) in ((:zheevr_,:Complex128,:Float64), (:cheevr_,:Complex64,:Float32)) @eval begin - function syevr!(jobz::BlasChar, range::BlasChar, uplo::BlasChar, A::StridedMatrix{$elty}, vl::FloatingPoint, vu::FloatingPoint, il::Integer, iu::Integer, Z::StridedMatrix{$elty}, abstol::FloatingPoint) + function syevr!(jobz::BlasChar, range::BlasChar, uplo::BlasChar, A::StridedMatrix{$elty}, vl::FloatingPoint, vu::FloatingPoint, il::Integer, iu::Integer, abstol::FloatingPoint) # SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, # $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, # $ RWORK, LRWORK, IWORK, LIWORK, INFO ) @@ -1656,7 +1671,7 @@ for (syevr, elty, relty) in # INTEGER ISUPPZ( * ), IWORK( * ) # DOUBLE PRECISION RWORK( * ), W( * ) # COMPLEX*16 A( LDA, * ), WORK( * ), Z( LDZ, * ) - chkstride1(A, Z) + chkstride1(A) chksquare(A) n = size(A, 2) lda = max(1,stride(A,2)) @@ -1664,12 +1679,12 @@ for (syevr, elty, relty) in w = Array($relty, n) if jobz == 'N' ldz = 1 + Z = Array($elty, ldz, 0) elseif jobz == 'V' - if stride(Z, 2) < n; error("Z has too few rows"); end - if size(Z, 2) < n; error("Z has too few columns"); end - ldz = max(1, stride(Z, 2)) + ldz = n + Z = Array($elty, ldz, n) else - error("joz must be 'N' of 'V'") + error("jobz must be 'N' of 'V'") end isuppz = Array(BlasInt, 2*n) work = Array($elty, 1) @@ -1693,7 +1708,7 @@ for (syevr, elty, relty) in w, Z, &ldz, isuppz, work, &lwork, rwork, &lrwork, iwork, &liwork, info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(real(work[1])) work = Array($elty, lwork) @@ -1703,12 +1718,11 @@ for (syevr, elty, relty) in iwork = Array(BlasInt, liwork) end end - return w[1:m[1]] + return w[1:m[1]], Z[:,1:(jobz == 'V' ? m[1] : 0)] end end end -syevr!(A::StridedMatrix, Z::StridedMatrix) = syevr!('V', 'A', 'U', A, 0.0, 0.0, 0, 0, Z, -1.0) -syevr!{T}(A::StridedMatrix{T}) = syevr!('N', 'A', 'U', A, 0.0, 0.0, 0, 0, zeros(T,0,0), -1.0) +syevr!(jobz::Char, A::StridedMatrix) = syevr!(jobz, 'A', 'U', A, 0.0, 0.0, 0, 0, -1.0) # Estimate condition number for (gecon, elty) in @@ -1739,7 +1753,7 @@ for (gecon, elty) in Ptr{BlasInt}), &normtype, &n, A, &lda, &anorm, rcond, work, iwork, info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end return rcond[1] end end @@ -1773,7 +1787,7 @@ for (gecon, elty, relty) in Ptr{BlasInt}), &normtype, &n, A, &lda, &anorm, rcond, work, rwork, info) - if info[1] < 0 throw(LapackException(info[1])) end + if info[1] < 0 throw(LAPACKException(info[1])) end return rcond[1] end end @@ -1807,7 +1821,7 @@ for (gehrd, elty) in &n, &ilo, &ihi, A, &max(1,n), tau, work, &lwork, info) - if info[1] < 0 throw(LapackException(info[1])) end + if info[1] < 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(work[1]) work = Array($elty, lwork) @@ -1817,7 +1831,7 @@ for (gehrd, elty) in end end end -gehrd!(A::StridedMatrix) = gehrd!(blas_int(1), blas_int(size(A, 1)), A) +gehrd!(A::StridedMatrix) = gehrd!(1, size(A, 1), A) # construct Q from Hessenberg for (orghr, elty) in @@ -1835,7 +1849,7 @@ for (orghr, elty) in chkstride1(A) chksquare(A) n = size(A, 1) - if n - length(tau) != 1 throw(LapackDimMismatch) end + if n - length(tau) != 1 throw(DimensionMismatch) end work = Array($elty, 1) lwork = blas_int(-1) info = Array(BlasInt, 1) @@ -1847,7 +1861,7 @@ for (orghr, elty) in &n, &ilo, &ihi, A, &max(1,n), tau, work, &lwork, info) - if info[1] < 0 throw(LapackException(info[1])) end + if info[1] < 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(work[1]) work = Array($elty, lwork) @@ -1893,7 +1907,7 @@ for (gees, elty) in A, &max(1, n), sdim, wr, wi, vs, &ldvs, work, &lwork, [], info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(work[1]) work = Array($elty, lwork) @@ -1942,7 +1956,7 @@ for (gees, elty, relty) in A, &max(1, n), sdim, w, vs, &ldvs, work, &lwork, rwork, [], info) - if info[1] != 0 throw(LapackException(info[1])) end + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(work[1]) work = Array($elty, lwork) diff --git a/base/linalg_dense.jl b/base/linalg_dense.jl index e3d275c1b3c33..a5e26c82f136a 100644 --- a/base/linalg_dense.jl +++ b/base/linalg_dense.jl @@ -1,3 +1,6 @@ +# Should probably go someweher else +symbol(x::Char) = symbol(string(x)) + # Linear algebra functions for dense matrices in column major format scale!(X::Array{Float32}, s::Real) = BLAS.scal!(length(X), float32(s), X, 1) @@ -197,15 +200,7 @@ kron(a::Number, b::Vector) = a * b kron(a::Matrix, b::Number) = a * b kron(a::Number, b::Matrix) = a * b -function randsym(n) - a = randn(n,n) - for j=1:n-1, i=j+1:n - x = (a[i,j]+a[j,i])/2 - a[i,j] = x - a[j,i] = x - end - a -end +randsym(n) = symmetrize!(randn(n,n)) ^(A::Matrix, p::Integer) = p < 0 ? inv(A^-p) : power_by_squaring(A,p) @@ -384,247 +379,279 @@ expm(x::Number) = exp(x) abstract Factorization{T} ## Create an extractor that extracts the modified original matrix, e.g. -## LD for BunchKaufman, LR for CholeskyDense, LU for LUDense and +## LD for BunchKaufman, UL for CholeskyDense, LU for LUDense and ## define size methods for Factorization types using it. type BunchKaufman{T<:BlasFloat} <: Factorization{T} LD::Matrix{T} ipiv::Vector{BlasInt} - UL::BlasChar - function BunchKaufman(A::Matrix{T}, UL::BlasChar) - LD, ipiv = LAPACK.sytrf!(UL , copy(A)) - new(LD, ipiv, UL) + uplo::BlasChar + function BunchKaufman(A::Matrix{T}, uplo::BlasChar) + LD, ipiv = LAPACK.sytrf!(uplo , copy(A)) + new(LD, ipiv, uplo) end end -BunchKaufman{T<:BlasFloat}(A::StridedMatrix{T}, UL::BlasChar) = BunchKaufman{T}(A, UL) -BunchKaufman{T<:Real}(A::StridedMatrix{T}, UL::BlasChar) = BunchKaufman(float64(A), UL) +BunchKaufman{T<:BlasFloat}(A::StridedMatrix{T}, uplo::BlasChar) = BunchKaufman{T}(A, uplo) +BunchKaufman{T<:Real}(A::StridedMatrix{T}, uplo::BlasChar) = BunchKaufman(float64(A), uplo) BunchKaufman{T<:Number}(A::StridedMatrix{T}) = BunchKaufman(A, 'U') size(B::BunchKaufman) = size(B.LD) size(B::BunchKaufman,d::Integer) = size(B.LD,d) -## need to work out how to extract the factors. -#factors(B::BunchKaufman) = LAPACK.syconv!(B.UL, copy(B.LD), B.ipiv) function inv(B::BunchKaufman) - symmetrize!(LAPACK.sytri!(B.UL, copy(B.LD), B.ipiv), B.UL) + symmetrize!(LAPACK.sytri!(B.uplo, copy(B.LD), B.ipiv), B.uplo) end \{T<:BlasFloat}(B::BunchKaufman{T}, R::StridedVecOrMat{T}) = - LAPACK.sytrs!(B.UL, B.LD, B.ipiv, copy(R)) + LAPACK.sytrs!(B.uplo, B.LD, B.ipiv, copy(R)) type CholeskyDense{T<:BlasFloat} <: Factorization{T} - LR::Matrix{T} - UL::BlasChar - function CholeskyDense(A::Matrix{T}, UL::BlasChar) - A, info = LAPACK.potrf!(UL, A) - if info != 0; throw(LAPACK.PosDefException(info)); end - if UL == 'U' - new(triu!(A), UL) - elseif UL == 'L' - new(tril!(A), UL) - else - error("Second argument UL should be 'U' or 'L'") - end + UL::Matrix{T} + uplo::Char + function CholeskyDense(A::Matrix{T}, uplo::Char) + A, info = LAPACK.potrf!(uplo, A) + if info > 0; throw(LAPACK.PosDefException(info)); end + return new(uplo == 'U' ? triu!(A) : tril!(A), uplo) end end +CholeskyDense{T<:BlasFloat}(A::Matrix{T}, uplo::Char) = CholeskyDense{T}(A, uplo) +CholeskyDense(A::Matrix, uplo::Symbol) = CholeskyDense(A, string(uplo)[1]) +CholeskyDense(A::Matrix) = CholeskyDense(A, :U) +CholeskyDense{T<:Integer}(A::Matrix{T}, args...) = CholeskyDense(float64(A), args...) -size(C::CholeskyDense) = size(C.LR) -size(C::CholeskyDense,d::Integer) = size(C.LR,d) +size(C::CholeskyDense) = size(C.UL) +size(C::CholeskyDense,d::Integer) = size(C.UL,d) -factors(C::CholeskyDense) = C.LR +function ref(C::CholeskyDense, d::Symbol) + if d == :U || d == :L + return symbol(C.uplo) == d ? C.UL : C.UL' + end + error("No such property") +end + +## Matlab (and R) compatible +chol(A::Matrix, uplo::Symbol) = CholeskyDense(copy(A), uplo)[uplo] +chol(A::Matrix) = chol(A, :U) +chol(x::Number) = imag(x) == 0 && real(x) > 0 ? sqrt(x) : error("Argument not positive-definite") \{T<:BlasFloat}(C::CholeskyDense{T}, B::StridedVecOrMat{T}) = - LAPACK.potrs!(C.UL, C.LR, copy(B)) + LAPACK.potrs!(C.uplo, C.UL, copy(B)) function det{T}(C::CholeskyDense{T}) - ff = C.LR dd = one(T) - for i in 1:size(ff,1) dd *= abs2(ff[i,i]) end + for i in 1:size(C.UL,1) dd *= abs2(C.UL[i,i]) end dd end function inv(C::CholeskyDense) - Ci, info = LAPACK.potri!(C.UL, copy(C.LR)) + Ci, info = LAPACK.potri!(C.uplo, copy(C.UL)) if info != 0; throw(LAPACK.SingularException(info)); end - symmetrize!(Ci, C.UL) + symmetrize!(Ci, C.uplo) end -## Should these functions check that the matrix is Hermitian? -cholfact!{T<:BlasFloat}(A::Matrix{T}, UL::BlasChar) = CholeskyDense{T}(A, UL) -cholfact!{T<:BlasFloat}(A::Matrix{T}) = cholfact!(A, 'U') -cholfact{T<:BlasFloat}(A::Matrix{T}, UL::BlasChar) = cholfact!(copy(A), UL) -cholfact{T<:Number}(A::Matrix{T}, UL::BlasChar) = cholfact(float64(A), UL) -cholfact{T<:Number}(A::Matrix{T}) = cholfact(A, 'U') - -## Matlab (and R) compatible -chol(A::Matrix, UL::BlasChar) = factors(cholfact(A, UL)) -chol(A::Matrix) = chol(A, 'U') -chol(x::Number) = imag(x) == 0 && real(x) > 0 ? sqrt(x) : error("Argument not positive-definite") - +## Pivoted Cholesky type CholeskyPivotedDense{T<:BlasFloat} <: Factorization{T} - LR::Matrix{T} - UL::BlasChar + UL::Matrix{T} + uplo::BlasChar piv::Vector{BlasInt} rank::BlasInt tol::Real - function CholeskyPivotedDense(A::Matrix{T}, UL::BlasChar, tol::Real) - A, piv, rank, info = LAPACK.pstrf!(UL, A, tol) - if info != 0; throw(LAPACK.RankDeficientException(info)); end - if UL == 'U' - new(triu!(A), UL, piv, rank, tol) - elseif UL == 'L' - new(tril!(A), UL, piv, rank, tol) - else - error("Second argument UL should be 'U' or 'L'") + info::BlasInt +end +function CholeskyPivotedDense{T<:BlasFloat}(A::Matrix{T}, uplo::BlasChar, tol::Real) + A, piv, rank, info = LAPACK.pstrf!(uplo, A, tol) + CholeskyPivotedDense{T}(uplo == 'U' ? triu!(A) : tril!(A), uplo, piv, rank, tol, info) +end +CholeskyPivotedDense(A::Matrix, uplo::Symbol, tol::Real) = CholeskyPivotedDense(A, string(uplo)[1], tol) +CholeskyPivotedDense(A::Matrix, tol::Real) = CholeskyPivotedDense(A, 'U', tol) +CholeskyPivotedDense(A::Matrix) = CholeskyPivotedDense(A, 'U', -1.) +CholeskyPivotedDense{T<:Int}(A::Matrix{T}, args...) = CholeskyPivotedDense(float64(A), args...) + +size(C::CholeskyPivotedDense) = size(C.UL) +size(C::CholeskyPivotedDense,d::Integer) = size(C.UL,d) + +ref(C::CholeskyPivotedDense) = C.UL, C.piv +function ref{T<:BlasFloat}(C::CholeskyPivotedDense{T}, d::Symbol) + if d == :U || d == :L + return symbol(C.uplo) == d ? C.UL : C.UL' + end + if d == :p return C.piv end + if d == :P + n = size(C, 1) + P = zeros(T, n, n) + for i in 1:n + P[C.piv[i],i] = one(T) end + return P end + error("No such property") end -size(C::CholeskyPivotedDense) = size(C.LR) -size(C::CholeskyPivotedDense,d::Integer) = size(C.LR,d) - -factors(C::CholeskyPivotedDense) = C.LR, C.piv - function \{T<:BlasFloat}(C::CholeskyPivotedDense{T}, B::StridedVector{T}) - if C.rank < size(C.LR, 1); throw(LAPACK.RankDeficientException(info)); end - LAPACK.potrs!(C.UL, C.LR, copy(B)[C.piv])[invperm(C.piv)] + if C.rank < size(C.UL, 1); throw(LAPACK.RankDeficientException(C.info)); end + LAPACK.potrs!(C.uplo, C.UL, copy(B)[C.piv])[invperm(C.piv)] end function \{T<:BlasFloat}(C::CholeskyPivotedDense{T}, B::StridedMatrix{T}) - if C.rank < size(C.LR, 1); throw(LAPACK.RankDeficientException(info)); end - LAPACK.potrs!(C.UL, C.LR, copy(B)[C.piv,:])[invperm(C.piv),:] + if C.rank < size(C.UL, 1); throw(LAPACK.RankDeficientException(C.info)); end + LAPACK.potrs!(C.uplo, C.UL, copy(B)[C.piv,:])[invperm(C.piv),:] end rank(C::CholeskyPivotedDense) = C.rank function det{T}(C::CholeskyPivotedDense{T}) - if C.rank < size(C.LR, 1) + if C.rank < size(C.UL, 1) return real(zero(T)) else - return prod(abs2(diag(C.LR))) + return prod(abs2(diag(C.UL))) end end function inv(C::CholeskyPivotedDense) - if C.rank < size(C.LR, 1) error("Matrix singular") end - Ci, info = LAPACK.potri!(C.UL, copy(C.LR)) - if info != 0 error("Matrix is singular") end + if C.rank < size(C.UL, 1) throw(LAPACK.RankDeficientException(C.info)) end + Ci, info = LAPACK.potri!(C.uplo, copy(C.UL)) + if info != 0 throw(LAPACK.RankDeficientException(info)) end ipiv = invperm(C.piv) - (symmetrize!(Ci, C.UL))[ipiv, ipiv] -end - -## Should these functions check that the matrix is Hermitian? -cholpfact!{T<:BlasFloat}(A::Matrix{T}, UL::BlasChar, tol::Real) = CholeskyPivotedDense{T}(A, UL, tol) -cholpfact!{T<:BlasFloat}(A::Matrix{T}, UL::BlasChar) = cholpfact!(A, UL, -1.) -cholpfact!{T<:BlasFloat}(A::Matrix{T}, tol::Real) = cholpfact!(A, 'U', tol) -cholpfact!{T<:BlasFloat}(A::Matrix{T}) = cholpfact!(A, 'U', -1.) -cholpfact{T<:Number}(A::Matrix{T}, UL::BlasChar, tol::Real) = cholpfact(float64(A), UL, tol) -cholpfact{T<:Number}(A::Matrix{T}, UL::BlasChar) = cholpfact(float64(A), UL, -1.) -cholpfact{T<:Number}(A::Matrix{T}, tol::Real) = cholpfact(float64(A), true, tol) -cholpfact{T<:Number}(A::Matrix{T}) = cholpfact(float64(A), 'U', -1.) -cholpfact{T<:BlasFloat}(A::Matrix{T}, UL::BlasChar, tol::Real) = cholpfact!(copy(A), UL, tol) -cholpfact{T<:BlasFloat}(A::Matrix{T}, UL::BlasChar) = cholpfact!(copy(A), UL, -1.) -cholpfact{T<:BlasFloat}(A::Matrix{T}, tol::Real) = cholpfact!(copy(A), 'U', tol) -cholpfact{T<:BlasFloat}(A::Matrix{T}) = cholpfact!(copy(A), 'U', -1.) + (symmetrize!(Ci, C.uplo))[ipiv, ipiv] +end +## LU type LUDense{T} <: Factorization{T} - lu::Matrix{T} + LU::Matrix{T} ipiv::Vector{BlasInt} info::BlasInt - function LUDense(lu::Matrix{T}, ipiv::Vector{BlasInt}, info::BlasInt) - m, n = size(lu) - m == n ? new(lu, ipiv, info) : error("LUDense only defined for square matrices") - end -end - -size(A::LUDense) = size(A.lu) -size(A::LUDense,n) = size(A.lu,n) - -function factors{T}(lu::LUDense{T}) - LU, ipiv = lu.lu, lu.ipiv - m, n = size(LU) - - L = m >= n ? tril(LU, -1) + eye(T,m,n) : tril(LU, -1)[:, 1:m] + eye(T,m) - U = m <= n ? triu(LU) : triu(LU)[1:n, :] - P = [1:m] - for i = 1:min(m,n) - t = P[i] - P[i] = P[ipiv[i]] - P[ipiv[i]] = t + function LUDense(LU::Matrix{T}, ipiv::Vector{BlasInt}, info::BlasInt) + m, n = size(LU) + m == n ? new(LU, ipiv, info) : throw(LAPACK.DimensionMismatch("LUDense only defined for square matrices")) + end +end +function LUDense{T<:BlasFloat}(A::Matrix{T}) + LU, ipiv, info = LAPACK.getrf!(A) + LUDense{T}(LU, ipiv, info) +end +LUDense{T<:Real}(A::Matrix{T}) = LUDense(float(A)) + +size(A::LUDense) = size(A.LU) +size(A::LUDense,n) = size(A.LU,n) + +function ref{T}(A::LUDense{T}, d::Symbol) + if d == :L; return tril(A.LU, -1) + eye(T, size(A, 1)); end; + if d == :U; return triu(A.LU); end; + if d == :p + n = size(A, 1) + p = [1:n] + for i in 1:n + tmp = p[i] + p[i] = p[A.ipiv[i]] + p[A.ipiv[i]] = tmp + end + return p + end + if d == :P + p = A[:p] + n = length(p) + P = zeros(T, n, n) + for i in 1:n + P[i,p[i]] = one(T) + end + return P end - L, U, P -end - -function lufact!{T<:BlasFloat}(A::Matrix{T}) - lu, ipiv, info = LAPACK.getrf!(A) - LUDense{T}(lu, ipiv, info) + error("No such property") end -lufact{T<:BlasFloat}(A::Matrix{T}) = lufact!(copy(A)) -lufact{T<:Number}(A::Matrix{T}) = lufact(float64(A)) - ## Matlab-compatible -lu{T<:Number}(A::Matrix{T}) = factors(lufact(A)) +function lu(A::Matrix) + LU = LUDense(copy(A)) + return LU[:L], LU[:U], LU[:p] +end lu(x::Number) = (one(x), x, [1]) -function det{T}(lu::LUDense{T}) - m, n = size(lu) - if lu.info > 0; return zero(typeof(lu.lu[1])); end - prod(diag(lu.lu)) * (bool(sum(lu.ipiv .!= 1:n) % 2) ? -one(T) : one(T)) +function det{T}(A::LUDense{T}) + m, n = size(A) + if A.info > 0; return zero(typeof(A.LU[1])); end + prod(diag(A.LU)) * (bool(sum(A.ipiv .!= 1:n) % 2) ? -one(T) : one(T)) end -function (\){T<:BlasFloat}(lu::LUDense{T}, B::StridedVecOrMat{T}) - if lu.info > 0; throw(LAPACK.SingularException(info)); end - LAPACK.getrs!('N', lu.lu, lu.ipiv, copy(B)) +function (\)(A::LUDense, B::StridedVecOrMat) + if A.info > 0; throw(LAPACK.SingularException(A.info)); end + LAPACK.getrs!('N', A.LU, A.ipiv, copy(B)) end -function inv{T<:BlasFloat}(lu::LUDense{T}) - m, n = size(lu.lu) - if m != n; error("inv only defined for square matrices"); end - if lu.info > 0; return throw(LAPACK.SingularException(info)); end - LAPACK.getri!(copy(lu.lu), lu.ipiv) +function inv(A::LUDense) + if A.info > 0; return throw(LAPACK.SingularException(A.info)); end + LAPACK.getri!(copy(A.LU), A.ipiv) end ## QR decomposition without column pivots type QRDense{T} <: Factorization{T} hh::Matrix{T} # Householder transformations and R tau::Vector{T} # Scalar factors of transformations - function QRDense(hh::Matrix{T}, tau::Vector{T}) - length(tau) == min(size(hh)) ? new(hh, tau) : error("QR: mismatched dimensions") - end end -size(A::QRDense) = size(A.hh) -size(A::QRDense,n) = size(A.hh,n) +QRDense(A::StridedMatrix) = QRDense(LAPACK.geqrf!(A)...) +QRDense{T<:Integer}(A::StridedMatrix{T}) = QRDense(float(A)) + +type QRDenseQ{T} <: AbstractMatrix{T} + hh::Matrix{T} # Householder transformations and R + tau::Vector{T} # Scalar factors of transformations +end +QRDenseQ(A::QRDense) = QRDenseQ(A.hh, A.tau) -qrfact!{T<:BlasFloat}(A::StridedMatrix{T}) = QRDense{T}(LAPACK.geqrf!(A)...) -qrfact{T<:BlasFloat}(A::StridedMatrix{T}) = qrfact!(copy(A)) -qrfact{T<:Real}(A::StridedMatrix{T}) = qrfact(float64(A)) +size(A::QRDense, args::Integer...) = size(A.hh, args...) +size(A::QRDenseQ, args::Integer...) = size(A.hh, args...) -function factors{T<:BlasFloat}(qrfact::QRDense{T}) - aa = copy(qrfact.hh) - R = triu(aa[1:min(size(aa)),:]) # must be *before* call to orgqr! - LAPACK.orgqr!(aa, qrfact.tau, size(aa,2)), R +function ref(A::QRDense, d::Symbol) + if d == :R; return triu(A.hh[1:min(size(A)),:]); end; + if d == :Q; return QRDenseQ(A); end + error("No such property") end +function full{T<:BlasFloat}(A::QRDenseQ{T}, thin::Bool) + if !thin + Q = Array(T, size(A, 1), size(A, 1)) + Q[:,1:size(A, 2)] = copy(A.hh) + return LAPACK.orgqr!(Q, A.tau) + else + return LAPACK.orgqr!(copy(A.hh), A.tau) + end +end +full(A::QRDenseQ) = full(A, true) -qr{T<:Number}(x::StridedMatrix{T}) = factors(qrfact(x)) +function qr(A::StridedMatrix) + QR = QRDense(copy(A)) + return full(QR[:Q]), QR[:R] +end qr(x::Number) = (one(x), x) ## Multiplication by Q from the QR decomposition -qmulQR{T<:BlasFloat}(A::QRDense{T}, B::StridedVecOrMat{T}) = - LAPACK.ormqr!('L', 'N', A.hh, size(A.hh,2), A.tau, copy(B)) - -## Multiplication by Q' from the QR decomposition -qTmulQR{T<:BlasFloat}(A::QRDense{T}, B::StridedVecOrMat{T}) = - LAPACK.ormqr!('L', iscomplex(A.tau)?'C':'T', A.hh, size(A.hh,2), A.tau, copy(B)) - -## Least squares solution. Should be more careful about cases with m < n -function (\){T<:BlasFloat}(A::QRDense{T}, B::StridedVecOrMat{T}) - n = length(A.tau) - ans, info = LAPACK.trtrs!('U','N','N',A.hh[1:n,:],(qTmulQR(A,B))[1:n,:]) - if info > 0; throw(LAPACK.SingularException(info)); end - return ans +function *{T<:BlasFloat}(A::QRDenseQ{T}, B::StridedVecOrMat{T}) + m = size(B, 1) + n = size(B, 2) + if m == size(A.hh, 1) + Bc = copy(B) + elseif m == size(A.hh, 2) + Bc = [B; zeros(T, size(A.hh, 1) - m, n)] + else + throw(LAPACK.DimensionMismatch("")) + end + LAPACK.ormqr!('L', 'N', A.hh, A.tau, Bc) +end +Ac_mul_B(A::QRDenseQ, B::StridedVecOrMat) = LAPACK.ormqr!('L', iscomplex(A.hh[1]) ? 'C' : 'T', A.hh, A.tau, copy(B)) +*(A::StridedVecOrMat, B::QRDenseQ) = LAPACK.ormqr!('R', 'N', B.hh, B.tau, copy(A)) +function A_mul_Bc{T<:BlasFloat}(A::StridedVecOrMat{T}, B::QRDenseQ{T}) + m = size(A, 1) + n = size(A, 2) + if n == size(B.hh, 1) + Ac = copy(A) + elseif n == size(B.hh, 2) + Ac = [B zeros(T, m, size(B.hh, 1) - n)] + else + throw(LAPACK.DimensionMismatch("")) + end + LAPACK.ormqr!('R', iscomplex(B.hh[1]) ? 'C' : 'T', B.hh, B.tau, Ac) end +## Least squares solution. Should be more careful about cases with m < n +(\)(A::QRDense, B::StridedVector) = A[:R]\(A[:Q]'B)[1:size(A, 2)] +(\)(A::QRDense, B::StridedMatrix) = A[:R]\(A[:Q]'B)[1:size(A, 2),:] type QRPivotedDense{T} <: Factorization{T} hh::Matrix{T} @@ -633,39 +660,34 @@ type QRPivotedDense{T} <: Factorization{T} function QRPivotedDense(hh::Matrix{T}, tau::Vector{T}, jpvt::Vector{BlasInt}) m, n = size(hh) if length(tau) != min(m,n) || length(jpvt) != n - error("QRPivotedDense: mismatched dimensions") + throw(LAPACK.DimensionMismatch("")) end new(hh,tau,jpvt) end end -size(x::QRPivotedDense) = size(x.hh) -size(x::QRPivotedDense,d) = size(x.hh,d) -## Multiplication by Q from the QR decomposition -qmulQR{T<:BlasFloat}(A::QRPivotedDense{T}, B::StridedVecOrMat{T}) = - LAPACK.ormqr!('L', 'N', A.hh, size(A,2), A.tau, copy(B)) -## Multiplication by Q' from the QR decomposition -qTmulQR{T<:BlasFloat}(A::QRPivotedDense{T}, B::StridedVecOrMat{T}) = - LAPACK.ormqr!('L', iscomplex(A.tau)?'C':'T', A.hh, size(A,2), A.tau, copy(B)) +QRPivotedDense{T<:BlasFloat}(A::Matrix{T}) = QRPivotedDense{T}(LAPACK.geqp3!(A)...) +QRDenseQ(A::QRPivotedDense) = QRDenseQ(A.hh, A.tau) -qrpfact!{T<:BlasFloat}(A::StridedMatrix{T}) = QRPivotedDense{T}(LAPACK.geqp3!(A)...) -qrpfact{T<:BlasFloat}(A::StridedMatrix{T}) = qrpfact!(copy(A)) -qrpfact{T<:Real}(x::StridedMatrix{T}) = qrpfact(float64(x)) +size(A::QRPivotedDense, args::Integer...) = size(A.hh, args...) -function factors{T<:BlasFloat}(x::QRPivotedDense{T}) - aa = copy(x.hh) - R = triu(aa[1:min(size(aa)),:]) - LAPACK.orgqr!(aa, x.tau, size(aa,2)), R, x.jpvt +function ref{T<:BlasFloat}(A::QRPivotedDense{T}, d::Symbol) + if d == :R; return triu(A.hh[1:min(size(A)),:]); end; + if d == :Q; return QRDenseQ(A); end + if d == :p; return A.jpvt; end + if d == :P + p = A[:p] + n = length(p) + P = zeros(T, n, n) + for i in 1:n + P[p[i],i] = one(T) + end + return P + end + error("No such property") end -qrp{T<:BlasFloat}(x::StridedMatrix{T}) = factors(qrpfact(x)) -qrp{T<:Real}(x::StridedMatrix{T}) = qrp(float64(x)) - -function (\){T<:BlasFloat}(A::QRPivotedDense{T}, B::StridedVecOrMat{T}) - n = length(A.tau) - x, info = LAPACK.trtrs!('U','N','N',A.hh[1:n,:],(qTmulQR(A,B))[1:n,:]) - if info > 0; throw(LAPACK.SingularException(info)); end - isa(B, Vector) ? x[invperm(A.jpvt)] : x[:,invperm(A.jpvt)] -end +(\)(A::QRPivotedDense, B::StridedVector) = (A[:R]\(A[:Q]'B)[1:size(A, 2)])[invperm(A.jpvt)] +(\)(A::QRPivotedDense, B::StridedMatrix) = A[:R]\(A[:Q]'B)[1:size(A, 2),:][invperm(A.jpvt),:] ##TODO: Add methods for rank(A::QRP{T}) and adjust the (\) method accordingly ## Add rcond methods for Cholesky, LU, QR and QRP types @@ -673,169 +695,194 @@ end # FIXME! Should add balancing option through xgebal type Hessenberg{T} <: Factorization{T} - H::Matrix{T} + hh::Matrix{T} tau::Vector{T} - ilo::Int - ihi::Int -end -function hessfact(A::StridedMatrix) - tmp = LAPACK.gehrd!(copy(A)) - return Hessenberg(tmp[1], tmp[2], 1, size(A, 1)) -end -function factors(H::Hessenberg) - A = copy(H.H) - n = size(A, 1) - for j = 1:n-2 - for i = j+2:n - A[i,j] = zero(A[1]) - end + function Hessenberg(hh::Matrix{T}, tau::Vector{T}) + if size(hh, 1) != size(hh, 2) throw(LAPACK.DimensionMismatch("")) end + return new(hh, tau) end - return (A, LAPACK.orghr!(BLAS.blas_int(H.ilo), BLAS.blas_int(H.ihi), H.H, H.tau)) end -hess(A::StridedMatrix) = factors(hessfact(A))[1] +Hessenberg{T<:BlasFloat}(hh::Matrix{T}, tau::Vector{T}) = Hessenberg{T}(hh, tau) +Hessenberg(A::StridedMatrix) = Hessenberg(LAPACK.gehrd!(A)...) + +type HessenbergQ{T} <: AbstractMatrix{T} + hh::Matrix{T} + tau::Vector{T} +end +HessenbergQ(A::Hessenberg) = HessenbergQ(A.hh, A.tau) +size(A::HessenbergQ, args...) = size(A.hh, args...) +ref(A::HessenbergQ, args...) = ref(full(A), args...) + +function ref(A::Hessenberg, d::Symbol) + if d == :Q; return HessenbergQ(A); end + if d == :H; return triu(A.hh, -1); end + error("No such property") +end + +full(A::HessenbergQ) = LAPACK.orghr!(1, size(A.hh, 1), copy(A.hh), A.tau) + +hess(A::StridedMatrix) = Hessenberg(copy(A))[:H] ### Linear algebra for general matrices function det(A::Matrix) m, n = size(A) - if m != n; error("det only defined for square matrices"); end - if istriu(A) | istril(A); return prod(diag(A)); end - return det(lufact(A)) + if m != n; throw(LAPACK.DimensionMismatch("det only defined for square matrices")); end + if istriu(A) | istril(A); return det(Triangular(A, 'U', false)); end + return det(LUDense(copy(A))) end det(x::Number) = x -logdet(A::Matrix) = 2.0 * sum(log(diag(chol(A)))) +logdet(A::Matrix) = 2.0 * sum(log(diag(chol(A)[:U]))) -function eig{T<:BlasFloat}(A::StridedMatrix{T}, vecs::Bool) - n = size(A, 2) - if n == 0; return vecs ? (zeros(T, 0), zeros(T, 0, 0)) : zeros(T, 0, 0); end +function inv(A::StridedMatrix) + if istriu(A) return inv(Triangular(A, 'U')) end + if istril(A) return inv(Triangular(A, 'L')) end + if ishermitian(A) return inv(Hermitian(A)) end + return inv(LUDense(copy(A))) +end - if ishermitian(A) - if vecs - Z = similar(A) - W = LAPACK.syevr!(copy(A), Z) - return W, Z +function eig{T<:BlasFloat}(A::StridedMatrix{T}) + n = size(A, 2) + if n == 0; return (zeros(T, 0), zeros(T, 0, 0)) end + if ishermitian(A) return eig(Hermitian(A)) end + if iscomplex(A) return LAPACK.geev!('N', 'V', copy(A))[[1,3]] end + + WR, WI, VL, VR = LAPACK.geev!('N', 'V', copy(A)) + if all(WI .== 0.) return WR, VR end + evec = complex(zeros(T, n, n)) + j = 1 + while j <= n + if WI[j] == 0.0 + evec[:,j] = VR[:,j] else - W = LAPACK.syevr!(copy(A)) - return W + evec[:,j] = VR[:,j] + im*VR[:,j+1] + evec[:,j+1] = VR[:,j] - im*VR[:,j+1] + j += 1 end + j += 1 end + return complex(WR, WI), evec +end - if iscomplex(A) - W, VR = LAPACK.geev!('N', vecs ? 'V' : 'N', copy(A))[2:3] - if vecs; return W, VR; end - return W - end +eig{T<:Integer}(x::StridedMatrix{T}) = eig(float64(x)) +eig(x::Number) = (x, one(x)) - VL, WR, WI, VR = LAPACK.geev!('N', vecs ? 'V' : 'N', copy(A)) - if all(WI .== 0.) - if vecs; return WR, VR; end - return WR - end - if vecs - evec = complex(zeros(T, n, n)) - j = 1 - while j <= n - if WI[j] == 0.0 - evec[:,j] = VR[:,j] - else - evec[:,j] = VR[:,j] + im*VR[:,j+1] - evec[:,j+1] = VR[:,j] - im*VR[:,j+1] - j += 1 - end - j += 1 - end - return complex(WR, WI), evec - end - complex(WR, WI) +function eigvals(A::StridedMatrix) + if ishermitian(A) return eigvals(Hermitian(A)) end + if iscomplex(A) return LAPACK.geev!('N', 'N', copy(A))[1] end + valsre, valsim, _, _ = LAPACK.geev!('N', 'N', copy(A)) + if all(valsim .== 0) return valsre end + return complex(valsre, valsim) end -eig{T<:Integer}(x::StridedMatrix{T}, vecs::Bool) = eig(float64(x), vecs) -eig(x::Number, vecs::Bool) = vecs ? (x, one(x)) : x -eig(x) = eig(x, true) -eigvals(x) = eig(x, false) +eigvals(x::Number) = 1.0 # SVD type SVDDense{T,Tr} <: Factorization{T} U::Matrix{T} S::Vector{Tr} - V::Matrix{T} + Vt::Matrix{T} end - -factors(F::SVDDense) = (F.U, F.S, F.V) - -function svdfact!{T<:BlasFloat}(A::StridedMatrix{T}, thin::Bool) +function SVDDense(A::StridedMatrix, thin::Bool) m,n = size(A) if m == 0 || n == 0 - u,s,v = (eye(m, thin ? n : m), zeros(0), eye(n,n)) + u,s,vt = (eye(m, thin ? n : m), zeros(0), eye(n,n)) else - u,s,v = LAPACK.gesdd!(thin ? 'S' : 'A', A) + u,s,vt = LAPACK.gesdd!(thin ? 'S' : 'A', A) end - return SVDDense(u,s,v) + return SVDDense(u,s,vt) end +SVDDense(A::StridedMatrix) = SVDDense(A, false) -svdfact!(A::StridedMatrix) = svdfact(A, false) - -svdfact(A::StridedMatrix, thin::Bool) = svdfact!(copy(A), thin) -svdfact(A::StridedMatrix) = svdfact(A, false) +function ref(F::SVDDense, d::Symbol) + if d == :U return F.U end + if d == :S return F.S end + if d == :Vt return F.Vt end + if d == :V return F.Vt' end + error("No such property") +end -function svdvals!(A::StridedMatrix) +function svdvals!{T<:BlasFloat}(A::StridedMatrix{T}) m,n = size(A) - if m == 0 || n == 0 - return (zeros(T, 0, 0), zeros(T, 0), zeros(T, 0, 0)) - end - U, S, V = LAPACK.gesdd!('N', A) - return S + if m == 0 || n == 0 return zeros(T, 0) end + return LAPACK.gesdd!('N', A)[2] end svdvals(A) = svdvals!(copy(A)) -svdt(A::StridedMatrix, thin::Bool) = factors(svdfact(A, thin)) -svdt(A::StridedMatrix) = svdt(A, false) -svdt(x::Number, thin::Bool) = (x==0?one(x):x/abs(x),abs(x),one(x)) - function svd(A::StridedMatrix, thin::Bool) - u,s,v = factors(svdfact(A, thin)) - return (u,s,v') + SVD = SVDDense(copy(A), thin) + return SVD[:U], SVD[:S], SVD[:V] end - svd(A::StridedMatrix) = svd(A, false) svd(x::Number, thin::Bool) = (x==0?one(x):x/abs(x),abs(x),one(x)) +# SVD least squares +function \{T<:BlasFloat}(A::SVDDense{T}, B::StridedVecOrMat{T}) + n = length(A[:S]) + Sinv = zeros(T, n) + Sinv[A[:S] .> sqrt(eps())] = 1.0 ./ A[:S] + return diagmm(A[:V], Sinv) * A[:U][:,1:n]'B +end # Generalized svd type GSVDDense{T} <: Factorization{T} U::Matrix{T} V::Matrix{T} Q::Matrix{T} - a::Vector #{eltype(real(one(T)))} - b::Vector #{eltype(real(one(T)))} + a::Vector + b::Vector k::Int l::Int R::Matrix{T} end -function svdfact(A::StridedMatrix, B::StridedMatrix) - U, V, Q, a, b, k, l, R = LAPACK.ggsvd!('U', 'V', 'Q', copy(A), copy(B)) +function GSVDDense(A::StridedMatrix, B::StridedMatrix) + U, V, Q, a, b, k, l, R = LAPACK.ggsvd!('U', 'V', 'Q', A, B) return GSVDDense(U, V, Q, a, b, int(k), int(l), R) end -svd(A::StridedMatrix, B::StridedMatrix) = factors(svdfact(A, B)) +function svd(A::StridedMatrix, B::StridedMatrix) + G = GSVDDense(copy(A), copy(B)) + return G[:U], G[:V], G[:Q], G[:D1], G[:D2], G[:R0] +end -function factors{T}(obj::GSVDDense{T}) - m = size(obj.U, 1) - p = size(obj.V, 1) - n = size(obj.Q, 1) - if m - obj.k - obj.l >= 0 - D1 = [eye(T, obj.k) zeros(T, obj.k, obj.l); zeros(T, obj.l, obj.k) diagm(obj.a[obj.k + 1:obj.k + obj.l]); zeros(T, m - obj.k - obj.l, obj.k + obj.l)] - D2 = [zeros(T, obj.l, obj.k) diagm(obj.b[obj.k + 1:obj.k + obj.l]); zeros(T, p - obj.l, obj.k + obj.l)] - R0 = [zeros(T, obj.k + obj.l, n - obj.k - obj.l) obj.R] - else - D1 = [eye(T, m, obj.k) [zeros(T, obj.k, m - obj.k); diagm(obj.a[obj.k + 1:m])] zeros(T, m, obj.k + obj.l - m)] - D2 = [zeros(T, p, obj.k) [diagm(obj.b[obj.k + 1:m]); zeros(T, obj.k + p - m, m - obj.k)] [zeros(T, m - obj.k, obj.k + obj.l - m); eye(T, obj.k + p - m, obj.k + obj.l - m)]] - R0 = [zeros(T, obj.k + obj.l, n - obj.k - obj.l) obj.R] +function ref{T}(obj::GSVDDense{T}, d::Symbol) + if d == :U return obj.U end + if d == :V return obj.V end + if d == :Q return obj.Q end + if d == :alpha || d == :a return obj.a end + if d == :beta || d == :b return obj.b end + if d == :vals || d == :S return obj.a[1:obj.k + obj.l] ./ obj.b[1:obj.k + obj.l] end + if d == :D1 + m = size(obj.U, 1) + if m - obj.k - obj.l >= 0 + return [eye(T, obj.k) zeros(T, obj.k, obj.l); zeros(T, obj.l, obj.k) diagm(obj.a[obj.k + 1:obj.k + obj.l]); zeros(T, m - obj.k - obj.l, obj.k + obj.l)] + else + return [eye(T, m, obj.k) [zeros(T, obj.k, m - obj.k); diagm(obj.a[obj.k + 1:m])] zeros(T, m, obj.k + obj.l - m)] + end end - return obj.U, obj.V, obj.Q, D1, D2, R0 + if d == :D2 + m = size(obj.U, 1) + p = size(obj.V, 1) + if m - obj.k - obj.l >= 0 + return [zeros(T, obj.l, obj.k) diagm(obj.b[obj.k + 1:obj.k + obj.l]); zeros(T, p - obj.l, obj.k + obj.l)] + else + return [zeros(T, p, obj.k) [diagm(obj.b[obj.k + 1:m]); zeros(T, obj.k + p - m, m - obj.k)] [zeros(T, m - obj.k, obj.k + obj.l - m); eye(T, obj.k + p - m, obj.k + obj.l - m)]] + end + end + if d == :R return obj.R end + if d == :R0 + m = size(obj.U, 1) + n = size(obj.Q, 1) + if m - obj.k - obj.l >= 0 + return [zeros(T, obj.k + obj.l, n - obj.k - obj.l) obj.R] + else + return [zeros(T, obj.k + obj.l, n - obj.k - obj.l) obj.R] + end + end + error("No such property") end function svdvals(A::StridedMatrix, B::StridedMatrix) @@ -877,47 +924,30 @@ function sqrtm(A::StridedMatrix, cond::Bool) R[i,j] = r / (R[i,i] + R[j,j]) end end - end - retmat = Q*R*Q' - if cond - alpha = norm(R)^2/norm(T) - return (all(imag(retmat) .== 0) ? real(retmat) : retmat), alpha - else - return (all(imag(retmat) .== 0) ? real(retmat) : retmat) + R[i,j] = (T[i,j] - r) / (R[i,i] + R[j,j]) end end + retmat = Q*R*Q' + if cond + alpha = norm(R)^2/norm(T) + return (all(imag(retmat) .== 0) ? real(retmat) : retmat), alpha + else + return (all(imag(retmat) .== 0) ? real(retmat) : retmat) + end end + sqrtm{T<:Integer}(A::StridedMatrix{T}, cond::Bool) = sqrtm(float(A), cond) sqrtm{T<:Integer}(A::StridedMatrix{ComplexPair{T}}, cond::Bool) = sqrtm(complex128(A), cond) sqrtm(A::StridedMatrix) = sqrtm(A, false) sqrtm(a::Number) = isreal(a) ? (b = sqrt(complex(a)); imag(b) == 0 ? real(b) : b) : sqrt(a) function (\){T<:BlasFloat}(A::StridedMatrix{T}, B::StridedVecOrMat{T}) - Acopy = copy(A) - m, n = size(Acopy) - X = copy(B) - - if m == n # Square - if istriu(A) - ans, info = LAPACK.trtrs!('U', 'N', 'N', Acopy, X) - if info > 0; throw(LAPACK.SingularException(info)); end - return ans - end - if istril(A) - ans, info = LAPACK.trtrs!('L', 'N', 'N', Acopy, X) - if info > 0; throw(LAPACK.SingularException(info)); end - return ans - end - if ishermitian(A) - ans, _, _, info = LAPACK.sysv!('U', Acopy, X) - if info > 0; throw(LAPACK.SingularException(info)); end - return ans - end - ans, _, _, info = LAPACK.gesv!(Acopy, X) - if info > 0; throw(LAPACK.SingularException(info)); end - return ans + if size(A, 1) == size(A, 2) # Square + if istriu(A) return Triangular(A, 'U')\B end + if istril(A) return Triangular(A, 'L')\B end + if ishermitian(A) return Hermitian(A)\B end end - LAPACK.gelsd!(Acopy, X)[1] + LAPACK.gelsd!(copy(A), copy(B))[1] end (\){T1<:BlasFloat, T2<:BlasFloat}(A::StridedMatrix{T1}, B::StridedVecOrMat{T2}) = @@ -931,11 +961,11 @@ end ## Moore-Penrose inverse function pinv{T<:BlasFloat}(A::StridedMatrix{T}) - u,s,vt = svdt(A, true) - sinv = zeros(T, length(s)) - index = s .> eps(real(one(T)))*max(size(A))*max(s) - sinv[index] = 1 ./ s[index] - vt'diagmm(sinv, u') + SVD = SVDDense(copy(A), true) + Sinv = zeros(T, length(SVD[:S])) + index = SVD[:S] .> eps(real(one(T)))*max(size(A))*max(SVD[:S]) + Sinv[index] = 1.0 ./ SVD[:S][index] + SVD[:Vt]'diagmm(Sinv, SVD[:U]') end pinv{T<:Integer}(A::StridedMatrix{T}) = pinv(float(A)) pinv(a::StridedVector) = pinv(reshape(a, length(a), 1)) @@ -944,10 +974,10 @@ pinv(x::Number) = one(x)/x ## Basis for null space function null{T<:BlasFloat}(A::StridedMatrix{T}) m,n = size(A) - _,s,vt = svdt(A) + SVD = SVDDense(copy(A)) if m == 0; return eye(T, n); end - indstart = sum(s .> max(m,n)*max(s)*eps(eltype(s))) + 1 - vt[indstart:,:]' + indstart = sum(SVD[:S] .> max(m,n)*max(SVD[:S])*eps(eltype(SVD[:S]))) + 1 + SVD[:V][:,indstart:] end null{T<:Integer}(A::StridedMatrix{T}) = null(float(A)) null(a::StridedVector) = null(reshape(a, length(a), 1)) @@ -960,7 +990,7 @@ function cond(A::StridedMatrix, p) elseif p == 1 || p == Inf m, n = size(A) if m != n; error("Use 2-norm for non-square matrices"); end - cnd = 1 / LAPACK.gecon!(p == 1 ? '1' : 'I', lufact(A).lu, norm(A, p)) + cnd = 1 / LAPACK.gecon!(p == 1 ? '1' : 'I', LUDense(copy(A)).LU, norm(A, p)) else error("Norm type must be 1, 2 or Inf") end @@ -970,7 +1000,7 @@ cond(A::StridedMatrix) = cond(A, 2) #### Specialized matrix types #### -## Symmetric tridiagonal matrices +## Hermitian tridiagonal matrices type SymTridiagonal{T<:BlasFloat} <: AbstractMatrix{T} dv::Vector{T} # diagonal ev::Vector{T} # sub/super diagonal @@ -1013,11 +1043,12 @@ function show(io::IO, S::SymTridiagonal) end size(m::SymTridiagonal) = (length(m.dv), length(m.dv)) -size(m::SymTridiagonal,d::Integer) = d<1 ? error("dimension out of range") : (d<2 ? length(m.dv) : 1) +size(m::SymTridiagonal, d::Integer) = d<1 ? error("dimension out of range") : (d<2 ? length(m.dv) : 1) -eig(m::SymTridiagonal, vecs::Bool) = LAPACK.stev!(vecs ? 'V' : 'N', copy(m.dv), copy(m.ev)) -eig(m::SymTridiagonal) = eig(m::SymTridiagonal, true) -eigvals(m::SymTridiagonal) = eig(m::SymTridiagonal, false)[1] +eig(m::SymTridiagonal) = LAPACK.stegr!('V', copy(m.dv), copy(m.ev)) +eigvals(m::SymTridiagonal, il::Int, ih::Int) = LAPACK.stebz!('I', 'E', 0.0, 0.0, il, iu, -1.0, copy(m.dv), copy(m.ev))[1] +eigvals(m::SymTridiagonal, vl::Int, iv::Int) = LAPACK.stebz!('V', 'E', vl, vh, 0, 0, -1.0, copy(m.dv), copy(m.ev))[1] +eigvals(m::SymTridiagonal) = eigvals(m, 1, size(m, 1)) ## Tridiagonal matrices ## type Tridiagonal{T} <: AbstractMatrix{T} @@ -1050,6 +1081,8 @@ function Tridiagonal{Tl<:Number, Td<:Number, Tu<:Number}(dl::Vector{Tl}, d::Vect Tridiagonal(convert(Vector{R}, dl), convert(Vector{R}, d), convert(Vector{R}, du)) end +copy(A::Tridiagonal) = Tridiagonal(copy(A.dl), copy(A.d), copy(A.du)) + size(M::Tridiagonal) = (length(M.d), length(M.d)) function show(io::IO, M::Tridiagonal) println(io, summary(M), ":") @@ -1258,19 +1291,16 @@ type LUTridiagonal{T} <: Factorization{T} new(dl, d, du, du2, ipiv) end end +LUTridiagonal{T}(A::Tridiagonal{T}) = LUTridiagonal{T}(LAPACK.gttrf!(A.dl,A.d,A.du)...) #show(io, lu::LUTridiagonal) = print(io, "LU decomposition of ", summary(lu.lu)) -lufact!{T}(A::Tridiagonal{T}) = LUTridiagonal{T}(LAPACK.gttrf!(A.dl,A.d,A.du)...) -lufact{T}(A::Tridiagonal{T}) = LUTridiagonal{T}(LAPACK.gttrf!(copy(A.dl),copy(A.d),copy(A.du))...) -lu(A::Tridiagonal) = factors(lufact(A)) - function det{T}(lu::LUTridiagonal{T}) n = length(lu.d) prod(lu.d) * (bool(sum(lu.ipiv .!= 1:n) % 2) ? -one(T) : one(T)) end -det(A::Tridiagonal) = det(lufact(A)) +det(A::Tridiagonal) = det(LUTridiagonal(copy(A))) (\){T<:BlasFloat}(lu::LUTridiagonal{T}, B::StridedVecOrMat{T}) = LAPACK.gttrs!('N', lu.dl, lu.d, lu.du, lu.du2, lu.ipiv, copy(B)) @@ -1392,3 +1422,92 @@ function solve(W::Woodbury, B::StridedMatrix) X = similar(B) solve(X, W, B) end + +### Special types used for dispatch +## Triangular +type Triangular{T<:BlasFloat} <: AbstractMatrix{T} + UL::Matrix{T} + uplo::Char + unitdiag::Char + function Triangular(A::Matrix{T}, uplo::Char, unitdiag::Char) + if size(A, 1) != size(A, 2) throw(LAPACK.DimensionMismatch("Matrix must be square")) end + return new(A, uplo, unitdiag) + end +end +Triangular{T<:BlasFloat}(A::Matrix{T}, uplo::Char, unitdiag::Char) = Triangular{T}(A, uplo, unitdiag) +Triangular(A::Matrix, uplo::Char, unitdiag::Bool) = Triangular(A, uplo, unitdiag ? 'U' : 'N') +Triangular(A::Matrix, uplo::Char) = Triangular(A, uplo, all(diag(A) .== 1) ? true : false) +function Triangular(A::Matrix) + if istriu(A) return Triangular(A, 'U') end + if istril(A) return Triangular(A, 'L') end + error("Matrix is not triangular") +end + +istril(A::Triangular) = A.uplo == 'L' +istriu(A::Triangular) = A.uplo == 'U' + +function \(A::Triangular, B::StridedVecOrMat) + r, info = LAPACK.trtrs!(A.uplo, 'N', A.unitdiag, A.UL, copy(B)) + if info > 0 throw(LAPACK.SingularException(info)) end + return r +end +function Ac_ldiv_B{T<:Union(Float64, Float32)}(A::Triangular{T}, B::StridedVecOrMat{T}) + r, info = LAPACK.trtrs!(A.uplo, 'T', A.unitdiag, A.UL, copy(B)) + if info > 0 throw(LAPACK.SingularException(info)) end + return r +end +function Ac_ldiv_B{T<:Union(Complex128, Complex64)}(A::Triangular{T}, B::StridedVecOrMat{T}) + r, info = LAPACK.trtrs!(A.uplo, 'C', A.unitdiag, A.UL, copy(B)) + if info > 0 throw(LAPACK.SingularException(info)) end + return r +end + +det(A::Triangular) = prod(diag(A.UL)) + +inv(A::Triangular) = LAPACK.trtri!(A.uplo, A.unitdiag, copy(A.UL))[1] + +## Hermitian +type Hermitian{T<:BlasFloat} <: AbstractMatrix{T} + S::Matrix{T} + uplo::Char + function Hermitian(S::Matrix{T}, uplo::Char) + if size(S, 1) != size(S, 2) throw(LAPACK.DimensionMismatch("Matrix must be square")); end + return new(S, uplo) + end +end +Hermitian{T<:BlasFloat}(S::Matrix{T}, uplo::Char) = Hermitian{T}(S, uplo) +Hermitian(A::StridedMatrix) = Hermitian(A, 'U') + +size(A::Hermitian, args...) = size(A.S, args...) +ishermitian(A::Hermitian) = true +issym{T<:Union(Float64, Float32)}(A::Hermitian{T}) = true + +function \(A::Hermitian, B::StridedVecOrMat) + r, _, _, info = LAPACK.sysv!(A.uplo, copy(A.S), copy(B)) + if info > 0 throw(LAPACK.SingularException(info)) end + return r +end + +inv(A::Hermitian) = inv(BunchKaufman(copy(A.S), A.uplo)) + +eig(A::Hermitian) = LAPACK.syevr!('V', 'A', A.uplo, copy(A.S), 0.0, 0.0, 0, 0, -1.0) +eigvals(A::Hermitian, il::Int, ih::Int) = LAPACK.syevr!('N', 'I', A.uplo, copy(A.S), 0.0, 0.0, il, ih, -1.0)[1] +eigvals(A::Hermitian, vl::Real, vh::Real) = LAPACK.syevr!('N', 'V', A.uplo, copy(A.S), vl, vh, 0, 0, -1.0)[1] +eigvals(A::Hermitian) = eigvals(A, 1, size(A, 1)) +eigmax(A::Hermitian) = eigvals(A, size(A, 1), size(A, 1))[1] + +function sqrtm(A::Hermitian, cond::Bool) + v, z = eig(A) + vsqrt = sqrt(complex(v)) + if all(imag(vsqrt) .== 0) + retmat = symmetrize!(diagmm(z, real(vsqrt)) * z') + else + zc = complex(z) + retmat = symmetrize!(diagmm(zc, vsqrt) * zc') + end + if cond + return retmat, norm(vsqrt, Inf)^2/norm(v, Inf) + else + return retmat + end +end diff --git a/extras/image.jl b/extras/image.jl index f609a3d153661..a19f1f1519dfa 100644 --- a/extras/image.jl +++ b/extras/image.jl @@ -710,7 +710,8 @@ function imfilter{T}(img::Matrix{T}, filter::Matrix{T}, border::String, value) error("wrong border treatment") end # check if separable - U, S, V = svdt(filter) + SVD = SVDDense(copy(filter)) + U, S, Vt = SVD[:U], SVD[:S], SVD[:Vt] separable = true; for i = 2:length(S) # assumption that <10^-7 \approx 0 @@ -720,7 +721,7 @@ function imfilter{T}(img::Matrix{T}, filter::Matrix{T}, border::String, value) # conv2 isn't suitable for this (kernel center should be the actual center of the kernel) #C = conv2(U[:,1]*sqrt(S[1]), vec(V[1,:])*sqrt(S[1]), A) x = U[:,1]*sqrt(S[1]) - y = vec(V[1,:])*sqrt(S[1]) + y = vec(Vt[1,:])*sqrt(S[1]) sa = size(A) m = length(y)+sa[1] n = length(x)+sa[2] diff --git a/test/linalg.jl b/test/linalg.jl index 0f88c94194848..d04431b7bfdab 100644 --- a/test/linalg.jl +++ b/test/linalg.jl @@ -8,20 +8,20 @@ for elty in (Float32, Float64, Complex64, Complex128) apd = a'*a # symmetric positive-definite b = convert(Vector{elty}, b) - capd = cholfact(apd) # upper Cholesky factor - r = factors(capd) + capd = CholeskyDense(copy(apd)) # upper Cholesky factor + r = capd[:U] @test_approx_eq r'*r apd @test_approx_eq b apd * (capd\b) @test_approx_eq apd * inv(capd) eye(elty, n) @test_approx_eq a*(capd\(a'*b)) b # least squares soln for square a @test_approx_eq det(capd) det(apd) - l = factors(cholfact(apd, 'L')) # lower Cholesky factor + l = CholeskyDense(copy(apd), 'L')[:L] # lower Cholesky factor @test_approx_eq l*l' apd - cpapd = cholpfact(apd) # pivoted Choleksy decomposition + cpapd = CholeskyPivotedDense(copy(apd)) # pivoted Choleksy decomposition @test rank(cpapd) == n - @test all(diff(diag(real(cpapd.LR))).<=0.) # diagonal should be non-increasing + @test all(diff(diag(real(cpapd.UL))).<=0.) # diagonal should be non-increasing @test_approx_eq b apd * (cpapd\b) @test_approx_eq apd * inv(cpapd) eye(elty, n) @@ -32,32 +32,30 @@ for elty in (Float32, Float64, Complex64, Complex128) @test_approx_eq inv(bc2) * apd eye(elty, n) @test_approx_eq apd * (bc2\b) b - lua = lufact(a) # LU decomposition + lua = LUDense(copy(a)) # LU decomposition l,u,p = lu(a) - L,U,P = factors(lua) + L,U,P = lua[:L], lua[:U], lua[:p] @test l == L && u == U && p == P @test_approx_eq l*u a[p,:] @test_approx_eq l[invperm(p),:]*u a @test_approx_eq a * inv(lua) eye(elty, n) @test_approx_eq a*(lua\b) b - qra = qrfact(a) # QR decomposition - q,r = factors(qra) - @test_approx_eq q'*q eye(elty, n) - @test_approx_eq q*q' eye(elty, n) + qra = QRDense(copy(a)) # QR decomposition + q,r = qra[:Q], qra[:R] + @test_approx_eq q'*full(q, false) eye(elty, n) + @test_approx_eq q*full(q, false)' eye(elty, n) Q,R = qr(a) - @test q == Q && r == R + @test full(q) == Q && r == R @test_approx_eq q*r a - @test_approx_eq qmulQR(qra,b) Q*b - @test_approx_eq qTmulQR(qra,b) Q'*b + @test_approx_eq q*b Q*b + @test_approx_eq q'b Q'*b @test_approx_eq a*(qra\b) b - qrpa = qrpfact(a) # pivoted QR decomposition - q,r,p = factors(qrpa) - @test_approx_eq q'*q eye(elty, n) - @test_approx_eq q*q' eye(elty, n) - Q,R,P = qrp(a) - @test q == Q && r == R && p == P + qrpa = QRPivotedDense(copy(a)) # pivoted QR decomposition + q,r,p = qrpa[:Q], qrpa[:R], qrpa[:p] + @test_approx_eq q'*full(q, false) eye(elty, n) + @test_approx_eq q*full(q, false)' eye(elty, n) @test_approx_eq q*r a[:,p] @test_approx_eq q*r[:,invperm(p)] a @test_approx_eq a*(qrpa\b) b @@ -68,15 +66,15 @@ for elty in (Float32, Float64, Complex64, Complex128) d,v = eig(a) # non-symmetric eigen decomposition for i in 1:size(a,2) @test_approx_eq a*v[:,i] d[i]*v[:,i] end - + u, q, v = schur(a) # Schur @test_approx_eq q*u*q' a @test_approx_eq sort(real(v)) sort(real(d)) @test_approx_eq sort(imag(v)) sort(imag(d)) @test istriu(u) || isreal(a) - u,s,vt = svdt(a) # singular value decomposition - @test_approx_eq u*diagmm(s,vt) a + u,s,v = svd(a) # singular value decomposition + @test_approx_eq u*diagmm(s,v') a gsvd = svd(a,a[1:5,:]) # Generalized svd @test_approx_eq gsvd[1]*gsvd[4]*gsvd[6]*gsvd[3]' a @@ -296,7 +294,7 @@ for elty in (Float32, Float64, Complex64, Complex128) @test_approx_eq solve(T,v) invFv B = convert(Matrix{elty}, B) @test_approx_eq solve(T, B) F\B - Tlu = lufact(T) + Tlu = LUTridiagonal(copy(T)) x = Tlu\v @test_approx_eq x invFv @test_approx_eq det(T) det(F) @@ -329,27 +327,27 @@ for elty in (Float32, Float64, Complex64, Complex128) # axiomatic definition of determinants. # If all axioms are satisfied and all the composition rules work, # all determinants will be correct except for floating point errors. - + # The determinant of the identity matrix should always be 1. for i = 1:10 A = eye(elty, i) @test_approx_eq det(A) one(elty) end - + # The determinant of a Householder reflection matrix should always be -1. for i = 1:10 A = eye(elty, 10) A[i, i] = -one(elty) @test_approx_eq det(A) -one(elty) end - + # The determinant of a rotation matrix should always be 1. for theta = convert(Vector{elty}, pi ./ [1:4]) R = [cos(theta) -sin(theta); sin(theta) cos(theta)] @test_approx_eq convert(elty, det(R)) one(elty) end - + # issue 1490 @test_approx_eq_eps det(ones(elty, 3,3)) zero(elty) 3*eps(one(elty)) end @@ -360,12 +358,11 @@ for elty in (Float32, Float64, Complex64, Complex128) # syevr! A = convert(Array{elty, 2}, Ainit) Asym = A'A - Z = Array(elty, 5, 5) - vals = LAPACK.syevr!(copy(Asym), Z) + vals, Z = LAPACK.syevr!('V', copy(Asym)) @test_approx_eq Z*diagmm(vals, Z') Asym @test all(vals .> 0.0) - @test_approx_eq LAPACK.syevr!('N','V','U',copy(Asym),0.0,1.0,4,5,zeros(elty,0,0),-1.0) vals[vals .< 1.0] - @test_approx_eq LAPACK.syevr!('N','I','U',copy(Asym),0.0,1.0,4,5,zeros(elty,0,0),-1.0) vals[4:5] + @test_approx_eq LAPACK.syevr!('N','V','U',copy(Asym),0.0,1.0,4,5,-1.0)[1] vals[vals .< 1.0] + @test_approx_eq LAPACK.syevr!('N','I','U',copy(Asym),0.0,1.0,4,5,-1.0)[1] vals[4:5] @test_approx_eq vals LAPACK.syev!('N','U',copy(Asym)) end From 05e4f74cd4083797e178153df7f12e1c25c6f8dc Mon Sep 17 00:00:00 2001 From: Andreas Noack Jensen Date: Wed, 20 Feb 2013 08:09:19 +0100 Subject: [PATCH 02/29] New structure without MATLAB compatibility --- base/blas.jl | 69 ++++++++++ base/deprecated.jl | 7 +- base/exports.jl | 6 +- base/lapack.jl | 13 +- base/linalg_dense.jl | 294 ++++++++++++++++++++++++++++--------------- test/linalg.jl | 30 ++--- 6 files changed, 290 insertions(+), 129 deletions(-) diff --git a/base/blas.jl b/base/blas.jl index efc9edad92626..61e14dfa82c57 100644 --- a/base/blas.jl +++ b/base/blas.jl @@ -452,6 +452,75 @@ for (mfname, vfname, elty) in end end +# (TR) Triangular matrix multiplication +# Vector +for (fname, elty) in + ((:dtrmv_,:Float64), + (:strmv_,:Float32), + (:ztrmv_,:Complex128), + (:ctrmv_,:Complex64)) + @eval begin +# SUBROUTINE DTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) +# * .. Scalar Arguments .. +# INTEGER INCX,LDA,N +# CHARACTER DIAG,TRANS,UPLO +# * .. +# * .. Array Arguments .. +# DOUBLE PRECISION A(LDA,*),X(*) + function trmv!(uplo::Char, trans::Char, diag::Char, A::StridedMatrix{$elty}, x::StridedVector{$elty}) + n, m = size(A) + if m != n throw(BlasDimMisMatch("Matrix must be square")) end + if n != length(x) throw(BlasDimMisMatch("Length of Vector must match matrix dimension")) end + lda = max(1,stride(A, 2)) + ccall(($(string(fname)), libblas), Void, + (Ptr{Uint8}, Ptr{Uint8}, Ptr{Uint8}, Ptr{BlasInt}, + Ptr{$elty}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}), + &uplo, &trans, &diag, &n, + A, &lda, x, &1) + return x + end + trmv(uplo::Char, trans::Char, diag::Char, A::StridedMatrix{$elty}, x::StridedVector{$elty}) = trmv!(uplo, trans, diag, A, copy(x)) + + end +end + +# Matrix +for (fname, elty) in + ((:dtrmm_,:Float64), + (:strmm_,:Float32), + (:ztrmm_,:Complex128), + (:ctrmm_,:Complex64)) + @eval begin +# SUBROUTINE DTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) +# * .. Scalar Arguments .. +# DOUBLE PRECISION ALPHA +# INTEGER LDA,LDB,M,N +# CHARACTER DIAG,SIDE,TRANSA,UPLO +# * .. +# * .. Array Arguments .. +# DOUBLE PRECISION A(LDA,*),B(LDB,*) + function trmm!(side::Char, uplo::Char, transa::Char, diag::Char, alpha::Number, A::StridedMatrix{$elty}, B::StridedMatrix{$elty}) + m, n = size(B) + mA, nA = size(A) + if mA != nA throw(BlasDimMisMatch("Matrix must be square")) end + if side == 'L' && nA != m throw(BlasDimMisMatch("")) end + if side == 'R' && nA != n throw(BlasDimMisMatch("")) end + lda = max(1,stride(A, 2)) + ldb = max(1,stride(B, 2)) + ccall(($(string(fname)), libblas), Void, + (Ptr{Uint8}, Ptr{Uint8}, Ptr{Uint8}, Ptr{Uint8}, + Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{$elty}, + Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}), + &side, &uplo, &transa, &diag, + &m, &n, &alpha, A, + &lda, B, &ldb) + return B + end + trmm(side::Char, uplo::Char, transa::Char, diag::Char, alpha::$elty, A::StridedMatrix{$elty}, B::StridedMatrix{$elty}) = trmm!(side, uplo, transa, diag, alpha, A, copy(B)) + + end +end + end # module # Use BLAS copy for small arrays where it is faster than memcpy, and for strided copying diff --git a/base/deprecated.jl b/base/deprecated.jl index 8e3ad9298f1b0..d6e28f33ad616 100644 --- a/base/deprecated.jl +++ b/base/deprecated.jl @@ -142,4 +142,9 @@ end # 0.2 -@deprecate localize localpart +@deprecate localize localpart +@deprecate cholfact chol +@deprecate cholpfact cholp +@deprecate lufact lu +@deprecate qrfact qr +@deprecate qrpfact qrp \ No newline at end of file diff --git a/base/exports.jl b/base/exports.jl index 8662ae98948f4..bd60567ebf9a6 100644 --- a/base/exports.jl +++ b/base/exports.jl @@ -239,6 +239,7 @@ export A_rdiv_Bt, Ac_ldiv_B, Ac_ldiv_Bc, + Ac_mul_b_RFP, Ac_mul_B, Ac_mul_Bc, Ac_rdiv_B, @@ -548,10 +549,7 @@ export # linear algebra chol, - cholfact, - cholfact!, - cholpfact, - cholpfact!, + cholp, cond, cross, ctranspose, diff --git a/base/lapack.jl b/base/lapack.jl index fd1b8ba10c521..a4de92a180b9b 100644 --- a/base/lapack.jl +++ b/base/lapack.jl @@ -1023,15 +1023,18 @@ for (orglq, orgqr, ormlq, ormqr, gemqrt, elty) in end C end - function gemqrt!(side::Char, trans::Char, V::Matrix{$elty}, T::Matrix{$elty}, C::StridedMatrix{$elty}) - m, n = size(C) + function gemqrt!(side::Char, trans::Char, V::Matrix{$elty}, T::Matrix{$elty}, C::StridedVecOrMat{$elty}) + m = size(C, 1) + n = size(C, 2) k = size(T, 1) if side == 'L' ldv = max(1, m) wss = n*k + if m != size(V, 1) throw(DimensionMismatch("")) end elseif side == 'R' ldv = max(1, n) wss = m*k + if n != size(V, 1) throw(DimensionMismatch("")) end else error("side must be either 'L' or 'R'") end @@ -2042,7 +2045,7 @@ for (fn, elty) in ((:dpftrs_, :Float64), (:zpftrs_, :Complex128), (:cpftrs_, :Complex64)) @eval begin - function pftrs!(transr::Char, uplo::Char, A::StridedVector{$elty}, B::StridedMatrix{$elty}) + function pftrs!(transr::Char, uplo::Char, A::StridedVector{$elty}, B::StridedVecOrMat{$elty}) n = int(div(sqrt(8length(A)), 2)) if n != size(B, 1) throw(DimensionMismatch("A and B must have the same number of rows")) end nhrs = size(B, 2) @@ -2051,10 +2054,10 @@ for (fn, elty) in ((:dpftrs_, :Float64), ccall(($(string(fn)), liblapack), Void, (Ptr{Uint8}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), - &transr, &uplo, &n, &nrhs, + &transr, &uplo, &n, &nhrs, A, B, &ldb, info) if info[1] < 0 throw(LapackException(info[1])) end - return B, info[1] + return B end end end diff --git a/base/linalg_dense.jl b/base/linalg_dense.jl index a5e26c82f136a..b6449d53a3da0 100644 --- a/base/linalg_dense.jl +++ b/base/linalg_dense.jl @@ -10,12 +10,12 @@ scale!(X::Array{Complex128}, s::Real) = (ccall(("dscal_",Base.libblas_name), Voi #Test whether a matrix is positive-definite -isposdef!{T<:BlasFloat}(A::Matrix{T}, UL::BlasChar) = LAPACK.potrf!(UL, A)[2] == 0 +isposdef!{T<:BlasFloat}(A::Matrix{T}, UL::Char) = LAPACK.potrf!(UL, A)[2] == 0 isposdef!(A::Matrix) = ishermitian(A) && isposdef!(A, 'U') -isposdef{T<:BlasFloat}(A::Matrix{T}, UL::BlasChar) = isposdef!(copy(A), UL) +isposdef{T<:BlasFloat}(A::Matrix{T}, UL::Char) = isposdef!(copy(A), UL) isposdef{T<:BlasFloat}(A::Matrix{T}) = isposdef!(copy(A)) -isposdef{T<:Number}(A::Matrix{T}, UL::BlasChar) = isposdef!(float64(A), UL) +isposdef{T<:Number}(A::Matrix{T}, UL::Char) = isposdef!(float64(A), UL) isposdef{T<:Number}(A::Matrix{T}) = isposdef!(float64(A)) isposdef(x::Number) = imag(x)==0 && real(x) > 0 @@ -385,15 +385,14 @@ abstract Factorization{T} type BunchKaufman{T<:BlasFloat} <: Factorization{T} LD::Matrix{T} ipiv::Vector{BlasInt} - uplo::BlasChar - function BunchKaufman(A::Matrix{T}, uplo::BlasChar) + uplo::Char + function BunchKaufman(A::Matrix{T}, uplo::Char) LD, ipiv = LAPACK.sytrf!(uplo , copy(A)) new(LD, ipiv, uplo) end end - -BunchKaufman{T<:BlasFloat}(A::StridedMatrix{T}, uplo::BlasChar) = BunchKaufman{T}(A, uplo) -BunchKaufman{T<:Real}(A::StridedMatrix{T}, uplo::BlasChar) = BunchKaufman(float64(A), uplo) +BunchKaufman{T<:BlasFloat}(A::StridedMatrix{T}, uplo::Char) = BunchKaufman{T}(A, uplo) +BunchKaufman{T<:Real}(A::StridedMatrix{T}, uplo::Char) = BunchKaufman(float64(A), uplo) BunchKaufman{T<:Number}(A::StridedMatrix{T}) = BunchKaufman(A, 'U') size(B::BunchKaufman) = size(B.LD) @@ -416,9 +415,11 @@ type CholeskyDense{T<:BlasFloat} <: Factorization{T} end end CholeskyDense{T<:BlasFloat}(A::Matrix{T}, uplo::Char) = CholeskyDense{T}(A, uplo) -CholeskyDense(A::Matrix, uplo::Symbol) = CholeskyDense(A, string(uplo)[1]) -CholeskyDense(A::Matrix) = CholeskyDense(A, :U) -CholeskyDense{T<:Integer}(A::Matrix{T}, args...) = CholeskyDense(float64(A), args...) + +chol(A::Matrix, uplo::Symbol) = CholeskyDense(copy(A), string(uplo)[1]) +chol(A::Matrix) = chol(A, :U) +chol{T<:Integer}(A::Matrix{T}, args...) = chol(float64(A), args...) +chol(x::Number) = imag(x) == 0 && real(x) > 0 ? sqrt(x) : error("Argument not positive-definite") size(C::CholeskyDense) = size(C.UL) size(C::CholeskyDense,d::Integer) = size(C.UL,d) @@ -426,15 +427,12 @@ size(C::CholeskyDense,d::Integer) = size(C.UL,d) function ref(C::CholeskyDense, d::Symbol) if d == :U || d == :L return symbol(C.uplo) == d ? C.UL : C.UL' + elseif d == :UL + return Triangular(C.UL, C.uplo) end error("No such property") end -## Matlab (and R) compatible -chol(A::Matrix, uplo::Symbol) = CholeskyDense(copy(A), uplo)[uplo] -chol(A::Matrix) = chol(A, :U) -chol(x::Number) = imag(x) == 0 && real(x) > 0 ? sqrt(x) : error("Argument not positive-definite") - \{T<:BlasFloat}(C::CholeskyDense{T}, B::StridedVecOrMat{T}) = LAPACK.potrs!(C.uplo, C.UL, copy(B)) @@ -453,20 +451,21 @@ end ## Pivoted Cholesky type CholeskyPivotedDense{T<:BlasFloat} <: Factorization{T} UL::Matrix{T} - uplo::BlasChar + uplo::Char piv::Vector{BlasInt} rank::BlasInt tol::Real info::BlasInt end -function CholeskyPivotedDense{T<:BlasFloat}(A::Matrix{T}, uplo::BlasChar, tol::Real) +function CholeskyPivotedDense{T<:BlasFloat}(A::Matrix{T}, uplo::Char, tol::Real) A, piv, rank, info = LAPACK.pstrf!(uplo, A, tol) CholeskyPivotedDense{T}(uplo == 'U' ? triu!(A) : tril!(A), uplo, piv, rank, tol, info) end -CholeskyPivotedDense(A::Matrix, uplo::Symbol, tol::Real) = CholeskyPivotedDense(A, string(uplo)[1], tol) -CholeskyPivotedDense(A::Matrix, tol::Real) = CholeskyPivotedDense(A, 'U', tol) -CholeskyPivotedDense(A::Matrix) = CholeskyPivotedDense(A, 'U', -1.) -CholeskyPivotedDense{T<:Int}(A::Matrix{T}, args...) = CholeskyPivotedDense(float64(A), args...) + +cholp(A::Matrix, uplo::Symbol, tol::Real) = CholeskyPivotedDense(copy(A), string(uplo)[1], tol) +cholp(A::Matrix, tol::Real) = cholp(A, :U, tol) +cholp(A::Matrix) = cholp(A, -1.) +cholp{T<:Int}(A::Matrix{T}, args...) = cholp(float64(A), args...) size(C::CholeskyPivotedDense) = size(C.UL) size(C::CholeskyPivotedDense,d::Integer) = size(C.UL,d) @@ -530,7 +529,10 @@ function LUDense{T<:BlasFloat}(A::Matrix{T}) LU, ipiv, info = LAPACK.getrf!(A) LUDense{T}(LU, ipiv, info) end -LUDense{T<:Real}(A::Matrix{T}) = LUDense(float(A)) + +lu(A::Matrix) = LUDense(copy(A)) +lu{T<:Integer}(A::Matrix{T}) = lu(float(A)) +lu(x::Number) = (one(x), x, [1]) size(A::LUDense) = size(A.LU) size(A::LUDense,n) = size(A.LU,n) @@ -560,13 +562,6 @@ function ref{T}(A::LUDense{T}, d::Symbol) error("No such property") end -## Matlab-compatible -function lu(A::Matrix) - LU = LUDense(copy(A)) - return LU[:L], LU[:U], LU[:p] -end -lu(x::Number) = (one(x), x, [1]) - function det{T}(A::LUDense{T}) m, n = size(A) if A.info > 0; return zero(typeof(A.LU[1])); end @@ -583,75 +578,71 @@ function inv(A::LUDense) LAPACK.getri!(copy(A.LU), A.ipiv) end -## QR decomposition without column pivots -type QRDense{T} <: Factorization{T} - hh::Matrix{T} # Householder transformations and R - tau::Vector{T} # Scalar factors of transformations +## QR decomposition without column pivots. By the faster geqrt3 +type QRDense{S} <: Factorization{S} + vs::Matrix{S} # the elements on and above the diagonal contain the N-by-N upper triangular matrix R; the elements below the diagonal are the columns of V + T::Matrix{S} # upper triangular factor of the block reflector. end -QRDense(A::StridedMatrix) = QRDense(LAPACK.geqrf!(A)...) -QRDense{T<:Integer}(A::StridedMatrix{T}) = QRDense(float(A)) +QRDense(A::Matrix) = QRDense(LAPACK.geqrt3!(A)...) -type QRDenseQ{T} <: AbstractMatrix{T} - hh::Matrix{T} # Householder transformations and R - tau::Vector{T} # Scalar factors of transformations -end -QRDenseQ(A::QRDense) = QRDenseQ(A.hh, A.tau) +qr(A::Matrix) = QRDense(copy(A)) +qr{T<:Integer}(A::Matrix{T}) = qr(float(A)) +qr(x::Number) = (one(x), x) -size(A::QRDense, args::Integer...) = size(A.hh, args...) -size(A::QRDenseQ, args::Integer...) = size(A.hh, args...) +size(A::QRDense, args::Integer...) = size(A.vs, args...) function ref(A::QRDense, d::Symbol) - if d == :R; return triu(A.hh[1:min(size(A)),:]); end; + if d == :R; return triu(A.vs[1:min(size(A)),:]); end; if d == :Q; return QRDenseQ(A); end error("No such property") end + +type QRDenseQ{S} <: AbstractMatrix{S} + vs::Matrix{S} + T::Matrix{S} +end +QRDenseQ(A::QRDense) = QRDenseQ(A.vs, A.T) + +size(A::QRDenseQ, args::Integer...) = size(A.vs, args...) + function full{T<:BlasFloat}(A::QRDenseQ{T}, thin::Bool) - if !thin - Q = Array(T, size(A, 1), size(A, 1)) - Q[:,1:size(A, 2)] = copy(A.hh) - return LAPACK.orgqr!(Q, A.tau) - else - return LAPACK.orgqr!(copy(A.hh), A.tau) - end + if thin return A * eye(T, size(A.T, 1)) end + return A * eye(T, size(A, 1)) end full(A::QRDenseQ) = full(A, true) -function qr(A::StridedMatrix) - QR = QRDense(copy(A)) - return full(QR[:Q]), QR[:R] -end -qr(x::Number) = (one(x), x) +print_matrix(io::IO, A::QRDenseQ) = print_matrix(io, full(A)) ## Multiplication by Q from the QR decomposition function *{T<:BlasFloat}(A::QRDenseQ{T}, B::StridedVecOrMat{T}) m = size(B, 1) n = size(B, 2) - if m == size(A.hh, 1) + if m == size(A.vs, 1) Bc = copy(B) - elseif m == size(A.hh, 2) - Bc = [B; zeros(T, size(A.hh, 1) - m, n)] + elseif m == size(A.vs, 2) + Bc = [B; zeros(T, size(A.vs, 1) - m, n)] else throw(LAPACK.DimensionMismatch("")) end - LAPACK.ormqr!('L', 'N', A.hh, A.tau, Bc) + LAPACK.gemqrt!('L', 'N', A.vs, A.T, Bc) end -Ac_mul_B(A::QRDenseQ, B::StridedVecOrMat) = LAPACK.ormqr!('L', iscomplex(A.hh[1]) ? 'C' : 'T', A.hh, A.tau, copy(B)) -*(A::StridedVecOrMat, B::QRDenseQ) = LAPACK.ormqr!('R', 'N', B.hh, B.tau, copy(A)) +Ac_mul_B(A::QRDenseQ, B::StridedVecOrMat) = LAPACK.gemqrt!('L', iscomplex(A.vs[1]) ? 'C' : 'T', A.vs, A.T, copy(B)) +*(A::StridedVecOrMat, B::QRDenseQ) = LAPACK.gemqrt!('R', 'N', B.vs, B.T, copy(A)) function A_mul_Bc{T<:BlasFloat}(A::StridedVecOrMat{T}, B::QRDenseQ{T}) m = size(A, 1) n = size(A, 2) - if n == size(B.hh, 1) + if n == size(B.vs, 1) Ac = copy(A) - elseif n == size(B.hh, 2) - Ac = [B zeros(T, m, size(B.hh, 1) - n)] + elseif n == size(B.vs, 2) + Ac = [B zeros(T, m, size(B.vs, 1) - n)] else throw(LAPACK.DimensionMismatch("")) end - LAPACK.ormqr!('R', iscomplex(B.hh[1]) ? 'C' : 'T', B.hh, B.tau, Ac) + LAPACK.gemqrt!('R', iscomplex(B.vs[1]) ? 'C' : 'T', B.vs, B.T, Ac) end ## Least squares solution. Should be more careful about cases with m < n -(\)(A::QRDense, B::StridedVector) = A[:R]\(A[:Q]'B)[1:size(A, 2)] -(\)(A::QRDense, B::StridedMatrix) = A[:R]\(A[:Q]'B)[1:size(A, 2),:] +(\)(A::QRDense, B::StridedVector) = Triangular(A[:R], 'U')\(A[:Q]'B)[1:size(A, 2)] +(\)(A::QRDense, B::StridedMatrix) = Triangular(A[:R], 'U')\(A[:Q]'B)[1:size(A, 2),:] type QRPivotedDense{T} <: Factorization{T} hh::Matrix{T} @@ -666,13 +657,14 @@ type QRPivotedDense{T} <: Factorization{T} end end QRPivotedDense{T<:BlasFloat}(A::Matrix{T}) = QRPivotedDense{T}(LAPACK.geqp3!(A)...) -QRDenseQ(A::QRPivotedDense) = QRDenseQ(A.hh, A.tau) +qrp(A::Matrix) = QRPivotedDense(copy(A)) +# QRDenseQ(A::QRPivotedDense) = QRDenseQ(A.hh, A.tau) size(A::QRPivotedDense, args::Integer...) = size(A.hh, args...) function ref{T<:BlasFloat}(A::QRPivotedDense{T}, d::Symbol) if d == :R; return triu(A.hh[1:min(size(A)),:]); end; - if d == :Q; return QRDenseQ(A); end + if d == :Q; return QRDensePivotedQ(A); end if d == :p; return A.jpvt; end if d == :P p = A[:p] @@ -686,8 +678,55 @@ function ref{T<:BlasFloat}(A::QRPivotedDense{T}, d::Symbol) error("No such property") end -(\)(A::QRPivotedDense, B::StridedVector) = (A[:R]\(A[:Q]'B)[1:size(A, 2)])[invperm(A.jpvt)] -(\)(A::QRPivotedDense, B::StridedMatrix) = A[:R]\(A[:Q]'B)[1:size(A, 2),:][invperm(A.jpvt),:] +(\)(A::QRPivotedDense, B::StridedVector) = (Triangular(A[:R])\(A[:Q]'B)[1:size(A, 2)])[invperm(A.jpvt)] +(\)(A::QRPivotedDense, B::StridedMatrix) = (Triangular(A[:R])\(A[:Q]'B)[1:size(A, 2),:])[invperm(A.jpvt),:] + +type QRDensePivotedQ{T} <: AbstractMatrix{T} + hh::Matrix{T} # Householder transformations and R + tau::Vector{T} # Scalar factors of transformations +end +QRDensePivotedQ(A::QRPivotedDense) = QRDensePivotedQ(A.hh, A.tau) + +size(A::QRDensePivotedQ, args...) = size(A.hh, args...) + +function full{T<:BlasFloat}(A::QRDensePivotedQ{T}, thin::Bool) + if !thin + Q = Array(T, size(A, 1), size(A, 1)) + Q[:,1:size(A, 2)] = copy(A.hh) + return LAPACK.orgqr!(Q, A.tau) + else + return LAPACK.orgqr!(copy(A.hh), A.tau) + end +end +full(A::QRDensePivotedQ) = full(A, true) + +## Multiplication by Q from the Pivoted QR decomposition +function *{T<:BlasFloat}(A::QRDensePivotedQ{T}, B::StridedVecOrMat{T}) + m = size(B, 1) + n = size(B, 2) + if m == size(A.hh, 1) + Bc = copy(B) + elseif m == size(A.hh, 2) + Bc = [B; zeros(T, size(A.hh, 1) - m, n)] + else + throw(LAPACK.DimensionMismatch("")) + end + LAPACK.ormqr!('L', 'N', A.hh, A.tau, Bc) +end +Ac_mul_B(A::QRDensePivotedQ, B::StridedVecOrMat) = LAPACK.ormqr!('L', iscomplex(A.hh[1]) ? 'C' : 'T', A.hh, A.tau, copy(B)) +*(A::StridedVecOrMat, B::QRDensePivotedQ) = LAPACK.ormqr!('R', 'N', B.hh, B.tau, copy(A)) +function A_mul_Bc{T<:BlasFloat}(A::StridedVecOrMat{T}, B::QRDensePivotedQ{T}) + m = size(A, 1) + n = size(A, 2) + if n == size(B.hh, 1) + Ac = copy(A) + elseif n == size(B.hh, 2) + Ac = [B zeros(T, m, size(B.hh, 1) - n)] + else + throw(LAPACK.DimensionMismatch("")) + end + LAPACK.ormqr!('R', iscomplex(B.hh[1]) ? 'C' : 'T', B.hh, B.tau, Ac) +end ##TODO: Add methods for rank(A::QRP{T}) and adjust the (\) method accordingly ## Add rcond methods for Cholesky, LU, QR and QRP types @@ -705,6 +744,8 @@ end Hessenberg{T<:BlasFloat}(hh::Matrix{T}, tau::Vector{T}) = Hessenberg{T}(hh, tau) Hessenberg(A::StridedMatrix) = Hessenberg(LAPACK.gehrd!(A)...) +hess(A::StridedMatrix) = Hessenberg(copy(A)) + type HessenbergQ{T} <: AbstractMatrix{T} hh::Matrix{T} tau::Vector{T} @@ -721,8 +762,6 @@ end full(A::HessenbergQ) = LAPACK.orghr!(1, size(A.hh, 1), copy(A.hh), A.tau) -hess(A::StridedMatrix) = Hessenberg(copy(A))[:H] - ### Linear algebra for general matrices function det(A::Matrix) @@ -794,6 +833,8 @@ function SVDDense(A::StridedMatrix, thin::Bool) return SVDDense(u,s,vt) end SVDDense(A::StridedMatrix) = SVDDense(A, false) +svd(A::StridedMatrix, args...) = SVDDense(copy(A), args...) +svd(x::Number, thin::Bool) = (x==0?one(x):x/abs(x),abs(x),one(x)) function ref(F::SVDDense, d::Symbol) if d == :U return F.U end @@ -811,13 +852,6 @@ end svdvals(A) = svdvals!(copy(A)) -function svd(A::StridedMatrix, thin::Bool) - SVD = SVDDense(copy(A), thin) - return SVD[:U], SVD[:S], SVD[:V] -end -svd(A::StridedMatrix) = svd(A, false) -svd(x::Number, thin::Bool) = (x==0?one(x):x/abs(x),abs(x),one(x)) - # SVD least squares function \{T<:BlasFloat}(A::SVDDense{T}, B::StridedVecOrMat{T}) n = length(A[:S]) @@ -843,10 +877,7 @@ function GSVDDense(A::StridedMatrix, B::StridedMatrix) return GSVDDense(U, V, Q, a, b, int(k), int(l), R) end -function svd(A::StridedMatrix, B::StridedMatrix) - G = GSVDDense(copy(A), copy(B)) - return G[:U], G[:V], G[:Q], G[:D1], G[:D2], G[:R0] -end +svd(A::StridedMatrix, B::StridedMatrix) = GSVDDense(copy(A), copy(B)) function ref{T}(obj::GSVDDense{T}, d::Symbol) if d == :U return obj.U end @@ -895,21 +926,8 @@ schur{T<:BlasFloat}(A::StridedMatrix{T}) = LAPACK.gees!('V', copy(A)) function sqrtm(A::StridedMatrix, cond::Bool) m, n = size(A) if m != n error("DimentionMismatch") end - if ishermitian(A) - z = similar(A) - v = LAPACK.syevr!(copy(A),z) - vsqrt = sqrt(complex(v)) - if all(imag(vsqrt) .== 0) - retmat = symmetrize!(diagmm(z, real(vsqrt)) * z') - else - zc = complex(z) - retmat = symmetrize!(diagmm(zc, vsqrt) * zc') - end - if cond - return retmat, norm(vsqrt, Inf)^2/norm(v, Inf) - else - return retmat - end + if ishermitian(A) + return sqrtm(Hermitian(A), cond) else T,Q,_ = schur(complex(A)) R = zeros(eltype(T), n, n) @@ -924,7 +942,6 @@ function sqrtm(A::StridedMatrix, cond::Bool) R[i,j] = r / (R[i,i] + R[j,j]) end end - R[i,j] = (T[i,j] - r) / (R[i,i] + R[j,j]) end end retmat = Q*R*Q' @@ -1443,9 +1460,32 @@ function Triangular(A::Matrix) error("Matrix is not triangular") end +size(A::Triangular, args...) = size(A.UL, args...) +function full(A::Triangular) + if + istril(A) return tril(A.UL) + else + return triu(A.UL) + end +end +print_matrix(io::IO, A::Triangular) = print_matrix(io, full(A)) + istril(A::Triangular) = A.uplo == 'L' istriu(A::Triangular) = A.uplo == 'U' +# Vector multiplication +*(A::Triangular, b::Vector) = BLAS.trmv(A.uplo, 'N', A.unitdiag, A.UL, b) +Ac_mul_B{T<:Union(Complex128, Complex64)}(A::Triangular{T}, b::Vector{T}) = BLAS.trmv(A.uplo, 'C', A.unitdiag, A.UL, b) +At_mul_B{T<:Union(Float64, Float32)}(A::Triangular{T}, b::Vector{T}) = BLAS.trmv(A.uplo, 'T', A.unitdiag, A.UL, b) + +# Matrix multiplication +*(A::Triangular, B::StridedMatrix) = BLAS.trmm('L', A.uplo, 'N', A.unitdiag, 1.0, A.UL, B) +*(A::StridedMatrix, B::Triangular) = BLAS.trmm('R', B.uplo, 'N', B.unitdiag, 1.0, A, B.UL) +Ac_mul_B{T<:Union(Complex128, Complex64)}(A::Triangular{T}, B::StridedMatrix{T}) = BLAS.trmm('L', A.uplo, 'C', A.unitdiag, 1.0, A.UL, B) +Ac_mul_B{T<:Union(Float64, Float32)}(A::Triangular{T}, B::StridedMatrix{T}) = BLAS.trmm('L', A.uplo, 'T', A.unitdiag, 1.0, A.UL, B) +A_mul_Bc{T<:Union(Complex128, Complex64)}(A::StridedMatrix{T}, B::Triangular{T}) = BLAS.trmm('R', B.uplo, 'C', B.unitdiag, 1.0, A, B.UL) +A_mul_Bc{T<:Union(Float64, Float32)}(A::StridedMatrix{T}, B::Triangular{T}) = BLAS.trmm('R', B.uplo, 'T', B.unitdiag, 1.0, A, B.UL) + function \(A::Triangular, B::StridedVecOrMat) r, info = LAPACK.trtrs!(A.uplo, 'N', A.unitdiag, A.UL, copy(B)) if info > 0 throw(LAPACK.SingularException(info)) end @@ -1479,6 +1519,8 @@ Hermitian{T<:BlasFloat}(S::Matrix{T}, uplo::Char) = Hermitian{T}(S, uplo) Hermitian(A::StridedMatrix) = Hermitian(A, 'U') size(A::Hermitian, args...) = size(A.S, args...) +print_matrix(io::IO, A::Hermitian) = print_matrix(io, full(A)) +full(A::Hermitian) = symmetrize!(copy(A.S), A.uplo) ishermitian(A::Hermitian) = true issym{T<:Union(Float64, Float32)}(A::Hermitian{T}) = true @@ -1511,3 +1553,53 @@ function sqrtm(A::Hermitian, cond::Bool) return retmat end end + +# Rectangular Full Packed Matrices + +type SymmetricRFP{T<:BlasFloat} <: AbstractMatrix{T} + data::Vector{T} + transr::Char + uplo::Char +end + +function Ac_mul_A_RFP{T<:BlasFloat}(A::Matrix{T}) + n = size(A, 2) + C = LAPACK.sfrk!('N', 'U', 'T', 1.0, A, 0.0, Array(T, div(n*(n+1),2))) + return SymmetricRFP(C, 'N', 'U') +end + +type TriangularRFP{T<:BlasFloat} <: AbstractMatrix{T} + data::Vector{T} + transr::Char + uplo::Char +end +TriangularRFP(A::Matrix) = TriangularRFP(trttf!('N', 'U', A)[1], 'N', 'U') + +function full(A::TriangularRFP) + B = LAPACK.tfttr!(A.transr, A.uplo, A.data)[1] + if A.uplo == 'U' + return triu!(B) + else + return tril!(B) + end +end + +type CholeskyDenseRFP{T<:BlasFloat} <: Factorization{T} + data::Vector{T} + transr::Char + uplo::Char +end + +function chol(A::SymmetricRFP) + C, info = LAPACK.pftrf!(A.transr, A.uplo, copy(A.data)) + return CholeskyDenseRFP(C, A.transr, A.uplo) +end + +# Least squares +\(A::CholeskyDenseRFP, B::VecOrMat) = LAPACK.pftrs!(A.transr, A.uplo, A.data, copy(B)) + +function inv(A::CholeskyDenseRFP) + B, info = LAPACK.pftri!(A.transr, A.uplo, copy(A.data)) + if info > 0 throw(LAPACK.SingularException(info)) end + return B +end \ No newline at end of file diff --git a/test/linalg.jl b/test/linalg.jl index d04431b7bfdab..4ba4ed622c4cc 100644 --- a/test/linalg.jl +++ b/test/linalg.jl @@ -8,7 +8,7 @@ for elty in (Float32, Float64, Complex64, Complex128) apd = a'*a # symmetric positive-definite b = convert(Vector{elty}, b) - capd = CholeskyDense(copy(apd)) # upper Cholesky factor + capd = chol(apd) # upper Cholesky factor r = capd[:U] @test_approx_eq r'*r apd @test_approx_eq b apd * (capd\b) @@ -16,10 +16,10 @@ for elty in (Float32, Float64, Complex64, Complex128) @test_approx_eq a*(capd\(a'*b)) b # least squares soln for square a @test_approx_eq det(capd) det(apd) - l = CholeskyDense(copy(apd), 'L')[:L] # lower Cholesky factor + l = chol(apd, :L)[:L] # lower Cholesky factor @test_approx_eq l*l' apd - cpapd = CholeskyPivotedDense(copy(apd)) # pivoted Choleksy decomposition + cpapd = cholp(apd) # pivoted Choleksy decomposition @test rank(cpapd) == n @test all(diff(diag(real(cpapd.UL))).<=0.) # diagonal should be non-increasing @test_approx_eq b apd * (cpapd\b) @@ -32,27 +32,21 @@ for elty in (Float32, Float64, Complex64, Complex128) @test_approx_eq inv(bc2) * apd eye(elty, n) @test_approx_eq apd * (bc2\b) b - lua = LUDense(copy(a)) # LU decomposition - l,u,p = lu(a) - L,U,P = lua[:L], lua[:U], lua[:p] - @test l == L && u == U && p == P + lua = lu(a) # LU decomposition + l,u,p = lua[:L], lua[:U], lua[:p] @test_approx_eq l*u a[p,:] @test_approx_eq l[invperm(p),:]*u a @test_approx_eq a * inv(lua) eye(elty, n) @test_approx_eq a*(lua\b) b - qra = QRDense(copy(a)) # QR decomposition + qra = qr(a) # QR decomposition q,r = qra[:Q], qra[:R] @test_approx_eq q'*full(q, false) eye(elty, n) @test_approx_eq q*full(q, false)' eye(elty, n) - Q,R = qr(a) - @test full(q) == Q && r == R @test_approx_eq q*r a - @test_approx_eq q*b Q*b - @test_approx_eq q'b Q'*b @test_approx_eq a*(qra\b) b - qrpa = QRPivotedDense(copy(a)) # pivoted QR decomposition + qrpa = qrp(a) # pivoted QR decomposition q,r,p = qrpa[:Q], qrpa[:R], qrpa[:p] @test_approx_eq q'*full(q, false) eye(elty, n) @test_approx_eq q*full(q, false)' eye(elty, n) @@ -73,12 +67,12 @@ for elty in (Float32, Float64, Complex64, Complex128) @test_approx_eq sort(imag(v)) sort(imag(d)) @test istriu(u) || isreal(a) - u,s,v = svd(a) # singular value decomposition - @test_approx_eq u*diagmm(s,v') a + usv = svd(a) # singular value decomposition + @test_approx_eq usv[:U]*diagmm(usv[:S],usv[:Vt]) a gsvd = svd(a,a[1:5,:]) # Generalized svd - @test_approx_eq gsvd[1]*gsvd[4]*gsvd[6]*gsvd[3]' a - @test_approx_eq gsvd[2]*gsvd[5]*gsvd[6]*gsvd[3]' a[1:5,:] + @test_approx_eq gsvd[:U]*gsvd[:D1]*gsvd[:R]*gsvd[:Q]' a + @test_approx_eq gsvd[:V]*gsvd[:D2]*gsvd[:R]*gsvd[:Q]' a[1:5,:] x = a \ b @test_approx_eq a*x b @@ -249,7 +243,7 @@ for elty in (Float32, Float64, Complex64, Complex128) @test_approx_eq expm(A3) eA3 # Hessenberg - @test_approx_eq hess(A1) convert(Matrix{elty}, + @test_approx_eq hess(A1)[:H] convert(Matrix{elty}, [4.000000000000000 -1.414213562373094 -1.414213562373095 -1.414213562373095 4.999999999999996 -0.000000000000000 0 -0.000000000000002 3.000000000000000]) From 8f619d46a4f870cd3ab69afcc59d7ace37a4c5b5 Mon Sep 17 00:00:00 2001 From: "Viral B. Shah" Date: Sat, 2 Mar 2013 18:08:28 +0530 Subject: [PATCH 03/29] Create a base/linalg directory for all the linear algebra code. --- base/{linalg_bitarray.jl => linalg/bitarray.jl} | 0 base/{ => linalg}/blas.jl | 0 base/{linalg_dense.jl => linalg/dense.jl} | 0 base/{ => linalg}/lapack.jl | 0 base/{ => linalg}/linalg.jl | 0 base/{ => linalg}/matmul.jl | 0 base/{linalg_sparse.jl => linalg/sparse.jl} | 0 base/sysimg.jl | 14 +++++++------- 8 files changed, 7 insertions(+), 7 deletions(-) rename base/{linalg_bitarray.jl => linalg/bitarray.jl} (100%) rename base/{ => linalg}/blas.jl (100%) rename base/{linalg_dense.jl => linalg/dense.jl} (100%) rename base/{ => linalg}/lapack.jl (100%) rename base/{ => linalg}/linalg.jl (100%) rename base/{ => linalg}/matmul.jl (100%) rename base/{linalg_sparse.jl => linalg/sparse.jl} (100%) diff --git a/base/linalg_bitarray.jl b/base/linalg/bitarray.jl similarity index 100% rename from base/linalg_bitarray.jl rename to base/linalg/bitarray.jl diff --git a/base/blas.jl b/base/linalg/blas.jl similarity index 100% rename from base/blas.jl rename to base/linalg/blas.jl diff --git a/base/linalg_dense.jl b/base/linalg/dense.jl similarity index 100% rename from base/linalg_dense.jl rename to base/linalg/dense.jl diff --git a/base/lapack.jl b/base/linalg/lapack.jl similarity index 100% rename from base/lapack.jl rename to base/linalg/lapack.jl diff --git a/base/linalg.jl b/base/linalg/linalg.jl similarity index 100% rename from base/linalg.jl rename to base/linalg/linalg.jl diff --git a/base/matmul.jl b/base/linalg/matmul.jl similarity index 100% rename from base/matmul.jl rename to base/linalg/matmul.jl diff --git a/base/linalg_sparse.jl b/base/linalg/sparse.jl similarity index 100% rename from base/linalg_sparse.jl rename to base/linalg/sparse.jl diff --git a/base/sysimg.jl b/base/sysimg.jl index 3ca8a974799f1..0aa2be2391d21 100644 --- a/base/sysimg.jl +++ b/base/sysimg.jl @@ -150,14 +150,14 @@ include("test.jl") include("meta.jl") # linear algebra -include("blas.jl") -include("lapack.jl") -include("matmul.jl") include("sparse.jl") -include("linalg.jl") -include("linalg_dense.jl") -include("linalg_bitarray.jl") -include("linalg_sparse.jl") +include("linalg/blas.jl") +include("linalg/lapack.jl") +include("linalg/matmul.jl") +include("linalg/linalg.jl") +include("linalg/dense.jl") +include("linalg/bitarray.jl") +include("linalg/sparse.jl") # signal processing include("fftw.jl") From 0df87c8e3d07d5808205b1f04736f50cdd873ce3 Mon Sep 17 00:00:00 2001 From: "Viral B. Shah" Date: Sat, 2 Mar 2013 18:20:24 +0530 Subject: [PATCH 04/29] Refactor dense.jl and move special matrices into different files. --- base/linalg/dense.jl | 589 ---------------------------------- base/linalg/generic.jl | 178 ++++++++++ base/linalg/hermitian.jl | 49 +++ base/linalg/linalg.jl | 189 +---------- base/linalg/rectfullpacked.jl | 49 +++ base/linalg/tridiag.jl | 372 +++++++++++++++++++++ base/linalg/woodbury.jl | 129 ++++++++ base/sysimg.jl | 6 - 8 files changed, 788 insertions(+), 773 deletions(-) create mode 100644 base/linalg/generic.jl create mode 100644 base/linalg/hermitian.jl create mode 100644 base/linalg/rectfullpacked.jl create mode 100644 base/linalg/tridiag.jl create mode 100644 base/linalg/woodbury.jl diff --git a/base/linalg/dense.jl b/base/linalg/dense.jl index b6449d53a3da0..a120032779178 100644 --- a/base/linalg/dense.jl +++ b/base/linalg/dense.jl @@ -1014,592 +1014,3 @@ function cond(A::StridedMatrix, p) return cnd end cond(A::StridedMatrix) = cond(A, 2) - -#### Specialized matrix types #### - -## Hermitian tridiagonal matrices -type SymTridiagonal{T<:BlasFloat} <: AbstractMatrix{T} - dv::Vector{T} # diagonal - ev::Vector{T} # sub/super diagonal - function SymTridiagonal(dv::Vector{T}, ev::Vector{T}) - if length(ev) != length(dv) - 1 error("dimension mismatch") end - new(dv,ev) - end -end - -SymTridiagonal{T<:BlasFloat}(dv::Vector{T}, ev::Vector{T}) = SymTridiagonal{T}(copy(dv), copy(ev)) - -function SymTridiagonal{T<:Real}(dv::Vector{T}, ev::Vector{T}) - SymTridiagonal{Float64}(float64(dv),float64(ev)) -end - -function SymTridiagonal{Td<:Number,Te<:Number}(dv::Vector{Td}, ev::Vector{Te}) - T = promote(Td,Te) - SymTridiagonal(convert(Vector{T}, dv), convert(Vector{T}, ev)) -end - -SymTridiagonal(A::AbstractMatrix) = SymTridiagonal(diag(A), diag(A,1)) - -copy(S::SymTridiagonal) = SymTridiagonal(S.dv,S.ev) - -function full(S::SymTridiagonal) - M = diagm(S.dv) - for i in 1:length(S.ev) - j = i + 1 - M[i,j] = M[j,i] = S.ev[i] - end - M -end - -function show(io::IO, S::SymTridiagonal) - println(io, summary(S), ":") - print(io, "diag: ") - print_matrix(io, (S.dv)') - print(io, "\n sup: ") - print_matrix(io, (S.ev)') -end - -size(m::SymTridiagonal) = (length(m.dv), length(m.dv)) -size(m::SymTridiagonal, d::Integer) = d<1 ? error("dimension out of range") : (d<2 ? length(m.dv) : 1) - -eig(m::SymTridiagonal) = LAPACK.stegr!('V', copy(m.dv), copy(m.ev)) -eigvals(m::SymTridiagonal, il::Int, ih::Int) = LAPACK.stebz!('I', 'E', 0.0, 0.0, il, iu, -1.0, copy(m.dv), copy(m.ev))[1] -eigvals(m::SymTridiagonal, vl::Int, iv::Int) = LAPACK.stebz!('V', 'E', vl, vh, 0, 0, -1.0, copy(m.dv), copy(m.ev))[1] -eigvals(m::SymTridiagonal) = eigvals(m, 1, size(m, 1)) - -## Tridiagonal matrices ## -type Tridiagonal{T} <: AbstractMatrix{T} - dl::Vector{T} # sub-diagonal - d::Vector{T} # diagonal - du::Vector{T} # sup-diagonal - dutmp::Vector{T} # scratch space for vector RHS solver, sup-diagonal - rhstmp::Vector{T}# scratch space, rhs - - function Tridiagonal(N::Integer) - dutmp = Array(T, N-1) - rhstmp = Array(T, N) - new(dutmp, rhstmp, dutmp, dutmp, rhstmp) # first three will be overwritten - end -end - -function Tridiagonal{T<:Number}(dl::Vector{T}, d::Vector{T}, du::Vector{T}) - N = length(d) - if length(dl) != N-1 || length(du) != N-1 - error("The sub- and super-diagonals must have length N-1") - end - M = Tridiagonal{T}(N) - M.dl = copy(dl) - M.d = copy(d) - M.du = copy(du) - return M -end -function Tridiagonal{Tl<:Number, Td<:Number, Tu<:Number}(dl::Vector{Tl}, d::Vector{Td}, du::Vector{Tu}) - R = promote(Tl, Td, Tu) - Tridiagonal(convert(Vector{R}, dl), convert(Vector{R}, d), convert(Vector{R}, du)) -end - -copy(A::Tridiagonal) = Tridiagonal(copy(A.dl), copy(A.d), copy(A.du)) - -size(M::Tridiagonal) = (length(M.d), length(M.d)) -function show(io::IO, M::Tridiagonal) - println(io, summary(M), ":") - print(io, " sub: ") - print_matrix(io, (M.dl)') - print(io, "\ndiag: ") - print_matrix(io, (M.d)') - print(io, "\n sup: ") - print_matrix(io, (M.du)') -end -full{T}(M::Tridiagonal{T}) = convert(Matrix{T}, M) -function convert{T}(::Type{Matrix{T}}, M::Tridiagonal{T}) - A = zeros(T, size(M)) - for i = 1:length(M.d) - A[i,i] = M.d[i] - end - for i = 1:length(M.d)-1 - A[i+1,i] = M.dl[i] - A[i,i+1] = M.du[i] - end - return A -end -function similar(M::Tridiagonal, T, dims::Dims) - if length(dims) != 2 || dims[1] != dims[2] - error("Tridiagonal matrices must be square") - end - return Tridiagonal{T}(dims[1]) -end -copy(M::Tridiagonal) = Tridiagonal(M.dl, M.d, M.du) - -# Operations on Tridiagonal matrices -round(M::Tridiagonal) = Tridiagonal(round(M.dl), round(M.d), round(M.du)) -iround(M::Tridiagonal) = Tridiagonal(iround(M.dl), iround(M.d), iround(M.du)) - -## Solvers - -#### Tridiagonal matrix routines #### -function \{T<:BlasFloat}(M::Tridiagonal{T}, rhs::StridedVecOrMat{T}) - if stride(rhs, 1) == 1 - return LAPACK.gtsv!(copy(M.dl), copy(M.d), copy(M.du), copy(rhs)) - end - solve(M, rhs) # use the Julia "fallback" -end - -# This is definitely not going to work -#eig(M::Tridiagonal) = LAPACK.stev!('V', copy(M)) - -# Allocation-free variants -# Note that solve is non-aliasing, so you can use the same array for -# input and output -function solve(x::AbstractArray, xrng::Ranges{Int}, M::Tridiagonal, rhs::AbstractArray, rhsrng::Ranges{Int}) - d = M.d - N = length(d) - if length(xrng) != N || length(rhsrng) != N - error("dimension mismatch") - end - dl = M.dl - du = M.du - dutmp = M.dutmp - rhstmp = M.rhstmp - xstart = first(xrng) - xstride = step(xrng) - rhsstart = first(rhsrng) - rhsstride = step(rhsrng) - # Forward sweep - denom = d[1] - dulast = du[1] / denom - dutmp[1] = dulast - rhslast = rhs[rhsstart] / denom - rhstmp[1] = rhslast - irhs = rhsstart+rhsstride - for i in 2:N-1 - dltmp = dl[i-1] - denom = d[i] - dltmp*dulast - dulast = du[i] / denom - dutmp[i] = dulast - rhslast = (rhs[irhs] - dltmp*rhslast)/denom - rhstmp[i] = rhslast - irhs += rhsstride - end - dltmp = dl[N-1] - denom = d[N] - dltmp*dulast - xlast = (rhs[irhs] - dltmp*rhslast)/denom - # Backward sweep - ix = xstart + (N-2)*xstride - x[ix+xstride] = xlast - for i in N-1:-1:1 - xlast = rhstmp[i] - dutmp[i]*xlast - x[ix] = xlast - ix -= xstride - end - return x -end - -solve(x::StridedVector, M::Tridiagonal, rhs::StridedVector) = solve(x, 1:length(x), M, rhs, 1:length(rhs)) - -function solve(M::Tridiagonal, rhs::StridedVector) - x = similar(rhs) - solve(x, M, rhs) -end - -function solve(X::StridedMatrix, M::Tridiagonal, B::StridedMatrix) - if size(B, 1) != size(M, 1) - error("dimension mismatch") - end - if size(X) != size(B) - error("dimension mismatch in output") - end - m, n = size(B) - r = 1:m - for j = 1:n - r.start = (j-1)*m+1 - solve(X, r, M, B, r) - end - return X -end - -function solve(M::Tridiagonal, B::StridedMatrix) - X = similar(B) - solve(X, M, B) -end - -# User-friendly solver -\(M::Tridiagonal, rhs::Union(StridedVector,StridedMatrix)) = solve(M, rhs) - -# Tridiagonal multiplication -function mult(x::AbstractArray, xrng::Ranges{Int}, M::Tridiagonal, v::AbstractArray, vrng::Ranges{Int}) - dl = M.dl - d = M.d - du = M.du - N = length(d) - xi = first(xrng) - xstride = step(xrng) - vi = first(vrng) - vstride = step(vrng) - x[xi] = d[1]*v[vi] + du[1]*v[vi+vstride] - xi += xstride - for i = 2:N-1 - x[xi] = dl[i-1]*v[vi] + d[i]*v[vi+vstride] + du[i]*v[vi+2*vstride] - xi += xstride - vi += vstride - end - x[xi] = dl[N-1]*v[vi] + d[N]*v[vi+vstride] - return x -end - -mult(x::StridedVector, M::Tridiagonal, v::StridedVector) = mult(x, 1:length(x), M, v, 1:length(v)) - -function mult(X::StridedMatrix, M::Tridiagonal, B::StridedMatrix) - if size(B, 1) != size(M, 1) - error("dimension mismatch") - end - if size(X) != size(B) - error("dimension mismatch in output") - end - m, n = size(B) - r = 1:m - for j = 1:n - r.start = (j-1)*m+1 - mult(X, r, M, B, r) - end - return X -end - -mult(X::StridedMatrix, M1::Tridiagonal, M2::Tridiagonal) = mult(X, M1, full(M2)) - -function *(M::Tridiagonal, B::Union(StridedVector,StridedMatrix)) - X = similar(B) - mult(X, M, B) -end - -*(A::Tridiagonal, B::Tridiagonal) = A*full(B) - -#### Factorizations for Tridiagonal #### -type LDLTTridiagonal{T<:BlasFloat,S<:BlasFloat} <: Factorization{T} - D::Vector{S} - E::Vector{T} - function LDLTTridiagonal(D::Vector{S}, E::Vector{T}) - if typeof(real(E[1])) != eltype(D) error("Wrong eltype") end - new(D, E) - end -end - -LDLTTridiagonal{S<:BlasFloat,T<:BlasFloat}(D::Vector{S}, E::Vector{T}) = LDLTTridiagonal{T,S}(D, E) - -ldltd!{T<:BlasFloat}(A::SymTridiagonal{T}) = LDLTTridiagonal(LAPACK.pttrf!(real(A.dv),A.ev)...) -ldltd{T<:BlasFloat}(A::SymTridiagonal{T}) = ldltd!(copy(A)) - -function (\){T<:BlasFloat}(C::LDLTTridiagonal{T}, B::StridedVecOrMat{T}) - if iscomplex(B) return LAPACK.pttrs!('L', C.D, C.E, copy(B)) end - LAPACK.pttrs!(C.D, C.E, copy(B)) -end - -type LUTridiagonal{T} <: Factorization{T} - dl::Vector{T} - d::Vector{T} - du::Vector{T} - du2::Vector{T} - ipiv::Vector{BlasInt} - function LUTridiagonal(dl::Vector{T}, d::Vector{T}, du::Vector{T}, - du2::Vector{T}, ipiv::Vector{BlasInt}) - n = length(d) - if length(dl) != n - 1 || length(du) != n - 1 || length(ipiv) != n || length(du2) != n-2 - error("LUTridiagonal: dimension mismatch") - end - new(dl, d, du, du2, ipiv) - end -end -LUTridiagonal{T}(A::Tridiagonal{T}) = LUTridiagonal{T}(LAPACK.gttrf!(A.dl,A.d,A.du)...) - -#show(io, lu::LUTridiagonal) = print(io, "LU decomposition of ", summary(lu.lu)) - -function det{T}(lu::LUTridiagonal{T}) - n = length(lu.d) - prod(lu.d) * (bool(sum(lu.ipiv .!= 1:n) % 2) ? -one(T) : one(T)) -end - -det(A::Tridiagonal) = det(LUTridiagonal(copy(A))) - -(\){T<:BlasFloat}(lu::LUTridiagonal{T}, B::StridedVecOrMat{T}) = - LAPACK.gttrs!('N', lu.dl, lu.d, lu.du, lu.du2, lu.ipiv, copy(B)) - - -#### Woodbury matrices #### -# This type provides support for the Woodbury matrix identity -type Woodbury{T} <: AbstractMatrix{T} - A - U::Matrix{T} - C - Cp - V::Matrix{T} - tmpN1::Vector{T} - tmpN2::Vector{T} - tmpk1::Vector{T} - tmpk2::Vector{T} - - function Woodbury(A::AbstractMatrix{T}, U::Matrix{T}, C, V::Matrix{T}) - N = size(A, 1) - k = size(U, 2) - if size(A, 2) != N || size(U, 1) != N || size(V, 1) != k || size(V, 2) != N - error("Sizes do not match") - end - if k > 1 - if size(C, 1) != k || size(C, 2) != k - error("Size of C is incorrect") - end - end - Cp = inv(inv(C) + V*(A\U)) - # temporary space for allocation-free solver - tmpN1 = Array(T, N) - tmpN2 = Array(T, N) - tmpk1 = Array(T, k) - tmpk2 = Array(T, k) - # don't copy A, it could be huge - new(A, copy(U), copy(C), Cp, copy(V), tmpN1, tmpN2, tmpk1, tmpk2) - end -end -Woodbury{T}(A::AbstractMatrix{T}, U::Matrix{T}, C, V::Matrix{T}) = Woodbury{T}(A, U, C, V) -Woodbury{T}(A::AbstractMatrix{T}, U::Vector{T}, C, V::Matrix{T}) = Woodbury{T}(A, reshape(U, length(U), 1), C, V) - -size(W::Woodbury) = size(W.A) -function show(io::IO, W::Woodbury) - println(io, summary(W), ":") - print(io, "A: ", W.A) - print(io, "\nU:\n") - print_matrix(io, W.U) - if isa(W.C, Matrix) - print(io, "\nC:\n") - print_matrix(io, W.C) - else - print(io, "\nC: ", W.C) - end - print(io, "\nV:\n") - print_matrix(io, W.V) -end -full{T}(W::Woodbury{T}) = convert(Matrix{T}, W) -convert{T}(::Type{Matrix{T}}, W::Woodbury{T}) = full(W.A) + W.U*W.C*W.V -function similar(W::Woodbury, T, dims::Dims) - if length(dims) != 2 || dims[1] != dims[2] - error("Woodbury matrices must be square") - end - n = size(W, 1) - k = size(W.U, 2) - return Woodbury{T}(similar(W.A), Array(T, n, k), Array(T, k, k), Array(T, k, n)) -end -copy(W::Woodbury) = Woodbury(W.A, W.U, W.C, W.V) - -## Woodbury matrix routines ## - -function *(W::Woodbury, B::StridedVecOrMat) - return W.A*B + W.U*(W.C*(W.V*B)) -end -function \(W::Woodbury, R::StridedVecOrMat) - AinvR = W.A\R - return AinvR - W.A\(W.U*(W.Cp*(W.V*AinvR))) -end -function det(W::Woodbury) - det(W.A)*det(W.C)/det(W.Cp) -end - -# Allocation-free solver for arbitrary strides (requires that W.A has a -# non-aliasing "solve" routine, e.g., is Tridiagonal) -function solve(x::AbstractArray, xrng::Ranges{Int}, W::Woodbury, rhs::AbstractArray, rhsrng::Ranges{Int}) - solve(W.tmpN1, 1:length(W.tmpN1), W.A, rhs, rhsrng) - A_mul_B(W.tmpk1, W.V, W.tmpN1) - A_mul_B(W.tmpk2, W.Cp, W.tmpk1) - A_mul_B(W.tmpN2, W.U, W.tmpk2) - solve(W.tmpN2, W.A, W.tmpN2) - indx = first(xrng) - xinc = step(xrng) - for i = 1:length(W.tmpN2) - x[indx] = W.tmpN1[i] - W.tmpN2[i] - indx += xinc - end -end -solve(x::AbstractVector, W::Woodbury, rhs::AbstractVector) = solve(x, 1:length(x), W, rhs, 1:length(rhs)) -function solve(W::Woodbury, rhs::AbstractVector) - x = similar(rhs) - solve(x, W, rhs) -end -function solve(X::StridedMatrix, W::Woodbury, B::StridedMatrix) - if size(B, 1) != size(W, 1) - error("dimension mismatch") - end - if size(X) != size(B) - error("dimension mismatch in output") - end - m, n = size(B) - r = 1:m - for j = 1:n - r.start = (j-1)*m+1 - solve(X, r, W, B, r) - end - return X -end -function solve(W::Woodbury, B::StridedMatrix) - X = similar(B) - solve(X, W, B) -end - -### Special types used for dispatch -## Triangular -type Triangular{T<:BlasFloat} <: AbstractMatrix{T} - UL::Matrix{T} - uplo::Char - unitdiag::Char - function Triangular(A::Matrix{T}, uplo::Char, unitdiag::Char) - if size(A, 1) != size(A, 2) throw(LAPACK.DimensionMismatch("Matrix must be square")) end - return new(A, uplo, unitdiag) - end -end -Triangular{T<:BlasFloat}(A::Matrix{T}, uplo::Char, unitdiag::Char) = Triangular{T}(A, uplo, unitdiag) -Triangular(A::Matrix, uplo::Char, unitdiag::Bool) = Triangular(A, uplo, unitdiag ? 'U' : 'N') -Triangular(A::Matrix, uplo::Char) = Triangular(A, uplo, all(diag(A) .== 1) ? true : false) -function Triangular(A::Matrix) - if istriu(A) return Triangular(A, 'U') end - if istril(A) return Triangular(A, 'L') end - error("Matrix is not triangular") -end - -size(A::Triangular, args...) = size(A.UL, args...) -function full(A::Triangular) - if - istril(A) return tril(A.UL) - else - return triu(A.UL) - end -end -print_matrix(io::IO, A::Triangular) = print_matrix(io, full(A)) - -istril(A::Triangular) = A.uplo == 'L' -istriu(A::Triangular) = A.uplo == 'U' - -# Vector multiplication -*(A::Triangular, b::Vector) = BLAS.trmv(A.uplo, 'N', A.unitdiag, A.UL, b) -Ac_mul_B{T<:Union(Complex128, Complex64)}(A::Triangular{T}, b::Vector{T}) = BLAS.trmv(A.uplo, 'C', A.unitdiag, A.UL, b) -At_mul_B{T<:Union(Float64, Float32)}(A::Triangular{T}, b::Vector{T}) = BLAS.trmv(A.uplo, 'T', A.unitdiag, A.UL, b) - -# Matrix multiplication -*(A::Triangular, B::StridedMatrix) = BLAS.trmm('L', A.uplo, 'N', A.unitdiag, 1.0, A.UL, B) -*(A::StridedMatrix, B::Triangular) = BLAS.trmm('R', B.uplo, 'N', B.unitdiag, 1.0, A, B.UL) -Ac_mul_B{T<:Union(Complex128, Complex64)}(A::Triangular{T}, B::StridedMatrix{T}) = BLAS.trmm('L', A.uplo, 'C', A.unitdiag, 1.0, A.UL, B) -Ac_mul_B{T<:Union(Float64, Float32)}(A::Triangular{T}, B::StridedMatrix{T}) = BLAS.trmm('L', A.uplo, 'T', A.unitdiag, 1.0, A.UL, B) -A_mul_Bc{T<:Union(Complex128, Complex64)}(A::StridedMatrix{T}, B::Triangular{T}) = BLAS.trmm('R', B.uplo, 'C', B.unitdiag, 1.0, A, B.UL) -A_mul_Bc{T<:Union(Float64, Float32)}(A::StridedMatrix{T}, B::Triangular{T}) = BLAS.trmm('R', B.uplo, 'T', B.unitdiag, 1.0, A, B.UL) - -function \(A::Triangular, B::StridedVecOrMat) - r, info = LAPACK.trtrs!(A.uplo, 'N', A.unitdiag, A.UL, copy(B)) - if info > 0 throw(LAPACK.SingularException(info)) end - return r -end -function Ac_ldiv_B{T<:Union(Float64, Float32)}(A::Triangular{T}, B::StridedVecOrMat{T}) - r, info = LAPACK.trtrs!(A.uplo, 'T', A.unitdiag, A.UL, copy(B)) - if info > 0 throw(LAPACK.SingularException(info)) end - return r -end -function Ac_ldiv_B{T<:Union(Complex128, Complex64)}(A::Triangular{T}, B::StridedVecOrMat{T}) - r, info = LAPACK.trtrs!(A.uplo, 'C', A.unitdiag, A.UL, copy(B)) - if info > 0 throw(LAPACK.SingularException(info)) end - return r -end - -det(A::Triangular) = prod(diag(A.UL)) - -inv(A::Triangular) = LAPACK.trtri!(A.uplo, A.unitdiag, copy(A.UL))[1] - -## Hermitian -type Hermitian{T<:BlasFloat} <: AbstractMatrix{T} - S::Matrix{T} - uplo::Char - function Hermitian(S::Matrix{T}, uplo::Char) - if size(S, 1) != size(S, 2) throw(LAPACK.DimensionMismatch("Matrix must be square")); end - return new(S, uplo) - end -end -Hermitian{T<:BlasFloat}(S::Matrix{T}, uplo::Char) = Hermitian{T}(S, uplo) -Hermitian(A::StridedMatrix) = Hermitian(A, 'U') - -size(A::Hermitian, args...) = size(A.S, args...) -print_matrix(io::IO, A::Hermitian) = print_matrix(io, full(A)) -full(A::Hermitian) = symmetrize!(copy(A.S), A.uplo) -ishermitian(A::Hermitian) = true -issym{T<:Union(Float64, Float32)}(A::Hermitian{T}) = true - -function \(A::Hermitian, B::StridedVecOrMat) - r, _, _, info = LAPACK.sysv!(A.uplo, copy(A.S), copy(B)) - if info > 0 throw(LAPACK.SingularException(info)) end - return r -end - -inv(A::Hermitian) = inv(BunchKaufman(copy(A.S), A.uplo)) - -eig(A::Hermitian) = LAPACK.syevr!('V', 'A', A.uplo, copy(A.S), 0.0, 0.0, 0, 0, -1.0) -eigvals(A::Hermitian, il::Int, ih::Int) = LAPACK.syevr!('N', 'I', A.uplo, copy(A.S), 0.0, 0.0, il, ih, -1.0)[1] -eigvals(A::Hermitian, vl::Real, vh::Real) = LAPACK.syevr!('N', 'V', A.uplo, copy(A.S), vl, vh, 0, 0, -1.0)[1] -eigvals(A::Hermitian) = eigvals(A, 1, size(A, 1)) -eigmax(A::Hermitian) = eigvals(A, size(A, 1), size(A, 1))[1] - -function sqrtm(A::Hermitian, cond::Bool) - v, z = eig(A) - vsqrt = sqrt(complex(v)) - if all(imag(vsqrt) .== 0) - retmat = symmetrize!(diagmm(z, real(vsqrt)) * z') - else - zc = complex(z) - retmat = symmetrize!(diagmm(zc, vsqrt) * zc') - end - if cond - return retmat, norm(vsqrt, Inf)^2/norm(v, Inf) - else - return retmat - end -end - -# Rectangular Full Packed Matrices - -type SymmetricRFP{T<:BlasFloat} <: AbstractMatrix{T} - data::Vector{T} - transr::Char - uplo::Char -end - -function Ac_mul_A_RFP{T<:BlasFloat}(A::Matrix{T}) - n = size(A, 2) - C = LAPACK.sfrk!('N', 'U', 'T', 1.0, A, 0.0, Array(T, div(n*(n+1),2))) - return SymmetricRFP(C, 'N', 'U') -end - -type TriangularRFP{T<:BlasFloat} <: AbstractMatrix{T} - data::Vector{T} - transr::Char - uplo::Char -end -TriangularRFP(A::Matrix) = TriangularRFP(trttf!('N', 'U', A)[1], 'N', 'U') - -function full(A::TriangularRFP) - B = LAPACK.tfttr!(A.transr, A.uplo, A.data)[1] - if A.uplo == 'U' - return triu!(B) - else - return tril!(B) - end -end - -type CholeskyDenseRFP{T<:BlasFloat} <: Factorization{T} - data::Vector{T} - transr::Char - uplo::Char -end - -function chol(A::SymmetricRFP) - C, info = LAPACK.pftrf!(A.transr, A.uplo, copy(A.data)) - return CholeskyDenseRFP(C, A.transr, A.uplo) -end - -# Least squares -\(A::CholeskyDenseRFP, B::VecOrMat) = LAPACK.pftrs!(A.transr, A.uplo, A.data, copy(B)) - -function inv(A::CholeskyDenseRFP) - B, info = LAPACK.pftri!(A.transr, A.uplo, copy(A.data)) - if info > 0 throw(LAPACK.SingularException(info)) end - return B -end \ No newline at end of file diff --git a/base/linalg/generic.jl b/base/linalg/generic.jl new file mode 100644 index 0000000000000..8ab7fe45f5a9d --- /dev/null +++ b/base/linalg/generic.jl @@ -0,0 +1,178 @@ +## linalg.jl: Some generic Linear Algebra definitions + +function scale!{T<:Number}(X::StridedArray{T}, s::Real) + # FIXME: could use BLAS in more cases + for i in 1:length(X) + X[i] *= s; + end + return X +end + +cross(a::Vector, b::Vector) = + [a[2]*b[3]-a[3]*b[2], a[3]*b[1]-a[1]*b[3], a[1]*b[2]-a[2]*b[1]] + +triu(M::AbstractMatrix) = triu(M,0) +tril(M::AbstractMatrix) = tril(M,0) +#triu{T}(M::AbstractMatrix{T}, k::Integer) +#tril{T}(M::AbstractMatrix{T}, k::Integer) +triu!(M::AbstractMatrix) = triu!(M,0) +tril!(M::AbstractMatrix) = tril!(M,0) + +#diff(a::AbstractVector) +#diff(a::AbstractMatrix, dim::Integer) +diff(a::AbstractMatrix) = diff(a, 1) + +gradient(F::AbstractVector) = gradient(F, [1:length(F)]) +gradient(F::AbstractVector, h::Real) = gradient(F, [h*(1:length(F))]) +#gradient(F::AbstractVector, h::AbstractVector) + +diag(A::AbstractVector) = error("Perhaps you meant to use diagm().") +#diag(A::AbstractMatrix) + +#diagm{T}(v::Union(AbstractVector{T},AbstractMatrix{T})) + +function norm{T}(x::AbstractVector{T}, p::Number) + if length(x) == 0 + a = zero(T) + elseif p == Inf + a = max(abs(x)) + elseif p == -Inf + a = min(abs(x)) + else + absx = abs(x) + dx = max(absx) + if dx != zero(T) + scale!(absx, 1/dx) + a = dx * (sum(absx.^p).^(1/p)) + else + a = sum(absx.^p).^(1/p) + end + end + return float(a) +end +norm{T<:Integer}(x::AbstractVector{T}, p::Number) = norm(float(x), p) +norm(x::AbstractVector) = norm(x, 2) + +function norm(A::AbstractMatrix, p::Number) + m, n = size(A) + if m == 0 || n == 0 + a = zero(eltype(A)) + elseif m == 1 || n == 1 + a = norm(reshape(A, length(A)), p) + elseif p == 1 + a = max(sum(abs(A),1)) + elseif p == 2 + a = max(svdvals(A)) + elseif p == Inf + a = max(sum(abs(A),2)) + else + error("invalid parameter p given to compute matrix norm") + end + return float(a) +end + +norm(A::AbstractMatrix) = norm(A, 2) + +norm(x::Number) = abs(x) +norm(x::Number, p) = abs(x) + +normfro(A::AbstractMatrix) = norm(reshape(A, length(A))) +normfro(x::Number) = abs(x) + +rank(A::AbstractMatrix, tol::Real) = sum(svdvals(A) .> tol) +function rank(A::AbstractMatrix) + m,n = size(A) + if m == 0 || n == 0; return 0; end + sv = svdvals(A) + sum(sv .> max(size(A))*eps(sv[1])) +end +rank(x::Number) = x == 0 ? 0 : 1 + +trace(A::AbstractMatrix) = sum(diag(A)) +trace(x::Number) = x + +#kron(a::AbstractVector, b::AbstractVector) +#kron{T,S}(a::AbstractMatrix{T}, b::AbstractMatrix{S}) + +#det(a::AbstractMatrix) +inv(a::AbstractMatrix) = a \ one(a) + +cond(x::Number) = x == 0 ? Inf : 1.0 +cond(x::Number, p) = cond(x) + +function issym(A::AbstractMatrix) + m, n = size(A) + if m != n; return false; end + for i = 1:(n-1), j = (i+1):n + if A[i,j] != A[j,i] + return false + end + end + return true +end + +issym(x::Number) = true + +function ishermitian(A::AbstractMatrix) + m, n = size(A) + if m != n; return false; end + for i = 1:n, j = i:n + if A[i,j] != conj(A[j,i]) + return false + end + end + return true +end + +ishermitian(x::Number) = (x == conj(x)) + +function istriu(A::AbstractMatrix) + m, n = size(A) + for j = 1:min(n,m-1), i = j+1:m + if A[i,j] != 0 + return false + end + end + return true +end + +function istril(A::AbstractMatrix) + m, n = size(A) + for j = 2:n, i = 1:min(j-1,m) + if A[i,j] != 0 + return false + end + end + return true +end + +istriu(x::Number) = true +istril(x::Number) = true + +function linreg{T<:Number}(X::StridedVecOrMat{T}, y::Vector{T}) + [ones(T, size(X,1)) X] \ y +end + +# weighted least squares +function linreg(x::AbstractVector, y::AbstractVector, w::AbstractVector) + w = sqrt(w) + [w w.*x] \ (w.*y) +end + +# multiply by diagonal matrix as vector +#diagmm!(C::AbstractMatrix, A::AbstractMatrix, b::AbstractVector) + +#diagmm!(C::AbstractMatrix, b::AbstractVector, A::AbstractMatrix) + +diagmm!(A::AbstractMatrix, b::AbstractVector) = diagmm!(A,A,b) +diagmm!(b::AbstractVector, A::AbstractMatrix) = diagmm!(A,b,A) + +#diagmm(A::AbstractMatrix, b::AbstractVector) +#diagmm(b::AbstractVector, A::AbstractMatrix) + +#^(A::AbstractMatrix, p::Number) + +#findmax(a::AbstractArray) +#findmin(a::AbstractArray) + +#rref{T}(A::AbstractMatrix{T}) diff --git a/base/linalg/hermitian.jl b/base/linalg/hermitian.jl new file mode 100644 index 0000000000000..e2b9f2cc17649 --- /dev/null +++ b/base/linalg/hermitian.jl @@ -0,0 +1,49 @@ +## Hermitian matrices + +type Hermitian{T<:BlasFloat} <: AbstractMatrix{T} + S::Matrix{T} + uplo::Char + function Hermitian(S::Matrix{T}, uplo::Char) + if size(S, 1) != size(S, 2) throw(LAPACK.DimensionMismatch("Matrix must be square")); end + return new(S, uplo) + end +end + +Hermitian{T<:BlasFloat}(S::Matrix{T}, uplo::Char) = Hermitian{T}(S, uplo) +Hermitian(A::StridedMatrix) = Hermitian(A, 'U') + +size(A::Hermitian, args...) = size(A.S, args...) +print_matrix(io::IO, A::Hermitian) = print_matrix(io, full(A)) +full(A::Hermitian) = symmetrize!(copy(A.S), A.uplo) +ishermitian(A::Hermitian) = true +issym{T<:Union(Float64, Float32)}(A::Hermitian{T}) = true + +function \(A::Hermitian, B::StridedVecOrMat) + r, _, _, info = LAPACK.sysv!(A.uplo, copy(A.S), copy(B)) + if info > 0 throw(LAPACK.SingularException(info)) end + return r +end + +inv(A::Hermitian) = inv(BunchKaufman(copy(A.S), A.uplo)) + +eig(A::Hermitian) = LAPACK.syevr!('V', 'A', A.uplo, copy(A.S), 0.0, 0.0, 0, 0, -1.0) +eigvals(A::Hermitian, il::Int, ih::Int) = LAPACK.syevr!('N', 'I', A.uplo, copy(A.S), 0.0, 0.0, il, ih, -1.0)[1] +eigvals(A::Hermitian, vl::Real, vh::Real) = LAPACK.syevr!('N', 'V', A.uplo, copy(A.S), vl, vh, 0, 0, -1.0)[1] +eigvals(A::Hermitian) = eigvals(A, 1, size(A, 1)) +eigmax(A::Hermitian) = eigvals(A, size(A, 1), size(A, 1))[1] + +function sqrtm(A::Hermitian, cond::Bool) + v, z = eig(A) + vsqrt = sqrt(complex(v)) + if all(imag(vsqrt) .== 0) + retmat = symmetrize!(diagmm(z, real(vsqrt)) * z') + else + zc = complex(z) + retmat = symmetrize!(diagmm(zc, vsqrt) * zc') + end + if cond + return retmat, norm(vsqrt, Inf)^2/norm(v, Inf) + else + return retmat + end +end diff --git a/base/linalg/linalg.jl b/base/linalg/linalg.jl index 8ab7fe45f5a9d..5d21f7ace29ac 100644 --- a/base/linalg/linalg.jl +++ b/base/linalg/linalg.jl @@ -1,178 +1,11 @@ -## linalg.jl: Some generic Linear Algebra definitions - -function scale!{T<:Number}(X::StridedArray{T}, s::Real) - # FIXME: could use BLAS in more cases - for i in 1:length(X) - X[i] *= s; - end - return X -end - -cross(a::Vector, b::Vector) = - [a[2]*b[3]-a[3]*b[2], a[3]*b[1]-a[1]*b[3], a[1]*b[2]-a[2]*b[1]] - -triu(M::AbstractMatrix) = triu(M,0) -tril(M::AbstractMatrix) = tril(M,0) -#triu{T}(M::AbstractMatrix{T}, k::Integer) -#tril{T}(M::AbstractMatrix{T}, k::Integer) -triu!(M::AbstractMatrix) = triu!(M,0) -tril!(M::AbstractMatrix) = tril!(M,0) - -#diff(a::AbstractVector) -#diff(a::AbstractMatrix, dim::Integer) -diff(a::AbstractMatrix) = diff(a, 1) - -gradient(F::AbstractVector) = gradient(F, [1:length(F)]) -gradient(F::AbstractVector, h::Real) = gradient(F, [h*(1:length(F))]) -#gradient(F::AbstractVector, h::AbstractVector) - -diag(A::AbstractVector) = error("Perhaps you meant to use diagm().") -#diag(A::AbstractMatrix) - -#diagm{T}(v::Union(AbstractVector{T},AbstractMatrix{T})) - -function norm{T}(x::AbstractVector{T}, p::Number) - if length(x) == 0 - a = zero(T) - elseif p == Inf - a = max(abs(x)) - elseif p == -Inf - a = min(abs(x)) - else - absx = abs(x) - dx = max(absx) - if dx != zero(T) - scale!(absx, 1/dx) - a = dx * (sum(absx.^p).^(1/p)) - else - a = sum(absx.^p).^(1/p) - end - end - return float(a) -end -norm{T<:Integer}(x::AbstractVector{T}, p::Number) = norm(float(x), p) -norm(x::AbstractVector) = norm(x, 2) - -function norm(A::AbstractMatrix, p::Number) - m, n = size(A) - if m == 0 || n == 0 - a = zero(eltype(A)) - elseif m == 1 || n == 1 - a = norm(reshape(A, length(A)), p) - elseif p == 1 - a = max(sum(abs(A),1)) - elseif p == 2 - a = max(svdvals(A)) - elseif p == Inf - a = max(sum(abs(A),2)) - else - error("invalid parameter p given to compute matrix norm") - end - return float(a) -end - -norm(A::AbstractMatrix) = norm(A, 2) - -norm(x::Number) = abs(x) -norm(x::Number, p) = abs(x) - -normfro(A::AbstractMatrix) = norm(reshape(A, length(A))) -normfro(x::Number) = abs(x) - -rank(A::AbstractMatrix, tol::Real) = sum(svdvals(A) .> tol) -function rank(A::AbstractMatrix) - m,n = size(A) - if m == 0 || n == 0; return 0; end - sv = svdvals(A) - sum(sv .> max(size(A))*eps(sv[1])) -end -rank(x::Number) = x == 0 ? 0 : 1 - -trace(A::AbstractMatrix) = sum(diag(A)) -trace(x::Number) = x - -#kron(a::AbstractVector, b::AbstractVector) -#kron{T,S}(a::AbstractMatrix{T}, b::AbstractMatrix{S}) - -#det(a::AbstractMatrix) -inv(a::AbstractMatrix) = a \ one(a) - -cond(x::Number) = x == 0 ? Inf : 1.0 -cond(x::Number, p) = cond(x) - -function issym(A::AbstractMatrix) - m, n = size(A) - if m != n; return false; end - for i = 1:(n-1), j = (i+1):n - if A[i,j] != A[j,i] - return false - end - end - return true -end - -issym(x::Number) = true - -function ishermitian(A::AbstractMatrix) - m, n = size(A) - if m != n; return false; end - for i = 1:n, j = i:n - if A[i,j] != conj(A[j,i]) - return false - end - end - return true -end - -ishermitian(x::Number) = (x == conj(x)) - -function istriu(A::AbstractMatrix) - m, n = size(A) - for j = 1:min(n,m-1), i = j+1:m - if A[i,j] != 0 - return false - end - end - return true -end - -function istril(A::AbstractMatrix) - m, n = size(A) - for j = 2:n, i = 1:min(j-1,m) - if A[i,j] != 0 - return false - end - end - return true -end - -istriu(x::Number) = true -istril(x::Number) = true - -function linreg{T<:Number}(X::StridedVecOrMat{T}, y::Vector{T}) - [ones(T, size(X,1)) X] \ y -end - -# weighted least squares -function linreg(x::AbstractVector, y::AbstractVector, w::AbstractVector) - w = sqrt(w) - [w w.*x] \ (w.*y) -end - -# multiply by diagonal matrix as vector -#diagmm!(C::AbstractMatrix, A::AbstractMatrix, b::AbstractVector) - -#diagmm!(C::AbstractMatrix, b::AbstractVector, A::AbstractMatrix) - -diagmm!(A::AbstractMatrix, b::AbstractVector) = diagmm!(A,A,b) -diagmm!(b::AbstractVector, A::AbstractMatrix) = diagmm!(A,b,A) - -#diagmm(A::AbstractMatrix, b::AbstractVector) -#diagmm(b::AbstractVector, A::AbstractMatrix) - -#^(A::AbstractMatrix, p::Number) - -#findmax(a::AbstractArray) -#findmin(a::AbstractArray) - -#rref{T}(A::AbstractMatrix{T}) +include("linalg/generic.jl") +include("linalg/blas.jl") +include("linalg/lapack.jl") +include("linalg/matmul.jl") +include("linalg/dense.jl") +include("linalg/hermitian.jl") +include("linalg/woodbury.jl") +include("linalg/tridiag.jl") +include("linalg/rectfullpacked.jl") +include("linalg/bitarray.jl") +include("linalg/sparse.jl") diff --git a/base/linalg/rectfullpacked.jl b/base/linalg/rectfullpacked.jl new file mode 100644 index 0000000000000..e057f9e3e5066 --- /dev/null +++ b/base/linalg/rectfullpacked.jl @@ -0,0 +1,49 @@ +# Rectangular Full Packed Matrices + +type SymmetricRFP{T<:BlasFloat} <: AbstractMatrix{T} + data::Vector{T} + transr::Char + uplo::Char +end + +function Ac_mul_A_RFP{T<:BlasFloat}(A::Matrix{T}) + n = size(A, 2) + C = LAPACK.sfrk!('N', 'U', 'T', 1.0, A, 0.0, Array(T, div(n*(n+1),2))) + return SymmetricRFP(C, 'N', 'U') +end + +type TriangularRFP{T<:BlasFloat} <: AbstractMatrix{T} + data::Vector{T} + transr::Char + uplo::Char +end +TriangularRFP(A::Matrix) = TriangularRFP(trttf!('N', 'U', A)[1], 'N', 'U') + +function full(A::TriangularRFP) + B = LAPACK.tfttr!(A.transr, A.uplo, A.data)[1] + if A.uplo == 'U' + return triu!(B) + else + return tril!(B) + end +end + +type CholeskyDenseRFP{T<:BlasFloat} <: Factorization{T} + data::Vector{T} + transr::Char + uplo::Char +end + +function chol(A::SymmetricRFP) + C, info = LAPACK.pftrf!(A.transr, A.uplo, copy(A.data)) + return CholeskyDenseRFP(C, A.transr, A.uplo) +end + +# Least squares +\(A::CholeskyDenseRFP, B::VecOrMat) = LAPACK.pftrs!(A.transr, A.uplo, A.data, copy(B)) + +function inv(A::CholeskyDenseRFP) + B, info = LAPACK.pftri!(A.transr, A.uplo, copy(A.data)) + if info > 0 throw(LAPACK.SingularException(info)) end + return B +end diff --git a/base/linalg/tridiag.jl b/base/linalg/tridiag.jl new file mode 100644 index 0000000000000..a0e371147f8b6 --- /dev/null +++ b/base/linalg/tridiag.jl @@ -0,0 +1,372 @@ +#### Specialized matrix types #### + +## Hermitian tridiagonal matrices +type SymTridiagonal{T<:BlasFloat} <: AbstractMatrix{T} + dv::Vector{T} # diagonal + ev::Vector{T} # sub/super diagonal + function SymTridiagonal(dv::Vector{T}, ev::Vector{T}) + if length(ev) != length(dv) - 1 error("dimension mismatch") end + new(dv,ev) + end +end + +SymTridiagonal{T<:BlasFloat}(dv::Vector{T}, ev::Vector{T}) = SymTridiagonal{T}(copy(dv), copy(ev)) + +function SymTridiagonal{T<:Real}(dv::Vector{T}, ev::Vector{T}) + SymTridiagonal{Float64}(float64(dv),float64(ev)) +end + +function SymTridiagonal{Td<:Number,Te<:Number}(dv::Vector{Td}, ev::Vector{Te}) + T = promote(Td,Te) + SymTridiagonal(convert(Vector{T}, dv), convert(Vector{T}, ev)) +end + +SymTridiagonal(A::AbstractMatrix) = SymTridiagonal(diag(A), diag(A,1)) + +copy(S::SymTridiagonal) = SymTridiagonal(S.dv,S.ev) + +function full(S::SymTridiagonal) + M = diagm(S.dv) + for i in 1:length(S.ev) + j = i + 1 + M[i,j] = M[j,i] = S.ev[i] + end + M +end + +function show(io::IO, S::SymTridiagonal) + println(io, summary(S), ":") + print(io, "diag: ") + print_matrix(io, (S.dv)') + print(io, "\n sup: ") + print_matrix(io, (S.ev)') +end + +size(m::SymTridiagonal) = (length(m.dv), length(m.dv)) +size(m::SymTridiagonal, d::Integer) = d<1 ? error("dimension out of range") : (d<2 ? length(m.dv) : 1) + +eig(m::SymTridiagonal) = LAPACK.stegr!('V', copy(m.dv), copy(m.ev)) +eigvals(m::SymTridiagonal, il::Int, ih::Int) = LAPACK.stebz!('I', 'E', 0.0, 0.0, il, iu, -1.0, copy(m.dv), copy(m.ev))[1] +eigvals(m::SymTridiagonal, vl::Int, iv::Int) = LAPACK.stebz!('V', 'E', vl, vh, 0, 0, -1.0, copy(m.dv), copy(m.ev))[1] +eigvals(m::SymTridiagonal) = eigvals(m, 1, size(m, 1)) + +## Tridiagonal matrices ## +type Tridiagonal{T} <: AbstractMatrix{T} + dl::Vector{T} # sub-diagonal + d::Vector{T} # diagonal + du::Vector{T} # sup-diagonal + dutmp::Vector{T} # scratch space for vector RHS solver, sup-diagonal + rhstmp::Vector{T}# scratch space, rhs + + function Tridiagonal(N::Integer) + dutmp = Array(T, N-1) + rhstmp = Array(T, N) + new(dutmp, rhstmp, dutmp, dutmp, rhstmp) # first three will be overwritten + end +end + +function Tridiagonal{T<:Number}(dl::Vector{T}, d::Vector{T}, du::Vector{T}) + N = length(d) + if length(dl) != N-1 || length(du) != N-1 + error("The sub- and super-diagonals must have length N-1") + end + M = Tridiagonal{T}(N) + M.dl = copy(dl) + M.d = copy(d) + M.du = copy(du) + return M +end +function Tridiagonal{Tl<:Number, Td<:Number, Tu<:Number}(dl::Vector{Tl}, d::Vector{Td}, du::Vector{Tu}) + R = promote(Tl, Td, Tu) + Tridiagonal(convert(Vector{R}, dl), convert(Vector{R}, d), convert(Vector{R}, du)) +end + +copy(A::Tridiagonal) = Tridiagonal(copy(A.dl), copy(A.d), copy(A.du)) + +size(M::Tridiagonal) = (length(M.d), length(M.d)) +function show(io::IO, M::Tridiagonal) + println(io, summary(M), ":") + print(io, " sub: ") + print_matrix(io, (M.dl)') + print(io, "\ndiag: ") + print_matrix(io, (M.d)') + print(io, "\n sup: ") + print_matrix(io, (M.du)') +end +full{T}(M::Tridiagonal{T}) = convert(Matrix{T}, M) +function convert{T}(::Type{Matrix{T}}, M::Tridiagonal{T}) + A = zeros(T, size(M)) + for i = 1:length(M.d) + A[i,i] = M.d[i] + end + for i = 1:length(M.d)-1 + A[i+1,i] = M.dl[i] + A[i,i+1] = M.du[i] + end + return A +end +function similar(M::Tridiagonal, T, dims::Dims) + if length(dims) != 2 || dims[1] != dims[2] + error("Tridiagonal matrices must be square") + end + return Tridiagonal{T}(dims[1]) +end +copy(M::Tridiagonal) = Tridiagonal(M.dl, M.d, M.du) + +# Operations on Tridiagonal matrices +round(M::Tridiagonal) = Tridiagonal(round(M.dl), round(M.d), round(M.du)) +iround(M::Tridiagonal) = Tridiagonal(iround(M.dl), iround(M.d), iround(M.du)) + +## Solvers + +#### Tridiagonal matrix routines #### +function \{T<:BlasFloat}(M::Tridiagonal{T}, rhs::StridedVecOrMat{T}) + if stride(rhs, 1) == 1 + return LAPACK.gtsv!(copy(M.dl), copy(M.d), copy(M.du), copy(rhs)) + end + solve(M, rhs) # use the Julia "fallback" +end + +# This is definitely not going to work +#eig(M::Tridiagonal) = LAPACK.stev!('V', copy(M)) + +# Allocation-free variants +# Note that solve is non-aliasing, so you can use the same array for +# input and output +function solve(x::AbstractArray, xrng::Ranges{Int}, M::Tridiagonal, rhs::AbstractArray, rhsrng::Ranges{Int}) + d = M.d + N = length(d) + if length(xrng) != N || length(rhsrng) != N + error("dimension mismatch") + end + dl = M.dl + du = M.du + dutmp = M.dutmp + rhstmp = M.rhstmp + xstart = first(xrng) + xstride = step(xrng) + rhsstart = first(rhsrng) + rhsstride = step(rhsrng) + # Forward sweep + denom = d[1] + dulast = du[1] / denom + dutmp[1] = dulast + rhslast = rhs[rhsstart] / denom + rhstmp[1] = rhslast + irhs = rhsstart+rhsstride + for i in 2:N-1 + dltmp = dl[i-1] + denom = d[i] - dltmp*dulast + dulast = du[i] / denom + dutmp[i] = dulast + rhslast = (rhs[irhs] - dltmp*rhslast)/denom + rhstmp[i] = rhslast + irhs += rhsstride + end + dltmp = dl[N-1] + denom = d[N] - dltmp*dulast + xlast = (rhs[irhs] - dltmp*rhslast)/denom + # Backward sweep + ix = xstart + (N-2)*xstride + x[ix+xstride] = xlast + for i in N-1:-1:1 + xlast = rhstmp[i] - dutmp[i]*xlast + x[ix] = xlast + ix -= xstride + end + return x +end + +solve(x::StridedVector, M::Tridiagonal, rhs::StridedVector) = solve(x, 1:length(x), M, rhs, 1:length(rhs)) + +function solve(M::Tridiagonal, rhs::StridedVector) + x = similar(rhs) + solve(x, M, rhs) +end + +function solve(X::StridedMatrix, M::Tridiagonal, B::StridedMatrix) + if size(B, 1) != size(M, 1) + error("dimension mismatch") + end + if size(X) != size(B) + error("dimension mismatch in output") + end + m, n = size(B) + r = 1:m + for j = 1:n + r.start = (j-1)*m+1 + solve(X, r, M, B, r) + end + return X +end + +function solve(M::Tridiagonal, B::StridedMatrix) + X = similar(B) + solve(X, M, B) +end + +# User-friendly solver +\(M::Tridiagonal, rhs::Union(StridedVector,StridedMatrix)) = solve(M, rhs) + +# Tridiagonal multiplication +function mult(x::AbstractArray, xrng::Ranges{Int}, M::Tridiagonal, v::AbstractArray, vrng::Ranges{Int}) + dl = M.dl + d = M.d + du = M.du + N = length(d) + xi = first(xrng) + xstride = step(xrng) + vi = first(vrng) + vstride = step(vrng) + x[xi] = d[1]*v[vi] + du[1]*v[vi+vstride] + xi += xstride + for i = 2:N-1 + x[xi] = dl[i-1]*v[vi] + d[i]*v[vi+vstride] + du[i]*v[vi+2*vstride] + xi += xstride + vi += vstride + end + x[xi] = dl[N-1]*v[vi] + d[N]*v[vi+vstride] + return x +end + +mult(x::StridedVector, M::Tridiagonal, v::StridedVector) = mult(x, 1:length(x), M, v, 1:length(v)) + +function mult(X::StridedMatrix, M::Tridiagonal, B::StridedMatrix) + if size(B, 1) != size(M, 1) + error("dimension mismatch") + end + if size(X) != size(B) + error("dimension mismatch in output") + end + m, n = size(B) + r = 1:m + for j = 1:n + r.start = (j-1)*m+1 + mult(X, r, M, B, r) + end + return X +end + +mult(X::StridedMatrix, M1::Tridiagonal, M2::Tridiagonal) = mult(X, M1, full(M2)) + +function *(M::Tridiagonal, B::Union(StridedVector,StridedMatrix)) + X = similar(B) + mult(X, M, B) +end + +*(A::Tridiagonal, B::Tridiagonal) = A*full(B) + +#### Factorizations for Tridiagonal #### +type LDLTTridiagonal{T<:BlasFloat,S<:BlasFloat} <: Factorization{T} + D::Vector{S} + E::Vector{T} + function LDLTTridiagonal(D::Vector{S}, E::Vector{T}) + if typeof(real(E[1])) != eltype(D) error("Wrong eltype") end + new(D, E) + end +end + +LDLTTridiagonal{S<:BlasFloat,T<:BlasFloat}(D::Vector{S}, E::Vector{T}) = LDLTTridiagonal{T,S}(D, E) + +ldltd!{T<:BlasFloat}(A::SymTridiagonal{T}) = LDLTTridiagonal(LAPACK.pttrf!(real(A.dv),A.ev)...) +ldltd{T<:BlasFloat}(A::SymTridiagonal{T}) = ldltd!(copy(A)) + +function (\){T<:BlasFloat}(C::LDLTTridiagonal{T}, B::StridedVecOrMat{T}) + if iscomplex(B) return LAPACK.pttrs!('L', C.D, C.E, copy(B)) end + LAPACK.pttrs!(C.D, C.E, copy(B)) +end + +type LUTridiagonal{T} <: Factorization{T} + dl::Vector{T} + d::Vector{T} + du::Vector{T} + du2::Vector{T} + ipiv::Vector{BlasInt} + function LUTridiagonal(dl::Vector{T}, d::Vector{T}, du::Vector{T}, + du2::Vector{T}, ipiv::Vector{BlasInt}) + n = length(d) + if length(dl) != n - 1 || length(du) != n - 1 || length(ipiv) != n || length(du2) != n-2 + error("LUTridiagonal: dimension mismatch") + end + new(dl, d, du, du2, ipiv) + end +end +LUTridiagonal{T}(A::Tridiagonal{T}) = LUTridiagonal{T}(LAPACK.gttrf!(A.dl,A.d,A.du)...) + +#show(io, lu::LUTridiagonal) = print(io, "LU decomposition of ", summary(lu.lu)) + +function det{T}(lu::LUTridiagonal{T}) + n = length(lu.d) + prod(lu.d) * (bool(sum(lu.ipiv .!= 1:n) % 2) ? -one(T) : one(T)) +end + +det(A::Tridiagonal) = det(LUTridiagonal(copy(A))) + +(\){T<:BlasFloat}(lu::LUTridiagonal{T}, B::StridedVecOrMat{T}) = + LAPACK.gttrs!('N', lu.dl, lu.d, lu.du, lu.du2, lu.ipiv, copy(B)) + +### Special types used for dispatch +## Triangular +type Triangular{T<:BlasFloat} <: AbstractMatrix{T} + UL::Matrix{T} + uplo::Char + unitdiag::Char + function Triangular(A::Matrix{T}, uplo::Char, unitdiag::Char) + if size(A, 1) != size(A, 2) throw(LAPACK.DimensionMismatch("Matrix must be square")) end + return new(A, uplo, unitdiag) + end +end +Triangular{T<:BlasFloat}(A::Matrix{T}, uplo::Char, unitdiag::Char) = Triangular{T}(A, uplo, unitdiag) +Triangular(A::Matrix, uplo::Char, unitdiag::Bool) = Triangular(A, uplo, unitdiag ? 'U' : 'N') +Triangular(A::Matrix, uplo::Char) = Triangular(A, uplo, all(diag(A) .== 1) ? true : false) +function Triangular(A::Matrix) + if istriu(A) return Triangular(A, 'U') end + if istril(A) return Triangular(A, 'L') end + error("Matrix is not triangular") +end + +size(A::Triangular, args...) = size(A.UL, args...) +function full(A::Triangular) + if + istril(A) return tril(A.UL) + else + return triu(A.UL) + end +end +print_matrix(io::IO, A::Triangular) = print_matrix(io, full(A)) + +istril(A::Triangular) = A.uplo == 'L' +istriu(A::Triangular) = A.uplo == 'U' + +# Vector multiplication +*(A::Triangular, b::Vector) = BLAS.trmv(A.uplo, 'N', A.unitdiag, A.UL, b) +Ac_mul_B{T<:Union(Complex128, Complex64)}(A::Triangular{T}, b::Vector{T}) = BLAS.trmv(A.uplo, 'C', A.unitdiag, A.UL, b) +At_mul_B{T<:Union(Float64, Float32)}(A::Triangular{T}, b::Vector{T}) = BLAS.trmv(A.uplo, 'T', A.unitdiag, A.UL, b) + +# Matrix multiplication +*(A::Triangular, B::StridedMatrix) = BLAS.trmm('L', A.uplo, 'N', A.unitdiag, 1.0, A.UL, B) +*(A::StridedMatrix, B::Triangular) = BLAS.trmm('R', B.uplo, 'N', B.unitdiag, 1.0, A, B.UL) +Ac_mul_B{T<:Union(Complex128, Complex64)}(A::Triangular{T}, B::StridedMatrix{T}) = BLAS.trmm('L', A.uplo, 'C', A.unitdiag, 1.0, A.UL, B) +Ac_mul_B{T<:Union(Float64, Float32)}(A::Triangular{T}, B::StridedMatrix{T}) = BLAS.trmm('L', A.uplo, 'T', A.unitdiag, 1.0, A.UL, B) +A_mul_Bc{T<:Union(Complex128, Complex64)}(A::StridedMatrix{T}, B::Triangular{T}) = BLAS.trmm('R', B.uplo, 'C', B.unitdiag, 1.0, A, B.UL) +A_mul_Bc{T<:Union(Float64, Float32)}(A::StridedMatrix{T}, B::Triangular{T}) = BLAS.trmm('R', B.uplo, 'T', B.unitdiag, 1.0, A, B.UL) + +function \(A::Triangular, B::StridedVecOrMat) + r, info = LAPACK.trtrs!(A.uplo, 'N', A.unitdiag, A.UL, copy(B)) + if info > 0 throw(LAPACK.SingularException(info)) end + return r +end +function Ac_ldiv_B{T<:Union(Float64, Float32)}(A::Triangular{T}, B::StridedVecOrMat{T}) + r, info = LAPACK.trtrs!(A.uplo, 'T', A.unitdiag, A.UL, copy(B)) + if info > 0 throw(LAPACK.SingularException(info)) end + return r +end +function Ac_ldiv_B{T<:Union(Complex128, Complex64)}(A::Triangular{T}, B::StridedVecOrMat{T}) + r, info = LAPACK.trtrs!(A.uplo, 'C', A.unitdiag, A.UL, copy(B)) + if info > 0 throw(LAPACK.SingularException(info)) end + return r +end + +det(A::Triangular) = prod(diag(A.UL)) + +inv(A::Triangular) = LAPACK.trtri!(A.uplo, A.unitdiag, copy(A.UL))[1] diff --git a/base/linalg/woodbury.jl b/base/linalg/woodbury.jl new file mode 100644 index 0000000000000..4e502927d17ce --- /dev/null +++ b/base/linalg/woodbury.jl @@ -0,0 +1,129 @@ +#### Woodbury matrices #### +# This type provides support for the Woodbury matrix identity +type Woodbury{T} <: AbstractMatrix{T} + A + U::Matrix{T} + C + Cp + V::Matrix{T} + tmpN1::Vector{T} + tmpN2::Vector{T} + tmpk1::Vector{T} + tmpk2::Vector{T} + + function Woodbury(A::AbstractMatrix{T}, U::Matrix{T}, C, V::Matrix{T}) + N = size(A, 1) + k = size(U, 2) + if size(A, 2) != N || size(U, 1) != N || size(V, 1) != k || size(V, 2) != N + error("Sizes do not match") + end + if k > 1 + if size(C, 1) != k || size(C, 2) != k + error("Size of C is incorrect") + end + end + Cp = inv(inv(C) + V*(A\U)) + # temporary space for allocation-free solver + tmpN1 = Array(T, N) + tmpN2 = Array(T, N) + tmpk1 = Array(T, k) + tmpk2 = Array(T, k) + # don't copy A, it could be huge + new(A, copy(U), copy(C), Cp, copy(V), tmpN1, tmpN2, tmpk1, tmpk2) + end +end + +Woodbury{T}(A::AbstractMatrix{T}, U::Matrix{T}, C, V::Matrix{T}) = Woodbury{T}(A, U, C, V) + +Woodbury{T}(A::AbstractMatrix{T}, U::Vector{T}, C, V::Matrix{T}) = Woodbury{T}(A, reshape(U, length(U), 1), C, V) + +size(W::Woodbury) = size(W.A) + +function show(io::IO, W::Woodbury) + println(io, summary(W), ":") + print(io, "A: ", W.A) + print(io, "\nU:\n") + print_matrix(io, W.U) + if isa(W.C, Matrix) + print(io, "\nC:\n") + print_matrix(io, W.C) + else + print(io, "\nC: ", W.C) + end + print(io, "\nV:\n") + print_matrix(io, W.V) +end + +full{T}(W::Woodbury{T}) = convert(Matrix{T}, W) + +convert{T}(::Type{Matrix{T}}, W::Woodbury{T}) = full(W.A) + W.U*W.C*W.V + +function similar(W::Woodbury, T, dims::Dims) + if length(dims) != 2 || dims[1] != dims[2] + error("Woodbury matrices must be square") + end + n = size(W, 1) + k = size(W.U, 2) + return Woodbury{T}(similar(W.A), Array(T, n, k), Array(T, k, k), Array(T, k, n)) +end + +copy(W::Woodbury) = Woodbury(W.A, W.U, W.C, W.V) + +## Woodbury matrix routines ## + +function *(W::Woodbury, B::StridedVecOrMat) + return W.A*B + W.U*(W.C*(W.V*B)) +end + +function \(W::Woodbury, R::StridedVecOrMat) + AinvR = W.A\R + return AinvR - W.A\(W.U*(W.Cp*(W.V*AinvR))) +end + +function det(W::Woodbury) + det(W.A)*det(W.C)/det(W.Cp) +end + +# Allocation-free solver for arbitrary strides (requires that W.A has a +# non-aliasing "solve" routine, e.g., is Tridiagonal) +function solve(x::AbstractArray, xrng::Ranges{Int}, W::Woodbury, rhs::AbstractArray, rhsrng::Ranges{Int}) + solve(W.tmpN1, 1:length(W.tmpN1), W.A, rhs, rhsrng) + A_mul_B(W.tmpk1, W.V, W.tmpN1) + A_mul_B(W.tmpk2, W.Cp, W.tmpk1) + A_mul_B(W.tmpN2, W.U, W.tmpk2) + solve(W.tmpN2, W.A, W.tmpN2) + indx = first(xrng) + xinc = step(xrng) + for i = 1:length(W.tmpN2) + x[indx] = W.tmpN1[i] - W.tmpN2[i] + indx += xinc + end +end + +solve(x::AbstractVector, W::Woodbury, rhs::AbstractVector) = solve(x, 1:length(x), W, rhs, 1:length(rhs)) + +function solve(W::Woodbury, rhs::AbstractVector) + x = similar(rhs) + solve(x, W, rhs) +end + +function solve(X::StridedMatrix, W::Woodbury, B::StridedMatrix) + if size(B, 1) != size(W, 1) + error("dimension mismatch") + end + if size(X) != size(B) + error("dimension mismatch in output") + end + m, n = size(B) + r = 1:m + for j = 1:n + r.start = (j-1)*m+1 + solve(X, r, W, B, r) + end + return X +end + +function solve(W::Woodbury, B::StridedMatrix) + X = similar(B) + solve(X, W, B) +end diff --git a/base/sysimg.jl b/base/sysimg.jl index 0aa2be2391d21..299c946a0109f 100644 --- a/base/sysimg.jl +++ b/base/sysimg.jl @@ -151,13 +151,7 @@ include("meta.jl") # linear algebra include("sparse.jl") -include("linalg/blas.jl") -include("linalg/lapack.jl") -include("linalg/matmul.jl") include("linalg/linalg.jl") -include("linalg/dense.jl") -include("linalg/bitarray.jl") -include("linalg/sparse.jl") # signal processing include("fftw.jl") From 6ae9a1256c61fe62093ae32cb55da078c1e6adac Mon Sep 17 00:00:00 2001 From: "Viral B. Shah" Date: Mon, 4 Mar 2013 12:56:31 +0530 Subject: [PATCH 05/29] Put factorizations into their own file. BunchKaufman factorizations are in a separate file. --- base/expr.jl | 1 + base/linalg/bunchkaufman.jl | 26 ++ base/linalg/dense.jl | 608 ----------------------------------- base/linalg/factorization.jl | 578 +++++++++++++++++++++++++++++++++ base/linalg/linalg.jl | 2 + 5 files changed, 607 insertions(+), 608 deletions(-) create mode 100644 base/linalg/bunchkaufman.jl create mode 100644 base/linalg/factorization.jl diff --git a/base/expr.jl b/base/expr.jl index c8fe0a536a411..e93dd44fd9f18 100644 --- a/base/expr.jl +++ b/base/expr.jl @@ -5,6 +5,7 @@ symbol(s::ASCIIString) = symbol(s.data) symbol(s::UTF8String) = symbol(s.data) symbol(a::Array{Uint8,1}) = ccall(:jl_symbol_n, Any, (Ptr{Uint8}, Int32), a, length(a))::Symbol +symbol(x::Char) = symbol(string(x)) gensym() = ccall(:jl_gensym, Any, ())::Symbol diff --git a/base/linalg/bunchkaufman.jl b/base/linalg/bunchkaufman.jl new file mode 100644 index 0000000000000..0a9d6a307d138 --- /dev/null +++ b/base/linalg/bunchkaufman.jl @@ -0,0 +1,26 @@ +## Create an extractor that extracts the modified original matrix, e.g. +## LD for BunchKaufman, UL for CholeskyDense, LU for LUDense and +## define size methods for Factorization types using it. + +type BunchKaufman{T<:BlasFloat} <: Factorization{T} + LD::Matrix{T} + ipiv::Vector{BlasInt} + uplo::Char + function BunchKaufman(A::Matrix{T}, uplo::Char) + LD, ipiv = LAPACK.sytrf!(uplo , copy(A)) + new(LD, ipiv, uplo) + end +end +BunchKaufman{T<:BlasFloat}(A::StridedMatrix{T}, uplo::Char) = BunchKaufman{T}(A, uplo) +BunchKaufman{T<:Real}(A::StridedMatrix{T}, uplo::Char) = BunchKaufman(float64(A), uplo) +BunchKaufman{T<:Number}(A::StridedMatrix{T}) = BunchKaufman(A, 'U') + +size(B::BunchKaufman) = size(B.LD) +size(B::BunchKaufman,d::Integer) = size(B.LD,d) + +function inv(B::BunchKaufman) + symmetrize!(LAPACK.sytri!(B.uplo, copy(B.LD), B.ipiv), B.uplo) +end + +\{T<:BlasFloat}(B::BunchKaufman{T}, R::StridedVecOrMat{T}) = + LAPACK.sytrs!(B.uplo, B.LD, B.ipiv, copy(R)) diff --git a/base/linalg/dense.jl b/base/linalg/dense.jl index a120032779178..e0dc3e66e6d5e 100644 --- a/base/linalg/dense.jl +++ b/base/linalg/dense.jl @@ -1,6 +1,3 @@ -# Should probably go someweher else -symbol(x::Char) = symbol(string(x)) - # Linear algebra functions for dense matrices in column major format scale!(X::Array{Float32}, s::Real) = BLAS.scal!(length(X), float32(s), X, 1) @@ -375,554 +372,6 @@ expm{T<:Union(Float32,Float64,Complex64,Complex128)}(A::StridedMatrix{T}) = expm expm{T<:Integer}(A::StridedMatrix{T}) = expm!(float(A)) expm(x::Number) = exp(x) -## Matrix factorizations and decompositions - -abstract Factorization{T} -## Create an extractor that extracts the modified original matrix, e.g. -## LD for BunchKaufman, UL for CholeskyDense, LU for LUDense and -## define size methods for Factorization types using it. - -type BunchKaufman{T<:BlasFloat} <: Factorization{T} - LD::Matrix{T} - ipiv::Vector{BlasInt} - uplo::Char - function BunchKaufman(A::Matrix{T}, uplo::Char) - LD, ipiv = LAPACK.sytrf!(uplo , copy(A)) - new(LD, ipiv, uplo) - end -end -BunchKaufman{T<:BlasFloat}(A::StridedMatrix{T}, uplo::Char) = BunchKaufman{T}(A, uplo) -BunchKaufman{T<:Real}(A::StridedMatrix{T}, uplo::Char) = BunchKaufman(float64(A), uplo) -BunchKaufman{T<:Number}(A::StridedMatrix{T}) = BunchKaufman(A, 'U') - -size(B::BunchKaufman) = size(B.LD) -size(B::BunchKaufman,d::Integer) = size(B.LD,d) - -function inv(B::BunchKaufman) - symmetrize!(LAPACK.sytri!(B.uplo, copy(B.LD), B.ipiv), B.uplo) -end - -\{T<:BlasFloat}(B::BunchKaufman{T}, R::StridedVecOrMat{T}) = - LAPACK.sytrs!(B.uplo, B.LD, B.ipiv, copy(R)) - -type CholeskyDense{T<:BlasFloat} <: Factorization{T} - UL::Matrix{T} - uplo::Char - function CholeskyDense(A::Matrix{T}, uplo::Char) - A, info = LAPACK.potrf!(uplo, A) - if info > 0; throw(LAPACK.PosDefException(info)); end - return new(uplo == 'U' ? triu!(A) : tril!(A), uplo) - end -end -CholeskyDense{T<:BlasFloat}(A::Matrix{T}, uplo::Char) = CholeskyDense{T}(A, uplo) - -chol(A::Matrix, uplo::Symbol) = CholeskyDense(copy(A), string(uplo)[1]) -chol(A::Matrix) = chol(A, :U) -chol{T<:Integer}(A::Matrix{T}, args...) = chol(float64(A), args...) -chol(x::Number) = imag(x) == 0 && real(x) > 0 ? sqrt(x) : error("Argument not positive-definite") - -size(C::CholeskyDense) = size(C.UL) -size(C::CholeskyDense,d::Integer) = size(C.UL,d) - -function ref(C::CholeskyDense, d::Symbol) - if d == :U || d == :L - return symbol(C.uplo) == d ? C.UL : C.UL' - elseif d == :UL - return Triangular(C.UL, C.uplo) - end - error("No such property") -end - -\{T<:BlasFloat}(C::CholeskyDense{T}, B::StridedVecOrMat{T}) = - LAPACK.potrs!(C.uplo, C.UL, copy(B)) - -function det{T}(C::CholeskyDense{T}) - dd = one(T) - for i in 1:size(C.UL,1) dd *= abs2(C.UL[i,i]) end - dd -end - -function inv(C::CholeskyDense) - Ci, info = LAPACK.potri!(C.uplo, copy(C.UL)) - if info != 0; throw(LAPACK.SingularException(info)); end - symmetrize!(Ci, C.uplo) -end - -## Pivoted Cholesky -type CholeskyPivotedDense{T<:BlasFloat} <: Factorization{T} - UL::Matrix{T} - uplo::Char - piv::Vector{BlasInt} - rank::BlasInt - tol::Real - info::BlasInt -end -function CholeskyPivotedDense{T<:BlasFloat}(A::Matrix{T}, uplo::Char, tol::Real) - A, piv, rank, info = LAPACK.pstrf!(uplo, A, tol) - CholeskyPivotedDense{T}(uplo == 'U' ? triu!(A) : tril!(A), uplo, piv, rank, tol, info) -end - -cholp(A::Matrix, uplo::Symbol, tol::Real) = CholeskyPivotedDense(copy(A), string(uplo)[1], tol) -cholp(A::Matrix, tol::Real) = cholp(A, :U, tol) -cholp(A::Matrix) = cholp(A, -1.) -cholp{T<:Int}(A::Matrix{T}, args...) = cholp(float64(A), args...) - -size(C::CholeskyPivotedDense) = size(C.UL) -size(C::CholeskyPivotedDense,d::Integer) = size(C.UL,d) - -ref(C::CholeskyPivotedDense) = C.UL, C.piv -function ref{T<:BlasFloat}(C::CholeskyPivotedDense{T}, d::Symbol) - if d == :U || d == :L - return symbol(C.uplo) == d ? C.UL : C.UL' - end - if d == :p return C.piv end - if d == :P - n = size(C, 1) - P = zeros(T, n, n) - for i in 1:n - P[C.piv[i],i] = one(T) - end - return P - end - error("No such property") -end - -function \{T<:BlasFloat}(C::CholeskyPivotedDense{T}, B::StridedVector{T}) - if C.rank < size(C.UL, 1); throw(LAPACK.RankDeficientException(C.info)); end - LAPACK.potrs!(C.uplo, C.UL, copy(B)[C.piv])[invperm(C.piv)] -end - -function \{T<:BlasFloat}(C::CholeskyPivotedDense{T}, B::StridedMatrix{T}) - if C.rank < size(C.UL, 1); throw(LAPACK.RankDeficientException(C.info)); end - LAPACK.potrs!(C.uplo, C.UL, copy(B)[C.piv,:])[invperm(C.piv),:] -end - -rank(C::CholeskyPivotedDense) = C.rank - -function det{T}(C::CholeskyPivotedDense{T}) - if C.rank < size(C.UL, 1) - return real(zero(T)) - else - return prod(abs2(diag(C.UL))) - end -end - -function inv(C::CholeskyPivotedDense) - if C.rank < size(C.UL, 1) throw(LAPACK.RankDeficientException(C.info)) end - Ci, info = LAPACK.potri!(C.uplo, copy(C.UL)) - if info != 0 throw(LAPACK.RankDeficientException(info)) end - ipiv = invperm(C.piv) - (symmetrize!(Ci, C.uplo))[ipiv, ipiv] -end - -## LU -type LUDense{T} <: Factorization{T} - LU::Matrix{T} - ipiv::Vector{BlasInt} - info::BlasInt - function LUDense(LU::Matrix{T}, ipiv::Vector{BlasInt}, info::BlasInt) - m, n = size(LU) - m == n ? new(LU, ipiv, info) : throw(LAPACK.DimensionMismatch("LUDense only defined for square matrices")) - end -end -function LUDense{T<:BlasFloat}(A::Matrix{T}) - LU, ipiv, info = LAPACK.getrf!(A) - LUDense{T}(LU, ipiv, info) -end - -lu(A::Matrix) = LUDense(copy(A)) -lu{T<:Integer}(A::Matrix{T}) = lu(float(A)) -lu(x::Number) = (one(x), x, [1]) - -size(A::LUDense) = size(A.LU) -size(A::LUDense,n) = size(A.LU,n) - -function ref{T}(A::LUDense{T}, d::Symbol) - if d == :L; return tril(A.LU, -1) + eye(T, size(A, 1)); end; - if d == :U; return triu(A.LU); end; - if d == :p - n = size(A, 1) - p = [1:n] - for i in 1:n - tmp = p[i] - p[i] = p[A.ipiv[i]] - p[A.ipiv[i]] = tmp - end - return p - end - if d == :P - p = A[:p] - n = length(p) - P = zeros(T, n, n) - for i in 1:n - P[i,p[i]] = one(T) - end - return P - end - error("No such property") -end - -function det{T}(A::LUDense{T}) - m, n = size(A) - if A.info > 0; return zero(typeof(A.LU[1])); end - prod(diag(A.LU)) * (bool(sum(A.ipiv .!= 1:n) % 2) ? -one(T) : one(T)) -end - -function (\)(A::LUDense, B::StridedVecOrMat) - if A.info > 0; throw(LAPACK.SingularException(A.info)); end - LAPACK.getrs!('N', A.LU, A.ipiv, copy(B)) -end - -function inv(A::LUDense) - if A.info > 0; return throw(LAPACK.SingularException(A.info)); end - LAPACK.getri!(copy(A.LU), A.ipiv) -end - -## QR decomposition without column pivots. By the faster geqrt3 -type QRDense{S} <: Factorization{S} - vs::Matrix{S} # the elements on and above the diagonal contain the N-by-N upper triangular matrix R; the elements below the diagonal are the columns of V - T::Matrix{S} # upper triangular factor of the block reflector. -end -QRDense(A::Matrix) = QRDense(LAPACK.geqrt3!(A)...) - -qr(A::Matrix) = QRDense(copy(A)) -qr{T<:Integer}(A::Matrix{T}) = qr(float(A)) -qr(x::Number) = (one(x), x) - -size(A::QRDense, args::Integer...) = size(A.vs, args...) - -function ref(A::QRDense, d::Symbol) - if d == :R; return triu(A.vs[1:min(size(A)),:]); end; - if d == :Q; return QRDenseQ(A); end - error("No such property") -end - -type QRDenseQ{S} <: AbstractMatrix{S} - vs::Matrix{S} - T::Matrix{S} -end -QRDenseQ(A::QRDense) = QRDenseQ(A.vs, A.T) - -size(A::QRDenseQ, args::Integer...) = size(A.vs, args...) - -function full{T<:BlasFloat}(A::QRDenseQ{T}, thin::Bool) - if thin return A * eye(T, size(A.T, 1)) end - return A * eye(T, size(A, 1)) -end -full(A::QRDenseQ) = full(A, true) - -print_matrix(io::IO, A::QRDenseQ) = print_matrix(io, full(A)) - -## Multiplication by Q from the QR decomposition -function *{T<:BlasFloat}(A::QRDenseQ{T}, B::StridedVecOrMat{T}) - m = size(B, 1) - n = size(B, 2) - if m == size(A.vs, 1) - Bc = copy(B) - elseif m == size(A.vs, 2) - Bc = [B; zeros(T, size(A.vs, 1) - m, n)] - else - throw(LAPACK.DimensionMismatch("")) - end - LAPACK.gemqrt!('L', 'N', A.vs, A.T, Bc) -end -Ac_mul_B(A::QRDenseQ, B::StridedVecOrMat) = LAPACK.gemqrt!('L', iscomplex(A.vs[1]) ? 'C' : 'T', A.vs, A.T, copy(B)) -*(A::StridedVecOrMat, B::QRDenseQ) = LAPACK.gemqrt!('R', 'N', B.vs, B.T, copy(A)) -function A_mul_Bc{T<:BlasFloat}(A::StridedVecOrMat{T}, B::QRDenseQ{T}) - m = size(A, 1) - n = size(A, 2) - if n == size(B.vs, 1) - Ac = copy(A) - elseif n == size(B.vs, 2) - Ac = [B zeros(T, m, size(B.vs, 1) - n)] - else - throw(LAPACK.DimensionMismatch("")) - end - LAPACK.gemqrt!('R', iscomplex(B.vs[1]) ? 'C' : 'T', B.vs, B.T, Ac) -end -## Least squares solution. Should be more careful about cases with m < n -(\)(A::QRDense, B::StridedVector) = Triangular(A[:R], 'U')\(A[:Q]'B)[1:size(A, 2)] -(\)(A::QRDense, B::StridedMatrix) = Triangular(A[:R], 'U')\(A[:Q]'B)[1:size(A, 2),:] - -type QRPivotedDense{T} <: Factorization{T} - hh::Matrix{T} - tau::Vector{T} - jpvt::Vector{BlasInt} - function QRPivotedDense(hh::Matrix{T}, tau::Vector{T}, jpvt::Vector{BlasInt}) - m, n = size(hh) - if length(tau) != min(m,n) || length(jpvt) != n - throw(LAPACK.DimensionMismatch("")) - end - new(hh,tau,jpvt) - end -end -QRPivotedDense{T<:BlasFloat}(A::Matrix{T}) = QRPivotedDense{T}(LAPACK.geqp3!(A)...) -qrp(A::Matrix) = QRPivotedDense(copy(A)) -# QRDenseQ(A::QRPivotedDense) = QRDenseQ(A.hh, A.tau) - -size(A::QRPivotedDense, args::Integer...) = size(A.hh, args...) - -function ref{T<:BlasFloat}(A::QRPivotedDense{T}, d::Symbol) - if d == :R; return triu(A.hh[1:min(size(A)),:]); end; - if d == :Q; return QRDensePivotedQ(A); end - if d == :p; return A.jpvt; end - if d == :P - p = A[:p] - n = length(p) - P = zeros(T, n, n) - for i in 1:n - P[p[i],i] = one(T) - end - return P - end - error("No such property") -end - -(\)(A::QRPivotedDense, B::StridedVector) = (Triangular(A[:R])\(A[:Q]'B)[1:size(A, 2)])[invperm(A.jpvt)] -(\)(A::QRPivotedDense, B::StridedMatrix) = (Triangular(A[:R])\(A[:Q]'B)[1:size(A, 2),:])[invperm(A.jpvt),:] - -type QRDensePivotedQ{T} <: AbstractMatrix{T} - hh::Matrix{T} # Householder transformations and R - tau::Vector{T} # Scalar factors of transformations -end -QRDensePivotedQ(A::QRPivotedDense) = QRDensePivotedQ(A.hh, A.tau) - -size(A::QRDensePivotedQ, args...) = size(A.hh, args...) - -function full{T<:BlasFloat}(A::QRDensePivotedQ{T}, thin::Bool) - if !thin - Q = Array(T, size(A, 1), size(A, 1)) - Q[:,1:size(A, 2)] = copy(A.hh) - return LAPACK.orgqr!(Q, A.tau) - else - return LAPACK.orgqr!(copy(A.hh), A.tau) - end -end -full(A::QRDensePivotedQ) = full(A, true) - -## Multiplication by Q from the Pivoted QR decomposition -function *{T<:BlasFloat}(A::QRDensePivotedQ{T}, B::StridedVecOrMat{T}) - m = size(B, 1) - n = size(B, 2) - if m == size(A.hh, 1) - Bc = copy(B) - elseif m == size(A.hh, 2) - Bc = [B; zeros(T, size(A.hh, 1) - m, n)] - else - throw(LAPACK.DimensionMismatch("")) - end - LAPACK.ormqr!('L', 'N', A.hh, A.tau, Bc) -end -Ac_mul_B(A::QRDensePivotedQ, B::StridedVecOrMat) = LAPACK.ormqr!('L', iscomplex(A.hh[1]) ? 'C' : 'T', A.hh, A.tau, copy(B)) -*(A::StridedVecOrMat, B::QRDensePivotedQ) = LAPACK.ormqr!('R', 'N', B.hh, B.tau, copy(A)) -function A_mul_Bc{T<:BlasFloat}(A::StridedVecOrMat{T}, B::QRDensePivotedQ{T}) - m = size(A, 1) - n = size(A, 2) - if n == size(B.hh, 1) - Ac = copy(A) - elseif n == size(B.hh, 2) - Ac = [B zeros(T, m, size(B.hh, 1) - n)] - else - throw(LAPACK.DimensionMismatch("")) - end - LAPACK.ormqr!('R', iscomplex(B.hh[1]) ? 'C' : 'T', B.hh, B.tau, Ac) -end - -##TODO: Add methods for rank(A::QRP{T}) and adjust the (\) method accordingly -## Add rcond methods for Cholesky, LU, QR and QRP types -## Lower priority: Add LQ, QL and RQ factorizations - -# FIXME! Should add balancing option through xgebal -type Hessenberg{T} <: Factorization{T} - hh::Matrix{T} - tau::Vector{T} - function Hessenberg(hh::Matrix{T}, tau::Vector{T}) - if size(hh, 1) != size(hh, 2) throw(LAPACK.DimensionMismatch("")) end - return new(hh, tau) - end -end -Hessenberg{T<:BlasFloat}(hh::Matrix{T}, tau::Vector{T}) = Hessenberg{T}(hh, tau) -Hessenberg(A::StridedMatrix) = Hessenberg(LAPACK.gehrd!(A)...) - -hess(A::StridedMatrix) = Hessenberg(copy(A)) - -type HessenbergQ{T} <: AbstractMatrix{T} - hh::Matrix{T} - tau::Vector{T} -end -HessenbergQ(A::Hessenberg) = HessenbergQ(A.hh, A.tau) -size(A::HessenbergQ, args...) = size(A.hh, args...) -ref(A::HessenbergQ, args...) = ref(full(A), args...) - -function ref(A::Hessenberg, d::Symbol) - if d == :Q; return HessenbergQ(A); end - if d == :H; return triu(A.hh, -1); end - error("No such property") -end - -full(A::HessenbergQ) = LAPACK.orghr!(1, size(A.hh, 1), copy(A.hh), A.tau) - -### Linear algebra for general matrices - -function det(A::Matrix) - m, n = size(A) - if m != n; throw(LAPACK.DimensionMismatch("det only defined for square matrices")); end - if istriu(A) | istril(A); return det(Triangular(A, 'U', false)); end - return det(LUDense(copy(A))) -end -det(x::Number) = x - -logdet(A::Matrix) = 2.0 * sum(log(diag(chol(A)[:U]))) - -function inv(A::StridedMatrix) - if istriu(A) return inv(Triangular(A, 'U')) end - if istril(A) return inv(Triangular(A, 'L')) end - if ishermitian(A) return inv(Hermitian(A)) end - return inv(LUDense(copy(A))) -end - -function eig{T<:BlasFloat}(A::StridedMatrix{T}) - n = size(A, 2) - if n == 0; return (zeros(T, 0), zeros(T, 0, 0)) end - if ishermitian(A) return eig(Hermitian(A)) end - if iscomplex(A) return LAPACK.geev!('N', 'V', copy(A))[[1,3]] end - - WR, WI, VL, VR = LAPACK.geev!('N', 'V', copy(A)) - if all(WI .== 0.) return WR, VR end - evec = complex(zeros(T, n, n)) - j = 1 - while j <= n - if WI[j] == 0.0 - evec[:,j] = VR[:,j] - else - evec[:,j] = VR[:,j] + im*VR[:,j+1] - evec[:,j+1] = VR[:,j] - im*VR[:,j+1] - j += 1 - end - j += 1 - end - return complex(WR, WI), evec -end - -eig{T<:Integer}(x::StridedMatrix{T}) = eig(float64(x)) -eig(x::Number) = (x, one(x)) - -function eigvals(A::StridedMatrix) - if ishermitian(A) return eigvals(Hermitian(A)) end - if iscomplex(A) return LAPACK.geev!('N', 'N', copy(A))[1] end - valsre, valsim, _, _ = LAPACK.geev!('N', 'N', copy(A)) - if all(valsim .== 0) return valsre end - return complex(valsre, valsim) -end - -eigvals(x::Number) = 1.0 - -# SVD -type SVDDense{T,Tr} <: Factorization{T} - U::Matrix{T} - S::Vector{Tr} - Vt::Matrix{T} -end -function SVDDense(A::StridedMatrix, thin::Bool) - m,n = size(A) - if m == 0 || n == 0 - u,s,vt = (eye(m, thin ? n : m), zeros(0), eye(n,n)) - else - u,s,vt = LAPACK.gesdd!(thin ? 'S' : 'A', A) - end - return SVDDense(u,s,vt) -end -SVDDense(A::StridedMatrix) = SVDDense(A, false) -svd(A::StridedMatrix, args...) = SVDDense(copy(A), args...) -svd(x::Number, thin::Bool) = (x==0?one(x):x/abs(x),abs(x),one(x)) - -function ref(F::SVDDense, d::Symbol) - if d == :U return F.U end - if d == :S return F.S end - if d == :Vt return F.Vt end - if d == :V return F.Vt' end - error("No such property") -end - -function svdvals!{T<:BlasFloat}(A::StridedMatrix{T}) - m,n = size(A) - if m == 0 || n == 0 return zeros(T, 0) end - return LAPACK.gesdd!('N', A)[2] -end - -svdvals(A) = svdvals!(copy(A)) - -# SVD least squares -function \{T<:BlasFloat}(A::SVDDense{T}, B::StridedVecOrMat{T}) - n = length(A[:S]) - Sinv = zeros(T, n) - Sinv[A[:S] .> sqrt(eps())] = 1.0 ./ A[:S] - return diagmm(A[:V], Sinv) * A[:U][:,1:n]'B -end - -# Generalized svd -type GSVDDense{T} <: Factorization{T} - U::Matrix{T} - V::Matrix{T} - Q::Matrix{T} - a::Vector - b::Vector - k::Int - l::Int - R::Matrix{T} -end - -function GSVDDense(A::StridedMatrix, B::StridedMatrix) - U, V, Q, a, b, k, l, R = LAPACK.ggsvd!('U', 'V', 'Q', A, B) - return GSVDDense(U, V, Q, a, b, int(k), int(l), R) -end - -svd(A::StridedMatrix, B::StridedMatrix) = GSVDDense(copy(A), copy(B)) - -function ref{T}(obj::GSVDDense{T}, d::Symbol) - if d == :U return obj.U end - if d == :V return obj.V end - if d == :Q return obj.Q end - if d == :alpha || d == :a return obj.a end - if d == :beta || d == :b return obj.b end - if d == :vals || d == :S return obj.a[1:obj.k + obj.l] ./ obj.b[1:obj.k + obj.l] end - if d == :D1 - m = size(obj.U, 1) - if m - obj.k - obj.l >= 0 - return [eye(T, obj.k) zeros(T, obj.k, obj.l); zeros(T, obj.l, obj.k) diagm(obj.a[obj.k + 1:obj.k + obj.l]); zeros(T, m - obj.k - obj.l, obj.k + obj.l)] - else - return [eye(T, m, obj.k) [zeros(T, obj.k, m - obj.k); diagm(obj.a[obj.k + 1:m])] zeros(T, m, obj.k + obj.l - m)] - end - end - if d == :D2 - m = size(obj.U, 1) - p = size(obj.V, 1) - if m - obj.k - obj.l >= 0 - return [zeros(T, obj.l, obj.k) diagm(obj.b[obj.k + 1:obj.k + obj.l]); zeros(T, p - obj.l, obj.k + obj.l)] - else - return [zeros(T, p, obj.k) [diagm(obj.b[obj.k + 1:m]); zeros(T, obj.k + p - m, m - obj.k)] [zeros(T, m - obj.k, obj.k + obj.l - m); eye(T, obj.k + p - m, obj.k + obj.l - m)]] - end - end - if d == :R return obj.R end - if d == :R0 - m = size(obj.U, 1) - n = size(obj.Q, 1) - if m - obj.k - obj.l >= 0 - return [zeros(T, obj.k + obj.l, n - obj.k - obj.l) obj.R] - else - return [zeros(T, obj.k + obj.l, n - obj.k - obj.l) obj.R] - end - end - error("No such property") -end - -function svdvals(A::StridedMatrix, B::StridedMatrix) - _, _, _, a, b, k, l, _ = LAPACK.ggsvd!('N', 'N', 'N', copy(A), copy(B)) - return a[1:k + l] ./ b[1:k + l] -end - -schur{T<:BlasFloat}(A::StridedMatrix{T}) = LAPACK.gees!('V', copy(A)) - function sqrtm(A::StridedMatrix, cond::Bool) m, n = size(A) if m != n error("DimentionMismatch") end @@ -957,60 +406,3 @@ sqrtm{T<:Integer}(A::StridedMatrix{T}, cond::Bool) = sqrtm(float(A), cond) sqrtm{T<:Integer}(A::StridedMatrix{ComplexPair{T}}, cond::Bool) = sqrtm(complex128(A), cond) sqrtm(A::StridedMatrix) = sqrtm(A, false) sqrtm(a::Number) = isreal(a) ? (b = sqrt(complex(a)); imag(b) == 0 ? real(b) : b) : sqrt(a) - -function (\){T<:BlasFloat}(A::StridedMatrix{T}, B::StridedVecOrMat{T}) - if size(A, 1) == size(A, 2) # Square - if istriu(A) return Triangular(A, 'U')\B end - if istril(A) return Triangular(A, 'L')\B end - if ishermitian(A) return Hermitian(A)\B end - end - LAPACK.gelsd!(copy(A), copy(B))[1] -end - -(\){T1<:BlasFloat, T2<:BlasFloat}(A::StridedMatrix{T1}, B::StridedVecOrMat{T2}) = - (\)(convert(Array{promote_type(T1,T2)},A), convert(Array{promote_type(T1,T2)},B)) -(\){T1<:BlasFloat, T2<:Real}(A::StridedMatrix{T1}, B::StridedVecOrMat{T2}) = (\)(A, convert(Array{T1}, B)) -(\){T1<:Real, T2<:BlasFloat}(A::StridedMatrix{T1}, B::StridedVecOrMat{T2}) = (\)(convert(Array{T2}, A), B) -(\){T1<:Real, T2<:Real}(A::StridedMatrix{T1}, B::StridedVecOrMat{T2}) = (\)(float64(A), float64(B)) -(\){T1<:Number, T2<:Number}(A::StridedMatrix{T1}, B::StridedVecOrMat{T2}) = (\)(complex128(A), complex128(B)) - -(/)(A::StridedVecOrMat, B::StridedVecOrMat) = (B' \ A')' - -## Moore-Penrose inverse -function pinv{T<:BlasFloat}(A::StridedMatrix{T}) - SVD = SVDDense(copy(A), true) - Sinv = zeros(T, length(SVD[:S])) - index = SVD[:S] .> eps(real(one(T)))*max(size(A))*max(SVD[:S]) - Sinv[index] = 1.0 ./ SVD[:S][index] - SVD[:Vt]'diagmm(Sinv, SVD[:U]') -end -pinv{T<:Integer}(A::StridedMatrix{T}) = pinv(float(A)) -pinv(a::StridedVector) = pinv(reshape(a, length(a), 1)) -pinv(x::Number) = one(x)/x - -## Basis for null space -function null{T<:BlasFloat}(A::StridedMatrix{T}) - m,n = size(A) - SVD = SVDDense(copy(A)) - if m == 0; return eye(T, n); end - indstart = sum(SVD[:S] .> max(m,n)*max(SVD[:S])*eps(eltype(SVD[:S]))) + 1 - SVD[:V][:,indstart:] -end -null{T<:Integer}(A::StridedMatrix{T}) = null(float(A)) -null(a::StridedVector) = null(reshape(a, length(a), 1)) - -function cond(A::StridedMatrix, p) - if p == 2 - v = svdvals(A) - maxv = max(v) - cnd = maxv == 0.0 ? Inf : maxv / min(v) - elseif p == 1 || p == Inf - m, n = size(A) - if m != n; error("Use 2-norm for non-square matrices"); end - cnd = 1 / LAPACK.gecon!(p == 1 ? '1' : 'I', LUDense(copy(A)).LU, norm(A, p)) - else - error("Norm type must be 1, 2 or Inf") - end - return cnd -end -cond(A::StridedMatrix) = cond(A, 2) diff --git a/base/linalg/factorization.jl b/base/linalg/factorization.jl new file mode 100644 index 0000000000000..773e68ab35a24 --- /dev/null +++ b/base/linalg/factorization.jl @@ -0,0 +1,578 @@ +## Matrix factorizations and decompositions + +abstract Factorization{T} + +type CholeskyDense{T<:BlasFloat} <: Factorization{T} + UL::Matrix{T} + uplo::Char + function CholeskyDense(A::Matrix{T}, uplo::Char) + A, info = LAPACK.potrf!(uplo, A) + if info > 0; throw(LAPACK.PosDefException(info)); end + return new(uplo == 'U' ? triu!(A) : tril!(A), uplo) + end +end +CholeskyDense{T<:BlasFloat}(A::Matrix{T}, uplo::Char) = CholeskyDense{T}(A, uplo) + +chol(A::Matrix, uplo::Symbol) = CholeskyDense(copy(A), string(uplo)[1]) +chol(A::Matrix) = chol(A, :U) +chol{T<:Integer}(A::Matrix{T}, args...) = chol(float64(A), args...) +chol(x::Number) = imag(x) == 0 && real(x) > 0 ? sqrt(x) : error("Argument not positive-definite") + +size(C::CholeskyDense) = size(C.UL) +size(C::CholeskyDense,d::Integer) = size(C.UL,d) + +function ref(C::CholeskyDense, d::Symbol) + if d == :U || d == :L + return symbol(C.uplo) == d ? C.UL : C.UL' + elseif d == :UL + return Triangular(C.UL, C.uplo) + end + error("No such property") +end + +\{T<:BlasFloat}(C::CholeskyDense{T}, B::StridedVecOrMat{T}) = + LAPACK.potrs!(C.uplo, C.UL, copy(B)) + +function det{T}(C::CholeskyDense{T}) + dd = one(T) + for i in 1:size(C.UL,1) dd *= abs2(C.UL[i,i]) end + dd +end + +function inv(C::CholeskyDense) + Ci, info = LAPACK.potri!(C.uplo, copy(C.UL)) + if info != 0; throw(LAPACK.SingularException(info)); end + symmetrize!(Ci, C.uplo) +end + +## Pivoted Cholesky +type CholeskyPivotedDense{T<:BlasFloat} <: Factorization{T} + UL::Matrix{T} + uplo::Char + piv::Vector{BlasInt} + rank::BlasInt + tol::Real + info::BlasInt +end +function CholeskyPivotedDense{T<:BlasFloat}(A::Matrix{T}, uplo::Char, tol::Real) + A, piv, rank, info = LAPACK.pstrf!(uplo, A, tol) + CholeskyPivotedDense{T}(uplo == 'U' ? triu!(A) : tril!(A), uplo, piv, rank, tol, info) +end + +cholp(A::Matrix, uplo::Symbol, tol::Real) = CholeskyPivotedDense(copy(A), string(uplo)[1], tol) +cholp(A::Matrix, tol::Real) = cholp(A, :U, tol) +cholp(A::Matrix) = cholp(A, -1.) +cholp{T<:Int}(A::Matrix{T}, args...) = cholp(float64(A), args...) + +size(C::CholeskyPivotedDense) = size(C.UL) +size(C::CholeskyPivotedDense,d::Integer) = size(C.UL,d) + +ref(C::CholeskyPivotedDense) = C.UL, C.piv +function ref{T<:BlasFloat}(C::CholeskyPivotedDense{T}, d::Symbol) + if d == :U || d == :L + return symbol(C.uplo) == d ? C.UL : C.UL' + end + if d == :p return C.piv end + if d == :P + n = size(C, 1) + P = zeros(T, n, n) + for i in 1:n + P[C.piv[i],i] = one(T) + end + return P + end + error("No such property") +end + +function \{T<:BlasFloat}(C::CholeskyPivotedDense{T}, B::StridedVector{T}) + if C.rank < size(C.UL, 1); throw(LAPACK.RankDeficientException(C.info)); end + LAPACK.potrs!(C.uplo, C.UL, copy(B)[C.piv])[invperm(C.piv)] +end + +function \{T<:BlasFloat}(C::CholeskyPivotedDense{T}, B::StridedMatrix{T}) + if C.rank < size(C.UL, 1); throw(LAPACK.RankDeficientException(C.info)); end + LAPACK.potrs!(C.uplo, C.UL, copy(B)[C.piv,:])[invperm(C.piv),:] +end + +rank(C::CholeskyPivotedDense) = C.rank + +function det{T}(C::CholeskyPivotedDense{T}) + if C.rank < size(C.UL, 1) + return real(zero(T)) + else + return prod(abs2(diag(C.UL))) + end +end + +function inv(C::CholeskyPivotedDense) + if C.rank < size(C.UL, 1) throw(LAPACK.RankDeficientException(C.info)) end + Ci, info = LAPACK.potri!(C.uplo, copy(C.UL)) + if info != 0 throw(LAPACK.RankDeficientException(info)) end + ipiv = invperm(C.piv) + (symmetrize!(Ci, C.uplo))[ipiv, ipiv] +end + +## LU +type LUDense{T} <: Factorization{T} + LU::Matrix{T} + ipiv::Vector{BlasInt} + info::BlasInt + function LUDense(LU::Matrix{T}, ipiv::Vector{BlasInt}, info::BlasInt) + m, n = size(LU) + m == n ? new(LU, ipiv, info) : throw(LAPACK.DimensionMismatch("LUDense only defined for square matrices")) + end +end +function LUDense{T<:BlasFloat}(A::Matrix{T}) + LU, ipiv, info = LAPACK.getrf!(A) + LUDense{T}(LU, ipiv, info) +end + +lu(A::Matrix) = LUDense(copy(A)) +lu{T<:Integer}(A::Matrix{T}) = lu(float(A)) +lu(x::Number) = (one(x), x, [1]) + +size(A::LUDense) = size(A.LU) +size(A::LUDense,n) = size(A.LU,n) + +function ref{T}(A::LUDense{T}, d::Symbol) + if d == :L; return tril(A.LU, -1) + eye(T, size(A, 1)); end; + if d == :U; return triu(A.LU); end; + if d == :p + n = size(A, 1) + p = [1:n] + for i in 1:n + tmp = p[i] + p[i] = p[A.ipiv[i]] + p[A.ipiv[i]] = tmp + end + return p + end + if d == :P + p = A[:p] + n = length(p) + P = zeros(T, n, n) + for i in 1:n + P[i,p[i]] = one(T) + end + return P + end + error("No such property") +end + +function det{T}(A::LUDense{T}) + m, n = size(A) + if A.info > 0; return zero(typeof(A.LU[1])); end + prod(diag(A.LU)) * (bool(sum(A.ipiv .!= 1:n) % 2) ? -one(T) : one(T)) +end + +function (\)(A::LUDense, B::StridedVecOrMat) + if A.info > 0; throw(LAPACK.SingularException(A.info)); end + LAPACK.getrs!('N', A.LU, A.ipiv, copy(B)) +end + +function inv(A::LUDense) + if A.info > 0; return throw(LAPACK.SingularException(A.info)); end + LAPACK.getri!(copy(A.LU), A.ipiv) +end + +## QR decomposition without column pivots. By the faster geqrt3 +type QRDense{S} <: Factorization{S} + vs::Matrix{S} # the elements on and above the diagonal contain the N-by-N upper triangular matrix R; the elements below the diagonal are the columns of V + T::Matrix{S} # upper triangular factor of the block reflector. +end +QRDense(A::Matrix) = QRDense(LAPACK.geqrt3!(A)...) + +qr(A::Matrix) = QRDense(copy(A)) +qr{T<:Integer}(A::Matrix{T}) = qr(float(A)) +qr(x::Number) = (one(x), x) + +size(A::QRDense, args::Integer...) = size(A.vs, args...) + +function ref(A::QRDense, d::Symbol) + if d == :R; return triu(A.vs[1:min(size(A)),:]); end; + if d == :Q; return QRDenseQ(A); end + error("No such property") +end + +type QRDenseQ{S} <: AbstractMatrix{S} + vs::Matrix{S} + T::Matrix{S} +end +QRDenseQ(A::QRDense) = QRDenseQ(A.vs, A.T) + +size(A::QRDenseQ, args::Integer...) = size(A.vs, args...) + +function full{T<:BlasFloat}(A::QRDenseQ{T}, thin::Bool) + if thin return A * eye(T, size(A.T, 1)) end + return A * eye(T, size(A, 1)) +end +full(A::QRDenseQ) = full(A, true) + +print_matrix(io::IO, A::QRDenseQ) = print_matrix(io, full(A)) + +## Multiplication by Q from the QR decomposition +function *{T<:BlasFloat}(A::QRDenseQ{T}, B::StridedVecOrMat{T}) + m = size(B, 1) + n = size(B, 2) + if m == size(A.vs, 1) + Bc = copy(B) + elseif m == size(A.vs, 2) + Bc = [B; zeros(T, size(A.vs, 1) - m, n)] + else + throw(LAPACK.DimensionMismatch("")) + end + LAPACK.gemqrt!('L', 'N', A.vs, A.T, Bc) +end +Ac_mul_B(A::QRDenseQ, B::StridedVecOrMat) = LAPACK.gemqrt!('L', iscomplex(A.vs[1]) ? 'C' : 'T', A.vs, A.T, copy(B)) +*(A::StridedVecOrMat, B::QRDenseQ) = LAPACK.gemqrt!('R', 'N', B.vs, B.T, copy(A)) +function A_mul_Bc{T<:BlasFloat}(A::StridedVecOrMat{T}, B::QRDenseQ{T}) + m = size(A, 1) + n = size(A, 2) + if n == size(B.vs, 1) + Ac = copy(A) + elseif n == size(B.vs, 2) + Ac = [B zeros(T, m, size(B.vs, 1) - n)] + else + throw(LAPACK.DimensionMismatch("")) + end + LAPACK.gemqrt!('R', iscomplex(B.vs[1]) ? 'C' : 'T', B.vs, B.T, Ac) +end +## Least squares solution. Should be more careful about cases with m < n +(\)(A::QRDense, B::StridedVector) = Triangular(A[:R], 'U')\(A[:Q]'B)[1:size(A, 2)] +(\)(A::QRDense, B::StridedMatrix) = Triangular(A[:R], 'U')\(A[:Q]'B)[1:size(A, 2),:] + +type QRPivotedDense{T} <: Factorization{T} + hh::Matrix{T} + tau::Vector{T} + jpvt::Vector{BlasInt} + function QRPivotedDense(hh::Matrix{T}, tau::Vector{T}, jpvt::Vector{BlasInt}) + m, n = size(hh) + if length(tau) != min(m,n) || length(jpvt) != n + throw(LAPACK.DimensionMismatch("")) + end + new(hh,tau,jpvt) + end +end +QRPivotedDense{T<:BlasFloat}(A::Matrix{T}) = QRPivotedDense{T}(LAPACK.geqp3!(A)...) +qrp(A::Matrix) = QRPivotedDense(copy(A)) +# QRDenseQ(A::QRPivotedDense) = QRDenseQ(A.hh, A.tau) + +size(A::QRPivotedDense, args::Integer...) = size(A.hh, args...) + +function ref{T<:BlasFloat}(A::QRPivotedDense{T}, d::Symbol) + if d == :R; return triu(A.hh[1:min(size(A)),:]); end; + if d == :Q; return QRDensePivotedQ(A); end + if d == :p; return A.jpvt; end + if d == :P + p = A[:p] + n = length(p) + P = zeros(T, n, n) + for i in 1:n + P[p[i],i] = one(T) + end + return P + end + error("No such property") +end + +(\)(A::QRPivotedDense, B::StridedVector) = (Triangular(A[:R])\(A[:Q]'B)[1:size(A, 2)])[invperm(A.jpvt)] +(\)(A::QRPivotedDense, B::StridedMatrix) = (Triangular(A[:R])\(A[:Q]'B)[1:size(A, 2),:])[invperm(A.jpvt),:] + +type QRDensePivotedQ{T} <: AbstractMatrix{T} + hh::Matrix{T} # Householder transformations and R + tau::Vector{T} # Scalar factors of transformations +end +QRDensePivotedQ(A::QRPivotedDense) = QRDensePivotedQ(A.hh, A.tau) + +size(A::QRDensePivotedQ, args...) = size(A.hh, args...) + +function full{T<:BlasFloat}(A::QRDensePivotedQ{T}, thin::Bool) + if !thin + Q = Array(T, size(A, 1), size(A, 1)) + Q[:,1:size(A, 2)] = copy(A.hh) + return LAPACK.orgqr!(Q, A.tau) + else + return LAPACK.orgqr!(copy(A.hh), A.tau) + end +end +full(A::QRDensePivotedQ) = full(A, true) + +## Multiplication by Q from the Pivoted QR decomposition +function *{T<:BlasFloat}(A::QRDensePivotedQ{T}, B::StridedVecOrMat{T}) + m = size(B, 1) + n = size(B, 2) + if m == size(A.hh, 1) + Bc = copy(B) + elseif m == size(A.hh, 2) + Bc = [B; zeros(T, size(A.hh, 1) - m, n)] + else + throw(LAPACK.DimensionMismatch("")) + end + LAPACK.ormqr!('L', 'N', A.hh, A.tau, Bc) +end +Ac_mul_B(A::QRDensePivotedQ, B::StridedVecOrMat) = LAPACK.ormqr!('L', iscomplex(A.hh[1]) ? 'C' : 'T', A.hh, A.tau, copy(B)) +*(A::StridedVecOrMat, B::QRDensePivotedQ) = LAPACK.ormqr!('R', 'N', B.hh, B.tau, copy(A)) +function A_mul_Bc{T<:BlasFloat}(A::StridedVecOrMat{T}, B::QRDensePivotedQ{T}) + m = size(A, 1) + n = size(A, 2) + if n == size(B.hh, 1) + Ac = copy(A) + elseif n == size(B.hh, 2) + Ac = [B zeros(T, m, size(B.hh, 1) - n)] + else + throw(LAPACK.DimensionMismatch("")) + end + LAPACK.ormqr!('R', iscomplex(B.hh[1]) ? 'C' : 'T', B.hh, B.tau, Ac) +end + +##TODO: Add methods for rank(A::QRP{T}) and adjust the (\) method accordingly +## Add rcond methods for Cholesky, LU, QR and QRP types +## Lower priority: Add LQ, QL and RQ factorizations + +# FIXME! Should add balancing option through xgebal +type Hessenberg{T} <: Factorization{T} + hh::Matrix{T} + tau::Vector{T} + function Hessenberg(hh::Matrix{T}, tau::Vector{T}) + if size(hh, 1) != size(hh, 2) throw(LAPACK.DimensionMismatch("")) end + return new(hh, tau) + end +end +Hessenberg{T<:BlasFloat}(hh::Matrix{T}, tau::Vector{T}) = Hessenberg{T}(hh, tau) +Hessenberg(A::StridedMatrix) = Hessenberg(LAPACK.gehrd!(A)...) + +hess(A::StridedMatrix) = Hessenberg(copy(A)) + +type HessenbergQ{T} <: AbstractMatrix{T} + hh::Matrix{T} + tau::Vector{T} +end +HessenbergQ(A::Hessenberg) = HessenbergQ(A.hh, A.tau) +size(A::HessenbergQ, args...) = size(A.hh, args...) +ref(A::HessenbergQ, args...) = ref(full(A), args...) + +function ref(A::Hessenberg, d::Symbol) + if d == :Q; return HessenbergQ(A); end + if d == :H; return triu(A.hh, -1); end + error("No such property") +end + +full(A::HessenbergQ) = LAPACK.orghr!(1, size(A.hh, 1), copy(A.hh), A.tau) + +### Linear algebra for general matrices + +function det(A::Matrix) + m, n = size(A) + if m != n; throw(LAPACK.DimensionMismatch("det only defined for square matrices")); end + if istriu(A) | istril(A); return det(Triangular(A, 'U', false)); end + return det(LUDense(copy(A))) +end +det(x::Number) = x + +logdet(A::Matrix) = 2.0 * sum(log(diag(chol(A)[:U]))) + +function inv(A::StridedMatrix) + if istriu(A) return inv(Triangular(A, 'U')) end + if istril(A) return inv(Triangular(A, 'L')) end + if ishermitian(A) return inv(Hermitian(A)) end + return inv(LUDense(copy(A))) +end + +function eig{T<:BlasFloat}(A::StridedMatrix{T}) + n = size(A, 2) + if n == 0; return (zeros(T, 0), zeros(T, 0, 0)) end + if ishermitian(A) return eig(Hermitian(A)) end + if iscomplex(A) return LAPACK.geev!('N', 'V', copy(A))[[1,3]] end + + WR, WI, VL, VR = LAPACK.geev!('N', 'V', copy(A)) + if all(WI .== 0.) return WR, VR end + evec = complex(zeros(T, n, n)) + j = 1 + while j <= n + if WI[j] == 0.0 + evec[:,j] = VR[:,j] + else + evec[:,j] = VR[:,j] + im*VR[:,j+1] + evec[:,j+1] = VR[:,j] - im*VR[:,j+1] + j += 1 + end + j += 1 + end + return complex(WR, WI), evec +end + +eig{T<:Integer}(x::StridedMatrix{T}) = eig(float64(x)) +eig(x::Number) = (x, one(x)) + +function eigvals(A::StridedMatrix) + if ishermitian(A) return eigvals(Hermitian(A)) end + if iscomplex(A) return LAPACK.geev!('N', 'N', copy(A))[1] end + valsre, valsim, _, _ = LAPACK.geev!('N', 'N', copy(A)) + if all(valsim .== 0) return valsre end + return complex(valsre, valsim) +end + +eigvals(x::Number) = 1.0 + +# SVD +type SVDDense{T,Tr} <: Factorization{T} + U::Matrix{T} + S::Vector{Tr} + Vt::Matrix{T} +end +function SVDDense(A::StridedMatrix, thin::Bool) + m,n = size(A) + if m == 0 || n == 0 + u,s,vt = (eye(m, thin ? n : m), zeros(0), eye(n,n)) + else + u,s,vt = LAPACK.gesdd!(thin ? 'S' : 'A', A) + end + return SVDDense(u,s,vt) +end +SVDDense(A::StridedMatrix) = SVDDense(A, false) +svd(A::StridedMatrix, args...) = SVDDense(copy(A), args...) +svd(x::Number, thin::Bool) = (x==0?one(x):x/abs(x),abs(x),one(x)) + +function ref(F::SVDDense, d::Symbol) + if d == :U return F.U end + if d == :S return F.S end + if d == :Vt return F.Vt end + if d == :V return F.Vt' end + error("No such property") +end + +function svdvals!{T<:BlasFloat}(A::StridedMatrix{T}) + m,n = size(A) + if m == 0 || n == 0 return zeros(T, 0) end + return LAPACK.gesdd!('N', A)[2] +end + +svdvals(A) = svdvals!(copy(A)) + +# SVD least squares +function \{T<:BlasFloat}(A::SVDDense{T}, B::StridedVecOrMat{T}) + n = length(A[:S]) + Sinv = zeros(T, n) + Sinv[A[:S] .> sqrt(eps())] = 1.0 ./ A[:S] + return diagmm(A[:V], Sinv) * A[:U][:,1:n]'B +end + +# Generalized svd +type GSVDDense{T} <: Factorization{T} + U::Matrix{T} + V::Matrix{T} + Q::Matrix{T} + a::Vector + b::Vector + k::Int + l::Int + R::Matrix{T} +end + +function GSVDDense(A::StridedMatrix, B::StridedMatrix) + U, V, Q, a, b, k, l, R = LAPACK.ggsvd!('U', 'V', 'Q', A, B) + return GSVDDense(U, V, Q, a, b, int(k), int(l), R) +end + +svd(A::StridedMatrix, B::StridedMatrix) = GSVDDense(copy(A), copy(B)) + +function ref{T}(obj::GSVDDense{T}, d::Symbol) + if d == :U return obj.U end + if d == :V return obj.V end + if d == :Q return obj.Q end + if d == :alpha || d == :a return obj.a end + if d == :beta || d == :b return obj.b end + if d == :vals || d == :S return obj.a[1:obj.k + obj.l] ./ obj.b[1:obj.k + obj.l] end + if d == :D1 + m = size(obj.U, 1) + if m - obj.k - obj.l >= 0 + return [eye(T, obj.k) zeros(T, obj.k, obj.l); zeros(T, obj.l, obj.k) diagm(obj.a[obj.k + 1:obj.k + obj.l]); zeros(T, m - obj.k - obj.l, obj.k + obj.l)] + else + return [eye(T, m, obj.k) [zeros(T, obj.k, m - obj.k); diagm(obj.a[obj.k + 1:m])] zeros(T, m, obj.k + obj.l - m)] + end + end + if d == :D2 + m = size(obj.U, 1) + p = size(obj.V, 1) + if m - obj.k - obj.l >= 0 + return [zeros(T, obj.l, obj.k) diagm(obj.b[obj.k + 1:obj.k + obj.l]); zeros(T, p - obj.l, obj.k + obj.l)] + else + return [zeros(T, p, obj.k) [diagm(obj.b[obj.k + 1:m]); zeros(T, obj.k + p - m, m - obj.k)] [zeros(T, m - obj.k, obj.k + obj.l - m); eye(T, obj.k + p - m, obj.k + obj.l - m)]] + end + end + if d == :R return obj.R end + if d == :R0 + m = size(obj.U, 1) + n = size(obj.Q, 1) + if m - obj.k - obj.l >= 0 + return [zeros(T, obj.k + obj.l, n - obj.k - obj.l) obj.R] + else + return [zeros(T, obj.k + obj.l, n - obj.k - obj.l) obj.R] + end + end + error("No such property") +end + +function svdvals(A::StridedMatrix, B::StridedMatrix) + _, _, _, a, b, k, l, _ = LAPACK.ggsvd!('N', 'N', 'N', copy(A), copy(B)) + return a[1:k + l] ./ b[1:k + l] +end + +schur{T<:BlasFloat}(A::StridedMatrix{T}) = LAPACK.gees!('V', copy(A)) + +function (\){T<:BlasFloat}(A::StridedMatrix{T}, B::StridedVecOrMat{T}) + if size(A, 1) == size(A, 2) # Square + if istriu(A) return Triangular(A, 'U')\B end + if istril(A) return Triangular(A, 'L')\B end + if ishermitian(A) return Hermitian(A)\B end + end + LAPACK.gelsd!(copy(A), copy(B))[1] +end + +(\){T1<:BlasFloat, T2<:BlasFloat}(A::StridedMatrix{T1}, B::StridedVecOrMat{T2}) = + (\)(convert(Array{promote_type(T1,T2)},A), convert(Array{promote_type(T1,T2)},B)) +(\){T1<:BlasFloat, T2<:Real}(A::StridedMatrix{T1}, B::StridedVecOrMat{T2}) = (\)(A, convert(Array{T1}, B)) +(\){T1<:Real, T2<:BlasFloat}(A::StridedMatrix{T1}, B::StridedVecOrMat{T2}) = (\)(convert(Array{T2}, A), B) +(\){T1<:Real, T2<:Real}(A::StridedMatrix{T1}, B::StridedVecOrMat{T2}) = (\)(float64(A), float64(B)) +(\){T1<:Number, T2<:Number}(A::StridedMatrix{T1}, B::StridedVecOrMat{T2}) = (\)(complex128(A), complex128(B)) + +(/)(A::StridedVecOrMat, B::StridedVecOrMat) = (B' \ A')' + +## Moore-Penrose inverse +function pinv{T<:BlasFloat}(A::StridedMatrix{T}) + SVD = SVDDense(copy(A), true) + Sinv = zeros(T, length(SVD[:S])) + index = SVD[:S] .> eps(real(one(T)))*max(size(A))*max(SVD[:S]) + Sinv[index] = 1.0 ./ SVD[:S][index] + SVD[:Vt]'diagmm(Sinv, SVD[:U]') +end +pinv{T<:Integer}(A::StridedMatrix{T}) = pinv(float(A)) +pinv(a::StridedVector) = pinv(reshape(a, length(a), 1)) +pinv(x::Number) = one(x)/x + +## Basis for null space +function null{T<:BlasFloat}(A::StridedMatrix{T}) + m,n = size(A) + SVD = SVDDense(copy(A)) + if m == 0; return eye(T, n); end + indstart = sum(SVD[:S] .> max(m,n)*max(SVD[:S])*eps(eltype(SVD[:S]))) + 1 + SVD[:V][:,indstart:] +end +null{T<:Integer}(A::StridedMatrix{T}) = null(float(A)) +null(a::StridedVector) = null(reshape(a, length(a), 1)) + +function cond(A::StridedMatrix, p) + if p == 2 + v = svdvals(A) + maxv = max(v) + cnd = maxv == 0.0 ? Inf : maxv / min(v) + elseif p == 1 || p == Inf + m, n = size(A) + if m != n; error("Use 2-norm for non-square matrices"); end + cnd = 1 / LAPACK.gecon!(p == 1 ? '1' : 'I', LUDense(copy(A)).LU, norm(A, p)) + else + error("Norm type must be 1, 2 or Inf") + end + return cnd +end +cond(A::StridedMatrix) = cond(A, 2) diff --git a/base/linalg/linalg.jl b/base/linalg/linalg.jl index 5d21f7ace29ac..425e5a0be022e 100644 --- a/base/linalg/linalg.jl +++ b/base/linalg/linalg.jl @@ -3,6 +3,8 @@ include("linalg/blas.jl") include("linalg/lapack.jl") include("linalg/matmul.jl") include("linalg/dense.jl") +include("linalg/factorization.jl") +include("linalg/bunchkaufman.jl") include("linalg/hermitian.jl") include("linalg/woodbury.jl") include("linalg/tridiag.jl") From f60f3b5825b6ace6d63fb96ba2a687d253e796dd Mon Sep 17 00:00:00 2001 From: "Viral B. Shah" Date: Mon, 4 Mar 2013 13:24:42 +0530 Subject: [PATCH 06/29] Move arpack from extras into base/linalg --- Makefile | 2 +- base/exports.jl | 3 ++- {extras => base/linalg}/arpack.jl | 6 +++--- base/linalg/linalg.jl | 1 + test/arpack.jl | 6 ++---- 5 files changed, 9 insertions(+), 9 deletions(-) rename {extras => base/linalg}/arpack.jl (99%) diff --git a/Makefile b/Makefile index de9a1b7ad7054..d598bee9f7ed8 100644 --- a/Makefile +++ b/Makefile @@ -33,7 +33,7 @@ $(BUILD)/share/julia/helpdb.jl: doc/helpdb.jl | $(BUILD)/share/julia @cp $< $@ # use sys.ji if it exists, otherwise run two stages -$(BUILD)/$(JL_PRIVATE_LIBDIR)/sys.ji: VERSION base/*.jl base/pkg/*.jl $(BUILD)/share/julia/helpdb.jl +$(BUILD)/$(JL_PRIVATE_LIBDIR)/sys.ji: VERSION base/*.jl base/pkg/*.jl base/linalg/*.jl $(BUILD)/share/julia/helpdb.jl @#echo `git rev-parse --short HEAD`-$(OS)-$(ARCH) \(`date +"%Y-%m-%d %H:%M:%S"`\) > COMMIT $(QUIET_JULIA) cd base && \ (test -f $(BUILD)/$(JL_PRIVATE_LIBDIR)/sys.ji || $(JULIA_EXECUTABLE) -bf sysimg.jl) && $(JULIA_EXECUTABLE) -f sysimg.jl || echo "Note: this error is usually fixed by running 'make clean'. If the error persists, 'make cleanall' may help." diff --git a/base/exports.jl b/base/exports.jl index d2c0c0912143d..2c903858d73d9 100644 --- a/base/exports.jl +++ b/base/exports.jl @@ -3,8 +3,9 @@ export PCRE, FFTW, DSP, - LAPACK, BLAS, + LAPACK, + ARPACK, LibRandom, Random, Math, diff --git a/extras/arpack.jl b/base/linalg/arpack.jl similarity index 99% rename from extras/arpack.jl rename to base/linalg/arpack.jl index a265c0419d3ec..4b327859e727c 100644 --- a/extras/arpack.jl +++ b/base/linalg/arpack.jl @@ -1,9 +1,9 @@ module ARPACK -export eigs, svds - const libarpack = "libarpack" +export eigs, svds + import Base.BlasInt import Base.blas_int @@ -260,4 +260,4 @@ svds(A::AbstractMatrix, rvec::Bool) = svds(A, 6, "LA", rvec) svds(A::AbstractMatrix, nev::Integer) = svds(A, nev, "LA", true) svds(A::AbstractMatrix) = svds(A, 6, "LA", true) -end #module ARPACK +end # module ARPACK diff --git a/base/linalg/linalg.jl b/base/linalg/linalg.jl index 425e5a0be022e..78222e193ce06 100644 --- a/base/linalg/linalg.jl +++ b/base/linalg/linalg.jl @@ -11,3 +11,4 @@ include("linalg/tridiag.jl") include("linalg/rectfullpacked.jl") include("linalg/bitarray.jl") include("linalg/sparse.jl") +include("linalg/arpack.jl") diff --git a/test/arpack.jl b/test/arpack.jl index 7c9aac87c8dab..c700a7121bdb3 100644 --- a/test/arpack.jl +++ b/test/arpack.jl @@ -1,8 +1,6 @@ -require("arpack") +import ARPACK.eigs +import ARPACK.svds -using ARPACK - -# arpack begin local n,a,asym,d,v n = 10 From a95df9856f203cec4090d8f76f25e03b564e884f Mon Sep 17 00:00:00 2001 From: Douglas Bates Date: Mon, 4 Mar 2013 12:10:30 -0600 Subject: [PATCH 07/29] Move suitesparse.jl from extras to base/linalg --- base/linalg/linalg.jl | 1 + base/linalg/suitesparse.jl | 895 +++++++++++++++++++++++ {extras => base/linalg}/suitesparse_h.jl | 45 +- extras/suitesparse.jl | 759 ------------------- test/Makefile | 3 +- test/extra.jl | 2 +- test/suitesparse.jl | 4 - 7 files changed, 919 insertions(+), 790 deletions(-) create mode 100644 base/linalg/suitesparse.jl rename {extras => base/linalg}/suitesparse_h.jl (76%) delete mode 100644 extras/suitesparse.jl diff --git a/base/linalg/linalg.jl b/base/linalg/linalg.jl index 78222e193ce06..ba0beec179672 100644 --- a/base/linalg/linalg.jl +++ b/base/linalg/linalg.jl @@ -12,3 +12,4 @@ include("linalg/rectfullpacked.jl") include("linalg/bitarray.jl") include("linalg/sparse.jl") include("linalg/arpack.jl") +include("linalg/suitesparse.jl") diff --git a/base/linalg/suitesparse.jl b/base/linalg/suitesparse.jl new file mode 100644 index 0000000000000..af860c41c5ce3 --- /dev/null +++ b/base/linalg/suitesparse.jl @@ -0,0 +1,895 @@ +module SuiteSparse + +export ChmCommon, + CholmodDense, # types + CholmodFactor, + CholmodSparse, + CholmodTriplet, + UmfpackLU, + # methods + chm_aat, + chm_analyze, + chm_check, + chm_chng_fac!, + chm_eye, + chm_fac_xtype!, + chm_factorize, + chm_factorize!, + chm_ones, + chm_pack_fac!, + chm_print, + chm_scale!, + chm_solve, + chm_sort, + chm_speye, + chm_spsolve, + chm_sp_to_tr, + chm_zeros, + decrement, + decrement!, + increment, + increment!, + indtype, + show_umf_ctrl, + show_umf_info + +import Base.(\) +import Base.Ac_ldiv_B +import Base.At_ldiv_B +import Base.SparseMatrixCSC +import Base.copy +import Base.diagmm +import Base.findn_nzs +import Base.nnz +import Base.show +import Base.size +import Base.solve + +include("linalg/suitesparse_h.jl") + +type MatrixIllConditionedException <: Exception end +type CholmodException <: Exception end + +function decrement!{T<:Integer}(A::AbstractArray{T}) + for i in 1:length(A) A[i] -= one(T) end + A +end +decrement{T<:Integer}(A::AbstractArray{T}) = decrement!(copy(A)) +function increment!{T<:Integer}(A::AbstractArray{T}) + for i in 1:length(A) A[i] += one(T) end + A +end +increment{T<:Integer}(A::AbstractArray{T}) = increment!(copy(A)) + +typealias CHMITypes Union(Int32,Int64) # also ITypes for UMFPACK +typealias CHMVTypes Union(Complex64, Complex128, Float32, Float64) +typealias UMFVTypes Union(Float64,Complex128) + +## UMFPACK + +# the control and info arrays +const umf_ctrl = Array(Float64, UMFPACK_CONTROL) +ccall((:umfpack_dl_defaults, :libumfpack), Void, (Ptr{Float64},), umf_ctrl) +const umf_info = Array(Float64, UMFPACK_INFO) + +function show_umf_ctrl(level::Real) + old_prt::Float64 = umf_ctrl[1] + umf_ctrl[1] = float64(level) + ccall((:umfpack_dl_report_control, :libumfpack), Void, (Ptr{Float64},), umf_ctrl) + umf_ctrl[1] = old_prt +end +show_umf_ctrl() = show_umf_ctrl(2.) + +function show_umf_info(level::Real) + old_prt::Float64 = umf_ctrl[1] + umf_ctrl[1] = float64(level) + ccall((:umfpack_dl_report_info, :libumfpack), Void, + (Ptr{Float64}, Ptr{Float64}), umf_ctrl, umf_info) + umf_ctrl[1] = old_prt +end +show_umf_info() = show_umf_info(2.) + +type UmfpackLU{Tv<:UMFVTypes,Ti<:CHMITypes} <: Factorization{Tv} + symbolic::Ptr{Void} + numeric::Ptr{Void} + m::Int + n::Int + colptr::Vector{Ti} # 0-based column pointers + rowval::Vector{Ti} # 0-based row indices + nzval::Vector{Tv} +end + +function lud{Tv<:UMFVTypes,Ti<:CHMITypes}(S::SparseMatrixCSC{Tv,Ti}) + zerobased = S.colptr[1] == 0 + lu = UmfpackLU(C_NULL, C_NULL, S.m, S.n, + zerobased ? copy(S.colptr) : decrement(S.colptr), + zerobased ? copy(S.rowval) : decrement(S.rowval), + copy(S.nzval)) + umfpack_numeric!(lu) +end + +function lud!{Tv<:UMFVTypes,Ti<:CHMITypes}(S::SparseMatrixCSC{Tv,Ti}) + zerobased = S.colptr[1] == 0 + UmfpackLU(C_NULL, C_NULL, S.m, S.n, + zerobased ? S.colptr : decrement!(S.colptr), + zerobased ? S.rowval : decrement!(S.rowval), + S.nzval) +end + +function show(io::IO, f::UmfpackLU) + @printf(io, "UMFPACK LU Factorization of a %d-by-%d sparse matrix\n", + f.m, f.n) + if f.numeric != C_NULL println(f.numeric) end +end + +### Solve with Factorization + +(\){T<:UMFVTypes}(fact::UmfpackLU{T}, b::Vector{T}) = umfpack_solve(fact, b) +(\){Ts<:UMFVTypes,Tb<:Number}(fact::UmfpackLU{Ts}, b::Vector{Tb}) = fact\convert(Vector{Ts},b) + +### Solve directly with matrix + +(\)(S::SparseMatrixCSC, b::Vector) = lud(S) \ b +At_ldiv_B{T<:UMFVTypes}(S::SparseMatrixCSC{T}, b::Vector{T}) = umfpack_solve(lud(S), b, UMFPACK_Aat) +function At_ldiv_B{Ts<:UMFVTypes,Tb<:Number}(S::SparseMatrixCSC{Ts}, b::Vector{Tb}) + ## should be more careful here in case Ts<:Real and Tb<:Complex + At_ldiv_B(S, convert(Vector{Ts}, b)) +end +Ac_ldiv_B{T<:UMFVTypes}(S::SparseMatrixCSC{T}, b::Vector{T}) = umfpack_solve(lud(S), b, UMFPACK_At) +function Ac_ldiv_B{Ts<:UMFVTypes,Tb<:Number}(S::SparseMatrixCSC{Ts}, b::Vector{Tb}) + ## should be more careful here in case Ts<:Real and Tb<:Complex + Ac_ldiv_B(S, convert(Vector{Ts}, b)) +end + +## Wrappers around UMFPACK routines + +for (f_sym_r, f_num_r, f_sym_c, f_num_c, itype) in + (("umfpack_di_symbolic","umfpack_di_numeric","umfpack_zi_symbolic","umfpack_zi_numeric",:Int32), + ("umfpack_dl_symbolic","umfpack_dl_numeric","umfpack_zl_symbolic","umfpack_zl_numeric",:Int64)) + @eval begin + function umfpack_symbolic!{Tv<:Float64,Ti<:$itype}(U::UmfpackLU{Tv,Ti}) + if U.symbolic != C_NULL return U end + tmp = Array(Ptr{Void},1) + status = ccall(($f_sym_r, :libumfpack), Ti, + (Ti, Ti, Ptr{Ti}, Ptr{Ti}, Ptr{Tv}, Ptr{Void}, + Ptr{Float64}, Ptr{Float64}), + U.m, U.n, U.colptr, U.rowval, U.nzval, tmp, + umf_ctrl, umf_info) + if status != UMFPACK_OK; error("Error code $status from symbolic factorization"); end + U.symbolic = tmp[1] + finalizer(U.symbolic,umfpack_free_symbolic) + U + end + + function umfpack_symbolic!{Tv<:Complex128,Ti<:$itype}(U::UmfpackLU{Tv,Ti}) + if U.symbolic != C_NULL return U end + tmp = Array(Ptr{Void},1) + status = ccall(($f_sym_r, :libumfpack), Ti, + (Ti, Ti, Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Float64}, Ptr{Void}, + Ptr{Float64}, Ptr{Float64}), + U.m, U.n, U.colptr, U.rowval, real(U.nzval), imag(U.nzval), tmp, + umf_ctrl, umf_info) + if status != UMFPACK_OK; error("Error code $status from symbolic factorization"); end + U.symbolic = tmp[1] + finalizer(U.symbolic,umfpack_free_symbolic) + U + end + + function umfpack_numeric!{Tv<:Float64,Ti<:$itype}(U::UmfpackLU{Tv,Ti}) + if U.numeric != C_NULL return U end + if U.symbolic == C_NULL umfpack_symbolic!(U) end + tmp = Array(Ptr{Void}, 1) + status = ccall(($f_num_r, :libumfpack), Ti, + (Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Void}, Ptr{Void}, + Ptr{Float64}, Ptr{Float64}), + U.colptr, U.rowval, U.nzval, U.symbolic, tmp, + umf_ctrl, umf_info) + if status > 0; throw(MatrixIllConditionedException); end + if status != UMFPACK_OK; error("Error code $status from numeric factorization"); end + U.numeric = tmp[1] + finalizer(U.numeric,umfpack_free_numeric) + U + end + + function umfpack_numeric!{Tv<:Complex128,Ti<:$itype}(U::UmfpackLU{Tv,Ti}) + if U.numeric != C_NULL return U end + if U.symbolic == C_NULL umfpack_symbolic!(U) end + tmp = Array(Ptr{Void}, 1) + status = ccall(($f_num_r, :libumfpack), Ti, + (Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Float64}, Ptr{Void}, Ptr{Void}, + Ptr{Float64}, Ptr{Float64}), + U.colptr, U.rowval, real(U.nzval), imag(U.nzval), U.symbolic, tmp, + umf_ctrl, umf_info) + if status > 0; throw(MatrixIllConditionedException); end + if status != UMFPACK_OK; error("Error code $status from numeric factorization"); end + U.numeric = tmp[1] + finalizer(U.numeric,umfpack_free_numeric) + U + end + end +end + +for (f_sol_r, f_sol_c, inttype) in + (("umfpack_di_solve","umfpack_zi_solve",:Int32), + ("umfpack_dl_solve","umfpack_zl_solve",:Int64)) + @eval begin + function umfpack_solve{Tv<:Float64,Ti<:$inttype}(lu::UmfpackLU{Tv,Ti}, b::Vector{Tv}, typ::Integer) + umfpack_numeric!(lu) + x = similar(b) + status = ccall(($f_sol_r, :libumfpack), Ti, + (Ti, Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Float64}, + Ptr{Float64}, Ptr{Void}, Ptr{Float64}, Ptr{Float64}), + typ, lu.colptr, lu.rowval, lu.nzval, x, b, lu.numeric, umf_ctrl, umf_info) + if status != UMFPACK_OK; error("Error code $status in umfpack_solve"); end + return x + end + + function umfpack_solve{Tv<:Complex128,Ti<:$inttype}(lu::UmfpackLU{Tv,Ti}, b::Vector{Tv}, typ::Integer) + umfpack_numeric!(lu) + xr = similar(b, Float64) + xi = similar(b, Float64) + status = ccall(($f_sol_c, :libumfpack), + Ti, + (Ti, Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Float64}, Ptr{Float64}, Ptr{Float64}, + Ptr{Float64}, Ptr{Float64}, Ptr{Void}, Ptr{Float64}, Ptr{Float64}), + typ, lu.colptr, lu.rowval, real(lu.nzval), imag(lu.nzval), + xr, xi, real(b), imag(b), lu.num, umf_ctrl, umf_info) + if status != UMFPACK_OK; error("Error code $status from umfpack_solve"); end + return complex(xr,xi) + end + end +end +show_umf_ctrl() = show_umf_ctrl(2.) + +umfpack_solve(lu::UmfpackLU, b::Vector) = umfpack_solve(lu, b, UMFPACK_A) + +## The C functions called by these Julia functions do not depend on +## the numeric and index types, even though the umfpack names indicate +## they do. The umfpack_free_* functions can be called on C_NULL without harm. +function umfpack_free_symbolic(symb::Ptr{Void}) + tmp = [symb] + ccall((:umfpack_dl_free_symbolic, :libumfpack), Void, (Ptr{Void},), tmp) +end +show_umf_info() = show_umf_info(2.) + +function umfpack_free_symbolic(lu::UmfpackLU) + if lu.symbolic == C_NULL return lu end + umfpack_free_numeric(lu) + umfpack_free_symbolic(lu.symbolic) + lu.symbolic = C_NULL + lu +end + +function umfpack_free_numeric(num::Ptr{Void}) + tmp = [num] + ccall((:umfpack_dl_free_numeric, :libumfpack), Void, (Ptr{Void},), tmp) +end + +function umfpack_free_symbolic(lu::UmfpackLU) + if lu.numeric == C_NULL return lu end + umfpack_free_numeric(lu.numeric) + lu.numeric = C_NULL + lu +end + +function umfpack_report_symbolic(symb::Ptr{Void}, level::Real) + old_prl::Float64 = umf_ctrl[UMFPACK_PRL] + umf_ctrl[UMFPACK_PRL] = float64(level) + status = ccall((:umfpack_dl_report_symbolic, :libumfpack), Int, + (Ptr{Void}, Ptr{Float64}), symb, umf_ctrl) + umf_ctrl[UMFPACK_PRL] = old_prl + if status != 0 + error("Error code $status from umfpack_report_symbolic") + end +end + +umfpack_report_symbolic(symb::Ptr{Void}) = umfpack_report_symbolic(symb, 4.) + +function umfpack_report_symbolic(lu::UmfpackLU, level::Real) + umfpack_report_symbolic(umfpack_symbolic!(lu).symbolic, level) +end + +umfpack_report_symbolic(lu::UmfpackLU) = umfpack_report_symbolic(lu.symbolic,4.) +function umfpack_report_numeric(num::Ptr{Void}, level::Real) + old_prl::Float64 = umf_ctrl[UMFPACK_PRL] + umf_ctrl[UMFPACK_PRL] = float64(level) + status = ccall((:umfpack_dl_report_numeric, :libumfpack), Int, + (Ptr{Void}, Ptr{Float64}), num, umf_ctrl) + umf_ctrl[UMFPACK_PRL] = old_prl + if status != 0 + error("Error code $status from umfpack_report_numeric") + end +end + +umfpack_report_numeric(num::Ptr{Void}) = umfpack_report_numeric(num, 4.) +function umfpack_report_numeric(lu::UmfpackLU, level::Real) + umfpack_report_numeric(umfpack_numeric!(lu).symbolic, level) +end + +umfpack_report_numeric(lu::UmfpackLU) = umfpack_report_numeric(lu.symbolic,4.) + +## CHOLMOD + +const chm_com_sz = ccall((:jl_cholmod_common_size,:libsuitesparse_wrapper),Int,()) +const chm_com = Array(Uint8, chm_com_sz) +ccall((:cholmod_start, :libcholmod), Int32, (Ptr{Uint8},), chm_com) + +### A way of examining some of the fields in chm_com +### Probably better to make this a Dict{ASCIIString,Tuple} and +### save the offsets and the lengths and the types. Then the names can be checked. +type ChmCommon + dbound::Float64 + maxrank::Int + supernodal_switch::Float64 + supernodal::Int32 + final_asis::Int32 + final_super::Int32 + final_ll::Int32 + final_pack::Int32 + final_monotonic::Int32 + final_resymbol::Int32 + prefer_zomplex::Int32 # should always be false + prefer_upper::Int32 + print::Int32 # print level. Default: 3 + precise::Int32 # print 16 digits, otherwise 5 + nmethods::Int32 # number of ordering methods + selected::Int32 + postorder::Int32 + itype::Int32 + dtype::Int32 +end + +### These offsets should be reconfigured to be less error-prone in matches +const chm_com_offsets = Array(Int, length(ChmCommon.types)) +ccall((:jl_cholmod_common_offsets, :libsuitesparse_wrapper), + Void, (Ptr{Uint8},), chm_com_offsets) +const chm_prt_inds = (1:4) + chm_com_offsets[13] +const chm_ityp_inds = (1:4) + chm_com_offsets[18] + +### there must be an easier way but at least this works. +function ChmCommon(aa::Array{Uint8,1}) + typs = ChmCommon.types + sz = map(sizeof, typs) + args = map(i->reinterpret(typs[i], aa[chm_com_offsets[i] + (1:sz[i])])[1], 1:length(sz)) + eval(Expr(:call, unshift!(args, :ChmCommon), Any)) +end +function chm_itype{Tv<:CHMVTypes,Ti<:CHMITypes}(S::SparseMatrixCSC{Tv,Ti}) + int32(Ti<:Int64 ? CHOLMOD_LONG : CHOLMOD_INT) +end +function chm_xtype{T<:CHMVTypes}(S::SparseMatrixCSC{T}) + int32(T<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL) +end +function chm_dtype{T<:CHMVTypes}(S::SparseMatrixCSC{T}) + int32(T<:Union(Float32, Complex64) ? CHOLMOD_SINGLE : CHOLMOD_DOUBLE) +end + +function set_chm_prt_lev(cm::Array{Uint8}, lev::Integer) + cm[(1:4) + chm_com_offsets[13]] = reinterpret(Uint8, [int32(lev)]) +end + +## cholmod_dense pointers passed to or returned from C functions are of Julia type +## Ptr{c_CholmodDense}. The CholmodDense type contains a c_CholmodDense object and other +## fields then ensure the memory pointed to is freed when it should be and not before. +type c_CholmodDense{T<:CHMVTypes} + m::Int + n::Int + nzmax::Int + lda::Int + xpt::Ptr{T} + zpt::Ptr{Void} + xtype::Int32 + dtype::Int32 +end + +type CholmodDense{T<:CHMVTypes} + c::c_CholmodDense + mat::Matrix{T} +end + +type c_CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes} + n::Int + minor::Int + Perm::Ptr{Ti} + ColCount::Ptr{Ti} + nzmax::Int + p::Ptr{Ti} + i::Ptr{Ti} + x::Ptr{Tv} + z::Ptr{Void} + nz::Ptr{Ti} + next::Ptr{Ti} + prev::Ptr{Ti} + nsuper::Int + ssize::Int + xsize::Int + maxcsize::Int + maxesize::Int + super::Ptr{Ti} + pi::Ptr{Ti} + px::Ptr{Tv} + s::Ptr{Ti} + ordering::Int32 + is_ll::Int32 + is_super::Int32 + is_monotonic::Int32 + itype::Int32 + xtype::Int32 + dtype::Int32 +end + +type CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes} + c::c_CholmodFactor{Tv,Ti} + Perm::Vector{Ti} + ColCount::Vector{Ti} + p::Vector{Ti} + i::Vector{Ti} + x::Vector{Tv} + nz::Vector{Ti} + next::Vector{Ti} + prev::Vector{Ti} + super::Vector{Ti} + pi::Vector{Ti} + px::Vector{Tv} + s::Vector{Ti} +end + +type c_CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes} + m::Int + n::Int + nzmax::Int + ppt::Ptr{Ti} + ipt::Ptr{Ti} + nzpt::Ptr{Void} + xpt::Ptr{Tv} + zpt::Ptr{Void} + stype::Int32 + itype::Int32 + xtype::Int32 + dtype::Int32 + sorted::Int32 + packed::Int32 +end + +type CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes} + c::c_CholmodSparse{Tv,Ti} + colptr0::Vector{Ti} + rowval0::Vector{Ti} + nzval::Vector{Tv} +end + +type c_CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes} + m::Int + n::Int + nzmax::Int + nnz::Int + i::Ptr{Ti} + j::Ptr{Ti} + x::Ptr{Tv} + z::Ptr{Void} + stype:Int32 + itype::Int32 + xtype::Int32 + dtype::Int32 +end + +type CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes} + c::c_CholmodTriplet{Tv,Ti} + i::Vector{Ti} + j::Vector{Ti} + x::Vector{Tv} +end + +function CholmodDense{T<:CHMVTypes}(aa::VecOrMat{T}) + m = size(aa,1); n = size(aa,2) + CholmodDense(c_CholmodDense{T}(m, n, m*n, stride(aa,2), + convert(Ptr{T}, aa), C_NULL, + T<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, + T<:Union(Float32,Complex64) ? CHOLMOD_SINGLE : CHOLMOD_DOUBLE), + length(size(aa)) == 2 ? aa : reshape(aa, (m,n))) +end + +function CholmodDense{T<:CHMVTypes}(c::Ptr{c_CholmodDense{T}}) + cp = unsafe_ref(c) + if cp.lda != cp.m || cp.nzmax != cp.m * cp.n + error("overallocated cholmod_sparse returned object of size $(cp.m) by $(cp.n) with leading dim $(cp.lda) and nzmax $(cp.nzmax)") + end + ## the true in the call to pointer_to_array means Julia will free the memory + val = CholmodDense(cp, pointer_to_array(cp.xpt, (cp.m,cp.n), true)) + c_free(c) + val +end +show(io::IO, cd::CholmodDense) = show(io, cd.mat) + +function chm_check{T<:CHMVTypes}(cd::CholmodDense{T}) + status = ccall((:cholmod_check_dense, :libcholmod), Int32, + (Ptr{c_CholmodDense{T}}, Ptr{Uint8}), &cd.c, chm_com) + if status != CHOLMOD_TRUE throw(CholmodException) end +end + +function chm_ones{T<:Union(Float64,Complex128)}(m::Integer, n::Integer, t::T) + CholmodDense(ccall((:cholmod_ones, :libcholmod), Ptr{c_CholmodDense{T}}, + (Int, Int, Int32, Ptr{Uint8}), + m, n, + T<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, + chm_com)) +end +chm_ones(m::Integer, n::Integer) = chm_ones(m, n, 1.) + +function chm_zeros{T<:Union(Float64,Complex128)}(m::Integer, n::Integer, t::T) + CholmodDense(ccall((:cholmod_zeros, :libcholmod), Ptr{c_CholmodDense{T}}, + (Int, Int, Int32, Ptr{Uint8}), + m, n, + T<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, + chm_com)) +end +chm_zeros(m::Integer, n::Integer) = chm_zeros(m, n, 1.) + +function chm_eye{T<:Union(Float64,Complex128)}(m::Integer, n::Integer, t::T) + CholmodDense(ccall((:cholmod_eye, :libcholmod), Ptr{c_CholmodDense{T}}, + (Int, Int, Int32, Ptr{Uint8}), + m, n, + T<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, + chm_com)) +end +chm_eye(m::Integer, n::Integer) = chm_eye(m, n, 1.) +chm_eye(n::Integer) = chm_eye(n, n, 1.) + + +function chm_print{T<:CHMVTypes}(cd::CholmodDense{T}, lev::Integer, nm::ASCIIString) + orig = chm_com[chm_prt_inds] + chm_com[chm_prt_inds] = reinterpret(Uint8, [int32(lev)]) + status = ccall((:cholmod_print_dense, :libcholmod), Int32, + (Ptr{c_CholmodDense{T}}, Ptr{Uint8}, Ptr{Uint8}), + &cd.c, nm, chm_com) + chm_com[chm_prt_inds] = orig + if status != CHOLMOD_TRUE throw(CholmodException) end +end +chm_print(cd::CholmodDense, lev::Integer) = chm_print(cd, lev, "") +chm_print(cd::CholmodDense) = chm_print(cd, int32(4), "") + +function CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes}(A::SparseMatrixCSC{Tv,Ti}) + stype = ishermitian(A) ? 1 : 0 + aa = stype > 0 ? triu(A) : A + colptr0 = decrement(aa.colptr) + rowval0 = decrement(aa.rowval) + nzval = copy(aa.nzval) + CholmodSparse{Tv,Ti}(c_CholmodSparse{Tv,Ti}(size(A,1),size(A,2), + int(colptr0[end]), + convert(Ptr{Ti}, colptr0), + convert(Ptr{Ti}, rowval0), C_NULL, + convert(Ptr{Tv}, nzval), C_NULL, + int32(stype), chm_itype(A), + chm_xtype(A), chm_dtype(A), +### Assuming that a SparseMatrixCSC always has sorted row indices. Need to check. + CHOLMOD_TRUE, CHOLMOD_TRUE), + colptr0, rowval0, nzval) +end + +function cmn{Ti<:CHMITypes}(i::Ti) + chm_com[chm_ityp_inds] = + reinterpret(Uint8, [Ti<:Int64 ? CHOLMOD_LONG : CHOLMOD_INT]) + chm_com +end +cmn{Tv,Ti<:CHMITypes}(A::CholmodSparse{Tv,Ti}) = cmn(one(Ti)) +cmn{Tv,Ti<:CHMITypes}(a::c_CholmodSparse{Tv,Ti}) = cmn(one(Ti)) +cmn{Tv,Ti<:CHMITypes}(ap::Ptr{c_CholmodSparse{Tv,Ti}}) = cmn(one(Ti)) +cmn{Tv,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti}) = cmn(one(Ti)) +cmn{Tv,Ti<:CHMITypes}(l::c_CholmodFactor{Tv,Ti}) = cmn(one(Ti)) +cmn{Tv,Ti<:CHMITypes}(lp::Ptr{c_CholmodFactor{Tv,Ti}}) = cmn(one(Ti)) + +function CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::Ptr{c_CholmodSparse{Tv,Ti}}) + csp = unsafe_ref(cp) + colptr0 = pointer_to_array(csp.ppt, (csp.n + 1,), true) + nnz = int(colptr0[end]) + cms = CholmodSparse{Tv,Ti}(csp, colptr0, + pointer_to_array(csp.ipt, (nnz,), true), + pointer_to_array(csp.xpt, (nnz,), true)) + c_free(cp) + cms +end + +for (chk,prt,srt,itype) in + ((:cholmod_check_sparse,:cholmod_print_sparse,:cholmod_sort,:Int32), + (:cholmod_l_check_sparse,:cholmod_l_print_sparse,:cholmod_l_sort,:Int64)) + @eval begin + function chm_check{Tv<:CHMVTypes}(cs::CholmodSparse{Tv,$itype}) + status = ccall(($(string(chk)),:libcholmod), Int32, + (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), + &cs.c, cmn(cs)) + if status != CHOLMOD_TRUE throw(CholmodException) end + end + function chm_print{Tv<:CHMVTypes}(cs::CholmodSparse{Tv,$itype},lev,nm) + orig = chm_com[chm_prt_inds] + chm_com[chm_prt_inds] = reinterpret(Uint8, [int32(lev)]) + status = ccall(($(string(prt)),:libcholmod), Int32, + (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}, Ptr{Uint8}), + &cs.c, nm, cmn(cs)) + chm_com[chm_prt_inds] = orig + if status != CHOLMOD_TRUE throw(CholmodException) end + end + function chm_sort{Tv<:CHMVTypes}(cs::CholmodSparse{Tv,$itype}) + status = ccall(($(string(srt)),:libcholmod), Int32, + (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), + &cs.c, cmn(cs)) + if status != CHOLMOD_TRUE throw(CholmodException) end + cs + end + end +end + +chm_print(cd::CholmodSparse, lev::Integer) = chm_print(cd, lev, "") +chm_print(cd::CholmodSparse) = chm_print(cd, int32(4), "") + +nnz{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::CholmodSparse{Tv,Ti}) = int(cp.colptr0[end]) +size{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::CholmodSparse{Tv,Ti}) = (int(cp.c.m), int(cp.c.n)) +function size{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::CholmodSparse{Tv,Ti}, d::Integer) + d == 1 ? cp.c.m : (d == 2 ? cp.c.n : 1) +end + +for (speye,aat,cop,copsp,freesp,itype) in + ((:cholmod_speye,:cholmod_aat,:cholmod_copy, + :cholmod_copy_sparse,:cholmod_free_sparse,:Int32), + (:cholmod_l_speye,:cholmod_l_aat,:cholmod_l_copy, + :cholmod_l_copy_sparse,:cholmod_l_free_sparse,:Int64)) + @eval begin + function chm_speye{Tv<:Union(Float64,Complex128)}(m::Integer, n::Integer, t::Tv, i::$itype) + CholmodSparse(ccall(($(string(speye)), :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, + (Int, Int, Int32, Ptr{Uint8}), + m, n, + Tv<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, + cmn(one($itype)))) + end + function chm_aat{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}) + cm = cmn(a) + aa = Array(Ptr{c_CholmodSparse{Tv,$itype}}, 1) + aa[1] = ccall(($(string(aat)), :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, + (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Void}, Int, Int32, Ptr{Uint8}), + &a, C_NULL, 0, 1, cm) + res = CholmodSparse(ccall(($(string(cop)), :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, + (Ptr{c_CholmodSparse{Tv,$itype}}, Int32, Int32, Ptr{Uint8}), + aa[1], 1, 1, cm)) + status = ccall(($(string(freesp)), :libcholmod), Int32, + (Ptr{Ptr{c_CholmodSparse{Tv,$itype}}}, Ptr{Uint8}), aa, cm) + if status != CHOLMOD_TRUE throw(CholmodException) end + res + end + function chm_copy_sp{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}) + ccall(($(string(copsp)),:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, + (Ptr{c_CholmodSparse{Tv,$itype}},Ptr{Uint8}), &a, cmn(a)) + end + end +end +chm_speye(m::Integer, n::Integer) = chm_speye(m, n, 1., 1) +chm_speye(n::Integer) = chm_speye(n, n, 1., 1) +chm_aat(A::CholmodSparse) = chm_aat(A.c) +chm_aat(A::SparseMatrixCSC) = chm_aat(CholmodSparse(A).c) +copy(A::CholmodSparse) = CholmodSparse(chm_copy_sp(A.c)) + +for (scl,itype) in + ((:cholmod_scale,:Int32), + (:cholmod_l_scale,:Int64)) + @eval begin + function chm_scale!{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}, + s::c_CholmodDense{Tv}, + typ::Integer) + status = ccall(($(string(scl)),:libcholmod), Int32, + (Ptr{c_CholmodDense{Tv}},Int32,Ptr{c_CholmodSparse{Tv,$itype}}, + Ptr{Uint8}), &s, typ, &a, cmn(a)) + if status != CHOLMOD_TRUE throw(CholmodException) end + end + end +end +function chm_scale!{T<:CHMVTypes}(A::CholmodSparse{T},S::CholmodDense{T},typ::Integer) + chm_scale!(A.c,S.c,typ) +end +function diagmm{T<:CHMVTypes}(b::Vector{T}, A::CholmodSparse{T}) + Acp = copy(A) + chm_scale!(Acp,CholmodDense(b),CHOLMOD_ROW) + Acp +end +function diagmm{T<:CHMVTypes}(A::CholmodSparse{T},b::Vector{T}) + Acp = copy(A) + chm_scale!(copy(A),CholmodDense(b),CHOLMOD_COL) + Acp +end + +function CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::Ptr{c_CholmodFactor{Tv,Ti}}) + cfp = unsafe_ref(cp) + Perm = pointer_to_array(cfp.Perm, (cfp.n,), true) + ColCount = pointer_to_array(cfp.ColCount, (cfp.n,), true) + p = pointer_to_array(cfp.p, (cfp.p == C_NULL ? 0 : cfp.n + 1,), true) + i = pointer_to_array(cfp.i, (cfp.i == C_NULL ? 0 : cfp.nzmax,), true) + x = pointer_to_array(cfp.x, (cfp.x == C_NULL ? 0 : cfp.nzmax,), true) + nz = pointer_to_array(cfp.nz, (cfp.nz == C_NULL ? 0 : cfp.n,), true) + next = pointer_to_array(cfp.next, (cfp.next == C_NULL ? 0 : cfp.n + 2,), true) + prev = pointer_to_array(cfp.prev, (cfp.prev == C_NULL ? 0 : cfp.n + 2,), true) + super = pointer_to_array(cfp.super, (cfp.super == C_NULL ? 0 : cfp.nsuper + 1,), true) + pi = pointer_to_array(cfp.pi, (cfp.pi == C_NULL ? 0 : cfp.nsuper + 1,), true) + px = pointer_to_array(cfp.px, (cfp.px == C_NULL ? 0 : cfp.nsuper + 1,), true) + s = pointer_to_array(cfp.s, (cfp.s == C_NULL ? 0 : cfp.ssize + 1,), true) + cf = CholmodFactor{Tv,Ti}(cfp, Perm, ColCount, p, i, x, nz, next, prev, + super, pi, px, s) + c_free(cp) + cf +end + +for (anl,chng,fac,slv,spslv,itype) in + ((:cholmod_analyze,:cholmod_change_factor,:cholmod_factorize, + :cholmod_solve,:cholmod_spsolve,:Int32), + (:cholmod_l_analyze,:cholmod_l_change_factor,:cholmod_l_factorize, + :cholmod_l_solve,:cholmod_l_spsolve,:Int64)) + @eval begin + function chm_analyze{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}) + ccall(($(string(anl)),:libcholmod), Ptr{c_CholmodFactor{Tv,$itype}}, + (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), &a, cmn(a)) + end + # update the factorization + function chm_factorize!{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}, + a::c_CholmodSparse{Tv,$itype}) + status = ccall(($(string(fac)),:libcholmod), Int32, + (Ptr{c_CholmodSparse{Tv,$itype}}, + Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), + &a, &l, cmn(a)) + if status != CHOLMOD_TRUE throw(CholmodException) end + end + # initialize a factorization + function chm_factorize{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}, ll::Bool) + Lpt = ccall(($(string(anl)),:libcholmod), Ptr{c_CholmodFactor{Tv,$itype}}, + (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), &a, cmn(a)) + status = ccall(($(string(fac)),:libcholmod), Int32, + (Ptr{c_CholmodSparse{Tv,$itype}}, + Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), + &a, Lpt, cmn(a)) + if status != CHOLMOD_TRUE throw(CholmodException) end + l = unsafe_ref(Lpt) + if int32(ll) != l.is_ll + status = ccall(($(string(chng)),:libcholmod), Int32, + (Int32,Int32,Int32,Int32,Int32, + Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), + l.xtype,ll,l.is_super,true,true,Lpt,cmn(l)) + if status != CHOLMOD_TRUE throw(CholmodException) end + end + CholmodFactor(Lpt) + end + function chm_solve{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}, + b::c_CholmodDense{Tv}, typ::Integer) + ccall(($(string(slv)),:libcholmod), Ptr{c_CholmodDense{Tv}}, + (Int32, Ptr{c_CholmodFactor{Tv,$itype}}, + Ptr{c_CholmodDense{Tv}}, Ptr{Uint8}), + typ, &l, &b, cmn(l)) + end + function chm_spsolve{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}, + b::c_CholmodSparse{Tv,$itype}, + typ::Integer) + ccall(($(string(spslv)),:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, + (Int32, Ptr{c_CholmodFactor{Tv,$itype}}, + Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), + typ, &l, &b, cmn(l)) + end + end +end +chm_analyze(ap::Ptr{c_CholmodSparse}) = chm_analyze(unsafe_ref(ap)) +chm_analyze(A::CholmodSparse) = chm_analyze(A.c) +chm_analyze(A::SparseMatrixCSC) = chm_analyze(CholmodSparse(A).c) + +chm_factorize(a::c_CholmodSparse) = chm_factorize(a,false) +chm_factorize(A::CholmodSparse) = chm_factorize(A.c,false) +chm_factorize(A::CholmodSparse,ll::Bool) = chm_factorize(A.c,ll) +chm_factorize(A::SparseMatrixCSC) = chm_factorize(CholmodSparse(A).c,false) +chm_factorize(A::SparseMatrixCSC,ll::Bool) = chm_factorize(CholmodSparse(A).c,ll) + +function chm_solve{T<:CHMVTypes}(l::c_CholmodFactor{T},b::c_CholmodDense{T}) + chm_solve(l,b,CHOLMOD_A) +end +function chm_solve{T<:CHMVTypes}(L::CholmodFactor{T},B::CholmodDense{T}) + chm_solve(L.c,B.c,CHOLMOD_A) +end + +function chm_spsolve{Tv<:CHMVTypes,Ti<:CHMITypes}(l::c_CholmodFactor{Tv,Ti}, + b::c_CholmodSparse{Tv,Ti}) + chm_spsolve(l,b,CHOLMOD_A) +end +function chm_spsolve{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti}, + B::CholmodSparse{Tv,Ti}) + chm_spsolve(L.c,B.c,CHOLMOD_A) +end + +for (chng,pack,cop,xtyp,f2s,itype) in + ((:cholmod_change_factor,:cholmod_pack_factor, + :cholmod_copy_factor,:cholmod_factor_xtype, + :cholmod_factor_to_sparse,:Int32), + (:cholmod_l_change_factor,:cholmod_l_pack_factor, + :cholmod_l_copy_factor,:cholmod_l_factor_xtype, + :cholmod_l_factor_to_sparse,:Int64)) + @eval begin + ## changing the factor is problematic because it reallocates the storage + ## for the arrays and frees the old arrays but Julia retains the old pointers + ## in the vectors + ## function chm_chng_fac!{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}, + ## xt,ll,super,packed,monotonic) + ## status = ccall(($(string(chng)),:libcholmod), Int32, + ## (Int32,Int32,Int32,Int32,Int32, + ## Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), + ## xt,ll,super,packed,monotonic,&l,cmn(l)) + ## if status != CHOLMOD_TRUE throw(CholmodException) end + ## end + function chm_copy_fac{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}) + ccall(($(string(cop)),:libcholmod), Ptr{c_CholmodFactor{Tv,$itype}}, + (Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), &l,cmn(l)) + end + function chm_fac_to_sp{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}) + ccall(($(string(f2s)),:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, + (Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), &l,cmn(l)) + end + function chm_fac_xtype!{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype},to_xtype) + status = ccall(($(string(xtyp)),:libcholmod), Int32, + (Int32, Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), + to_xtype,&l,cmn(l)) + if status != CHOLMOD_TRUE throw(CholmodException) end + end + function chm_pack_fac!{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}) + status = ccall(($(string(pack)),:libcholmod), Int32, + (Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), + &l,cmn(l)) + if status != CHOLMOD_TRUE throw(CholmodException) end + end + end +end +function chm_chng_fac!(L::CholmodFactor,xt,ll,super,packed,monotonic) + chm_chng_fac!(L.c, xt,ll,super,packed,monotonic) +end + +copy(L::CholmodFactor) = CholmodFactor(chm_copy_fac(L.c)) +CholmodSparse(L::CholmodFactor) = CholmodSparse(chm_fac_to_sp(L.c)) + +function chm_fac_xtype!{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},to_xtype) + chm_fac_xtype(L.c,to_xtype) +end + +function CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes}(tp::Ptr{c_CholmodTriplet{Tv,Ti}}) + ctp = unsafe_ref(tp) + i = pointer_to_array(ctp.i, (ctp.nnz,), true) + j = pointer_to_array(ctp.j, (ctp.nnz,), true) + x = pointer_to_array(ctp.x, (ctp.x == C_NULL ? 0 : ctp.nnz), true) + ct = CholmodTriplet{Tv,Ti}(ctp, i, j, x) + c_free(tp) + ct +end + +for (s2t,itype) in + ((:cholmod_sparse_to_triplet, :Int32), + (:cholmod_l_sparse_to_triplet, :Int64)) + @eval begin + function chm_sp_to_tr{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}) + ccall(($(string(s2t)), :libcholmod), Ptr{c_CholmodTriplet{Tv,$itype}}, + (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), &a, chm(a)) + end + end +end +chm_sp_to_tr(A::CholmodSparse) = chm_sp_to_tr(A.c) + +function findn_nzs{Tv,Ti}(A::CholmodSparse{Tv,Ti}) + jj = similar(A.rowval0) # expand A.colptr0 to a vector of indices + for j in 1:A.c.n, k in (A.colptr0[j]+1):A.colptr0[j+1] + jj[k] = j + end + + ind = similar(A.rowval0) + ipos = 1 + count = 0 + for k in 1:length(A.nzval) + if A.nzval[k] != 0 + ind[ipos] = k + ipos += 1 + count += 1 + else + println("Warning: sparse matrix contains explicitly stored zeros.") + end + end + ind = ind[1:count] # ind is the indices of nonzeros in A.nzval + (increment!(A.rowval0[ind]), jj[ind], A.nzval[ind]) +end + +findn_nzs(L::CholmodFactor) = findn_nzs(chm_fac_to_sp(L)) + +end #module diff --git a/extras/suitesparse_h.jl b/base/linalg/suitesparse_h.jl similarity index 76% rename from extras/suitesparse_h.jl rename to base/linalg/suitesparse_h.jl index 8bc3a623477e9..7e675d8bc855b 100644 --- a/extras/suitesparse_h.jl +++ b/base/linalg/suitesparse_h.jl @@ -4,33 +4,33 @@ const CHOLMOD_TRUE = int32(1) const CHOLMOD_FALSE = int32(0) # Types of systems to solve -const CHOLMOD_A = int32(0) # solve Ax=b -const CHOLMOD_LDLt = int32(1) # solve LDL'x=b -const CHOLMOD_LD = int32(2) # solve LDx=b -const CHOLMOD_DLt = int32(3) # solve DL'x=b -const CHOLMOD_L = int32(4) # solve Lx=b -const CHOLMOD_Lt = int32(5) # solve L'x=b -const CHOLMOD_D = int32(6) # solve Dx=b -const CHOLMOD_P = int32(7) # permute x=Px -const CHOLMOD_Pt = int32(8) # permute x=P'x +const CHOLMOD_A = int32(0) # solve Ax=b +const CHOLMOD_LDLt = int32(1) # solve LDL'x=b +const CHOLMOD_LD = int32(2) # solve LDx=b +const CHOLMOD_DLt = int32(3) # solve DL'x=b +const CHOLMOD_L = int32(4) # solve Lx=b +const CHOLMOD_Lt = int32(5) # solve L'x=b +const CHOLMOD_D = int32(6) # solve Dx=b +const CHOLMOD_P = int32(7) # permute x=Px +const CHOLMOD_Pt = int32(8) # permute x=P'x # itype defines the types of integer used: const CHOLMOD_INT = int32(0) # all integer arrays are int const CHOLMOD_LONG = int32(2) # all integer arrays are UF_long # dtype defines what the numerical type is (double or float): -const CHOLMOD_DOUBLE = int32(0) # all numerical values are double -const CHOLMOD_SINGLE = int32(1) # all numerical values are float +const CHOLMOD_DOUBLE = int32(0) # all numerical values are double +const CHOLMOD_SINGLE = int32(1) # all numerical values are float # xtype defines the kind of numerical values used: -const CHOLMOD_PATTERN = int32(0) # pattern only, no numerical values -const CHOLMOD_REAL = int32(1) # a real matrix -const CHOLMOD_COMPLEX = int32(2) # a complex matrix (ANSI C99 compatible) -const CHOLMOD_ZOMPLEX = int32(3) # a complex matrix (MATLAB compatible) +const CHOLMOD_PATTERN = int32(0) # pattern only, no numerical values +const CHOLMOD_REAL = int32(1) # a real matrix +const CHOLMOD_COMPLEX = int32(2) # a complex matrix (ANSI C99 compatible) +const CHOLMOD_ZOMPLEX = int32(3) # a complex matrix (MATLAB compatible) # Definitions for cholmod_common: -const CHOLMOD_MAXMETHODS = int32(9) # maximum number of different methods that - # cholmod_analyze can try. Must be >= 9. +const CHOLMOD_MAXMETHODS = int32(9) # maximum number of different methods that + # cholmod_analyze can try. Must be >= 9. # Common->status values. zero means success, negative means a fatal error, positive is a warning. const CHOLMOD_OK = int32(0) # success @@ -47,8 +47,8 @@ const CHOLMOD_GIVEN = int32(1) # use given permutation const CHOLMOD_AMD = int32(2) # use minimum degree (AMD) const CHOLMOD_METIS = int32(3) # use METIS' nested dissection const CHOLMOD_NESDIS = int32(4) # use CHOLMOD's version of nested dissection: - # node bisector applied recursively, followed - # by constrained minimum degree (CSYMAMD or CCOLAMD) + # node bisector applied recursively, followed + # by constrained minimum degree (CSYMAMD or CCOLAMD) const CHOLMOD_COLAMD = int32(5) # use AMD for A, COLAMD for A*A' # POSTORDERED is not a method, but a result of natural ordering followed by a @@ -60,12 +60,6 @@ const CHOLMOD_SIMPLICIAL = int32(0) # always do simplicial const CHOLMOD_AUTO = int32(1) # select simpl/super depending on matrix const CHOLMOD_SUPERNODAL = int32(2) # always do supernodal -# scaling modes, selected by the scale input parameter: -const CHOLMOD_SCALAR = int32(0) # A = s*A -const CHOLMOD_ROW = int32(1) # A = diag(s)*A -const CHOLMOD_COL = int32(2) # A = A*diag(s) -const CHOLMOD_SYM = int32(3) # A = diag(s)*A*diag(s) - ## UMFPACK ## Type of solve @@ -138,3 +132,4 @@ const SPQR_RX_EQUALS_B = int32(0) # solve R*X=B or X = R\B const SPQR_RETX_EQUALS_B = int32(1) # solve R*E'*X=B or X = E*(R\B) const SPQR_RTX_EQUALS_B = int32(2) # solve R'*X=B or X = R'\B const SPQR_RTX_EQUALS_ETB = int32(3) # solve R'*X=E'*B or X = R'\(E'*B) + diff --git a/extras/suitesparse.jl b/extras/suitesparse.jl deleted file mode 100644 index 7c89c6f0b2f36..0000000000000 --- a/extras/suitesparse.jl +++ /dev/null @@ -1,759 +0,0 @@ -module SuiteSparse - -import Base.SparseMatrixCSC, Base.size, Base.nnz, Base.eltype, Base.show -import Base.triu, Base.norm, Base.solve, Base.(\), Base.ctranspose, Base.transpose - -import Base.BlasInt -import Base.blas_int - -export # types - CholmodPtr, - CholmodCommon, - CholmodSparse, - CholmodFactor, - CholmodDense, - CholmodSparseOut, - UmfpackPtr, - UmfpackLU, - UmfpackLU!, - UmfpackLUTrans, - # methods - chm_aat, # drop prefix? - eltype, #? maybe not - indtype, #? maybe not - nnz, - show, - size, - solve, - \, - At_ldiv_B, - Ac_ldiv_B - -include("suitesparse_h.jl") - -const libsuitesparse_wrapper = "libsuitesparse_wrapper" -const libcholmod = "libcholmod" -const libumfpack = "libumfpack" -const libspqr = "libspqr" - -const _chm_aat = (:cholmod_aat, libcholmod) -const _chm_amd = (:cholmod_amd, libcholmod) -const _chm_analyze = (:cholmod_analyze, libcholmod) -const _chm_colamd = (:cholmod_colamd, libcholmod) -const _chm_copy = (:cholmod_copy, libcholmod) -const _chm_factorize = (:cholmod_factorize, libcholmod) -const _chm_free_dn = (:cholmod_free_dense, libcholmod) -const _chm_free_fa = (:cholmod_free_factor, libcholmod) -const _chm_free_sp = (:cholmod_free_sparse, libcholmod) -const _chm_print_dn = (:cholmod_print_dense, libcholmod) -const _chm_print_fa = (:cholmod_print_factor, libcholmod) -const _chm_print_sp = (:cholmod_print_sparse, libcholmod) -const _chm_solve = (:cholmod_solve, libcholmod) -const _chm_sort = (:cholmod_sort, libcholmod) -const _chm_submatrix = (:cholmod_submatrix, libcholmod) - -const _spqr_C_QR = (:SuiteSparseQR_C_QR, libspqr) -const _spqr_C_backslash = (:SuiteSparseQR_C_backslash, libspqr) -const _spqr_C_backslash_default = (:SuiteSparseQR_C_backslash_default, libspqr) -const _spqr_C_backslash_sparse = (:SuiteSparseQR_C_backslash_sparse, libspqr) -const _spqr_C_factorize = (:SuiteSparseQR_C_factorize, libspqr) -const _spqr_C_symbolic = (:SuiteSparseQR_C_symbolic, libspqr) -const _spqr_C_numeric = (:SuiteSparseQR_C_numeric, libspqr) -const _spqr_C_free = (:SuiteSparseQR_C_free, libspqr) -const _spqr_C_solve = (:SuiteSparseQR_C_solve, libspqr) -const _spqr_C_qmult = (:SuiteSparseQR_C_qmult, libspqr) - -type MatrixIllConditionedException <: Exception end - -function convert_to_0_based_indexing!(S::SparseMatrixCSC) - for i=1:(S.colptr[end]-1); S.rowval[i] -= 1; end - for i=1:length(S.colptr); S.colptr[i] -= 1; end - return S -end - -function convert_to_1_based_indexing!(S::SparseMatrixCSC) - for i=1:length(S.colptr); S.colptr[i] += 1; end - for i=1:(S.colptr[end]-1); S.rowval[i] += 1; end - return S -end - -convert_to_0_based_indexing(S) = convert_to_0_based_indexing!(copy(S)) -convert_to_1_based_indexing(S) = convert_to_1_based_indexing!(copy(S)) - -## CHOLMOD - -typealias CHMVTypes Union(Complex64, Complex128, Float32, Float64) -typealias CHMITypes Union(Int32, Int64) - -function chm_itype{Tv,Ti}(S::SparseMatrixCSC{Tv,Ti}) - if !(Ti<:CHMITypes) error("chm_itype: indtype(S) must be in CHMITypes") end - Ti == Int32 ? CHOLMOD_INT : CHOLMOD_LONG -end - -function chm_xtype{T}(S::SparseMatrixCSC{T}) - if !(T<:CHMVTypes) error("chm_xtype: eltype(S) must be in CHMVTypes") end - T <: Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL -end - -function chm_dtype{T}(S::SparseMatrixCSC{T}) - if !(T<:CHMVTypes) error("chm_dtype: eltype(S) must be in CHMVTypes") end - T <: Union(Float32, Complex64) ? CHOLMOD_SINGLE : CHOLMOD_DOUBLE -end - -# Wrapper for memory allocated by CHOLMOD. Carry along the value and index types. -## FIXME: CholmodPtr and UmfpackPtr should be amalgamated -type CholmodPtr{Tv<:CHMVTypes,Ti<:CHMITypes} - val::Vector{Ptr{Void}} -end - -eltype{Tv,Ti}(P::CholmodPtr{Tv,Ti}) = Tv -indtype{Tv,Ti}(P::CholmodPtr{Tv,Ti}) = Ti - -function cholmod_common_finalizer(x::Vector{Ptr{Void}}) - st = ccall((:cholmod_finish, libcholmod), BlasInt, (Ptr{Void},), x[1]) - if st != CHOLMOD_TRUE error("Error calling cholmod_finish") end - c_free(x[1]) -end - -type CholmodCommon - pt::Vector{Ptr{Void}} - function CholmodCommon() - pt = Array(Ptr{Void}, 1) - ccall((:jl_cholmod_common, libsuitesparse_wrapper), Void, - (Ptr{Void},), pt) - st = ccall((:cholmod_start, libcholmod), BlasInt, (Ptr{Void}, ), pt[1]) - if st != CHOLMOD_TRUE error("Error calling cholmod_start") end - finalizer(pt, cholmod_common_finalizer) - new(pt) - end -end - -function show(io::IO, cm::CholmodCommon) - st = ccall((:cholmod_print_common, libcholmod), BlasInt, - (Ptr{Uint8},Ptr{Void}), "", cm.pt[1]) - if st != CHOLMOD_TRUE error("Error calling cholmod_print_common") end -end - -type CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes} - pt::CholmodPtr{Tv,Ti} - ## cp contains a copy of the original matrix but with 0-based indices - cp::SparseMatrixCSC{Tv,Ti} - stype::Int - cm::CholmodCommon - function CholmodSparse(S::SparseMatrixCSC{Tv,Ti}, stype::BlasInt, cm::CholmodCommon) - pt = CholmodPtr{Tv,Ti}(Array(Ptr{Void}, 1)) - cp = convert_to_0_based_indexing(S) - - ccall((:jl_cholmod_sparse, libsuitesparse_wrapper), Void, - (Ptr{Void}, Uint, Uint, Uint, Ptr{Void}, Ptr{Void}, Ptr{Void}, - Ptr{Void}, Ptr{Void}, BlasInt, BlasInt, BlasInt, BlasInt, BlasInt, Int), - pt.val, S.m, S.n, nnz(S), cp.colptr, cp.rowval, C_NULL, - cp.nzval, C_NULL, stype, chm_itype(S), chm_xtype(S), chm_dtype(S), - CHOLMOD_TRUE, CHOLMOD_TRUE) - finalizer(pt, x->c_free(x.val[1])) - new(pt, cp, blas_int(stype), cm) - end -end - -CholmodSparse{Tv,Ti}(S::SparseMatrixCSC{Tv,Ti}, stype::Int) = CholmodSparse{Tv,Ti}(S, stype, CholmodCommon()) - -function CholmodSparse{Tv,Ti}(S::SparseMatrixCSC{Tv,Ti}, cm::CholmodCommon) - stype = S.m == S.n && ishermitian(S) - CholmodSparse{Tv,Ti}(stype ? triu(S) : S, blas_int(stype), cm) -end - -CholmodSparse(S::SparseMatrixCSC) = CholmodSparse(S, CholmodCommon()) - -function show(io::IO, cs::CholmodSparse) - ccall(_chm_print_sp, - BlasInt, (Ptr{Void}, Ptr{Uint8},Ptr{Void}), cs.pt.val[1], "", cs.cm.pt[1]) -end - -size(cs::CholmodSparse) = size(cs.cp) -nnz(cs::CholmodSparse) = cs.cp.colptr[end] -eltype{T}(cs::CholmodSparse{T}) = T -indtype{Tv,Ti}(cs::CholmodSparse{Tv,Ti}) = Ti - -SparseMatrixCSC(cs::CholmodSparse) = convert_to_1_based_indexing(cs.cp) - -## For testing only. The infinity and 1 norms of a sparse matrix are simply -## the same norm applied to its nzval field. -function norm(cs::CholmodSparse, p::Number) - ccall((:cholmod_norm_sparse, libcholmod), Float64, - (Ptr{Void}, BlasInt, Ptr{Void}), cs.pt.val[1], p == Inf ? 0 : 1, cs.cm.pt[1]) -end - -norm(cs::CholmodSparse) = norm(cs, Inf) - -## Approximate minimal degree ordering -function chm_amd(cs::CholmodSparse) - aa = Array(BlasInt, cs.cp.m) - st = cs.stype == 0 ? ccall(_chm_colamd, BlasInt, - (Ptr{Void}, Ptr{Void}, Uint, BlasInt, Ptr{BlasInt}, Ptr{Void}), - cs.pt.val[1], C_NULL, 0, 1, aa, cs.cm.pt[1]) : - ccall(_chm_amd, BlasInt, (Ptr{Void}, Ptr{Void}, Uint, Ptr{BlasInt}, Ptr{Void}), - cs.pt.val[1], C_NULL, 0, aa, cs.cm.pt[1]) - if st != CHOLMOD_TRUE error("Error in cholmod_amd") end - aa -end - -type CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes} <: Factorization{Tv} - pt::CholmodPtr{Tv,Ti} - cs::CholmodSparse{Tv,Ti} - function CholmodFactor(pt::CholmodPtr{Tv,Ti}, cs::CholmodSparse{Tv,Ti}) - ff = new(pt, cs) - finalizer(ff, cholmod_factor_finalizer) - ff - end -end - -function cholmod_factor_finalizer(x::CholmodFactor) - if ccall(_chm_free_fa, BlasInt, (Ptr{Void}, Ptr{Void}), x.pt.val, x.cs.cm[1]) != CHOLMOD_TRUE - error("CHOLMOD error in cholmod_free_factor") - end -end - -function size(F::CholmodFactor) - n = size(F.cs,1) - (n, n) -end - -eltype{T}(F::CholmodFactor{T}) = T -indtype{Tv,Ti}(F::CholmodFactor{Tv,Ti}) = Ti - -function CholmodFactor{Tv,Ti}(cs::CholmodSparse{Tv,Ti}) - pt = CholmodPtr{Tv,Ti}(Array(Ptr{Void}, 1)) - pt.val[1] = ccall(_chm_analyze, Ptr{Void}, - (Ptr{Void}, Ptr{Void}), cs.pt.val[1], cs.cm.pt[1]) - st = ccall(_chm_factorize, BlasInt, - (Ptr{Void}, Ptr{Void}, Ptr{Void}), cs.pt.val[1], pt.val[1], cs.cm.pt[1]) - if st != CHOLMOD_TRUE error("CHOLMOD failure in factorize") end - CholmodFactor{Tv,Ti}(pt, cs) -end - -function show(io::IO, cf::CholmodFactor) - st = ccall(_chm_print_fa, BlasInt, (Ptr{Void}, Ptr{Uint8}, Ptr{Void}), cf.pt.val[1], "", cf.cs.cm.pt[1]) - if st != CHOLMOD_TRUE error("Cholmod error in print_factor") end -end - -type CholmodDense{T<:CHMVTypes} - pt::Vector{Ptr{Void}} - m::Int - n::Int - aa::VecOrMat{T} # original array - cm::CholmodCommon -end - -function CholmodDense{T<:CHMVTypes}(b::VecOrMat{T}, cm::CholmodCommon) - m = size(b, 1) - n = isa(b, Matrix) ? size(b, 2) : 1 - - xtype = T <: Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL - dtype = T <: Float32 || T == Complex64 ? CHOLMOD_SINGLE : CHOLMOD_DOUBLE - - pt = Array(Ptr{Void}, 1) - - ccall((:jl_cholmod_dense, libsuitesparse_wrapper), Void, - (Ptr{Void}, Uint, Uint, Uint, Uint, Ptr{Void}, Ptr{Void}, BlasInt, Int), - pt, m, n, length(b), m, b, C_NULL, xtype, dtype) - finalizer(pt, x->c_free(pt[1])) - CholmodDense{T}(pt, m, n, copy(b), cm) -end - -CholmodDense{T<:Integer}(B::VecOrMat{T}, cm::CholmodCommon) = CholmodDense(float64(B), cm) - -size(cd::CholmodDense) = (cd.m, cd.n) - -function show(io::IO, cd::CholmodDense) - st = ccall(_chm_print_dn, BlasInt, (Ptr{Void},Ptr{Uint8},Ptr{Void}), cd.pt[1], "", cd.cm.pt[1]) - if st != CHOLMOD_TRUE error("Cholmod error in print_dense") end -end - -type CholmodDenseOut{Tv<:CHMVTypes,Ti<:CHMITypes} - pt::CholmodPtr{Tv,Ti} - m::Int - n::Int - cm::CholmodCommon - function CholmodDenseOut(pt::CholmodPtr{Tv,Ti}, m::BlasInt, n::BlasInt, cm::CholmodCommon) - dd = new(pt, m, n, cm) - finalizer(dd, cholmod_denseout_finalizer) - dd - end -end - -function cholmod_denseout_finalizer(cd::CholmodDenseOut) - st = ccall(_chm_free_dn, BlasInt, (Ptr{Void}, Ptr{Void}), cd.pt.val, cd.cm.pt[1]) - if st != CHOLMOD_TRUE error("Error in cholmod_free_dense") end -end - -eltype{T}(cdo::CholmodDenseOut{T}) = T -indtype{Tv,Ti}(cdo::CholmodDenseOut{Tv,Ti}) = Ti -size(cd::CholmodDenseOut) = (cd.m, cd.n) - -function convert{T}(::Type{Array{T}}, cdo::CholmodDenseOut{T}) - mm = Array(T, size(cdo)) - ccall((:jl_cholmod_dense_copy_out, libsuitesparse_wrapper), Void, - (Ptr{Void}, Ptr{T}), cdo.pt.val[1], mm) - mm -end - -function solve{Tv,Ti}(cf::CholmodFactor{Tv,Ti}, B::CholmodDense{Tv}, solv::Integer) - m, n = size(B) - cdo = CholmodPtr{Tv,Ti}(Array(Ptr{Void},1)) - cdo.val[1] = ccall(_chm_solve, Ptr{Void}, - (BlasInt, Ptr{Void}, Ptr{Void}, Ptr{Void}), - solv, cf.pt.val[1], B.pt[1], cf.cs.cm.pt[1]) - return cdo, m, n, cf.cs.cm - CholmodDenseOut(cdo, m, n, cf.cs.cm) -end - -solve(cf::CholmodFactor, B::CholmodDense) = solve(cf, B, CHOLMOD_A) - -(\){Tf,Tb}(cf::CholmodFactor{Tf}, b::VecOrMat{Tb}) = solve(cf, CholmodDense{Tf}(convert(Array{Tf},b), cf.cs.cm), CHOLMOD_A) - -type CholmodSparseOut{Tv<:CHMVTypes,Ti<:CHMITypes} - pt::CholmodPtr{Tv,Ti} - m::Int - n::Int - cm::CholmodCommon - function CholmodSparseOut(pt::CholmodPtr{Tv,Ti}, m::BlasInt, n::BlasInt, cm::CholmodCommon) - cso = new(pt, m, n, cm) - finalizer(cso, cholmod_sparseout_finalizer) - cso - end -end - -function cholmod_sparseout_finalizer(cso::CholmodSparseOut) - st = ccall(_chm_free_sp, BlasInt, - (Ptr{Void}, Ptr{Void}), cso.pt.val, cso.cm.pt[1]) - if st != CHOLMOD_TRUE error("Error in cholmod_free_sparse") end -end - -function nnz(cso::CholmodSparseOut) - ccall((:cholmod_nnz, libcholmod), BlasInt, - (Ptr{Void}, Ptr{Void}), cso.pt.val[1], cso.cm.pt[1]) -end -size(cso::CholmodSparseOut) = (cso.m, cso.n) -eltype{T}(cso::CholmodSparseOut{T}) = T -indtype{Tv,Ti}(cso::CholmodSparseOut{Tv,Ti}) = Ti - -function solve{Tv,Ti}(cf::CholmodFactor{Tv,Ti}, B::CholmodSparse{Tv,Ti}, solv::Integer) - m, n = size(B) - cso = CholmodPtr{Tv,Ti}(Array(Ptr{Void},1)) - cso.val[1] = ccall((:cholmod_spsolve, libcholmod), Ptr{Void}, - (BlasInt, Ptr{Void}, Ptr{Void}, Ptr{Void}), - solv, cf.pt.val[1], B.pt[1], B.cm.pt[1]) - CholmodSparseOut{Tv,Ti}(cso, m, n, cf.cs.cm) -end - -function CholmodSparseOut{Tv,Ti}(cf::CholmodFactor{Tv,Ti}) - n = size(cf.cs)[1] - cso = CholmodPtr{Tv,Ti}(Array(Ptr{Void},1)) - cso.val[1] = ccall((:cholmod_factor_to_sparse, libcholmod), Ptr{Void}, - (Ptr{Void}, Ptr{Void}), cf.pt.val[1], cf.cs.cm.pt[1]) - CholmodSparseOut{Tv,Ti}(cso, n, n, cf.cs.cm) -end - -function SparseMatrixCSC{Tv,Ti}(cso::CholmodSparseOut{Tv,Ti}) - nz = nnz(cso) - sp = SparseMatrixCSC{Tv,Ti}(cso.m, cso.n, Array(Ti, cso.n + 1), Array(Ti, nz), Array(Tv, nz)) - st = ccall((:jl_cholmod_sparse_copy_out, libsuitesparse_wrapper), BlasInt, - (Ptr{Void}, Ptr{Ti}, Ptr{Ti}, Ptr{Tv}), - cso.pt.val[1], sp.colptr, sp.rowval, sp.nzval) - if st == 1 error("CholmodSparseOut object is not packed") end - if st == 2 error("CholmodSparseOut object is not sorted") end # Should not occur - if st == 3 error("CholmodSparseOut object has INTLONG itype") end - convert_to_1_based_indexing!(sp) -end - -function show(io::IO, cso::CholmodSparseOut) - sp = ccall(_chm_print_sp, BlasInt, (Ptr{Void}, Ptr{Uint8},Ptr{Void}), cso.pt.val[1], "", cso.cm.pt[1]) - if sp != CHOLMOD_TRUE error("Cholmod error in print_sparse") end -end - -function chm_aat{Tv,Ti}(A::SparseMatrixCSC{Tv,Ti}, symm::Bool) - cs = CholmodSparse(A, 0) - aa = CholmodPtr{Tv,Ti}(Array(Ptr{Void},1)) - aa.val[1] = ccall(_chm_aat, Ptr{Void}, (Ptr{Void},Ptr{BlasInt},BlasInt,BlasInt,Ptr{Void}), - cs.pt.val[1], C_NULL, 0, 1, cs.cm.pt[1]) - if ccall(_chm_sort, BlasInt, (Ptr{Void}, Ptr{Void}), aa.val[1], cs.cm.pt[1]) != CHOLMOD_TRUE - error("Cholmod error in sort") - end - if symm - pt = ccall(_chm_copy, Ptr{Void}, (Ptr{Void}, BlasInt, BlasInt, Ptr{Void}), - aa.val[1], 1, 1, cs.cm.pt[1]) - if ccall(_chm_free_sp, BlasInt, (Ptr{Void}, Ptr{Void}), aa.val, cs.cm.pt[1]) != CHOLMOD_TRUE - error("Cholmod error in free_sparse") - end - aa.val[1] = pt - end - m = size(A, 1) - CholmodSparseOut{Tv,Ti}(aa, m, m, cs.cm) -end - -chm_aat{Tv,Ti}(A::SparseMatrixCSC{Tv,Ti}) = chm_aat(A, false) - -## call wrapper function to create cholmod_sparse objects -cholmod_sparse(S) = cholmod_sparse(S, 0) - -function cholmod_sparse{Tv,Ti}(S::SparseMatrixCSC{Tv,Ti}, stype::Int) - cs = Array(Ptr{Void}, 1) - - if Ti == Int; itype = CHOLMOD_INT; - elseif Ti == Int64; itype = CHOLMOD_LONG; end - - if Tv == Float64 || Tv == Float32; xtype = CHOLMOD_REAL; - elseif Tv == Complex128 || Tv == Complex64 ; xtype = CHOLMOD_COMPLEX; end - - if Tv == Float64 || Tv == Complex128; dtype = CHOLMOD_DOUBLE; - elseif Tv == Float32 || Tv == Complex64 ; dtype = CHOLMOD_SINGLE; end - - ccall((:jl_cholmod_sparse, libsuitesparse_wrapper), - Ptr{Void}, - (Ptr{Void}, BlasInt, BlasInt, BlasInt, Ptr{Void}, Ptr{Void}, Ptr{Void}, Ptr{Void}, Ptr{Void}, - BlasInt, BlasInt, BlasInt, BlasInt, BlasInt, Int), - cs, blas_int(S.m), blas_int(S.n), blas_int(length(S.nzval)), S.colptr, S.rowval, C_NULL, S.nzval, C_NULL, - int32(stype), itype, xtype, dtype, CHOLMOD_TRUE, CHOLMOD_TRUE - ) - - return cs -end - -## Call wrapper function to create cholmod_dense objects -function cholmod_dense{T}(B::VecOrMat{T}) - m = size(B, 1) - n = isa(B, Matrix) ? size(B, 2) : 1 - - cd = Array(Ptr{Void}, 1) - - if T == Float64 || T == Float32; xtype = CHOLMOD_REAL; - elseif T == Complex128 || T == Complex64 ; xtype = CHOLMOD_COMPLEX; end - - if T == Float64 || T == Complex128; dtype = CHOLMOD_DOUBLE; - elseif T == Float32 || T == Complex64 ; dtype = CHOLMOD_SINGLE; end - - ccall((:jl_cholmod_dense, libsuitesparse_wrapper), - Ptr{Void}, - (Ptr{Void}, BlasInt, BlasInt, BlasInt, BlasInt, Ptr{T}, Ptr{Void}, BlasInt, Int), - cd, m, n, length(B), m, B, C_NULL, xtype, dtype - ) - - return cd -end - -function cholmod_dense_copy_out{T}(x::Ptr{Void}, sol::VecOrMat{T}) - ccall((:jl_cholmod_dense_copy_out, libsuitesparse_wrapper), - Void, - (Ptr{Void}, Ptr{T}), - x, sol - ) - return sol -end - -function cholmod_transpose_unsym{Tv,Ti}(S::SparseMatrixCSC{Tv,Ti}, cm::Array{Ptr{Void}, 1}) - S_t = SparseMatrixCSC(Tv, S.n, S.m, nnz(S)+1) - - # Allocate space for a cholmod_sparse object - cs = cholmod_sparse(S) - cs_t = cholmod_sparse(S_t) - - status = ccall((:cholmod_transpose_unsym), - Int32, - (Ptr{Void}, BlasInt, Ptr{BlasInt}, Ptr{BlasInt}, BlasInt, Ptr{Void}, Ptr{Void}), - cs[1], int32(1), C_NULL, C_NULL, int32(-1), cs_t[1], cm[1]); - - # Deallocate space for cholmod_sparse objects - c_free(cs[1]) - c_free(cs_t[1]) - - return S_t -end - -function cholmod_analyze{Tv<:Union(Float64,Complex128), Ti<:CHMITypes}(cs::Array{Ptr{Void},1}, cm::Array{Ptr{Void},1}) - ccall(_chm_analyze, Ptr{Void}, (Ptr{Void}, Ptr{Void}), cs[1], cm[1]) -end - -function cholmod_factorize{Tv<:Union(Float64,Complex128), Ti<:CHMITypes}(cs::Array{Ptr{Void},1}, cs_factor::Ptr{Void}, cm::Array{Ptr{Void},1}) - st = ccall(_chm_factorize, BlasInt, (Ptr{Void}, Ptr{Void}, Ptr{Void}), cs[1], cs_factor, cm[1]) - if st != CHOLMOD_TRUE error("CHOLMOD could not factorize the matrix") end -end - -function cholmod_solve(cs_factor::Ptr{Void}, cd_rhs::Array{Ptr{Void},1}, cm::Array{Ptr{Void},1}) - ccall(_chm_solve, Ptr{Void}, (BlasInt, Ptr{Void}, Ptr{Void}, Ptr{Void}), - CHOLMOD_A, cs_factor, cd_rhs[1], cm[1]) -end - -## UMFPACK - -# Wrapper for memory allocated by umfpack. Carry along the value and index types. -type UmfpackPtr{Tv<:Union(Float64,Complex128),Ti<:CHMITypes} - val::Vector{Ptr{Void}} -end - -type UmfpackLU{Tv<:Union(Float64,Complex128),Ti<:CHMITypes} <: Factorization{Tv} - numeric::UmfpackPtr{Tv,Ti} - mat::SparseMatrixCSC{Tv,Ti} -end - -function show(io::IO, f::UmfpackLU) - @printf(io, "UMFPACK LU Factorization of a %d-by-%d sparse matrix\n", - size(f.mat,1), size(f.mat,2)) - println(f.numeric) - umfpack_report(f) -end - -type UmfpackLUTrans{Tv<:Union(Float64,Complex128),Ti<:CHMITypes} <: Factorization{Tv} - numeric::UmfpackPtr{Tv,Ti} - mat::SparseMatrixCSC{Tv,Ti} -end - -function show(io::IO, f::UmfpackLUTrans) - @printf(io, "UMFPACK LU Factorization of a transposed %d-by-%d sparse matrix\n", - size(f.mat,1), size(f.mat,2)) - println(f.numeric) - umfpack_report(f) -end - -function UmfpackLU{Tv<:Union(Float64,Complex128),Ti<:CHMITypes}(S::SparseMatrixCSC{Tv,Ti}) - Scopy = copy(S) - Scopy = convert_to_0_based_indexing!(Scopy) - numeric = [] - - try - symbolic = umfpack_symbolic(Scopy) - numeric = umfpack_numeric(Scopy, symbolic) - catch e - if is(e,MatrixIllConditionedException) - error("Input matrix is ill conditioned or singular"); - else - error("Error calling UMFPACK") - end - end - - return UmfpackLU(numeric,Scopy) -end - -function UmfpackLU!{Tv<:Union(Float64,Complex128),Ti<:CHMITypes}(S::SparseMatrixCSC{Tv,Ti}) - Sshallow = SparseMatrixCSC(S.m,S.n,S.colptr,S.rowval,S.nzval) - Sshallow = convert_to_0_based_indexing!(Sshallow) - numeric = [] - - try - symbolic = umfpack_symbolic(Sshallow) - numeric = umfpack_numeric(Sshallow, symbolic) - catch e - Sshallow = convert_to_1_based_indexing!(Sshallow) - if is(e,MatrixIllConditionedException) - error("Input matrix is ill conditioned or singular"); - else - error("Error calling UMFPACK") - end - end - - S.rowval = [] - S.nzval = [] - S.colptr = ones(S.n+1) - - return UmfpackLU(numeric,Sshallow) -end - -function UmfpackLUTrans(S::SparseMatrixCSC) - x = UmfpackLU(S) - return UmfpackLUTrans(x.numeric, x.mat) -end - -# Solve with Factorization - -(\){T}(fact::UmfpackLU{T}, b::Vector) = fact \ convert(Array{T,1}, b) -(\){T}(fact::UmfpackLU{T}, b::Vector{T}) = umfpack_solve(fact.mat,b,fact.numeric) - -(\){T}(fact::UmfpackLUTrans{T}, b::Vector) = fact \ convert(Array{T,1}, b) -(\){T}(fact::UmfpackLUTrans{T}, b::Vector{T}) = umfpack_transpose_solve(fact.mat,b,fact.numeric) - -ctranspose(fact::UmfpackLU) = UmfpackLUTrans(fact.numeric, fact.mat) - -# Solve directly with matrix - -(\)(S::SparseMatrixCSC, b::Vector) = UmfpackLU(S) \ b -At_ldiv_B(S::SparseMatrixCSC, b::Vector) = UmfpackLUTrans(S) \ b -Ac_ldiv_B(S::SparseMatrixCSC, b::Vector) = UmfpackLUTrans(S) \ b - -## Wrappers around UMFPACK routines - -for (f_sym_r, f_sym_c, inttype) in - (("umfpack_di_symbolic","umfpack_zi_symbolic",:Int32), - ("umfpack_dl_symbolic","umfpack_zl_symbolic",:Int64)) - @eval begin - - function umfpack_symbolic{Tv<:Float64,Ti<:$inttype}(S::SparseMatrixCSC{Tv,Ti}) - # Pointer to store the symbolic factorization returned by UMFPACK - Symbolic = UmfpackPtr{Tv,Ti}(Array(Ptr{Void},1)) - status = ccall(($f_sym_r, libumfpack), - Ti, - (Ti, Ti, - Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Void}, Ptr{Float64}, Ptr{Float64}), - S.m, S.n, - S.colptr, S.rowval, S.nzval, Symbolic.val, C_NULL, C_NULL) - if status != UMFPACK_OK; error("Error in symbolic factorization"); end - finalizer(Symbolic,umfpack_free_symbolic) - return Symbolic - end - - function umfpack_symbolic{Tv<:Complex128,Ti<:$inttype}(S::SparseMatrixCSC{Tv,Ti}) - # Pointer to store the symbolic factorization returned by UMFPACK - Symbolic = UmfpackPtr{Tv,Ti}(Array(Ptr{Void},1)) - status = ccall(($f_sym_c, libumfpack), - Ti, - (Ti, Ti, - Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Float64}, Ptr{Void}, - Ptr{Float64}, Ptr{Float64}), - S.m, S.n, - S.colptr, S.rowval, real(S.nzval), imag(S.nzval), Symbolic.val, - C_NULL, C_NULL) - if status != UMFPACK_OK; error("Error in symbolic factorization"); end - finalizer(Symbolic,umfpack_free_symbolic) # Check: do we need to free if there was an error? - return Symbolic - end - - end -end - -for (f_num_r, f_num_c, inttype) in - (("umfpack_di_numeric","umfpack_zi_numeric",:Int32), - ("umfpack_dl_numeric","umfpack_zl_numeric",:Int64)) - @eval begin - - function umfpack_numeric{Tv<:Float64,Ti<:$inttype}(S::SparseMatrixCSC{Tv,Ti}, Symbolic) - # Pointer to store the numeric factorization returned by UMFPACK - Numeric = UmfpackPtr{Tv,Ti}(Array(Ptr{Void},1)) - status = ccall(($f_num_r, libumfpack), - Ti, - (Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Void}, Ptr{Void}, - Ptr{Float64}, Ptr{Float64}), - S.colptr, S.rowval, S.nzval, Symbolic.val[1], Numeric.val, - C_NULL, C_NULL) - if status > 0; throw(MatrixIllConditionedException); end - if status != UMFPACK_OK; error("Error in numeric factorization"); end - finalizer(Numeric,umfpack_free_numeric) - return Numeric - end - - function umfpack_numeric{Tv<:Complex128,Ti<:$inttype}(S::SparseMatrixCSC{Tv,Ti}, Symbolic) - # Pointer to store the numeric factorization returned by UMFPACK - Numeric = UmfpackPtr{Tv,Ti}(Array(Ptr{Void},1)) - status = ccall(($f_num_c, libumfpack), - Ti, - (Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Float64}, Ptr{Void}, Ptr{Void}, - Ptr{Float64}, Ptr{Float64}), - S.colptr, S.rowval, real(S.nzval), imag(S.nzval), Symbolic.val[1], Numeric.val, - C_NULL, C_NULL) - if status > 0; throw(MatrixIllConditionedException); end - if status != UMFPACK_OK; error("Error in numeric factorization"); end - finalizer(Numeric,umfpack_free_numeric) - return Numeric - end - - end -end - -for (f_sol_r, f_sol_c, inttype) in - (("umfpack_di_solve","umfpack_zi_solve",:Int32), - ("umfpack_dl_solve","umfpack_zl_solve",:Int64)) - @eval begin - - function umfpack_solve{Tv<:Float64,Ti<:$inttype}(S::SparseMatrixCSC{Tv,Ti}, - b::Vector{Tv}, Numeric::UmfpackPtr{Tv,Ti}) - x = similar(b) - status = ccall(($f_sol_r, libumfpack), - Ti, - (Ti, Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, - Ptr{Float64}, Ptr{Float64}, Ptr{Void}, Ptr{Float64}, Ptr{Float64}), - UMFPACK_A, S.colptr, S.rowval, S.nzval, - x, b, Numeric.val[1], C_NULL, C_NULL) - if status != UMFPACK_OK; error("Error in solve"); end - return x - end - - function umfpack_solve{Tv<:Complex128,Ti<:$inttype}(S::SparseMatrixCSC{Tv,Ti}, - b::Vector{Tv}, Numeric::UmfpackPtr{Tv,Ti}) - xr = similar(b, Float64) - xi = similar(b, Float64) - status = ccall(($f_sol_c, libumfpack), - Ti, - (Ti, Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Float64}, Ptr{Float64}, Ptr{Float64}, - Ptr{Float64}, Ptr{Float64}, Ptr{Void}, Ptr{Float64}, Ptr{Float64}), - UMFPACK_A, S.colptr, S.rowval, real(S.nzval), imag(S.nzval), - xr, xi, real(b), imag(b), Numeric.val[1], C_NULL, C_NULL) - if status != UMFPACK_OK; error("Error in solve"); end - return complex(xr,xi) - end - - function umfpack_transpose_solve{Tv<:Float64,Ti<:$inttype}(S::SparseMatrixCSC{Tv,Ti}, - b::Vector{Tv}, Numeric::UmfpackPtr{Tv,Ti}) - x = similar(b) - status = ccall(($f_sol_r, libumfpack), - Ti, - (Ti, Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, - Ptr{Float64}, Ptr{Float64}, Ptr{Void}, Ptr{Float64}, Ptr{Float64}), - UMFPACK_At, S.colptr, S.rowval, S.nzval, - x, b, Numeric.val[1], C_NULL, C_NULL) - if status != UMFPACK_OK; error("Error in solve"); end - return x - end - - function umfpack_transpose_solve{Tv<:Complex128,Ti<:$inttype}(S::SparseMatrixCSC{Tv,Ti}, - b::Vector{Tv}, Numeric::UmfpackPtr{Tv,Ti}) - xr = similar(b, Float64) - xi = similar(b, Float64) - status = ccall(($f_sol_c, libumfpack), - Ti, - (Ti, Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Float64}, Ptr{Float64}, Ptr{Float64}, - Ptr{Float64}, Ptr{Float64}, Ptr{Void}, Ptr{Float64}, Ptr{Float64}), - UMFPACK_At, S.colptr, S.rowval, real(S.nzval), imag(S.nzval), - xr, xi, real(b), imag(b), Numeric.val[1], C_NULL, C_NULL) - if status != UMFPACK_OK; error("Error in solve"); end - return complex(xr,xi) - end - - end -end - -for (f_report, elty, inttype) in - (("umfpack_di_report_numeric", :Float64, :Int), - ("umfpack_zi_report_numeric", :Complex128, :Int), - ("umfpack_dl_report_numeric", :Float64, :Int64), - ("umfpack_zl_report_numeric", :Complex128, :Int64)) - @eval begin - - function umfpack_report{Tv<:$elty,Ti<:$inttype}(slu::UmfpackLU{Tv,Ti}) - - control = zeros(Float64, UMFPACK_CONTROL) - control[UMFPACK_PRL] = 4 - - ccall(($f_report, libumfpack), - Ti, - (Ptr{Void}, Ptr{Float64}), - slu.numeric.val[1], control) - end - - end -end - - -for (f_symfree, f_numfree, elty, inttype) in - (("umfpack_di_free_symbolic","umfpack_di_free_numeric",:Float64,:Int32), - ("umfpack_zi_free_symbolic","umfpack_zi_free_numeric",:Complex128,:Int32), - ("umfpack_dl_free_symbolic","umfpack_dl_free_numeric",:Float64,:Int64), - ("umfpack_zl_free_symbolic","umfpack_zl_free_numeric",:Complex128,:Int64)) - @eval begin - - umfpack_free_symbolic{Tv<:$elty,Ti<:$inttype}(Symbolic::UmfpackPtr{Tv,Ti}) = - ccall(($f_symfree, libumfpack), Void, (Ptr{Void},), Symbolic.val) - - umfpack_free_numeric{Tv<:$elty,Ti<:$inttype}(Numeric::UmfpackPtr{Tv,Ti}) = - ccall(($f_numfree, libumfpack), Void, (Ptr{Void},), Numeric.val) - - end -end - -end #module diff --git a/test/Makefile b/test/Makefile index ea2eb436cf6ac..8250241f3ad53 100644 --- a/test/Makefile +++ b/test/Makefile @@ -7,7 +7,8 @@ TESTS = default all extra \ core numbers strings unicode corelib hashing remote \ arrayops blas linalg fft dct sparse bitarray suitesparse arpack \ random math functional bigint bigfloat sorting \ -statistics poly file Rmath remote zlib image \ +statistics poly file \ +remote zlib image \ iostring gzip integers spawn ccall parallel pkg $(TESTS) :: diff --git a/test/extra.jl b/test/extra.jl index 9d278df32defb..ff37e9c70ac3e 100644 --- a/test/extra.jl +++ b/test/extra.jl @@ -3,7 +3,7 @@ runtests("arpack") runtests("bigfloat") runtests("poly") runtests("file") -runtests("Rmath") +#runtests("Rmath") runtests("zlib") # runtests("options") runtests("image") diff --git a/test/suitesparse.jl b/test/suitesparse.jl index c2756429c93f1..9b4dd547157f4 100644 --- a/test/suitesparse.jl +++ b/test/suitesparse.jl @@ -1,7 +1,3 @@ -require("suitesparse") - -using SuiteSparse - se33 = speye(3) do33 = ones(3) @test isequal(se33 \ do33, do33) From 801b96f1565c873af949547016af3bd444b9c07b Mon Sep 17 00:00:00 2001 From: Andreas Noack Jensen Date: Wed, 6 Mar 2013 20:44:51 +0100 Subject: [PATCH 08/29] Add vector methods to fix #2431 and move functions for general matrices to dense.jl from factorizations.jl. --- base/linalg/dense.jl | 113 ++++++++++++++++++++++++++++++++++ base/linalg/factorization.jl | 115 +---------------------------------- 2 files changed, 114 insertions(+), 114 deletions(-) diff --git a/base/linalg/dense.jl b/base/linalg/dense.jl index e0dc3e66e6d5e..7c090bf9ad9f9 100644 --- a/base/linalg/dense.jl +++ b/base/linalg/dense.jl @@ -406,3 +406,116 @@ sqrtm{T<:Integer}(A::StridedMatrix{T}, cond::Bool) = sqrtm(float(A), cond) sqrtm{T<:Integer}(A::StridedMatrix{ComplexPair{T}}, cond::Bool) = sqrtm(complex128(A), cond) sqrtm(A::StridedMatrix) = sqrtm(A, false) sqrtm(a::Number) = isreal(a) ? (b = sqrt(complex(a)); imag(b) == 0 ? real(b) : b) : sqrt(a) + +function det(A::Matrix) + m, n = size(A) + if m != n; throw(LAPACK.DimensionMismatch("det only defined for square matrices")); end + if istriu(A) | istril(A); return det(Triangular(A, 'U', false)); end + return det(LUDense(copy(A))) +end +det(x::Number) = x + +logdet(A::Matrix) = 2.0 * sum(log(diag(chol(A)[:U]))) + +function inv(A::StridedMatrix) + if istriu(A) return inv(Triangular(A, 'U')) end + if istril(A) return inv(Triangular(A, 'L')) end + if ishermitian(A) return inv(Hermitian(A)) end + return inv(LUDense(copy(A))) +end + +function eig{T<:BlasFloat}(A::StridedMatrix{T}) + n = size(A, 2) + if n == 0; return (zeros(T, 0), zeros(T, 0, 0)) end + if ishermitian(A) return eig(Hermitian(A)) end + if iscomplex(A) return LAPACK.geev!('N', 'V', copy(A))[[1,3]] end + + WR, WI, VL, VR = LAPACK.geev!('N', 'V', copy(A)) + if all(WI .== 0.) return WR, VR end + evec = complex(zeros(T, n, n)) + j = 1 + while j <= n + if WI[j] == 0.0 + evec[:,j] = VR[:,j] + else + evec[:,j] = VR[:,j] + im*VR[:,j+1] + evec[:,j+1] = VR[:,j] - im*VR[:,j+1] + j += 1 + end + j += 1 + end + return complex(WR, WI), evec +end + +eig{T<:Integer}(x::StridedMatrix{T}) = eig(float64(x)) +eig(x::Number) = (x, one(x)) + +function eigvals(A::StridedMatrix) + if ishermitian(A) return eigvals(Hermitian(A)) end + if iscomplex(A) return LAPACK.geev!('N', 'N', copy(A))[1] end + valsre, valsim, _, _ = LAPACK.geev!('N', 'N', copy(A)) + if all(valsim .== 0) return valsre end + return complex(valsre, valsim) +end + +eigvals(x::Number) = 1.0 + +schur{T<:BlasFloat}(A::StridedMatrix{T}) = LAPACK.gees!('V', copy(A)) + +function (\){T<:BlasFloat}(A::StridedMatrix{T}, B::StridedVecOrMat{T}) + if size(A, 1) == size(A, 2) # Square + if istriu(A) return Triangular(A, 'U')\B end + if istril(A) return Triangular(A, 'L')\B end + if ishermitian(A) return Hermitian(A)\B end + end + LAPACK.gelsd!(copy(A), copy(B))[1] +end + +(\){T1<:BlasFloat, T2<:BlasFloat}(A::StridedMatrix{T1}, B::StridedVecOrMat{T2}) = + (\)(convert(Array{promote_type(T1,T2)},A), convert(Array{promote_type(T1,T2)},B)) +(\){T1<:BlasFloat, T2<:Real}(A::StridedMatrix{T1}, B::StridedVecOrMat{T2}) = (\)(A, convert(Array{T1}, B)) +(\){T1<:Real, T2<:BlasFloat}(A::StridedMatrix{T1}, B::StridedVecOrMat{T2}) = (\)(convert(Array{T2}, A), B) +(\){T1<:Real, T2<:Real}(A::StridedMatrix{T1}, B::StridedVecOrMat{T2}) = (\)(float64(A), float64(B)) +(\){T1<:Number, T2<:Number}(A::StridedMatrix{T1}, B::StridedVecOrMat{T2}) = (\)(complex128(A), complex128(B)) +(\)(a::Vector, B::StridedVecOrMat) = (\)(reshape(a, length(a), 1), B) + +(/)(A::StridedVecOrMat, B::StridedVecOrMat) = (B' \ A')' + +## Moore-Penrose inverse +function pinv{T<:BlasFloat}(A::StridedMatrix{T}) + SVD = SVDDense(copy(A), true) + Sinv = zeros(T, length(SVD[:S])) + index = SVD[:S] .> eps(real(one(T)))*max(size(A))*max(SVD[:S]) + Sinv[index] = 1.0 ./ SVD[:S][index] + SVD[:Vt]'diagmm(Sinv, SVD[:U]') +end +pinv{T<:Integer}(A::StridedMatrix{T}) = pinv(float(A)) +pinv(a::StridedVector) = pinv(reshape(a, length(a), 1)) +pinv(x::Number) = one(x)/x + +## Basis for null space +function null{T<:BlasFloat}(A::StridedMatrix{T}) + m,n = size(A) + SVD = SVDDense(copy(A)) + if m == 0; return eye(T, n); end + indstart = sum(SVD[:S] .> max(m,n)*max(SVD[:S])*eps(eltype(SVD[:S]))) + 1 + SVD[:V][:,indstart:] +end +null{T<:Integer}(A::StridedMatrix{T}) = null(float(A)) +null(a::StridedVector) = null(reshape(a, length(a), 1)) + +function cond(A::StridedMatrix, p) + if p == 2 + v = svdvals(A) + maxv = max(v) + cnd = maxv == 0.0 ? Inf : maxv / min(v) + elseif p == 1 || p == Inf + m, n = size(A) + if m != n; error("Use 2-norm for non-square matrices"); end + cnd = 1 / LAPACK.gecon!(p == 1 ? '1' : 'I', LUDense(copy(A)).LU, norm(A, p)) + else + error("Norm type must be 1, 2 or Inf") + end + return cnd +end +cond(A::StridedMatrix) = cond(A, 2) diff --git a/base/linalg/factorization.jl b/base/linalg/factorization.jl index 773e68ab35a24..6fa21716e895e 100644 --- a/base/linalg/factorization.jl +++ b/base/linalg/factorization.jl @@ -359,61 +359,6 @@ end full(A::HessenbergQ) = LAPACK.orghr!(1, size(A.hh, 1), copy(A.hh), A.tau) -### Linear algebra for general matrices - -function det(A::Matrix) - m, n = size(A) - if m != n; throw(LAPACK.DimensionMismatch("det only defined for square matrices")); end - if istriu(A) | istril(A); return det(Triangular(A, 'U', false)); end - return det(LUDense(copy(A))) -end -det(x::Number) = x - -logdet(A::Matrix) = 2.0 * sum(log(diag(chol(A)[:U]))) - -function inv(A::StridedMatrix) - if istriu(A) return inv(Triangular(A, 'U')) end - if istril(A) return inv(Triangular(A, 'L')) end - if ishermitian(A) return inv(Hermitian(A)) end - return inv(LUDense(copy(A))) -end - -function eig{T<:BlasFloat}(A::StridedMatrix{T}) - n = size(A, 2) - if n == 0; return (zeros(T, 0), zeros(T, 0, 0)) end - if ishermitian(A) return eig(Hermitian(A)) end - if iscomplex(A) return LAPACK.geev!('N', 'V', copy(A))[[1,3]] end - - WR, WI, VL, VR = LAPACK.geev!('N', 'V', copy(A)) - if all(WI .== 0.) return WR, VR end - evec = complex(zeros(T, n, n)) - j = 1 - while j <= n - if WI[j] == 0.0 - evec[:,j] = VR[:,j] - else - evec[:,j] = VR[:,j] + im*VR[:,j+1] - evec[:,j+1] = VR[:,j] - im*VR[:,j+1] - j += 1 - end - j += 1 - end - return complex(WR, WI), evec -end - -eig{T<:Integer}(x::StridedMatrix{T}) = eig(float64(x)) -eig(x::Number) = (x, one(x)) - -function eigvals(A::StridedMatrix) - if ishermitian(A) return eigvals(Hermitian(A)) end - if iscomplex(A) return LAPACK.geev!('N', 'N', copy(A))[1] end - valsre, valsim, _, _ = LAPACK.geev!('N', 'N', copy(A)) - if all(valsim .== 0) return valsre end - return complex(valsre, valsim) -end - -eigvals(x::Number) = 1.0 - # SVD type SVDDense{T,Tr} <: Factorization{T} U::Matrix{T} @@ -431,6 +376,7 @@ function SVDDense(A::StridedMatrix, thin::Bool) end SVDDense(A::StridedMatrix) = SVDDense(A, false) svd(A::StridedMatrix, args...) = SVDDense(copy(A), args...) +svd(a::Vector, args...) = svd(reshape(a, length(a), 1), args...) svd(x::Number, thin::Bool) = (x==0?one(x):x/abs(x),abs(x),one(x)) function ref(F::SVDDense, d::Symbol) @@ -517,62 +463,3 @@ function svdvals(A::StridedMatrix, B::StridedMatrix) _, _, _, a, b, k, l, _ = LAPACK.ggsvd!('N', 'N', 'N', copy(A), copy(B)) return a[1:k + l] ./ b[1:k + l] end - -schur{T<:BlasFloat}(A::StridedMatrix{T}) = LAPACK.gees!('V', copy(A)) - -function (\){T<:BlasFloat}(A::StridedMatrix{T}, B::StridedVecOrMat{T}) - if size(A, 1) == size(A, 2) # Square - if istriu(A) return Triangular(A, 'U')\B end - if istril(A) return Triangular(A, 'L')\B end - if ishermitian(A) return Hermitian(A)\B end - end - LAPACK.gelsd!(copy(A), copy(B))[1] -end - -(\){T1<:BlasFloat, T2<:BlasFloat}(A::StridedMatrix{T1}, B::StridedVecOrMat{T2}) = - (\)(convert(Array{promote_type(T1,T2)},A), convert(Array{promote_type(T1,T2)},B)) -(\){T1<:BlasFloat, T2<:Real}(A::StridedMatrix{T1}, B::StridedVecOrMat{T2}) = (\)(A, convert(Array{T1}, B)) -(\){T1<:Real, T2<:BlasFloat}(A::StridedMatrix{T1}, B::StridedVecOrMat{T2}) = (\)(convert(Array{T2}, A), B) -(\){T1<:Real, T2<:Real}(A::StridedMatrix{T1}, B::StridedVecOrMat{T2}) = (\)(float64(A), float64(B)) -(\){T1<:Number, T2<:Number}(A::StridedMatrix{T1}, B::StridedVecOrMat{T2}) = (\)(complex128(A), complex128(B)) - -(/)(A::StridedVecOrMat, B::StridedVecOrMat) = (B' \ A')' - -## Moore-Penrose inverse -function pinv{T<:BlasFloat}(A::StridedMatrix{T}) - SVD = SVDDense(copy(A), true) - Sinv = zeros(T, length(SVD[:S])) - index = SVD[:S] .> eps(real(one(T)))*max(size(A))*max(SVD[:S]) - Sinv[index] = 1.0 ./ SVD[:S][index] - SVD[:Vt]'diagmm(Sinv, SVD[:U]') -end -pinv{T<:Integer}(A::StridedMatrix{T}) = pinv(float(A)) -pinv(a::StridedVector) = pinv(reshape(a, length(a), 1)) -pinv(x::Number) = one(x)/x - -## Basis for null space -function null{T<:BlasFloat}(A::StridedMatrix{T}) - m,n = size(A) - SVD = SVDDense(copy(A)) - if m == 0; return eye(T, n); end - indstart = sum(SVD[:S] .> max(m,n)*max(SVD[:S])*eps(eltype(SVD[:S]))) + 1 - SVD[:V][:,indstart:] -end -null{T<:Integer}(A::StridedMatrix{T}) = null(float(A)) -null(a::StridedVector) = null(reshape(a, length(a), 1)) - -function cond(A::StridedMatrix, p) - if p == 2 - v = svdvals(A) - maxv = max(v) - cnd = maxv == 0.0 ? Inf : maxv / min(v) - elseif p == 1 || p == Inf - m, n = size(A) - if m != n; error("Use 2-norm for non-square matrices"); end - cnd = 1 / LAPACK.gecon!(p == 1 ? '1' : 'I', LUDense(copy(A)).LU, norm(A, p)) - else - error("Norm type must be 1, 2 or Inf") - end - return cnd -end -cond(A::StridedMatrix) = cond(A, 2) From b989be4351c926c32abf3b0770b2a2d4bcaa0684 Mon Sep 17 00:00:00 2001 From: Douglas Bates Date: Fri, 8 Mar 2013 14:58:27 -0600 Subject: [PATCH 09/29] Added extractors for components of the UmfpackLU type and tests for same. --- base/linalg/suitesparse.jl | 124 +++++++++++++++++++++++++++++++------ test/suitesparse.jl | 21 +++++++ 2 files changed, 125 insertions(+), 20 deletions(-) diff --git a/base/linalg/suitesparse.jl b/base/linalg/suitesparse.jl index af860c41c5ce3..4e6225a4483ec 100644 --- a/base/linalg/suitesparse.jl +++ b/base/linalg/suitesparse.jl @@ -31,15 +31,20 @@ export ChmCommon, increment!, indtype, show_umf_ctrl, - show_umf_info + show_umf_info, + umf_extract, + umf_lunz import Base.(\) import Base.Ac_ldiv_B import Base.At_ldiv_B import Base.SparseMatrixCSC +import Base.chol import Base.copy +import Base.det import Base.diagmm import Base.findn_nzs +import Base.lu import Base.nnz import Base.show import Base.size @@ -99,21 +104,24 @@ type UmfpackLU{Tv<:UMFVTypes,Ti<:CHMITypes} <: Factorization{Tv} nzval::Vector{Tv} end -function lud{Tv<:UMFVTypes,Ti<:CHMITypes}(S::SparseMatrixCSC{Tv,Ti}) +function lu{Tv<:UMFVTypes,Ti<:CHMITypes}(S::SparseMatrixCSC{Tv,Ti}) zerobased = S.colptr[1] == 0 - lu = UmfpackLU(C_NULL, C_NULL, S.m, S.n, - zerobased ? copy(S.colptr) : decrement(S.colptr), - zerobased ? copy(S.rowval) : decrement(S.rowval), - copy(S.nzval)) - umfpack_numeric!(lu) + res = UmfpackLU(C_NULL, C_NULL, S.m, S.n, + zerobased ? copy(S.colptr) : decrement(S.colptr), + zerobased ? copy(S.rowval) : decrement(S.rowval), + copy(S.nzval)) + finalizer(res, umfpack_free_symbolic) + umfpack_numeric!(res) end -function lud!{Tv<:UMFVTypes,Ti<:CHMITypes}(S::SparseMatrixCSC{Tv,Ti}) +function lu!{Tv<:UMFVTypes,Ti<:CHMITypes}(S::SparseMatrixCSC{Tv,Ti}) zerobased = S.colptr[1] == 0 - UmfpackLU(C_NULL, C_NULL, S.m, S.n, - zerobased ? S.colptr : decrement!(S.colptr), - zerobased ? S.rowval : decrement!(S.rowval), - S.nzval) + res = UmfpackLU(C_NULL, C_NULL, S.m, S.n, + zerobased ? S.colptr : decrement!(S.colptr), + zerobased ? S.rowval : decrement!(S.rowval), + S.nzval) + finalizer(res, umfpack_free_symbolic) + umfpack_numeric!(res) end function show(io::IO, f::UmfpackLU) @@ -129,13 +137,13 @@ end ### Solve directly with matrix -(\)(S::SparseMatrixCSC, b::Vector) = lud(S) \ b -At_ldiv_B{T<:UMFVTypes}(S::SparseMatrixCSC{T}, b::Vector{T}) = umfpack_solve(lud(S), b, UMFPACK_Aat) +(\)(S::SparseMatrixCSC, b::Vector) = lu(S) \ b +At_ldiv_B{T<:UMFVTypes}(S::SparseMatrixCSC{T}, b::Vector{T}) = umfpack_solve(lu(S), b, UMFPACK_Aat) function At_ldiv_B{Ts<:UMFVTypes,Tb<:Number}(S::SparseMatrixCSC{Ts}, b::Vector{Tb}) ## should be more careful here in case Ts<:Real and Tb<:Complex At_ldiv_B(S, convert(Vector{Ts}, b)) end -Ac_ldiv_B{T<:UMFVTypes}(S::SparseMatrixCSC{T}, b::Vector{T}) = umfpack_solve(lud(S), b, UMFPACK_At) +Ac_ldiv_B{T<:UMFVTypes}(S::SparseMatrixCSC{T}, b::Vector{T}) = umfpack_solve(lu(S), b, UMFPACK_At) function Ac_ldiv_B{Ts<:UMFVTypes,Tb<:Number}(S::SparseMatrixCSC{Ts}, b::Vector{Tb}) ## should be more careful here in case Ts<:Real and Tb<:Complex Ac_ldiv_B(S, convert(Vector{Ts}, b)) @@ -157,7 +165,7 @@ for (f_sym_r, f_num_r, f_sym_c, f_num_c, itype) in umf_ctrl, umf_info) if status != UMFPACK_OK; error("Error code $status from symbolic factorization"); end U.symbolic = tmp[1] - finalizer(U.symbolic,umfpack_free_symbolic) +# finalizer(U.symbolic,umfpack_free_symbolic) U end @@ -171,7 +179,7 @@ for (f_sym_r, f_num_r, f_sym_c, f_num_c, itype) in umf_ctrl, umf_info) if status != UMFPACK_OK; error("Error code $status from symbolic factorization"); end U.symbolic = tmp[1] - finalizer(U.symbolic,umfpack_free_symbolic) +# finalizer(U.symbolic,umfpack_free_symbolic) U end @@ -187,7 +195,7 @@ for (f_sym_r, f_num_r, f_sym_c, f_num_c, itype) in if status > 0; throw(MatrixIllConditionedException); end if status != UMFPACK_OK; error("Error code $status from numeric factorization"); end U.numeric = tmp[1] - finalizer(U.numeric,umfpack_free_numeric) +# finalizer(U.numeric,umfpack_free_numeric) U end @@ -203,7 +211,7 @@ for (f_sym_r, f_num_r, f_sym_c, f_num_c, itype) in if status > 0; throw(MatrixIllConditionedException); end if status != UMFPACK_OK; error("Error code $status from numeric factorization"); end U.numeric = tmp[1] - finalizer(U.numeric,umfpack_free_numeric) +# finalizer(U.numeric,umfpack_free_numeric) U end end @@ -243,6 +251,82 @@ show_umf_ctrl() = show_umf_ctrl(2.) umfpack_solve(lu::UmfpackLU, b::Vector) = umfpack_solve(lu, b, UMFPACK_A) +for (det_r,det_z,itype) in + (("umfpack_di_get_determinant","umfpack_zi_get_determinant",:Int32), + ("umfpack_dl_get_determinant","umfpack_zl_get_determinant",:Int64)) + @eval begin + function det{Tv<:Float64,Ti<:$itype}(lu::UmfpackLU{Tv,Ti}) + mx = Array(Tv,1) + status = ccall(($det_r,:libumfpack), Ti, + (Ptr{Tv},Ptr{Tv},Ptr{Void},Ptr{Float64}), + mx, C_NULL, lu.numeric, umf_info) + if status != UMFPACK_OK error("Error code $status from umfpack_get_determinant") end + mx[1] + end + function det{Tv<:Complex128,Ti<:$itype}(lu::UmfpackLU{Tv,Ti}) + mx = Array(Float64,1) + mz = Array(Float64,1) + status = ccall(($det_z,:libumfpack), Ti, + (Ptr{Float64},Ptr{Float64},Ptr{Float64},Ptr{Void},Ptr{Float64}), + mx, mz, C_NULL, lu.numeric, umf_info) + if status != UMFPACK_OK error("Error code $status from umfpack_get_determinant") end + complex(mx[1], mz[1]) + end + end +end + +for (lunz,itype) in + (("umfpack_di_get_lunz", :Int32), # no distinction between real and complex here + ("umfpack_dl_get_lunz", :Int64)) + @eval begin + function umf_lunz{Tv<:UMFVTypes,Ti<:$itype}(lu::UmfpackLU{Tv,Ti}) + lnz = Array(Ti, 1) + unz = Array(Ti, 1) + n_row = Array(Ti, 1) + n_col = Array(Ti, 1) + nz_diag = Array(Ti, 1) + status = ccall(($lunz,:libumfpack), Ti, + (Ptr{Ti},Ptr{Ti},Ptr{Ti},Ptr{Ti},Ptr{Ti},Ptr{Void}), + lnz, unz, n_row, n_col, nz_diag, lu.numeric) + if status != UMFPACK_OK error("Error code $status from umfpack_get_lunz") end + (lnz[1], unz[1], n_row[1], n_col[1], nz_diag[1]) + end + end +end + +for (get_numeric_r,get_numeric_z,itype) in + (("umfpack_di_get_numeric","umfpack_zi_get_numeric",:Int32), + ("umfpack_dl_get_numeric","umfpack_zl_get_numeric",:Int64)) + @eval begin + function umf_extract{Tv<:Float64,Ti<:$itype}(lu::UmfpackLU{Tv,Ti}) + umfpack_numeric!(lu) # ensure the numeric decomposition exists + (lnz,unz,n_row,n_col,nz_diag) = umf_lunz(lu) + Lp = Array(Ti, n_col + 1) + Lj = Array(Ti, lnz) # L is returned in CSR (compressed sparse row) format + Lx = Array(Tv, lnz) + Up = Array(Ti, n_col + 1) + Ui = Array(Ti, unz) + Ux = Array(Tv, unz) + P = Array(Ti, n_row) + Q = Array(Ti, n_col) + Rs = Array(Tv, n_row) + status = ccall(($get_numeric_r,:libumfpack), Ti, + (Ptr{Ti},Ptr{Ti},Ptr{Tv}, + Ptr{Ti},Ptr{Ti},Ptr{Tv}, + Ptr{Ti},Ptr{Ti},Ptr{Void}, + Ptr{Ti},Ptr{Tv},Ptr{Void}), + Lp,Lj,Lx, + Up,Ui,Ux, + P, Q, C_NULL, + &0, Rs, lu.numeric) + if status != UMFPACK_OK error("Error code $status from numeric") end + (transpose(SparseMatrixCSC(n_row,n_row,increment!(Lp),increment(Lj),Lx)), + SparseMatrixCSC(n_row,n_col,increment!(Up),increment(Ui),Ux), + increment!(P), increment!(Q), Rs) + end + end +end + ## The C functions called by these Julia functions do not depend on ## the numeric and index types, even though the umfpack names indicate ## they do. The umfpack_free_* functions can be called on C_NULL without harm. @@ -265,7 +349,7 @@ function umfpack_free_numeric(num::Ptr{Void}) ccall((:umfpack_dl_free_numeric, :libumfpack), Void, (Ptr{Void},), tmp) end -function umfpack_free_symbolic(lu::UmfpackLU) +function umfpack_free_numeric(lu::UmfpackLU) if lu.numeric == C_NULL return lu end umfpack_free_numeric(lu.numeric) lu.numeric = C_NULL diff --git a/test/suitesparse.jl b/test/suitesparse.jl index 9b4dd547157f4..5344432338228 100644 --- a/test/suitesparse.jl +++ b/test/suitesparse.jl @@ -1,3 +1,24 @@ se33 = speye(3) do33 = ones(3) @test isequal(se33 \ do33, do33) + +using Base.SuiteSparse + +# based on deps/Suitesparse-4.0.2/UMFPACK/Demo/umfpack_di_demo.c + +A = sparse(increment!([0,4,1,1,2,2,0,1,2,3,4,4]), + increment!([0,4,0,2,1,2,1,4,3,2,1,2]), + [2.,1.,3.,4.,-1.,-3.,3.,6.,2.,1.,4.,2.], 5, 5) +lua = lu(A) +umf_lunz(lua) +@test_approx_eq det(lua) det(full(A)) + +b = [8., 45., -3., 3., 19.] +x = lua\b +@test_approx_eq x float([1:5]) + +@test norm(A*x-b,1) < eps(1e4) + +L,U,P,Q,Rs = umf_extract(lua) +@test_approx_eq diagmm(Rs,A)[P,Q] L*U + From a9a590ef5c45b626b261425384ad7f14f6f380b2 Mon Sep 17 00:00:00 2001 From: "Viral B. Shah" Date: Sun, 10 Mar 2013 19:46:55 +0530 Subject: [PATCH 10/29] import Base.convert in suitesparse.jl (from master) --- base/linalg/suitesparse.jl | 1 + extras/suitesparse.jl | 760 ------------------------------------- 2 files changed, 1 insertion(+), 760 deletions(-) delete mode 100644 extras/suitesparse.jl diff --git a/base/linalg/suitesparse.jl b/base/linalg/suitesparse.jl index 4e6225a4483ec..ac896bc1604da 100644 --- a/base/linalg/suitesparse.jl +++ b/base/linalg/suitesparse.jl @@ -49,6 +49,7 @@ import Base.nnz import Base.show import Base.size import Base.solve +import Base.convert include("linalg/suitesparse_h.jl") diff --git a/extras/suitesparse.jl b/extras/suitesparse.jl deleted file mode 100644 index d99ab203478b9..0000000000000 --- a/extras/suitesparse.jl +++ /dev/null @@ -1,760 +0,0 @@ -module SuiteSparse - -import Base.SparseMatrixCSC, Base.size, Base.nnz, Base.eltype, Base.show -import Base.triu, Base.norm, Base.solve, Base.(\), Base.ctranspose, Base.transpose -import Base.convert - -import Base.BlasInt -import Base.blas_int - -export # types - CholmodPtr, - CholmodCommon, - CholmodSparse, - CholmodFactor, - CholmodDense, - CholmodSparseOut, - UmfpackPtr, - UmfpackLU, - UmfpackLU!, - UmfpackLUTrans, - # methods - chm_aat, # drop prefix? - eltype, #? maybe not - indtype, #? maybe not - nnz, - show, - size, - solve, - \, - At_ldiv_B, - Ac_ldiv_B - -include("suitesparse_h.jl") - -const libsuitesparse_wrapper = "libsuitesparse_wrapper" -const libcholmod = "libcholmod" -const libumfpack = "libumfpack" -const libspqr = "libspqr" - -const _chm_aat = (:cholmod_aat, libcholmod) -const _chm_amd = (:cholmod_amd, libcholmod) -const _chm_analyze = (:cholmod_analyze, libcholmod) -const _chm_colamd = (:cholmod_colamd, libcholmod) -const _chm_copy = (:cholmod_copy, libcholmod) -const _chm_factorize = (:cholmod_factorize, libcholmod) -const _chm_free_dn = (:cholmod_free_dense, libcholmod) -const _chm_free_fa = (:cholmod_free_factor, libcholmod) -const _chm_free_sp = (:cholmod_free_sparse, libcholmod) -const _chm_print_dn = (:cholmod_print_dense, libcholmod) -const _chm_print_fa = (:cholmod_print_factor, libcholmod) -const _chm_print_sp = (:cholmod_print_sparse, libcholmod) -const _chm_solve = (:cholmod_solve, libcholmod) -const _chm_sort = (:cholmod_sort, libcholmod) -const _chm_submatrix = (:cholmod_submatrix, libcholmod) - -const _spqr_C_QR = (:SuiteSparseQR_C_QR, libspqr) -const _spqr_C_backslash = (:SuiteSparseQR_C_backslash, libspqr) -const _spqr_C_backslash_default = (:SuiteSparseQR_C_backslash_default, libspqr) -const _spqr_C_backslash_sparse = (:SuiteSparseQR_C_backslash_sparse, libspqr) -const _spqr_C_factorize = (:SuiteSparseQR_C_factorize, libspqr) -const _spqr_C_symbolic = (:SuiteSparseQR_C_symbolic, libspqr) -const _spqr_C_numeric = (:SuiteSparseQR_C_numeric, libspqr) -const _spqr_C_free = (:SuiteSparseQR_C_free, libspqr) -const _spqr_C_solve = (:SuiteSparseQR_C_solve, libspqr) -const _spqr_C_qmult = (:SuiteSparseQR_C_qmult, libspqr) - -type MatrixIllConditionedException <: Exception end - -function convert_to_0_based_indexing!(S::SparseMatrixCSC) - for i=1:(S.colptr[end]-1); S.rowval[i] -= 1; end - for i=1:length(S.colptr); S.colptr[i] -= 1; end - return S -end - -function convert_to_1_based_indexing!(S::SparseMatrixCSC) - for i=1:length(S.colptr); S.colptr[i] += 1; end - for i=1:(S.colptr[end]-1); S.rowval[i] += 1; end - return S -end - -convert_to_0_based_indexing(S) = convert_to_0_based_indexing!(copy(S)) -convert_to_1_based_indexing(S) = convert_to_1_based_indexing!(copy(S)) - -## CHOLMOD - -typealias CHMVTypes Union(Complex64, Complex128, Float32, Float64) -typealias CHMITypes Union(Int32, Int64) - -function chm_itype{Tv,Ti}(S::SparseMatrixCSC{Tv,Ti}) - if !(Ti<:CHMITypes) error("chm_itype: indtype(S) must be in CHMITypes") end - Ti == Int32 ? CHOLMOD_INT : CHOLMOD_LONG -end - -function chm_xtype{T}(S::SparseMatrixCSC{T}) - if !(T<:CHMVTypes) error("chm_xtype: eltype(S) must be in CHMVTypes") end - T <: Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL -end - -function chm_dtype{T}(S::SparseMatrixCSC{T}) - if !(T<:CHMVTypes) error("chm_dtype: eltype(S) must be in CHMVTypes") end - T <: Union(Float32, Complex64) ? CHOLMOD_SINGLE : CHOLMOD_DOUBLE -end - -# Wrapper for memory allocated by CHOLMOD. Carry along the value and index types. -## FIXME: CholmodPtr and UmfpackPtr should be amalgamated -type CholmodPtr{Tv<:CHMVTypes,Ti<:CHMITypes} - val::Vector{Ptr{Void}} -end - -eltype{Tv,Ti}(P::CholmodPtr{Tv,Ti}) = Tv -indtype{Tv,Ti}(P::CholmodPtr{Tv,Ti}) = Ti - -function cholmod_common_finalizer(x::Vector{Ptr{Void}}) - st = ccall((:cholmod_finish, libcholmod), BlasInt, (Ptr{Void},), x[1]) - if st != CHOLMOD_TRUE error("Error calling cholmod_finish") end - c_free(x[1]) -end - -type CholmodCommon - pt::Vector{Ptr{Void}} - function CholmodCommon() - pt = Array(Ptr{Void}, 1) - ccall((:jl_cholmod_common, libsuitesparse_wrapper), Void, - (Ptr{Void},), pt) - st = ccall((:cholmod_start, libcholmod), BlasInt, (Ptr{Void}, ), pt[1]) - if st != CHOLMOD_TRUE error("Error calling cholmod_start") end - finalizer(pt, cholmod_common_finalizer) - new(pt) - end -end - -function show(io::IO, cm::CholmodCommon) - st = ccall((:cholmod_print_common, libcholmod), BlasInt, - (Ptr{Uint8},Ptr{Void}), "", cm.pt[1]) - if st != CHOLMOD_TRUE error("Error calling cholmod_print_common") end -end - -type CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes} - pt::CholmodPtr{Tv,Ti} - ## cp contains a copy of the original matrix but with 0-based indices - cp::SparseMatrixCSC{Tv,Ti} - stype::Int - cm::CholmodCommon - function CholmodSparse(S::SparseMatrixCSC{Tv,Ti}, stype::BlasInt, cm::CholmodCommon) - pt = CholmodPtr{Tv,Ti}(Array(Ptr{Void}, 1)) - cp = convert_to_0_based_indexing(S) - - ccall((:jl_cholmod_sparse, libsuitesparse_wrapper), Void, - (Ptr{Void}, Uint, Uint, Uint, Ptr{Void}, Ptr{Void}, Ptr{Void}, - Ptr{Void}, Ptr{Void}, BlasInt, BlasInt, BlasInt, BlasInt, BlasInt, Int), - pt.val, S.m, S.n, nnz(S), cp.colptr, cp.rowval, C_NULL, - cp.nzval, C_NULL, stype, chm_itype(S), chm_xtype(S), chm_dtype(S), - CHOLMOD_TRUE, CHOLMOD_TRUE) - finalizer(pt, x->c_free(x.val[1])) - new(pt, cp, blas_int(stype), cm) - end -end - -CholmodSparse{Tv,Ti}(S::SparseMatrixCSC{Tv,Ti}, stype::Int) = CholmodSparse{Tv,Ti}(S, stype, CholmodCommon()) - -function CholmodSparse{Tv,Ti}(S::SparseMatrixCSC{Tv,Ti}, cm::CholmodCommon) - stype = S.m == S.n && ishermitian(S) - CholmodSparse{Tv,Ti}(stype ? triu(S) : S, blas_int(stype), cm) -end - -CholmodSparse(S::SparseMatrixCSC) = CholmodSparse(S, CholmodCommon()) - -function show(io::IO, cs::CholmodSparse) - ccall(_chm_print_sp, - BlasInt, (Ptr{Void}, Ptr{Uint8},Ptr{Void}), cs.pt.val[1], "", cs.cm.pt[1]) -end - -size(cs::CholmodSparse) = size(cs.cp) -nnz(cs::CholmodSparse) = cs.cp.colptr[end] -eltype{T}(cs::CholmodSparse{T}) = T -indtype{Tv,Ti}(cs::CholmodSparse{Tv,Ti}) = Ti - -SparseMatrixCSC(cs::CholmodSparse) = convert_to_1_based_indexing(cs.cp) - -## For testing only. The infinity and 1 norms of a sparse matrix are simply -## the same norm applied to its nzval field. -function norm(cs::CholmodSparse, p::Number) - ccall((:cholmod_norm_sparse, libcholmod), Float64, - (Ptr{Void}, BlasInt, Ptr{Void}), cs.pt.val[1], p == Inf ? 0 : 1, cs.cm.pt[1]) -end - -norm(cs::CholmodSparse) = norm(cs, Inf) - -## Approximate minimal degree ordering -function chm_amd(cs::CholmodSparse) - aa = Array(BlasInt, cs.cp.m) - st = cs.stype == 0 ? ccall(_chm_colamd, BlasInt, - (Ptr{Void}, Ptr{Void}, Uint, BlasInt, Ptr{BlasInt}, Ptr{Void}), - cs.pt.val[1], C_NULL, 0, 1, aa, cs.cm.pt[1]) : - ccall(_chm_amd, BlasInt, (Ptr{Void}, Ptr{Void}, Uint, Ptr{BlasInt}, Ptr{Void}), - cs.pt.val[1], C_NULL, 0, aa, cs.cm.pt[1]) - if st != CHOLMOD_TRUE error("Error in cholmod_amd") end - aa -end - -type CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes} <: Factorization{Tv} - pt::CholmodPtr{Tv,Ti} - cs::CholmodSparse{Tv,Ti} - function CholmodFactor(pt::CholmodPtr{Tv,Ti}, cs::CholmodSparse{Tv,Ti}) - ff = new(pt, cs) - finalizer(ff, cholmod_factor_finalizer) - ff - end -end - -function cholmod_factor_finalizer(x::CholmodFactor) - if ccall(_chm_free_fa, BlasInt, (Ptr{Void}, Ptr{Void}), x.pt.val, x.cs.cm[1]) != CHOLMOD_TRUE - error("CHOLMOD error in cholmod_free_factor") - end -end - -function size(F::CholmodFactor) - n = size(F.cs,1) - (n, n) -end - -eltype{T}(F::CholmodFactor{T}) = T -indtype{Tv,Ti}(F::CholmodFactor{Tv,Ti}) = Ti - -function CholmodFactor{Tv,Ti}(cs::CholmodSparse{Tv,Ti}) - pt = CholmodPtr{Tv,Ti}(Array(Ptr{Void}, 1)) - pt.val[1] = ccall(_chm_analyze, Ptr{Void}, - (Ptr{Void}, Ptr{Void}), cs.pt.val[1], cs.cm.pt[1]) - st = ccall(_chm_factorize, BlasInt, - (Ptr{Void}, Ptr{Void}, Ptr{Void}), cs.pt.val[1], pt.val[1], cs.cm.pt[1]) - if st != CHOLMOD_TRUE error("CHOLMOD failure in factorize") end - CholmodFactor{Tv,Ti}(pt, cs) -end - -function show(io::IO, cf::CholmodFactor) - st = ccall(_chm_print_fa, BlasInt, (Ptr{Void}, Ptr{Uint8}, Ptr{Void}), cf.pt.val[1], "", cf.cs.cm.pt[1]) - if st != CHOLMOD_TRUE error("Cholmod error in print_factor") end -end - -type CholmodDense{T<:CHMVTypes} - pt::Vector{Ptr{Void}} - m::Int - n::Int - aa::VecOrMat{T} # original array - cm::CholmodCommon -end - -function CholmodDense{T<:CHMVTypes}(b::VecOrMat{T}, cm::CholmodCommon) - m = size(b, 1) - n = isa(b, Matrix) ? size(b, 2) : 1 - - xtype = T <: Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL - dtype = T <: Float32 || T == Complex64 ? CHOLMOD_SINGLE : CHOLMOD_DOUBLE - - pt = Array(Ptr{Void}, 1) - - ccall((:jl_cholmod_dense, libsuitesparse_wrapper), Void, - (Ptr{Void}, Uint, Uint, Uint, Uint, Ptr{Void}, Ptr{Void}, BlasInt, Int), - pt, m, n, length(b), m, b, C_NULL, xtype, dtype) - finalizer(pt, x->c_free(pt[1])) - CholmodDense{T}(pt, m, n, copy(b), cm) -end - -CholmodDense{T<:Integer}(B::VecOrMat{T}, cm::CholmodCommon) = CholmodDense(float64(B), cm) - -size(cd::CholmodDense) = (cd.m, cd.n) - -function show(io::IO, cd::CholmodDense) - st = ccall(_chm_print_dn, BlasInt, (Ptr{Void},Ptr{Uint8},Ptr{Void}), cd.pt[1], "", cd.cm.pt[1]) - if st != CHOLMOD_TRUE error("Cholmod error in print_dense") end -end - -type CholmodDenseOut{Tv<:CHMVTypes,Ti<:CHMITypes} - pt::CholmodPtr{Tv,Ti} - m::Int - n::Int - cm::CholmodCommon - function CholmodDenseOut(pt::CholmodPtr{Tv,Ti}, m::BlasInt, n::BlasInt, cm::CholmodCommon) - dd = new(pt, m, n, cm) - finalizer(dd, cholmod_denseout_finalizer) - dd - end -end - -function cholmod_denseout_finalizer(cd::CholmodDenseOut) - st = ccall(_chm_free_dn, BlasInt, (Ptr{Void}, Ptr{Void}), cd.pt.val, cd.cm.pt[1]) - if st != CHOLMOD_TRUE error("Error in cholmod_free_dense") end -end - -eltype{T}(cdo::CholmodDenseOut{T}) = T -indtype{Tv,Ti}(cdo::CholmodDenseOut{Tv,Ti}) = Ti -size(cd::CholmodDenseOut) = (cd.m, cd.n) - -function convert{T}(::Type{Array{T}}, cdo::CholmodDenseOut{T}) - mm = Array(T, size(cdo)) - ccall((:jl_cholmod_dense_copy_out, libsuitesparse_wrapper), Void, - (Ptr{Void}, Ptr{T}), cdo.pt.val[1], mm) - mm -end - -function solve{Tv,Ti}(cf::CholmodFactor{Tv,Ti}, B::CholmodDense{Tv}, solv::Integer) - m, n = size(B) - cdo = CholmodPtr{Tv,Ti}(Array(Ptr{Void},1)) - cdo.val[1] = ccall(_chm_solve, Ptr{Void}, - (BlasInt, Ptr{Void}, Ptr{Void}, Ptr{Void}), - solv, cf.pt.val[1], B.pt[1], cf.cs.cm.pt[1]) - return cdo, m, n, cf.cs.cm - CholmodDenseOut(cdo, m, n, cf.cs.cm) -end - -solve(cf::CholmodFactor, B::CholmodDense) = solve(cf, B, CHOLMOD_A) - -(\){Tf,Tb}(cf::CholmodFactor{Tf}, b::VecOrMat{Tb}) = solve(cf, CholmodDense{Tf}(convert(Array{Tf},b), cf.cs.cm), CHOLMOD_A) - -type CholmodSparseOut{Tv<:CHMVTypes,Ti<:CHMITypes} - pt::CholmodPtr{Tv,Ti} - m::Int - n::Int - cm::CholmodCommon - function CholmodSparseOut(pt::CholmodPtr{Tv,Ti}, m::BlasInt, n::BlasInt, cm::CholmodCommon) - cso = new(pt, m, n, cm) - finalizer(cso, cholmod_sparseout_finalizer) - cso - end -end - -function cholmod_sparseout_finalizer(cso::CholmodSparseOut) - st = ccall(_chm_free_sp, BlasInt, - (Ptr{Void}, Ptr{Void}), cso.pt.val, cso.cm.pt[1]) - if st != CHOLMOD_TRUE error("Error in cholmod_free_sparse") end -end - -function nnz(cso::CholmodSparseOut) - ccall((:cholmod_nnz, libcholmod), BlasInt, - (Ptr{Void}, Ptr{Void}), cso.pt.val[1], cso.cm.pt[1]) -end -size(cso::CholmodSparseOut) = (cso.m, cso.n) -eltype{T}(cso::CholmodSparseOut{T}) = T -indtype{Tv,Ti}(cso::CholmodSparseOut{Tv,Ti}) = Ti - -function solve{Tv,Ti}(cf::CholmodFactor{Tv,Ti}, B::CholmodSparse{Tv,Ti}, solv::Integer) - m, n = size(B) - cso = CholmodPtr{Tv,Ti}(Array(Ptr{Void},1)) - cso.val[1] = ccall((:cholmod_spsolve, libcholmod), Ptr{Void}, - (BlasInt, Ptr{Void}, Ptr{Void}, Ptr{Void}), - solv, cf.pt.val[1], B.pt[1], B.cm.pt[1]) - CholmodSparseOut{Tv,Ti}(cso, m, n, cf.cs.cm) -end - -function CholmodSparseOut{Tv,Ti}(cf::CholmodFactor{Tv,Ti}) - n = size(cf.cs)[1] - cso = CholmodPtr{Tv,Ti}(Array(Ptr{Void},1)) - cso.val[1] = ccall((:cholmod_factor_to_sparse, libcholmod), Ptr{Void}, - (Ptr{Void}, Ptr{Void}), cf.pt.val[1], cf.cs.cm.pt[1]) - CholmodSparseOut{Tv,Ti}(cso, n, n, cf.cs.cm) -end - -function SparseMatrixCSC{Tv,Ti}(cso::CholmodSparseOut{Tv,Ti}) - nz = nnz(cso) - sp = SparseMatrixCSC{Tv,Ti}(cso.m, cso.n, Array(Ti, cso.n + 1), Array(Ti, nz), Array(Tv, nz)) - st = ccall((:jl_cholmod_sparse_copy_out, libsuitesparse_wrapper), BlasInt, - (Ptr{Void}, Ptr{Ti}, Ptr{Ti}, Ptr{Tv}), - cso.pt.val[1], sp.colptr, sp.rowval, sp.nzval) - if st == 1 error("CholmodSparseOut object is not packed") end - if st == 2 error("CholmodSparseOut object is not sorted") end # Should not occur - if st == 3 error("CholmodSparseOut object has INTLONG itype") end - convert_to_1_based_indexing!(sp) -end - -function show(io::IO, cso::CholmodSparseOut) - sp = ccall(_chm_print_sp, BlasInt, (Ptr{Void}, Ptr{Uint8},Ptr{Void}), cso.pt.val[1], "", cso.cm.pt[1]) - if sp != CHOLMOD_TRUE error("Cholmod error in print_sparse") end -end - -function chm_aat{Tv,Ti}(A::SparseMatrixCSC{Tv,Ti}, symm::Bool) - cs = CholmodSparse(A, 0) - aa = CholmodPtr{Tv,Ti}(Array(Ptr{Void},1)) - aa.val[1] = ccall(_chm_aat, Ptr{Void}, (Ptr{Void},Ptr{BlasInt},BlasInt,BlasInt,Ptr{Void}), - cs.pt.val[1], C_NULL, 0, 1, cs.cm.pt[1]) - if ccall(_chm_sort, BlasInt, (Ptr{Void}, Ptr{Void}), aa.val[1], cs.cm.pt[1]) != CHOLMOD_TRUE - error("Cholmod error in sort") - end - if symm - pt = ccall(_chm_copy, Ptr{Void}, (Ptr{Void}, BlasInt, BlasInt, Ptr{Void}), - aa.val[1], 1, 1, cs.cm.pt[1]) - if ccall(_chm_free_sp, BlasInt, (Ptr{Void}, Ptr{Void}), aa.val, cs.cm.pt[1]) != CHOLMOD_TRUE - error("Cholmod error in free_sparse") - end - aa.val[1] = pt - end - m = size(A, 1) - CholmodSparseOut{Tv,Ti}(aa, m, m, cs.cm) -end - -chm_aat{Tv,Ti}(A::SparseMatrixCSC{Tv,Ti}) = chm_aat(A, false) - -## call wrapper function to create cholmod_sparse objects -cholmod_sparse(S) = cholmod_sparse(S, 0) - -function cholmod_sparse{Tv,Ti}(S::SparseMatrixCSC{Tv,Ti}, stype::Int) - cs = Array(Ptr{Void}, 1) - - if Ti == Int; itype = CHOLMOD_INT; - elseif Ti == Int64; itype = CHOLMOD_LONG; end - - if Tv == Float64 || Tv == Float32; xtype = CHOLMOD_REAL; - elseif Tv == Complex128 || Tv == Complex64 ; xtype = CHOLMOD_COMPLEX; end - - if Tv == Float64 || Tv == Complex128; dtype = CHOLMOD_DOUBLE; - elseif Tv == Float32 || Tv == Complex64 ; dtype = CHOLMOD_SINGLE; end - - ccall((:jl_cholmod_sparse, libsuitesparse_wrapper), - Ptr{Void}, - (Ptr{Void}, BlasInt, BlasInt, BlasInt, Ptr{Void}, Ptr{Void}, Ptr{Void}, Ptr{Void}, Ptr{Void}, - BlasInt, BlasInt, BlasInt, BlasInt, BlasInt, Int), - cs, blas_int(S.m), blas_int(S.n), blas_int(length(S.nzval)), S.colptr, S.rowval, C_NULL, S.nzval, C_NULL, - int32(stype), itype, xtype, dtype, CHOLMOD_TRUE, CHOLMOD_TRUE - ) - - return cs -end - -## Call wrapper function to create cholmod_dense objects -function cholmod_dense{T}(B::VecOrMat{T}) - m = size(B, 1) - n = isa(B, Matrix) ? size(B, 2) : 1 - - cd = Array(Ptr{Void}, 1) - - if T == Float64 || T == Float32; xtype = CHOLMOD_REAL; - elseif T == Complex128 || T == Complex64 ; xtype = CHOLMOD_COMPLEX; end - - if T == Float64 || T == Complex128; dtype = CHOLMOD_DOUBLE; - elseif T == Float32 || T == Complex64 ; dtype = CHOLMOD_SINGLE; end - - ccall((:jl_cholmod_dense, libsuitesparse_wrapper), - Ptr{Void}, - (Ptr{Void}, BlasInt, BlasInt, BlasInt, BlasInt, Ptr{T}, Ptr{Void}, BlasInt, Int), - cd, m, n, length(B), m, B, C_NULL, xtype, dtype - ) - - return cd -end - -function cholmod_dense_copy_out{T}(x::Ptr{Void}, sol::VecOrMat{T}) - ccall((:jl_cholmod_dense_copy_out, libsuitesparse_wrapper), - Void, - (Ptr{Void}, Ptr{T}), - x, sol - ) - return sol -end - -function cholmod_transpose_unsym{Tv,Ti}(S::SparseMatrixCSC{Tv,Ti}, cm::Array{Ptr{Void}, 1}) - S_t = SparseMatrixCSC(Tv, S.n, S.m, nnz(S)+1) - - # Allocate space for a cholmod_sparse object - cs = cholmod_sparse(S) - cs_t = cholmod_sparse(S_t) - - status = ccall((:cholmod_transpose_unsym), - Int32, - (Ptr{Void}, BlasInt, Ptr{BlasInt}, Ptr{BlasInt}, BlasInt, Ptr{Void}, Ptr{Void}), - cs[1], int32(1), C_NULL, C_NULL, int32(-1), cs_t[1], cm[1]); - - # Deallocate space for cholmod_sparse objects - c_free(cs[1]) - c_free(cs_t[1]) - - return S_t -end - -function cholmod_analyze{Tv<:Union(Float64,Complex128), Ti<:CHMITypes}(cs::Array{Ptr{Void},1}, cm::Array{Ptr{Void},1}) - ccall(_chm_analyze, Ptr{Void}, (Ptr{Void}, Ptr{Void}), cs[1], cm[1]) -end - -function cholmod_factorize{Tv<:Union(Float64,Complex128), Ti<:CHMITypes}(cs::Array{Ptr{Void},1}, cs_factor::Ptr{Void}, cm::Array{Ptr{Void},1}) - st = ccall(_chm_factorize, BlasInt, (Ptr{Void}, Ptr{Void}, Ptr{Void}), cs[1], cs_factor, cm[1]) - if st != CHOLMOD_TRUE error("CHOLMOD could not factorize the matrix") end -end - -function cholmod_solve(cs_factor::Ptr{Void}, cd_rhs::Array{Ptr{Void},1}, cm::Array{Ptr{Void},1}) - ccall(_chm_solve, Ptr{Void}, (BlasInt, Ptr{Void}, Ptr{Void}, Ptr{Void}), - CHOLMOD_A, cs_factor, cd_rhs[1], cm[1]) -end - -## UMFPACK - -# Wrapper for memory allocated by umfpack. Carry along the value and index types. -type UmfpackPtr{Tv<:Union(Float64,Complex128),Ti<:CHMITypes} - val::Vector{Ptr{Void}} -end - -type UmfpackLU{Tv<:Union(Float64,Complex128),Ti<:CHMITypes} <: Factorization{Tv} - numeric::UmfpackPtr{Tv,Ti} - mat::SparseMatrixCSC{Tv,Ti} -end - -function show(io::IO, f::UmfpackLU) - @printf(io, "UMFPACK LU Factorization of a %d-by-%d sparse matrix\n", - size(f.mat,1), size(f.mat,2)) - println(f.numeric) - umfpack_report(f) -end - -type UmfpackLUTrans{Tv<:Union(Float64,Complex128),Ti<:CHMITypes} <: Factorization{Tv} - numeric::UmfpackPtr{Tv,Ti} - mat::SparseMatrixCSC{Tv,Ti} -end - -function show(io::IO, f::UmfpackLUTrans) - @printf(io, "UMFPACK LU Factorization of a transposed %d-by-%d sparse matrix\n", - size(f.mat,1), size(f.mat,2)) - println(f.numeric) - umfpack_report(f) -end - -function UmfpackLU{Tv<:Union(Float64,Complex128),Ti<:CHMITypes}(S::SparseMatrixCSC{Tv,Ti}) - Scopy = copy(S) - Scopy = convert_to_0_based_indexing!(Scopy) - numeric = [] - - try - symbolic = umfpack_symbolic(Scopy) - numeric = umfpack_numeric(Scopy, symbolic) - catch e - if is(e,MatrixIllConditionedException) - error("Input matrix is ill conditioned or singular"); - else - error("Error calling UMFPACK") - end - end - - return UmfpackLU(numeric,Scopy) -end - -function UmfpackLU!{Tv<:Union(Float64,Complex128),Ti<:CHMITypes}(S::SparseMatrixCSC{Tv,Ti}) - Sshallow = SparseMatrixCSC(S.m,S.n,S.colptr,S.rowval,S.nzval) - Sshallow = convert_to_0_based_indexing!(Sshallow) - numeric = [] - - try - symbolic = umfpack_symbolic(Sshallow) - numeric = umfpack_numeric(Sshallow, symbolic) - catch e - Sshallow = convert_to_1_based_indexing!(Sshallow) - if is(e,MatrixIllConditionedException) - error("Input matrix is ill conditioned or singular"); - else - error("Error calling UMFPACK") - end - end - - S.rowval = [] - S.nzval = [] - S.colptr = ones(S.n+1) - - return UmfpackLU(numeric,Sshallow) -end - -function UmfpackLUTrans(S::SparseMatrixCSC) - x = UmfpackLU(S) - return UmfpackLUTrans(x.numeric, x.mat) -end - -# Solve with Factorization - -(\){T}(fact::UmfpackLU{T}, b::Vector) = fact \ convert(Array{T,1}, b) -(\){T}(fact::UmfpackLU{T}, b::Vector{T}) = umfpack_solve(fact.mat,b,fact.numeric) - -(\){T}(fact::UmfpackLUTrans{T}, b::Vector) = fact \ convert(Array{T,1}, b) -(\){T}(fact::UmfpackLUTrans{T}, b::Vector{T}) = umfpack_transpose_solve(fact.mat,b,fact.numeric) - -ctranspose(fact::UmfpackLU) = UmfpackLUTrans(fact.numeric, fact.mat) - -# Solve directly with matrix - -(\)(S::SparseMatrixCSC, b::Vector) = UmfpackLU(S) \ b -At_ldiv_B(S::SparseMatrixCSC, b::Vector) = UmfpackLUTrans(S) \ b -Ac_ldiv_B(S::SparseMatrixCSC, b::Vector) = UmfpackLUTrans(S) \ b - -## Wrappers around UMFPACK routines - -for (f_sym_r, f_sym_c, inttype) in - (("umfpack_di_symbolic","umfpack_zi_symbolic",:Int32), - ("umfpack_dl_symbolic","umfpack_zl_symbolic",:Int64)) - @eval begin - - function umfpack_symbolic{Tv<:Float64,Ti<:$inttype}(S::SparseMatrixCSC{Tv,Ti}) - # Pointer to store the symbolic factorization returned by UMFPACK - Symbolic = UmfpackPtr{Tv,Ti}(Array(Ptr{Void},1)) - status = ccall(($f_sym_r, libumfpack), - Ti, - (Ti, Ti, - Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Void}, Ptr{Float64}, Ptr{Float64}), - S.m, S.n, - S.colptr, S.rowval, S.nzval, Symbolic.val, C_NULL, C_NULL) - if status != UMFPACK_OK; error("Error in symbolic factorization"); end - finalizer(Symbolic,umfpack_free_symbolic) - return Symbolic - end - - function umfpack_symbolic{Tv<:Complex128,Ti<:$inttype}(S::SparseMatrixCSC{Tv,Ti}) - # Pointer to store the symbolic factorization returned by UMFPACK - Symbolic = UmfpackPtr{Tv,Ti}(Array(Ptr{Void},1)) - status = ccall(($f_sym_c, libumfpack), - Ti, - (Ti, Ti, - Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Float64}, Ptr{Void}, - Ptr{Float64}, Ptr{Float64}), - S.m, S.n, - S.colptr, S.rowval, real(S.nzval), imag(S.nzval), Symbolic.val, - C_NULL, C_NULL) - if status != UMFPACK_OK; error("Error in symbolic factorization"); end - finalizer(Symbolic,umfpack_free_symbolic) # Check: do we need to free if there was an error? - return Symbolic - end - - end -end - -for (f_num_r, f_num_c, inttype) in - (("umfpack_di_numeric","umfpack_zi_numeric",:Int32), - ("umfpack_dl_numeric","umfpack_zl_numeric",:Int64)) - @eval begin - - function umfpack_numeric{Tv<:Float64,Ti<:$inttype}(S::SparseMatrixCSC{Tv,Ti}, Symbolic) - # Pointer to store the numeric factorization returned by UMFPACK - Numeric = UmfpackPtr{Tv,Ti}(Array(Ptr{Void},1)) - status = ccall(($f_num_r, libumfpack), - Ti, - (Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Void}, Ptr{Void}, - Ptr{Float64}, Ptr{Float64}), - S.colptr, S.rowval, S.nzval, Symbolic.val[1], Numeric.val, - C_NULL, C_NULL) - if status > 0; throw(MatrixIllConditionedException); end - if status != UMFPACK_OK; error("Error in numeric factorization"); end - finalizer(Numeric,umfpack_free_numeric) - return Numeric - end - - function umfpack_numeric{Tv<:Complex128,Ti<:$inttype}(S::SparseMatrixCSC{Tv,Ti}, Symbolic) - # Pointer to store the numeric factorization returned by UMFPACK - Numeric = UmfpackPtr{Tv,Ti}(Array(Ptr{Void},1)) - status = ccall(($f_num_c, libumfpack), - Ti, - (Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Float64}, Ptr{Void}, Ptr{Void}, - Ptr{Float64}, Ptr{Float64}), - S.colptr, S.rowval, real(S.nzval), imag(S.nzval), Symbolic.val[1], Numeric.val, - C_NULL, C_NULL) - if status > 0; throw(MatrixIllConditionedException); end - if status != UMFPACK_OK; error("Error in numeric factorization"); end - finalizer(Numeric,umfpack_free_numeric) - return Numeric - end - - end -end - -for (f_sol_r, f_sol_c, inttype) in - (("umfpack_di_solve","umfpack_zi_solve",:Int32), - ("umfpack_dl_solve","umfpack_zl_solve",:Int64)) - @eval begin - - function umfpack_solve{Tv<:Float64,Ti<:$inttype}(S::SparseMatrixCSC{Tv,Ti}, - b::Vector{Tv}, Numeric::UmfpackPtr{Tv,Ti}) - x = similar(b) - status = ccall(($f_sol_r, libumfpack), - Ti, - (Ti, Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, - Ptr{Float64}, Ptr{Float64}, Ptr{Void}, Ptr{Float64}, Ptr{Float64}), - UMFPACK_A, S.colptr, S.rowval, S.nzval, - x, b, Numeric.val[1], C_NULL, C_NULL) - if status != UMFPACK_OK; error("Error in solve"); end - return x - end - - function umfpack_solve{Tv<:Complex128,Ti<:$inttype}(S::SparseMatrixCSC{Tv,Ti}, - b::Vector{Tv}, Numeric::UmfpackPtr{Tv,Ti}) - xr = similar(b, Float64) - xi = similar(b, Float64) - status = ccall(($f_sol_c, libumfpack), - Ti, - (Ti, Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Float64}, Ptr{Float64}, Ptr{Float64}, - Ptr{Float64}, Ptr{Float64}, Ptr{Void}, Ptr{Float64}, Ptr{Float64}), - UMFPACK_A, S.colptr, S.rowval, real(S.nzval), imag(S.nzval), - xr, xi, real(b), imag(b), Numeric.val[1], C_NULL, C_NULL) - if status != UMFPACK_OK; error("Error in solve"); end - return complex(xr,xi) - end - - function umfpack_transpose_solve{Tv<:Float64,Ti<:$inttype}(S::SparseMatrixCSC{Tv,Ti}, - b::Vector{Tv}, Numeric::UmfpackPtr{Tv,Ti}) - x = similar(b) - status = ccall(($f_sol_r, libumfpack), - Ti, - (Ti, Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, - Ptr{Float64}, Ptr{Float64}, Ptr{Void}, Ptr{Float64}, Ptr{Float64}), - UMFPACK_At, S.colptr, S.rowval, S.nzval, - x, b, Numeric.val[1], C_NULL, C_NULL) - if status != UMFPACK_OK; error("Error in solve"); end - return x - end - - function umfpack_transpose_solve{Tv<:Complex128,Ti<:$inttype}(S::SparseMatrixCSC{Tv,Ti}, - b::Vector{Tv}, Numeric::UmfpackPtr{Tv,Ti}) - xr = similar(b, Float64) - xi = similar(b, Float64) - status = ccall(($f_sol_c, libumfpack), - Ti, - (Ti, Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Float64}, Ptr{Float64}, Ptr{Float64}, - Ptr{Float64}, Ptr{Float64}, Ptr{Void}, Ptr{Float64}, Ptr{Float64}), - UMFPACK_At, S.colptr, S.rowval, real(S.nzval), imag(S.nzval), - xr, xi, real(b), imag(b), Numeric.val[1], C_NULL, C_NULL) - if status != UMFPACK_OK; error("Error in solve"); end - return complex(xr,xi) - end - - end -end - -for (f_report, elty, inttype) in - (("umfpack_di_report_numeric", :Float64, :Int), - ("umfpack_zi_report_numeric", :Complex128, :Int), - ("umfpack_dl_report_numeric", :Float64, :Int64), - ("umfpack_zl_report_numeric", :Complex128, :Int64)) - @eval begin - - function umfpack_report{Tv<:$elty,Ti<:$inttype}(slu::UmfpackLU{Tv,Ti}) - - control = zeros(Float64, UMFPACK_CONTROL) - control[UMFPACK_PRL] = 4 - - ccall(($f_report, libumfpack), - Ti, - (Ptr{Void}, Ptr{Float64}), - slu.numeric.val[1], control) - end - - end -end - - -for (f_symfree, f_numfree, elty, inttype) in - (("umfpack_di_free_symbolic","umfpack_di_free_numeric",:Float64,:Int32), - ("umfpack_zi_free_symbolic","umfpack_zi_free_numeric",:Complex128,:Int32), - ("umfpack_dl_free_symbolic","umfpack_dl_free_numeric",:Float64,:Int64), - ("umfpack_zl_free_symbolic","umfpack_zl_free_numeric",:Complex128,:Int64)) - @eval begin - - umfpack_free_symbolic{Tv<:$elty,Ti<:$inttype}(Symbolic::UmfpackPtr{Tv,Ti}) = - ccall(($f_symfree, libumfpack), Void, (Ptr{Void},), Symbolic.val) - - umfpack_free_numeric{Tv<:$elty,Ti<:$inttype}(Numeric::UmfpackPtr{Tv,Ti}) = - ccall(($f_numfree, libumfpack), Void, (Ptr{Void},), Numeric.val) - - end -end - -end #module From 75a9664b604bfa439b9ccb70810d0352de774307 Mon Sep 17 00:00:00 2001 From: "Viral B. Shah" Date: Mon, 11 Mar 2013 17:26:08 +0530 Subject: [PATCH 11/29] Change ref() to getindex() --- base/linalg/factorization.jl | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/base/linalg/factorization.jl b/base/linalg/factorization.jl index 6fa21716e895e..47eb631115d27 100644 --- a/base/linalg/factorization.jl +++ b/base/linalg/factorization.jl @@ -21,7 +21,7 @@ chol(x::Number) = imag(x) == 0 && real(x) > 0 ? sqrt(x) : error("Argument not po size(C::CholeskyDense) = size(C.UL) size(C::CholeskyDense,d::Integer) = size(C.UL,d) -function ref(C::CholeskyDense, d::Symbol) +function getindex(C::CholeskyDense, d::Symbol) if d == :U || d == :L return symbol(C.uplo) == d ? C.UL : C.UL' elseif d == :UL @@ -67,7 +67,7 @@ cholp{T<:Int}(A::Matrix{T}, args...) = cholp(float64(A), args...) size(C::CholeskyPivotedDense) = size(C.UL) size(C::CholeskyPivotedDense,d::Integer) = size(C.UL,d) -ref(C::CholeskyPivotedDense) = C.UL, C.piv +getindex(C::CholeskyPivotedDense) = C.UL, C.piv function ref{T<:BlasFloat}(C::CholeskyPivotedDense{T}, d::Symbol) if d == :U || d == :L return symbol(C.uplo) == d ? C.UL : C.UL' @@ -188,7 +188,7 @@ qr(x::Number) = (one(x), x) size(A::QRDense, args::Integer...) = size(A.vs, args...) -function ref(A::QRDense, d::Symbol) +function getindex(A::QRDense, d::Symbol) if d == :R; return triu(A.vs[1:min(size(A)),:]); end; if d == :Q; return QRDenseQ(A); end error("No such property") @@ -349,9 +349,9 @@ type HessenbergQ{T} <: AbstractMatrix{T} end HessenbergQ(A::Hessenberg) = HessenbergQ(A.hh, A.tau) size(A::HessenbergQ, args...) = size(A.hh, args...) -ref(A::HessenbergQ, args...) = ref(full(A), args...) +getindex(A::HessenbergQ, args...) = getindex(full(A), args...) -function ref(A::Hessenberg, d::Symbol) +function getindex(A::Hessenberg, d::Symbol) if d == :Q; return HessenbergQ(A); end if d == :H; return triu(A.hh, -1); end error("No such property") @@ -379,7 +379,7 @@ svd(A::StridedMatrix, args...) = SVDDense(copy(A), args...) svd(a::Vector, args...) = svd(reshape(a, length(a), 1), args...) svd(x::Number, thin::Bool) = (x==0?one(x):x/abs(x),abs(x),one(x)) -function ref(F::SVDDense, d::Symbol) +function getindex(F::SVDDense, d::Symbol) if d == :U return F.U end if d == :S return F.S end if d == :Vt return F.Vt end From 654c95ed08d1f38714ee106cc3c1f94585da0cbf Mon Sep 17 00:00:00 2001 From: "Viral B. Shah" Date: Mon, 11 Mar 2013 17:31:05 +0530 Subject: [PATCH 12/29] Comment out the deprecation of ref(). Otherwise, sys.ji fails to build. --- base/deprecated.jl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/base/deprecated.jl b/base/deprecated.jl index 50f8b30b86268..21fef5c3bd2cf 100644 --- a/base/deprecated.jl +++ b/base/deprecated.jl @@ -159,7 +159,7 @@ end # note removed macros: str, B_str, I_str, E_str, L_str, L_mstr, I_mstr, E_mstr # renamings -const ref = getindex -export ref +#const ref = getindex +#export ref const assign = setindex! export assign From ac55e4e128d840c5ac76226592dd8cf5474efe13 Mon Sep 17 00:00:00 2001 From: "Viral B. Shah" Date: Mon, 11 Mar 2013 17:40:55 +0530 Subject: [PATCH 13/29] Rename ref calls to getindex that were missed earlier. Update bitarray tests to use getindex and setindex! Reinstate the ref() deprecation. --- base/deprecated.jl | 4 ++-- base/linalg/factorization.jl | 8 ++++---- test/bitarray.jl | 14 +++++++------- 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/base/deprecated.jl b/base/deprecated.jl index 21fef5c3bd2cf..50f8b30b86268 100644 --- a/base/deprecated.jl +++ b/base/deprecated.jl @@ -159,7 +159,7 @@ end # note removed macros: str, B_str, I_str, E_str, L_str, L_mstr, I_mstr, E_mstr # renamings -#const ref = getindex -#export ref +const ref = getindex +export ref const assign = setindex! export assign diff --git a/base/linalg/factorization.jl b/base/linalg/factorization.jl index 47eb631115d27..bcf7217e5851f 100644 --- a/base/linalg/factorization.jl +++ b/base/linalg/factorization.jl @@ -68,7 +68,7 @@ size(C::CholeskyPivotedDense) = size(C.UL) size(C::CholeskyPivotedDense,d::Integer) = size(C.UL,d) getindex(C::CholeskyPivotedDense) = C.UL, C.piv -function ref{T<:BlasFloat}(C::CholeskyPivotedDense{T}, d::Symbol) +function getindex{T<:BlasFloat}(C::CholeskyPivotedDense{T}, d::Symbol) if d == :U || d == :L return symbol(C.uplo) == d ? C.UL : C.UL' end @@ -134,7 +134,7 @@ lu(x::Number) = (one(x), x, [1]) size(A::LUDense) = size(A.LU) size(A::LUDense,n) = size(A.LU,n) -function ref{T}(A::LUDense{T}, d::Symbol) +function getindex{T}(A::LUDense{T}, d::Symbol) if d == :L; return tril(A.LU, -1) + eye(T, size(A, 1)); end; if d == :U; return triu(A.LU); end; if d == :p @@ -259,7 +259,7 @@ qrp(A::Matrix) = QRPivotedDense(copy(A)) size(A::QRPivotedDense, args::Integer...) = size(A.hh, args...) -function ref{T<:BlasFloat}(A::QRPivotedDense{T}, d::Symbol) +function getindex{T<:BlasFloat}(A::QRPivotedDense{T}, d::Symbol) if d == :R; return triu(A.hh[1:min(size(A)),:]); end; if d == :Q; return QRDensePivotedQ(A); end if d == :p; return A.jpvt; end @@ -422,7 +422,7 @@ end svd(A::StridedMatrix, B::StridedMatrix) = GSVDDense(copy(A), copy(B)) -function ref{T}(obj::GSVDDense{T}, d::Symbol) +function getindex{T}(obj::GSVDDense{T}, d::Symbol) if d == :U return obj.U end if d == :V return obj.V end if d == :Q return obj.Q end diff --git a/test/bitarray.jl b/test/bitarray.jl index 9a32737564135..f96cd73bf6b94 100644 --- a/test/bitarray.jl +++ b/test/bitarray.jl @@ -71,17 +71,17 @@ m1 = rand(1:n1) m2 = rand(1:n2) b2 = randbool(m1, m2) @check_bit_operation copy! BitMatrix (b1, b2) -@check_bit_operation ref BitMatrix (b1, 1:m1, m2:n2) -@check_bit_operation ref BitVector (b1, 1:m1, m2) -@check_bit_operation ref BitMatrix (b1, 1:m1, [n2,m2,1]) +@check_bit_operation getindex BitMatrix (b1, 1:m1, m2:n2) +@check_bit_operation getindex BitVector (b1, 1:m1, m2) +@check_bit_operation getindex BitMatrix (b1, 1:m1, [n2,m2,1]) b2 = randbool(m1, m2) -@check_bit_operation assign BitMatrix (b1, b2, 1:m1, n2-m2+1:n2) +@check_bit_operation setindex! BitMatrix (b1, b2, 1:m1, n2-m2+1:n2) k1 = randperm(m1) k2 = randperm(m2) -@check_bit_operation assign BitMatrix (b1, b2, 1:m1, k2) -@check_bit_operation assign BitMatrix (b1, b2, k1, k2) +@check_bit_operation setindex! BitMatrix (b1, b2, 1:m1, k2) +@check_bit_operation setindex! BitMatrix (b1, b2, k1, k2) b2 = randbool(m1) -@check_bit_operation assign BitMatrix (b1, b2, 1:m1, m2) +@check_bit_operation setindex! BitMatrix (b1, b2, 1:m1, m2) for p1 = [rand(1:v1) 1 63 64 65 191 192 193] for p2 = [rand(1:v1) 1 63 64 65 191 192 193] From 9350b2f1aa66e7e1f9903aa64e2d65144ae8d809 Mon Sep 17 00:00:00 2001 From: Douglas Bates Date: Mon, 11 Mar 2013 16:28:58 -0500 Subject: [PATCH 14/29] Added more methods and tests for the SuiteSparse module. --- base/linalg/suitesparse.jl | 169 ++++++++++++++++++++++--------------- test/suitesparse.jl | 119 ++++++++++++++++++++++++++ 2 files changed, 222 insertions(+), 66 deletions(-) diff --git a/base/linalg/suitesparse.jl b/base/linalg/suitesparse.jl index ac896bc1604da..4e3daddac0705 100644 --- a/base/linalg/suitesparse.jl +++ b/base/linalg/suitesparse.jl @@ -15,10 +15,12 @@ export ChmCommon, chm_fac_xtype!, chm_factorize, chm_factorize!, + chm_norm, chm_ones, chm_pack_fac!, chm_print, chm_scale!, + chm_sdmult, chm_solve, chm_sort, chm_speye, @@ -166,7 +168,6 @@ for (f_sym_r, f_num_r, f_sym_c, f_num_c, itype) in umf_ctrl, umf_info) if status != UMFPACK_OK; error("Error code $status from symbolic factorization"); end U.symbolic = tmp[1] -# finalizer(U.symbolic,umfpack_free_symbolic) U end @@ -180,7 +181,6 @@ for (f_sym_r, f_num_r, f_sym_c, f_num_c, itype) in umf_ctrl, umf_info) if status != UMFPACK_OK; error("Error code $status from symbolic factorization"); end U.symbolic = tmp[1] -# finalizer(U.symbolic,umfpack_free_symbolic) U end @@ -196,7 +196,6 @@ for (f_sym_r, f_num_r, f_sym_c, f_num_c, itype) in if status > 0; throw(MatrixIllConditionedException); end if status != UMFPACK_OK; error("Error code $status from numeric factorization"); end U.numeric = tmp[1] -# finalizer(U.numeric,umfpack_free_numeric) U end @@ -212,17 +211,17 @@ for (f_sym_r, f_num_r, f_sym_c, f_num_c, itype) in if status > 0; throw(MatrixIllConditionedException); end if status != UMFPACK_OK; error("Error code $status from numeric factorization"); end U.numeric = tmp[1] -# finalizer(U.numeric,umfpack_free_numeric) U end end end -for (f_sol_r, f_sol_c, inttype) in +for (f_sol_r, f_sol_c, itype) in (("umfpack_di_solve","umfpack_zi_solve",:Int32), ("umfpack_dl_solve","umfpack_zl_solve",:Int64)) @eval begin - function umfpack_solve{Tv<:Float64,Ti<:$inttype}(lu::UmfpackLU{Tv,Ti}, b::Vector{Tv}, typ::Integer) + function umfpack_solve{Tv<:Float64,Ti<:$itype}(lu::UmfpackLU{Tv,Ti}, + b::Vector{Tv}, typ::Integer) umfpack_numeric!(lu) x = similar(b) status = ccall(($f_sol_r, :libumfpack), Ti, @@ -233,16 +232,19 @@ for (f_sol_r, f_sol_c, inttype) in return x end - function umfpack_solve{Tv<:Complex128,Ti<:$inttype}(lu::UmfpackLU{Tv,Ti}, b::Vector{Tv}, typ::Integer) + function umfpack_solve{Tv<:Complex128,Ti<:$itype}(lu::UmfpackLU{Tv,Ti}, + b::Vector{Tv}, typ::Integer) umfpack_numeric!(lu) xr = similar(b, Float64) xi = similar(b, Float64) status = ccall(($f_sol_c, :libumfpack), Ti, - (Ti, Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Float64}, Ptr{Float64}, Ptr{Float64}, - Ptr{Float64}, Ptr{Float64}, Ptr{Void}, Ptr{Float64}, Ptr{Float64}), + (Ti, Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Float64}, + Ptr{Float64}, Ptr{Float64}, Ptr{Float64}, Ptr{Float64}, + Ptr{Void}, Ptr{Float64}, Ptr{Float64}), typ, lu.colptr, lu.rowval, real(lu.nzval), imag(lu.nzval), - xr, xi, real(b), imag(b), lu.num, umf_ctrl, umf_info) + xr, xi, real(b), imag(b), + lu.num, umf_ctrl, umf_info) if status != UMFPACK_OK; error("Error code $status from umfpack_solve"); end return complex(xr,xi) end @@ -276,9 +278,9 @@ for (det_r,det_z,itype) in end end -for (lunz,itype) in - (("umfpack_di_get_lunz", :Int32), # no distinction between real and complex here - ("umfpack_dl_get_lunz", :Int64)) +for (lunz,get_numeric_r,get_numeric_z,itype) in + (("umfpack_di_get_lunz","umfpack_di_get_numeric","umfpack_zi_get_numeric",:Int32), + ("umfpack_dl_get_lunz","umfpack_dl_get_numeric","umfpack_zl_get_numeric",:Int64)) @eval begin function umf_lunz{Tv<:UMFVTypes,Ti<:$itype}(lu::UmfpackLU{Tv,Ti}) lnz = Array(Ti, 1) @@ -292,13 +294,6 @@ for (lunz,itype) in if status != UMFPACK_OK error("Error code $status from umfpack_get_lunz") end (lnz[1], unz[1], n_row[1], n_col[1], nz_diag[1]) end - end -end - -for (get_numeric_r,get_numeric_z,itype) in - (("umfpack_di_get_numeric","umfpack_zi_get_numeric",:Int32), - ("umfpack_dl_get_numeric","umfpack_zl_get_numeric",:Int64)) - @eval begin function umf_extract{Tv<:Float64,Ti<:$itype}(lu::UmfpackLU{Tv,Ti}) umfpack_numeric!(lu) # ensure the numeric decomposition exists (lnz,unz,n_row,n_col,nz_diag) = umf_lunz(lu) @@ -321,13 +316,13 @@ for (get_numeric_r,get_numeric_z,itype) in P, Q, C_NULL, &0, Rs, lu.numeric) if status != UMFPACK_OK error("Error code $status from numeric") end - (transpose(SparseMatrixCSC(n_row,n_row,increment!(Lp),increment(Lj),Lx)), - SparseMatrixCSC(n_row,n_col,increment!(Up),increment(Ui),Ux), + (transpose(SparseMatrixCSC(n_row,n_row,increment!(Lp),increment!(Lj),Lx)), + SparseMatrixCSC(n_row,n_col,increment!(Up),increment!(Ui),Ux), increment!(P), increment!(Q), Rs) end end end - + ## The C functions called by these Julia functions do not depend on ## the numeric and index types, even though the umfpack names indicate ## they do. The umfpack_free_* functions can be called on C_NULL without harm. @@ -396,8 +391,7 @@ umfpack_report_numeric(lu::UmfpackLU) = umfpack_report_numeric(lu.symbolic,4.) ## CHOLMOD const chm_com_sz = ccall((:jl_cholmod_common_size,:libsuitesparse_wrapper),Int,()) -const chm_com = Array(Uint8, chm_com_sz) -ccall((:cholmod_start, :libcholmod), Int32, (Ptr{Uint8},), chm_com) +const chm_com = ones(Uint8, chm_com_sz) ### A way of examining some of the fields in chm_com ### Probably better to make this a Dict{ASCIIString,Tuple} and @@ -455,7 +449,7 @@ end ## cholmod_dense pointers passed to or returned from C functions are of Julia type ## Ptr{c_CholmodDense}. The CholmodDense type contains a c_CholmodDense object and other ## fields then ensure the memory pointed to is freed when it should be and not before. -type c_CholmodDense{T<:CHMVTypes} +immutable c_CholmodDense{T<:CHMVTypes} m::Int n::Int nzmax::Int @@ -466,12 +460,12 @@ type c_CholmodDense{T<:CHMVTypes} dtype::Int32 end -type CholmodDense{T<:CHMVTypes} +immutable CholmodDense{T<:CHMVTypes} c::c_CholmodDense mat::Matrix{T} end -type c_CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes} +immutable c_CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes} n::Int minor::Int Perm::Ptr{Ti} @@ -502,7 +496,7 @@ type c_CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes} dtype::Int32 end -type CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes} +immutable CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes} c::c_CholmodFactor{Tv,Ti} Perm::Vector{Ti} ColCount::Vector{Ti} @@ -518,7 +512,7 @@ type CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes} s::Vector{Ti} end -type c_CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes} +immutable c_CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes} m::Int n::Int nzmax::Int @@ -535,14 +529,14 @@ type c_CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes} packed::Int32 end -type CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes} +immutable CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes} c::c_CholmodSparse{Tv,Ti} colptr0::Vector{Ti} rowval0::Vector{Ti} nzval::Vector{Tv} end -type c_CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes} +immutable c_CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes} m::Int n::Int nzmax::Int @@ -557,7 +551,7 @@ type c_CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes} dtype::Int32 end -type CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes} +immutable CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes} c::c_CholmodTriplet{Tv,Ti} i::Vector{Ti} j::Vector{Ti} @@ -632,11 +626,10 @@ end chm_print(cd::CholmodDense, lev::Integer) = chm_print(cd, lev, "") chm_print(cd::CholmodDense) = chm_print(cd, int32(4), "") -function CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes}(A::SparseMatrixCSC{Tv,Ti}) - stype = ishermitian(A) ? 1 : 0 - aa = stype > 0 ? triu(A) : A - colptr0 = decrement(aa.colptr) - rowval0 = decrement(aa.rowval) +function CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes}(A::SparseMatrixCSC{Tv,Ti}, stype::Integer) + zerobased = A.colptr[1] == 0 + colptr0 = zerobased ? copy(aa.colptr) : decrement(aa.colptr) + rowval0 = zerobased ? copy(aa.rowptr) : decrement(aa.rowval) nzval = copy(aa.nzval) CholmodSparse{Tv,Ti}(c_CholmodSparse{Tv,Ti}(size(A,1),size(A,2), int(colptr0[end]), @@ -649,10 +642,17 @@ function CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes}(A::SparseMatrixCSC{Tv,Ti}) CHOLMOD_TRUE, CHOLMOD_TRUE), colptr0, rowval0, nzval) end +function CholmodSparse(A::SparseMatrixCSC) + stype = ishermitian(A) ? 1 : 0 + CholmodSparse(stype > 0 ? triu(A) : A, stype) +end -function cmn{Ti<:CHMITypes}(i::Ti) - chm_com[chm_ityp_inds] = - reinterpret(Uint8, [Ti<:Int64 ? CHOLMOD_LONG : CHOLMOD_INT]) +function cmn{Ti<:CHMITypes}(i::Ti) # turns out this is as fast as checking for initialization + if Ti <: Int64 + ccall((:cholmod_l_start, :libcholmod), Int32, (Ptr{Uint8},), chm_com) + else + ccall((:cholmod_start, :libcholmod), Int32, (Ptr{Uint8},), chm_com) + end chm_com end cmn{Tv,Ti<:CHMITypes}(A::CholmodSparse{Tv,Ti}) = cmn(one(Ti)) @@ -661,6 +661,14 @@ cmn{Tv,Ti<:CHMITypes}(ap::Ptr{c_CholmodSparse{Tv,Ti}}) = cmn(one(Ti)) cmn{Tv,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti}) = cmn(one(Ti)) cmn{Tv,Ti<:CHMITypes}(l::c_CholmodFactor{Tv,Ti}) = cmn(one(Ti)) cmn{Tv,Ti<:CHMITypes}(lp::Ptr{c_CholmodFactor{Tv,Ti}}) = cmn(one(Ti)) + +function chm_rdsp(fnm::String) + fd = ccall(:fopen, Ptr{Void}, (Ptr{Uint8},Ptr{Uint8}), fnm, "r") + res = ccall((:cholmod_read_sparse,:libcholmod), Ptr{c_CholmodSparse{Float64,Int32}}, + (Ptr{Void},Ptr{Uint8}),fd,cmn(one(Int32))) + ccall(:fclose, Cint, (Ptr{Void},), fd) + CholmodSparse(res) +end function CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::Ptr{c_CholmodSparse{Tv,Ti}}) csp = unsafe_ref(cp) @@ -674,26 +682,28 @@ function CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::Ptr{c_CholmodSparse{Tv,T end for (chk,prt,srt,itype) in - ((:cholmod_check_sparse,:cholmod_print_sparse,:cholmod_sort,:Int32), - (:cholmod_l_check_sparse,:cholmod_l_print_sparse,:cholmod_l_sort,:Int64)) + (("cholmod_check_sparse","cholmod_print_sparse","cholmod_sort",:Int32), + ("cholmod_l_check_sparse","cholmod_l_print_sparse","cholmod_l_sort",:Int64)) @eval begin function chm_check{Tv<:CHMVTypes}(cs::CholmodSparse{Tv,$itype}) - status = ccall(($(string(chk)),:libcholmod), Int32, + cmn(cs) + status = ccall(($chk,:libcholmod), Int32, (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), - &cs.c, cmn(cs)) + &cs.c, chm_com) if status != CHOLMOD_TRUE throw(CholmodException) end end function chm_print{Tv<:CHMVTypes}(cs::CholmodSparse{Tv,$itype},lev,nm) + cmn(cs) # initialize if necessary orig = chm_com[chm_prt_inds] chm_com[chm_prt_inds] = reinterpret(Uint8, [int32(lev)]) - status = ccall(($(string(prt)),:libcholmod), Int32, + status = ccall(($prt,:libcholmod), Int32, (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}, Ptr{Uint8}), - &cs.c, nm, cmn(cs)) + &cs.c, nm, chm_com) chm_com[chm_prt_inds] = orig if status != CHOLMOD_TRUE throw(CholmodException) end end function chm_sort{Tv<:CHMVTypes}(cs::CholmodSparse{Tv,$itype}) - status = ccall(($(string(srt)),:libcholmod), Int32, + status = ccall(($srt,:libcholmod), Int32, (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), &cs.c, cmn(cs)) if status != CHOLMOD_TRUE throw(CholmodException) end @@ -711,53 +721,80 @@ function size{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::CholmodSparse{Tv,Ti}, d::Integer) d == 1 ? cp.c.m : (d == 2 ? cp.c.n : 1) end -for (speye,aat,cop,copsp,freesp,itype) in - ((:cholmod_speye,:cholmod_aat,:cholmod_copy, - :cholmod_copy_sparse,:cholmod_free_sparse,:Int32), - (:cholmod_l_speye,:cholmod_l_aat,:cholmod_l_copy, - :cholmod_l_copy_sparse,:cholmod_l_free_sparse,:Int64)) +for (aat,cop,copsp,freesp,normsp,sdmult,speye,itype) in + (("cholmod_aat","cholmod_copy","cholmod_copy_sparse","cholmod_free_sparse", + "cholmod_norm_sparse","cholmod_sdmult","cholmod_speye",:Int32), + ("cholmod_l_aat","cholmod_l_copy","cholmod_l_copy_sparse","cholmod_l_free_sparse", + "cholmod_norm_sparse","cholmod_l_sdmult","cholmod_l_speye",:Int64)) @eval begin - function chm_speye{Tv<:Union(Float64,Complex128)}(m::Integer, n::Integer, t::Tv, i::$itype) - CholmodSparse(ccall(($(string(speye)), :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, - (Int, Int, Int32, Ptr{Uint8}), - m, n, - Tv<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, - cmn(one($itype)))) - end function chm_aat{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}) cm = cmn(a) aa = Array(Ptr{c_CholmodSparse{Tv,$itype}}, 1) - aa[1] = ccall(($(string(aat)), :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, + aa[1] = ccall(($aat, :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Void}, Int, Int32, Ptr{Uint8}), &a, C_NULL, 0, 1, cm) res = CholmodSparse(ccall(($(string(cop)), :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, (Ptr{c_CholmodSparse{Tv,$itype}}, Int32, Int32, Ptr{Uint8}), aa[1], 1, 1, cm)) - status = ccall(($(string(freesp)), :libcholmod), Int32, + status = ccall(($freesp, :libcholmod), Int32, (Ptr{Ptr{c_CholmodSparse{Tv,$itype}}}, Ptr{Uint8}), aa, cm) if status != CHOLMOD_TRUE throw(CholmodException) end res end function chm_copy_sp{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}) - ccall(($(string(copsp)),:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, + ccall(($copsp,:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, (Ptr{c_CholmodSparse{Tv,$itype}},Ptr{Uint8}), &a, cmn(a)) end + function chm_norm{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}, norm::Integer) + ccall(($normsp, :libcholmod), Float64, + (Ptr{c_CholmodSparse{Tv,$itype}}, Int32, Ptr{Uint8}), + &a,norm,cmn(a)) + end + function chm_sdmult{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}, + trans::Bool, + alpha::Tv, + beta::Tv, + x::c_CholmodDense{Tv}) + nc = trans ? a.m : a.n + nr = trans ? a.n : a.m + if nc != x.m + error("Incompatible dimensions, $nc and $(x.m), in sdmult") + end + Y = CholmodDense(Array(Tv,nr,x.n)) + status = ccall(($sdmult,:libcholmod), Int32, + (Ptr{c_CholmodSparse{Tv,$itype}},Int32,Ptr{Tv},Ptr{Tv}, + Ptr{c_CholmodDense{Tv}}, Ptr{c_CholmodDense{Tv}}, Ptr{Uint8}), + &a,trans,&alpha,&beta,&x,&Y.c,cmn(a)) + if status != CHOLMOD_TRUE throw(CholmodException) end + Y + end + function chm_speye{Tv<:Union(Float64,Complex128)}(m::Integer, n::Integer, t::Tv, i::$itype) + CholmodSparse(ccall(($speye, :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, + (Int, Int, Int32, Ptr{Uint8}), + m, n, + Tv<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, + cmn(one($itype)))) + end end end chm_speye(m::Integer, n::Integer) = chm_speye(m, n, 1., 1) chm_speye(n::Integer) = chm_speye(n, n, 1., 1) chm_aat(A::CholmodSparse) = chm_aat(A.c) chm_aat(A::SparseMatrixCSC) = chm_aat(CholmodSparse(A).c) +chm_norm(A::CholmodSparse,norm::Integer) = chm_norm(A.c,norm) +chm_norm(A::SparseMatrixCSC,norm::Integer) = chm_norm(CholmodSparse(A).c,norm) +chm_norm(A::CholmodSparse) = chm_norm(A.c,one(Int32)) +chm_norm(A::SparseMatrixCSC) = chm_norm(CholmodSparse(A).c,one(Int32)) copy(A::CholmodSparse) = CholmodSparse(chm_copy_sp(A.c)) for (scl,itype) in - ((:cholmod_scale,:Int32), - (:cholmod_l_scale,:Int64)) + (("cholmod_scale",:Int32), + ("cholmod_l_scale",:Int64)) @eval begin function chm_scale!{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}, s::c_CholmodDense{Tv}, typ::Integer) - status = ccall(($(string(scl)),:libcholmod), Int32, + status = ccall(($scl,:libcholmod), Int32, (Ptr{c_CholmodDense{Tv}},Int32,Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), &s, typ, &a, cmn(a)) if status != CHOLMOD_TRUE throw(CholmodException) end diff --git a/test/suitesparse.jl b/test/suitesparse.jl index 5344432338228..4a783e2f8f636 100644 --- a/test/suitesparse.jl +++ b/test/suitesparse.jl @@ -22,3 +22,122 @@ x = lua\b L,U,P,Q,Rs = umf_extract(lua) @test_approx_eq diagmm(Rs,A)[P,Q] L*U +# based on deps/SuiteSparse-4.0.2/CHOLMOD/Demo/ + +# use inline values instead of +# chm_rdsp(joinpath(JULIA_HOME, "../../deps/SuiteSparse-4.0.2/CHOLMOD/Demo/Matrix/bcsstk01.tri")) +# because the file may not exist in binary distributions and when a system suitesparse library +# is used + +## Result from C program +## ---------------------------------- cholmod_demo: +## norm (A,inf) = 3.57095e+09 +## norm (A,1) = 3.57095e+09 +## CHOLMOD sparse: A: 48-by-48, nz 224, upper. OK +## CHOLMOD dense: B: 48-by-1, OK +## bnorm 1.97917 +## Analyze: flop 6009 lnz 489 +## Factorizing A +## CHOLMOD factor: L: 48-by-48 simplicial, LDL'. nzmax 489. nz 489 OK +## Ordering: AMD fl/lnz 12.3 lnz/anz 2.2 +## ints in L: 782, doubles in L: 489 +## factor flops 6009 nnz(L) 489 (w/no amalgamation) +## nnz(A*A'): 224 +## flops / nnz(L): 12.3 +## nnz(L) / nnz(A): 2.2 +## analyze cputime: 0.0000 +## factor cputime: 0.0000 mflop: 0.0 +## solve cputime: 0.0000 mflop: 0.0 +## overall cputime: 0.0000 mflop: 0.0 +## peak memory usage: 0 (MB) +## residual 2.5e-19 (|Ax-b|/(|A||x|+|b|)) +## residual 1.3e-19 (|Ax-b|/(|A||x|+|b|)) after iterative refinement +## rcond 9.5e-06 + +nzval = + [2.83226851852e6,1.63544753086e6,1.72436728395e6,-2.0e6,-2.08333333333e6,1.00333333333e9,1.0e6, + -2.77777777778e6,1.0675e9,2.08333333333e6,5.55555555555e6,1.53533333333e9,-3333.33333333,-1.0e6, + 2.83226851852e6,-6666.66666667,2.0e6,1.63544753086e6,-1.68e6,1.72436728395e6,-2.0e6,4.0e8,2.0e6, + -2.08333333333e6,1.00333333333e9,1.0e6,2.0e8,-1.0e6,-2.77777777778e6,1.0675e9,-2.0e6, + 2.08333333333e6,5.55555555555e6,1.53533333333e9,-2.8e6,2.8360994695e6,-30864.1975309, + -5.55555555555e6,1.76741074446e6,-15432.0987654,2.77777777778e6,517922.131816,3.89003806848e6, + -3.33333333333e6,4.29857058902e6,-2.6349902747e6,1.97572063531e9,-2.77777777778e6,3.33333333333e8, + -2.14928529451e6,2.77777777778e6,1.52734651547e9,5.55555555555e6,6.66666666667e8,2.35916180402e6, + -5.55555555555e6,-1.09779731332e8,1.56411143711e9,-2.8e6,-3333.33333333,1.0e6,2.83226851852e6, + -30864.1975309,-5.55555555555e6,-6666.66666667,-2.0e6,1.63544753086e6,-15432.0987654, + 2.77777777778e6,-1.68e6,1.72436728395e6,-3.33333333333e6,2.0e6,4.0e8,-2.0e6,-2.08333333333e6, + 1.00333333333e9,-2.77777777778e6,3.33333333333e8,-1.0e6,2.0e8,1.0e6,2.77777777778e6,1.0675e9, + 5.55555555555e6,6.66666666667e8,-2.0e6,2.08333333333e6,-5.55555555555e6,1.53533333333e9, + -28935.1851852,-2.08333333333e6,60879.6296296,-1.59791666667e6,3.37291666667e6,-28935.1851852, + 2.08333333333e6,2.41171296296e6,-2.08333333333e6,1.0e8,-2.5e6,-416666.666667,1.5e9,-833333.333333, + 1.25e6,5.01833333333e8,2.08333333333e6,1.0e8,416666.666667,5.025e8,-28935.1851852,-2.08333333333e6, + -4166.66666667,-1.25e6,3.98587962963e6,-1.59791666667e6,-8333.33333333,2.5e6,3.41149691358e6, + -28935.1851852,2.08333333333e6,-2.355e6,2.43100308642e6,-2.08333333333e6,1.0e8,-2.5e6,5.0e8,2.5e6, + -416666.666667,1.50416666667e9,-833333.333333,1.25e6,2.5e8,-1.25e6,-3.47222222222e6,1.33516666667e9, + 2.08333333333e6,1.0e8,-2.5e6,416666.666667,6.94444444444e6,2.16916666667e9,-28935.1851852, + -2.08333333333e6,-3.925e6,3.98587962963e6,-1.59791666667e6,-38580.2469136,-6.94444444444e6, + 3.41149691358e6,-28935.1851852,2.08333333333e6,-19290.1234568,3.47222222222e6,2.43100308642e6, + -2.08333333333e6,1.0e8,-4.16666666667e6,2.5e6,-416666.666667,1.50416666667e9,-833333.333333, + -3.47222222222e6,4.16666666667e8,-1.25e6,3.47222222222e6,1.33516666667e9,2.08333333333e6,1.0e8, + 6.94444444445e6,8.33333333333e8,416666.666667,-6.94444444445e6,2.16916666667e9,-3830.95098171, + 1.14928529451e6,-275828.470683,-28935.1851852,-2.08333333333e6,-4166.66666667,1.25e6,64710.5806113, + -131963.213599,-517922.131816,-2.29857058902e6,-1.59791666667e6,-8333.33333333,-2.5e6, + 3.50487988027e6,-517922.131816,-2.16567078453e6,551656.941366,-28935.1851852,2.08333333333e6, + -2.355e6,517922.131816,4.57738374749e6,2.29857058902e6,-551656.941367,4.8619365099e8, + -2.08333333333e6,1.0e8,2.5e6,5.0e8,-4.79857058902e6,134990.2747,2.47238730198e9,-1.14928529451e6, + 2.29724661236e8,-5.57173510779e7,-833333.333333,-1.25e6,2.5e8,2.39928529451e6,9.61679848804e8, + 275828.470683,-5.57173510779e7,1.09411960038e7,2.08333333333e6,1.0e8,-2.5e6,140838.195984, + -1.09779731332e8,5.31278103775e8] +colptr0 = int32([0,1,2,3,6,9,12,15,18,20,25,30,34,36,39,43,47,52,58,62,67,71,77,84,90,93,95, + 98,103,106,110,115,119,123,130,136,142,146,150,155,161,167,174,182,189,197, + 207,215,224]) +rowval0 = int32([0,1,2,1,2,3,0,2,4,0,1,5,0,4,6,1,3,7,2,8,1,3,7,8,9,0,4,6,8,10,5,6,7,11,6,12, + 7,11,13,8,10,13,14,9,13,14,15,8,10,12,14,16,7,11,12,13,16,17,0,12,16,18,1,5, + 13,15,19,2,4,14,20,3,13,15,19,20,21,2,4,12,16,18,20,22,1,5,17,18,19,23,0,5, + 24,1,25,2,3,26,2,3,25,26,27,4,24,28,0,5,24,29,6,11,24,28,30,7,25,27,31,8,9, + 26,32,8,9,25,27,31,32,33,10,24,28,30,32,34,6,11,29,30,31,35,12,17,30,36,13, + 31,35,37,14,15,32,34,38,14,15,33,37,38,39,16,32,34,36,38,40,12,17,31,35,36, + 37,41,12,16,17,18,23,36,40,42,13,14,15,19,37,39,43,13,14,15,20,21,38,43,44, + 13,14,15,20,21,37,39,43,44,45,12,16,17,22,36,40,42,46,12,16,17,18,23,41,42,46,47]) +A = CholmodSparse{Float64,Int32}(Base.SuiteSparse.c_CholmodSparse{Float64,Int32}(48,48,224, + convert(Ptr{Int32}, colptr0), + convert(Ptr{Int32}, rowval0), + C_NULL, + convert(Ptr{Float64}, nzval), + C_NULL, + one(Int32), zero(Int32), + one(Int32), zero(Int32), + one(Int32), one(Int32)), + colptr0, rowval0, nzval) +@test_approx_eq chm_norm(A,0) 3.570948074697437e9 +@test_approx_eq chm_norm(A,1) 3.570948074697437e9 +chm_print(A,3) +B = chm_sdmult(A.c, false, 1., 0., CholmodDense(ones(size(A,2))).c) +chm_print(B,3) + +#lp_afiro example + +nzval = [1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0, + -1.0,-1.06,1.0,0.301,1.0,-1.0,1.0,-1.0,1.0,1.0,-1.0,-1.06,1.0,0.301,-1.0,-1.06, + 1.0,0.313,-1.0,-0.96,1.0,0.313,-1.0,-0.86,1.0,0.326,-1.0,2.364,-1.0,2.386,-1.0, + 2.408,-1.0,2.429,1.4,1.0,1.0,-1.0,1.0,1.0,-1.0,-0.43,1.0,0.109,1.0,-1.0,1.0, + -1.0,1.0,-1.0,1.0,1.0,-0.43,1.0,1.0,0.109,-0.43,1.0,1.0,0.108,-0.39,1.0,1.0, + 0.108,-0.37,1.0,1.0,0.107,-1.0,2.191,-1.0,2.219,-1.0,2.249,-1.0,2.279,1.4, + -1.0,1.0,-1.0,1.0,1.0,1.0] +colptr0 = int32([0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,23,25,27,29,33,37,41,45,47, + 49,51,53,55,57,59,63,65,67,69,71,75,79,83,87,89,91,93,95,97,99,101,102]) +rowval0 = int32([2,3,6,7,8,9,12,13,16,17,18,19,20,21,22,23,24,25,26,0,1,2,23,0,3,0,21,1,25,4,5, + 6,24,4,5,7,24,4,5,8,24,4,5,9,24,6,20,7,20,8,20,9,20,3,4,4,22,5,26,10,11,12,21, + 10,13,10,23,10,20,11,25,14,15,16,22,14,15,17,22,14,15,18,22,14,15,19,22,16,20, + 17,20,18,20,19,20,13,15,15,24,14,26,15]) +afiro = CholmodSparse{Float64,Int32}(Base.SuiteSparse.c_CholmodSparse{Float64,Int32}(27,51,102, + convert(Ptr{Int32}, colptr0), + convert(Ptr{Int32}, rowval0), + C_NULL, + convert(Ptr{Float64}, nzval), + C_NULL, + zero(Int32), zero(Int32), + one(Int32), zero(Int32), + one(Int32), one(Int32)), + colptr0, rowval0, nzval) + From 0f4cb99a26676121fd3053f3b059c6f2f4998c63 Mon Sep 17 00:00:00 2001 From: "Viral B. Shah" Date: Tue, 12 Mar 2013 11:29:00 +0530 Subject: [PATCH 15/29] Refactor the ARPACK interface. arpack.jl has the ARPACK wrappers. arnoldi.jl has the higher level APIs. --- base/exports.jl | 3 +- base/linalg/arnoldi.jl | 206 ++++++++++++++++++++++++++ base/linalg/arpack.jl | 329 +++++++++++------------------------------ base/linalg/linalg.jl | 3 +- test/arpack.jl | 3 - 5 files changed, 297 insertions(+), 247 deletions(-) create mode 100644 base/linalg/arnoldi.jl diff --git a/base/exports.jl b/base/exports.jl index 421764ce9bb31..5e7a70028b52e 100644 --- a/base/exports.jl +++ b/base/exports.jl @@ -561,6 +561,7 @@ export diagmm!, dot, eig, + eigs, eigvals, expm, sqrtm, @@ -603,7 +604,7 @@ export svd, svdfact!, svdfact, - svdt, + svds, svdvals!, svdvals, symmetrize!, diff --git a/base/linalg/arnoldi.jl b/base/linalg/arnoldi.jl new file mode 100644 index 0000000000000..5c7a40482577b --- /dev/null +++ b/base/linalg/arnoldi.jl @@ -0,0 +1,206 @@ +using ARPACK + +# For a dense matrix A is ignored and At is actually A'*A +sarupdate{T}(A::StridedMatrix{T}, At::StridedMatrix{T}, X::StridedVector{T}) = BLAS.symv('U', one(T), At, X) +sarupdate{Tv,Ti}(A::SparseMatrixCSC{Tv,Ti}, At::SparseMatrixCSC{Tv,Ti}, X::StridedVector{Tv}) = At*(A*X) + +function eigs{T<:Union(Float64,Float32)}(A::AbstractMatrix{T}, nev::Integer, evtype::ASCIIString, rvec::Bool) + (m, n) = size(A) + if m != n error("eigs: matrix A is $m by $n but must be square") end + sym = issym(A) + if n <= nev nev = n - 1 end + + ncv = min(max(nev*2, 20), n) +# if ncv-nev < 2 || ncv > n error("Compute fewer eigenvalues using eigs(A, k)") end + + bmat = "I" + lworkl = sym ? ncv * (ncv + 8) : ncv * (3*ncv + 6) + + v = Array(T, n, ncv) + workd = Array(T, 3*n) + workl = Array(T, lworkl) + resid = Array(T, n) + select = Array(BlasInt, ncv) + iparam = zeros(BlasInt, 11) + ipntr = zeros(BlasInt, 14) + + tol = zeros(T, 1) + ido = zeros(BlasInt, 1) + info = zeros(BlasInt, 1) + + iparam[1] = blas_int(1) # ishifts + iparam[3] = blas_int(1000) # maxitr + iparam[7] = blas_int(1) # mode 1 + + zernm1 = 0:(n-1) + + while true + if sym + saupd(ido, bmat, n, evtype, nev, tol, resid, ncv, v, n, + iparam, ipntr, workd, workl, lworkl, info) + else + naupd(ido, bmat, n, evtype, nev, tol, resid, ncv, v, n, + iparam, ipntr, workd, workl, lworkl, info) + end + if info[1] != 0; error("error code $(info[1]) from ARPACK aupd"); end + if (ido[1] != -1 && ido[1] != 1); break; end + workd[ipntr[2]+zernm1] = A*getindex(workd, ipntr[1]+zernm1) + end + + howmny = "A" + + if sym + d = Array(T, nev) + sigma = zeros(T, 1) + + seupd(rvec, howmny, select, d, v, n, sigma, + bmat, n, evtype, nev, tol, resid, ncv, v, n, + iparam, ipntr, workd, workl, lworkl, info) + + if info[1] != 0; error("error code $(info[1]) from ARPACK eupd"); end + return rvec ? (d, v[1:n, 1:nev]) : d + end + + dr = Array(T, nev+1) + di = Array(T, nev+1) + sigmar = zeros(T, 1) + sigmai = zeros(T, 1) + workev = Array(T, 3*ncv) + + neupd(rvec, howmny, select, dr, di, v, n, sigmar, sigmai, + workev, bmat, n, evtype, nev, tol, resid, ncv, v, n, + iparam, ipntr, workd, workl, lworkl, info) + + if info[1] != 0; error("error code $(info[1]) from ARPACK eupd"); end + evec = complex(zeros(T, n, nev+1), zeros(T, n, nev+1)) + j = 1 + while j <= nev + if di[j] == 0.0 + evec[:,j] = v[:,j] + else + evec[:,j] = v[:,j] + im*v[:,j+1] + evec[:,j+1] = v[:,j] - im*v[:,j+1] + j += 1 + end + j += 1 + end + return (complex(dr[1:nev],di[1:nev]), evec[1:n, 1:nev]) +end + +function eigs{T<:Union(Complex128,Complex64)}(A::AbstractMatrix{T}, nev::Integer, evtype::ASCIIString, rvec::Bool) + (m, n) = size(A) + if m != n error("eigs: matrix A is $m by $n but must be square") end + if n <= nev nev = n - 1 end + + ncv = min(max(nev*2, 20), n) +# if ncv-nev < 2 || ncv > n error("Compute fewer eigenvalues using eigs(A, k)") end + + bmat = "I" + lworkl = ncv * (3*ncv + 5) + + v = Array(T, n, ncv) + TR = typeof(real(v[1])) + workd = Array(T, 3*n) + workl = Array(T, lworkl) + rwork = Array(TR, ncv) + resid = Array(T, n) + select = Array(BlasInt, ncv) + iparam = zeros(BlasInt, 11) + ipntr = zeros(BlasInt, 14) + + tol = zeros(TR, 1) + ido = zeros(BlasInt, 1) + info = zeros(BlasInt, 1) + + iparam[1] = blas_int(1) # ishifts + iparam[3] = blas_int(1000) # maxitr + iparam[7] = blas_int(1) # mode 1 + + zernm1 = 0:(n-1) + + while true + naupd(ido, bmat, n, evtype, nev, tol, resid, ncv, v, n, + iparam, ipntr, workd, workl, lworkl, rwork, info) + + if info[1] != 0; error("error code $(info[1]) from ARPACK aupd"); end + if (ido[1] != -1 && ido[1] != 1); break; end + workd[ipntr[2]+zernm1] = A*getindex(workd, ipntr[1]+zernm1) + end + + howmny = "A" + + d = Array(T, nev+1) + sigma = zeros(T, 1) + workev = Array(T, 2ncv) + neupd(rvec, howmny, select, d, v, n, workev, sigma, + bmat, n, evtype, nev, tol, resid, ncv, v, n, + iparam, ipntr, workd, workl, lworkl, rwork, info) + if info[1] != 0; error("error code $(info[1]) from ARPACK eupd"); end + rvec ? (d, v[1:n, 1:nev]) : d +end + +eigs(A::AbstractMatrix, nev::Integer, typ::ASCIIString) = eigs(A, nev, which, true) +eigs(A::AbstractMatrix, nev::Integer, rvec::Bool) = eigs(A, nev, "LM", rvec) +eigs(A::AbstractMatrix, rvec::Bool) = eigs(A, 6, "LM", rvec) +eigs(A::AbstractMatrix, nev::Integer) = eigs(A, nev, "LM", true) +eigs(A::AbstractMatrix) = eigs(A, 6, "LM", true) + + +# For a dense matrix A is ignored and At is actually A'*A +sarupdate{T}(A::StridedMatrix{T}, At::StridedMatrix{T}, X::StridedVector{T}) = BLAS.symv('U', one(T), At, X) +sarupdate{Tv,Ti}(A::SparseMatrixCSC{Tv,Ti}, At::SparseMatrixCSC{Tv,Ti}, X::StridedVector{Tv}) = At*(A*X) + +function svds{T<:Union(Float64,Float32)}(A::AbstractMatrix{T}, nev::Integer, which::ASCIIString, rvec::Bool) + (m, n) = size(A) + if m < n error("m = $m, n = $n and only the m >= n case is implemented") end + if n <= nev nev = n - 1 end + + At = isa(A, StridedMatrix) ? BLAS.syrk('U','T',1.,A) : A' + + ncv = min(max(nev*2, 20), n) + lworkl = ncv*(ncv+8) + + v = Array(T, n, ncv) + workd = Array(T, 3n) + workl = Array(T, lworkl) + resid = Array(T, n) + select = Array(BlasInt, ncv) + iparam = zeros(BlasInt, 11) + iparam[1] = 1 # ishifts + iparam[3] = 1000 # maxitr + iparam[7] = 1 # mode 1 + ipntr = zeros(BlasInt, 14) + + tol = zeros(T, 1) + sigma = zeros(T, 1) + ido = zeros(BlasInt, 1) + info = Array(BlasInt, 1) + bmat = "I" + zernm1 = 0:(n-1) + + while true + saupd(ido, bmat, n, which, nev, tol, resid, ncv, v, n, + iparam, ipntr, workd, workl, lworkl, info) + if (info[1] < 0) error("error code $(info[1]) from ARPACK saupd") end + if (ido[1] != -1 && ido[1] != 1); break; end + workd[ipntr[2]+zernm1] = sarupdate(A, At, getindex(workd, ipntr[1]+zernm1)) + end + + d = Array(T, nev) + howmny = "A" + + seupd(rvec, howmny, select, d, v, n, sigma, + bmat, n, which, nev, tol, resid, ncv, v, n, + iparam, ipntr, workd, workl, lworkl, info) + if info[1] != 0; error("error code $(info[1]) from ARPACK eupd"); end + d = sqrt(d) + if !rvec return d end + v = v[1:n, 1:nev] + A*v*diagm(1./d), d, v.' +end + +svds(A::AbstractMatrix, nev::Integer, which::ASCIIString) = svds(A, nev, which, true) +svds(A::AbstractMatrix, nev::Integer, rvec::Bool) = svds(A, nev, "LA", rvec) +svds(A::AbstractMatrix, rvec::Bool) = svds(A, 6, "LA", rvec) +svds(A::AbstractMatrix, nev::Integer) = svds(A, nev, "LA", true) +svds(A::AbstractMatrix) = svds(A, 6, "LA", true) diff --git a/base/linalg/arpack.jl b/base/linalg/arpack.jl index 7b8639698c9b8..b085a2ae1b44e 100644 --- a/base/linalg/arpack.jl +++ b/base/linalg/arpack.jl @@ -2,262 +2,107 @@ module ARPACK const libarpack = "libarpack" -export eigs, svds +export naupd, neupd, saupd, seupd import Base.BlasInt import Base.blas_int -# For a dense matrix A is ignored and At is actually A'*A -sarupdate{T}(A::StridedMatrix{T}, At::StridedMatrix{T}, X::StridedVector{T}) = BLAS.symv('U', one(T), At, X) -sarupdate{Tv,Ti}(A::SparseMatrixCSC{Tv,Ti}, At::SparseMatrixCSC{Tv,Ti}, X::StridedVector{Tv}) = At*(A*X) - -for (T, saupd, seupd, naupd, neupd) in +for (T, saupd_name, seupd_name, naupd_name, neupd_name) in ((:Float64, :dsaupd_, :dseupd_, :dnaupd_, :dneupd_), (:Float32, :ssaupd_, :sseupd_, :snaupd_, :sneupd_)) @eval begin - function eigs(A::AbstractMatrix{$T}, nev::Integer, evtype::ASCIIString, rvec::Bool) - (m, n) = size(A) - if m != n error("eigs: matrix A is $m by $n but must be square") end - sym = issym(A) - if n <= nev nev = n - 1 end - - ncv = min(max(nev*2, 20), n) -# if ncv-nev < 2 || ncv > n error("Compute fewer eigenvalues using eigs(A, k)") end - - bmat = "I" - lworkl = sym ? ncv * (ncv + 8) : ncv * (3*ncv + 6) - - v = Array($T, n, ncv) - workd = Array($T, 3*n) - workl = Array($T, lworkl) - resid = Array($T, n) - select = Array(BlasInt, ncv) - iparam = zeros(BlasInt, 11) - ipntr = zeros(BlasInt, 14) - - tol = zeros($T, 1) - ido = zeros(BlasInt, 1) - info = zeros(BlasInt, 1) - iparam[1] = blas_int(1) # ishifts - iparam[3] = blas_int(1000) # maxitr - iparam[7] = blas_int(1) # mode 1 - - zernm1 = 0:(n-1) - - while true - if sym - ccall(($(string(saupd)), libarpack), Void, - (Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, - Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, Ptr{$T}, Ptr{BlasInt}, - Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, Ptr{BlasInt}), - ido, bmat, &n, evtype, &nev, tol, resid, &ncv, v, &n, - iparam, ipntr, workd, workl, &lworkl, info) - else - ccall(($(string(naupd)), libarpack), Void, - (Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, - Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, Ptr{$T}, Ptr{BlasInt}, - Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, Ptr{BlasInt}), - ido, bmat, &n, evtype, &nev, tol, resid, &ncv, v, &n, - iparam, ipntr, workd, workl, &lworkl, info) - end - if info[1] != 0 error("error code $(info[1]) from ARPACK aupd") end - if (ido[1] != -1 && ido[1] != 1) break end - workd[ipntr[2]+zernm1] = A*getindex(workd, ipntr[1]+zernm1) - end - - howmny = "A" - - if sym - d = Array($T, nev) - sigma = zeros($T, 1) + function naupd(ido, bmat, n, evtype, nev, tol, resid, ncv, v, ldv, + iparam, ipntr, workd::Array{$T}, workl::Array{$T}, lworkl, info) + + ccall(($(string(naupd_name)), libarpack), Void, + (Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, + Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, Ptr{$T}, Ptr{BlasInt}, + Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, Ptr{BlasInt}), + ido, bmat, &n, evtype, &nev, tol, resid, &ncv, v, &ldv, + iparam, ipntr, workd, workl, &lworkl, info) + end + + function neupd(rvec, howmny, select, dr, di, z, ldz, sigmar, sigmai, + workev, bmat, n, evtype, nev, tol, resid, ncv, v, ldv, + iparam, ipntr, workd::Array{$T}, workl::Array{$T}, lworkl, info) + + ccall(($(string(neupd_name)), libarpack), Void, + (Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{$T}, + Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{$T}, Ptr{Uint8}, Ptr{BlasInt}, + Ptr{Uint8}, Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, Ptr{$T}, + Ptr{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, + Ptr{BlasInt}, Ptr{BlasInt}), + &rvec, howmny, select, dr, di, z, &ldz, sigmar, sigmai, + workev, bmat, &n, evtype, &nev, tol, resid, &ncv, v, &ldv, + iparam, ipntr, workd, workl, &lworkl, info) + end + + function saupd(ido, bmat, n, which, nev, tol, resid, ncv, v, ldv, + iparam, ipntr, workd::Array{$T}, workl::Array{$T}, lworkl, info) + + ccall(($(string(saupd_name)), libarpack), Void, + (Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, + Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, Ptr{$T}, Ptr{BlasInt}, + Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, Ptr{BlasInt}), + ido, bmat, &n, which, &nev, tol, resid, &ncv, v, &ldv, + iparam, ipntr, workd, workl, &lworkl, info) + + end + + function seupd(rvec, howmny, select, d, z, ldz, sigma, + bmat, n, evtype, nev, tol, resid, ncv, v, ldv, + iparam, ipntr, workd::Array{$T}, workl::Array{$T}, lworkl, info) + + ccall(($(string(seupd_name)), libarpack), Void, + (Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, Ptr{$T}, + Ptr{Uint8}, Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, + Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, Ptr{$T}, Ptr{BlasInt}, Ptr{BlasInt}, + Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, Ptr{BlasInt}), + &rvec, howmny, select, d, z, &ldz, sigma, + bmat, &n, evtype, &nev, tol, resid, &ncv, v, &ldv, + iparam, ipntr, workd, workl, &lworkl, info) + end - ccall(($(string(seupd)), libarpack), Void, - (Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, - Ptr{$T}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, - Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, Ptr{$T}, Ptr{BlasInt}, Ptr{BlasInt}, - Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, Ptr{BlasInt}), - &rvec, howmny, select, d, v, &n, sigma, - bmat, &n, evtype, &nev, tol, resid, &ncv, v, &n, - iparam, ipntr, workd, workl, &lworkl, info) - if info[1] != 0 error("error code $(info[1]) from ARPACK eupd") end - return rvec ? (d, v[1:n, 1:nev]) : d - end - dr = Array($T, nev+1) - di = Array($T, nev+1) - sigmar = zeros($T, 1) - sigmai = zeros($T, 1) - workev = Array($T, 3*ncv) - ccall(($(string(neupd)), libarpack), Void, - (Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{$T}, - Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{$T}, Ptr{Uint8}, Ptr{BlasInt}, - Ptr{Uint8}, Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, Ptr{$T}, - Ptr{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, - Ptr{BlasInt}, Ptr{BlasInt}), - &rvec, howmny, select, dr, di, v, &n, sigmar, sigmai, - workev, bmat, &n, evtype, &nev, tol, resid, &ncv, v, &n, - iparam, ipntr, workd, workl, &lworkl, info) - if info[1] != 0 error("error code $(info[1]) from ARPACK eupd") end - evec = complex(zeros($T, n, nev+1), zeros($T, n, nev+1)) - j = 1 - while j <= nev - if di[j] == 0.0 - evec[:,j] = v[:,j] - else - evec[:,j] = v[:,j] + im*v[:,j+1] - evec[:,j+1] = v[:,j] - im*v[:,j+1] - j += 1 - end - j += 1 - end - complex(dr[1:nev],di[1:nev]), evec[1:n, 1:nev] - end - end + end end -for (T, TR, naupd, neupd) in +for (T, TR, naupd_name, neupd_name) in ((:Complex128, :Float64, :znaupd_, :zneupd_), (:Complex64, :Float32, :cnaupd_, :cneupd_)) - @eval begin - function eigs(A::AbstractMatrix{$T}, nev::Integer, evtype::ASCIIString, rvec::Bool) - (m, n) = size(A) - if m != n error("eigs: matrix A is $m by $n but must be square") end - if n <= nev nev = n - 1 end - - ncv = min(max(nev*2, 20), n) -# if ncv-nev < 2 || ncv > n error("Compute fewer eigenvalues using eigs(A, k)") end - - bmat = "I" - lworkl = ncv * (3*ncv + 5) - - v = Array($T, n, ncv) - workd = Array($T, 3*n) - workl = Array($T, lworkl) - rwork = Array($TR, ncv) - resid = Array($T, n) - select = Array(BlasInt, ncv) - iparam = zeros(BlasInt, 11) - ipntr = zeros(BlasInt, 14) - - tol = zeros($TR, 1) - ido = zeros(BlasInt, 1) - info = zeros(BlasInt, 1) - - iparam[1] = blas_int(1) # ishifts - iparam[3] = blas_int(1000) # maxitr - iparam[7] = blas_int(1) # mode 1 - - zernm1 = 0:(n-1) - - while true - ccall(($(string(naupd)), libarpack), Void, - (Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, - Ptr{$TR}, Ptr{$T}, Ptr{BlasInt}, Ptr{$T}, Ptr{BlasInt}, - Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, - Ptr{$TR}, Ptr{BlasInt}), - ido, bmat, &n, evtype, &nev, tol, resid, &ncv, v, &n, - iparam, ipntr, workd, workl, &lworkl, rwork, info) - if info[1] != 0 error("error code $(info[1]) from ARPACK aupd") end - if (ido[1] != -1 && ido[1] != 1) break end - workd[ipntr[2]+zernm1] = A*getindex(workd, ipntr[1]+zernm1) - end - - howmny = "A" - - d = Array($T, nev+1) - sigma = zeros($T, 1) - workev = Array($T, 2ncv) - ccall(($(string(neupd)), libarpack), Void, - (Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, - Ptr{$T}, Ptr{$T}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, - Ptr{$TR}, Ptr{$T}, Ptr{BlasInt}, Ptr{$T}, Ptr{BlasInt}, Ptr{BlasInt}, - Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, Ptr{$TR}, Ptr{BlasInt}), - &rvec, howmny, select, d, v, &n, workev, sigma, - bmat, &n, evtype, &nev, tol, resid, &ncv, v, &n, - iparam, ipntr, workd, workl, &lworkl, rwork, info) - if info[1] != 0 error("error code $(info[1]) from ARPACK eupd") end - rvec ? (d, v[1:n, 1:nev]) : d - end - end -end - -eigs(A::AbstractMatrix, nev::Integer, typ::ASCIIString) = eigs(A, nev, which, true) -eigs(A::AbstractMatrix, nev::Integer, rvec::Bool) = eigs(A, nev, "LM", rvec) -eigs(A::AbstractMatrix, rvec::Bool) = eigs(A, 6, "LM", rvec) -eigs(A::AbstractMatrix, nev::Integer) = eigs(A, nev, "LM", true) -eigs(A::AbstractMatrix) = eigs(A, 6, "LM", true) - - -# For a dense matrix A is ignored and At is actually A'*A -sarupdate{T}(A::StridedMatrix{T}, At::StridedMatrix{T}, X::StridedVector{T}) = BLAS.symv('U', one(T), At, X) -sarupdate{Tv,Ti}(A::SparseMatrixCSC{Tv,Ti}, At::SparseMatrixCSC{Tv,Ti}, X::StridedVector{Tv}) = At*(A*X) - -for (T, saupd, seupd) in ((:Float64, :dsaupd_, :dseupd_), (:Float32, :ssaupd_, :sseupd_)) - @eval begin - function svds(A::AbstractMatrix{$T}, nev::Integer, which::ASCIIString, rvec::Bool) - (m, n) = size(A) - if m < n error("m = $m, n = $n and only the m >= n case is implemented") end - if n <= nev nev = n - 1 end - - At = isa(A, StridedMatrix) ? BLAS.syrk('U','T',1.,A) : A' - - ncv = min(max(nev*2, 20), n) - lworkl = ncv*(ncv+8) - - v = Array($T, n, ncv) - workd = Array($T, 3n) - workl = Array($T, lworkl) - resid = Array($T, n) - select = Array(BlasInt, ncv) - iparam = zeros(BlasInt, 11) - iparam[1] = 1 # ishifts - iparam[3] = 1000 # maxitr - iparam[7] = 1 # mode 1 - ipntr = zeros(BlasInt, 14) - - tol = zeros($T, 1) - sigma = zeros($T, 1) - ido = zeros(BlasInt, 1) - info = Array(BlasInt, 1) - bmat = "I" - zernm1 = 0:(n-1) - - while true - ccall(($(string(saupd)), libarpack), Void, - (Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, - Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, Ptr{$T}, Ptr{BlasInt}, - Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, Ptr{BlasInt}), - ido, bmat, &n, which, &nev, tol, resid, &ncv, v, &n, - iparam, ipntr, workd, workl, &lworkl, info) - if (info[1] < 0) error("error code $(info[1]) from ARPACK saupd") end - if (ido[1] != -1 && ido[1] != 1) break end - workd[ipntr[2]+zernm1] = sarupdate(A, At, getindex(workd, ipntr[1]+zernm1)) - end - - d = Array($T, nev) - howmny = "A" + @eval begin - ccall(($(string(seupd)), libarpack), Void, - (Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, Ptr{$T}, - Ptr{Uint8}, Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, - Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, Ptr{$T}, Ptr{BlasInt}, Ptr{BlasInt}, - Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, Ptr{BlasInt}), - &rvec, howmny, select, d, v, &n, sigma, - bmat, &n, which, &nev, tol, resid, &ncv, v, &n, - iparam, ipntr, workd, workl, &lworkl, info) - if info[1] != 0 error("error code $(info[1]) from ARPACK eupd") end - d = sqrt(d) - if !rvec return d end - v = v[1:n, 1:nev] - A*v*diagm(1./d), d, v.' - end - end + function naupd(ido, bmat, n, evtype, nev, tol, resid, ncv, v, ldv, + iparam, ipntr, workd::Array{$T}, workl::Array{$T}, lworkl, + rwork::Array{$TR}, info) + + ccall(($(string(naupd_name)), libarpack), Void, + (Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, + Ptr{$TR}, Ptr{$T}, Ptr{BlasInt}, Ptr{$T}, Ptr{BlasInt}, + Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, + Ptr{$TR}, Ptr{BlasInt}), + ido, bmat, &n, evtype, &nev, tol, resid, &ncv, v, &ldv, + iparam, ipntr, workd, workl, &lworkl, rwork, info) + + end + + function neupd(rvec, howmny, select, d, z, ldz, workev, sigma, + bmat, n, evtype, nev, tol, resid, ncv, v, ldv, + iparam, ipntr, workd::Array{$T}, workl::Array{$T}, lworkl, + rwork::Array{$TR}, info) + + ccall(($(string(neupd_name)), libarpack), Void, + (Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, + Ptr{$T}, Ptr{$T}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{Uint8}, Ptr{BlasInt}, + Ptr{$TR}, Ptr{$T}, Ptr{BlasInt}, Ptr{$T}, Ptr{BlasInt}, Ptr{BlasInt}, + Ptr{BlasInt}, Ptr{$T}, Ptr{$T}, Ptr{BlasInt}, Ptr{$TR}, Ptr{BlasInt}), + &rvec, howmny, select, d, z, &ldz, workev, sigma, + bmat, &n, evtype, &nev, tol, resid, &ncv, v, &ldv, + iparam, ipntr, workd, workl, &lworkl, rwork, info) + + end + + end end -svds(A::AbstractMatrix, nev::Integer, which::ASCIIString) = svds(A, nev, which, true) -svds(A::AbstractMatrix, nev::Integer, rvec::Bool) = svds(A, nev, "LA", rvec) -svds(A::AbstractMatrix, rvec::Bool) = svds(A, 6, "LA", rvec) -svds(A::AbstractMatrix, nev::Integer) = svds(A, nev, "LA", true) -svds(A::AbstractMatrix) = svds(A, 6, "LA", true) - end # module ARPACK diff --git a/base/linalg/linalg.jl b/base/linalg/linalg.jl index ba0beec179672..93b94e91f7888 100644 --- a/base/linalg/linalg.jl +++ b/base/linalg/linalg.jl @@ -11,5 +11,6 @@ include("linalg/tridiag.jl") include("linalg/rectfullpacked.jl") include("linalg/bitarray.jl") include("linalg/sparse.jl") -include("linalg/arpack.jl") include("linalg/suitesparse.jl") +include("linalg/arpack.jl") +include("linalg/arnoldi.jl") diff --git a/test/arpack.jl b/test/arpack.jl index c700a7121bdb3..7cf29e3889d9f 100644 --- a/test/arpack.jl +++ b/test/arpack.jl @@ -1,6 +1,3 @@ -import ARPACK.eigs -import ARPACK.svds - begin local n,a,asym,d,v n = 10 From 1c109d2e16a46e7cc2690edb8ae8cb4c2afec01d Mon Sep 17 00:00:00 2001 From: "Viral B. Shah" Date: Tue, 12 Mar 2013 15:05:19 +0530 Subject: [PATCH 16/29] Put all of linalg in a LinAlg module. --- base/exports.jl | 3 +- base/linalg/arpack.jl | 4 +- base/linalg/bitarray.jl | 10 +-- base/linalg/blas.jl | 21 ++---- base/linalg/dense.jl | 6 +- base/linalg/lapack.jl | 8 +-- base/linalg/linalg.jl | 142 ++++++++++++++++++++++++++++++++++++- base/linalg/matmul.jl | 8 +-- base/linalg/suitesparse.jl | 14 ++-- base/sysimg.jl | 3 +- test/blas.jl | 84 +++++++++++----------- test/linalg.jl | 8 +-- test/suitesparse.jl | 6 +- 13 files changed, 226 insertions(+), 91 deletions(-) diff --git a/base/exports.jl b/base/exports.jl index 5e7a70028b52e..163102b592357 100644 --- a/base/exports.jl +++ b/base/exports.jl @@ -3,6 +3,7 @@ export PCRE, FFTW, DSP, + LinAlg, BLAS, LAPACK, ARPACK, @@ -466,7 +467,6 @@ export cumsum_kbn, cummin, cummax, - diff, fill, fill!, find, @@ -559,6 +559,7 @@ export diagm, diagmm, diagmm!, + diff, dot, eig, eigs, diff --git a/base/linalg/arpack.jl b/base/linalg/arpack.jl index b085a2ae1b44e..0640387318b4a 100644 --- a/base/linalg/arpack.jl +++ b/base/linalg/arpack.jl @@ -4,8 +4,8 @@ const libarpack = "libarpack" export naupd, neupd, saupd, seupd -import Base.BlasInt -import Base.blas_int +import LinAlg.BlasInt +import LinAlg.blas_int for (T, saupd_name, seupd_name, naupd_name, neupd_name) in ((:Float64, :dsaupd_, :dseupd_, :dnaupd_, :dneupd_), diff --git a/base/linalg/bitarray.jl b/base/linalg/bitarray.jl index 2c2502f94a8f5..88b5c1252b981 100644 --- a/base/linalg/bitarray.jl +++ b/base/linalg/bitarray.jl @@ -42,7 +42,7 @@ function triu(B::BitMatrix, k::Int) A = falses(m,n) for i = max(k+1,1):n j = clamp((i - 1) * m + 1, 1, i * m) - copy_chunks(A.chunks, j, B.chunks, j, min(i-k, m)) + Base.copy_chunks(A.chunks, j, B.chunks, j, min(i-k, m)) end return A end @@ -53,7 +53,7 @@ function tril(B::BitMatrix, k::Int) A = falses(m, n) for i = 1:min(n, m+k) j = clamp((i - 1) * m + i - k, 1, i * m) - copy_chunks(A.chunks, j, B.chunks, j, max(m-i+k+1, 0)) + Base.copy_chunks(A.chunks, j, B.chunks, j, max(m-i+k+1, 0)) end return A end @@ -117,7 +117,7 @@ function kron(a::BitVector, b::BitVector) zS = zero(S) for j = 1:n if b[j] != zS - copy_chunks(R.chunks, (j-1)*m+1, a.chunks, 1, m) + Base.copy_chunks(R.chunks, (j-1)*m+1, a.chunks, 1, m) end end return R @@ -245,8 +245,8 @@ function findmin(a::BitArray) return (false, ti) end end - l = (@_mod64 (length(a)-1)) + 1 - msk = @_mskr l + l = (Base.@_mod64 (length(a)-1)) + 1 + msk = Base.@_mskr l k = trailing_ones(a.chunks[end] & msk) ti += k if k != l diff --git a/base/linalg/blas.jl b/base/linalg/blas.jl index 4d1b931c4542f..65bc539a3e75e 100644 --- a/base/linalg/blas.jl +++ b/base/linalg/blas.jl @@ -1,16 +1,7 @@ -typealias BlasFloat Union(Float64,Float32,Complex128,Complex64) -typealias BlasChar Char - -if USE_LIB64 - typealias BlasInt Int64 - blas_int(x) = int64(x) -else - typealias BlasInt Int32 - blas_int(x) = int32(x) -end - module BLAS +import Base.copy! + export copy!, scal!, scal, @@ -35,10 +26,10 @@ export copy!, const libblas = Base.libblas_name -import Base.BlasFloat -import Base.BlasChar -import Base.BlasInt -import Base.blas_int +import LinAlg.BlasFloat +import LinAlg.BlasChar +import LinAlg.BlasInt +import LinAlg.blas_int # SUBROUTINE DCOPY(N,DX,INCX,DY,INCY) for (fname, elty) in ((:dcopy_,:Float64), (:scopy_,:Float32), diff --git a/base/linalg/dense.jl b/base/linalg/dense.jl index 7c090bf9ad9f9..a5ab2bb56a45b 100644 --- a/base/linalg/dense.jl +++ b/base/linalg/dense.jl @@ -199,15 +199,15 @@ kron(a::Number, b::Matrix) = a * b randsym(n) = symmetrize!(randn(n,n)) -^(A::Matrix, p::Integer) = p < 0 ? inv(A^-p) : power_by_squaring(A,p) +^(A::Matrix, p::Integer) = p < 0 ? inv(A^-p) : Base.power_by_squaring(A,p) function ^(A::Matrix, p::Number) if integer_valued(p) ip = integer(real(p)) if ip < 0 - return inv(power_by_squaring(A, -ip)) + return inv(Base.power_by_squaring(A, -ip)) else - return power_by_squaring(A, ip) + return Base.power_by_squaring(A, ip) end end if size(A,1) != size(A,2) diff --git a/base/linalg/lapack.jl b/base/linalg/lapack.jl index a4de92a180b9b..88cd2183074ba 100644 --- a/base/linalg/lapack.jl +++ b/base/linalg/lapack.jl @@ -3,10 +3,10 @@ module LAPACK const liblapack = Base.liblapack_name -import Base.BlasFloat -import Base.BlasChar -import Base.BlasInt -import Base.blas_int +import LinAlg.BlasFloat +import LinAlg.BlasChar +import LinAlg.BlasInt +import LinAlg.blas_int type LAPACKException <: Exception info::BlasInt diff --git a/base/linalg/linalg.jl b/base/linalg/linalg.jl index 93b94e91f7888..b8da036136514 100644 --- a/base/linalg/linalg.jl +++ b/base/linalg/linalg.jl @@ -1,16 +1,156 @@ +module LinAlg + +importall Base +import Base.USE_LIB64, Base.size, Base.copy, Base.copy_transpose!, Base.power_by_squaring + +export +# Types + BunchKaufman, + SymTridiagonal, + Tridiagonal, + Woodbury, + Factorization, + BunchKaufman, + CholeskyDense, + CholeskyPivotedDense, + GSVDDense, + Hessenberg, + LUDense, + LUTridiagonal, + LDLTTridiagonal, + QRDense, + QRPivotedDense, + SVDDense, + Hermitian, + Triangular, + +# Functions + chol, + cholp, + cond, + copy!, + cross, + ctranspose, + det, + diag, + diagm, + diagmm, + diagmm!, + diff, + dot, + eig, + eigs, + eigvals, + expm, + sqrtm, + eye, + factors, + hess, + hessfact, + ishermitian, + isposdef, + isposdef!, + issym, + istril, + istriu, + kron, + ldltd!, + ldltd, + linreg, + logdet, + lu, + lufact, + lufact!, + norm, + normfro, + null, + pinv, + qr, + qrfact!, + qrfact, + qrp, + qrpfact!, + qrpfact, + qmulQR, + qTmulQR, + randsym, + rank, + rref, + scale!, + schur, + solve, + svd, + svdfact!, + svdfact, + svds, + svdvals!, + svdvals, + symmetrize!, + trace, + transpose, + tril, + triu, + tril!, + triu!, + +# Operators + \, + /, + A_ldiv_Bc, + A_ldiv_Bt, + A_mul_B, + A_mul_Bc, + A_mul_Bt, + A_rdiv_Bc, + A_rdiv_Bt, + Ac_ldiv_B, + Ac_ldiv_Bc, + Ac_mul_b_RFP, + Ac_mul_B, + Ac_mul_Bc, + Ac_rdiv_B, + Ac_rdiv_Bc, + At_ldiv_B, + At_ldiv_Bt, + At_mul_B, + At_mul_Bt, + At_rdiv_B, + At_rdiv_Bt + + + +typealias BlasFloat Union(Float64,Float32,Complex128,Complex64) +typealias BlasChar Char + +if USE_LIB64 + typealias BlasInt Int64 + blas_int(x) = int64(x) +else + typealias BlasInt Int32 + blas_int(x) = int32(x) +end + include("linalg/generic.jl") + include("linalg/blas.jl") -include("linalg/lapack.jl") include("linalg/matmul.jl") +include("linalg/lapack.jl") + include("linalg/dense.jl") include("linalg/factorization.jl") + include("linalg/bunchkaufman.jl") include("linalg/hermitian.jl") include("linalg/woodbury.jl") include("linalg/tridiag.jl") include("linalg/rectfullpacked.jl") + include("linalg/bitarray.jl") + include("linalg/sparse.jl") include("linalg/suitesparse.jl") + include("linalg/arpack.jl") include("linalg/arnoldi.jl") + +end # module LinAlg \ No newline at end of file diff --git a/base/linalg/matmul.jl b/base/linalg/matmul.jl index 01487e801a091..018920ff7e0a5 100644 --- a/base/linalg/matmul.jl +++ b/base/linalg/matmul.jl @@ -302,7 +302,7 @@ function copy!{R,S}(B::Matrix{R}, ir_dest::Range1{Int}, jr_dest::Range1{Int}, tM if tM == 'N' copy!(B, ir_dest, jr_dest, M, ir_src, jr_src) else - copy_transpose!(B, ir_dest, jr_dest, M, jr_src, ir_src) + Base.copy_transpose!(B, ir_dest, jr_dest, M, jr_src, ir_src) if tM == 'C' conj!(B) end @@ -311,7 +311,7 @@ end function copy_transpose!{R,S}(B::Matrix{R}, ir_dest::Range1{Int}, jr_dest::Range1{Int}, tM::Char, M::StridedMatrix{S}, ir_src::Range1{Int}, jr_src::Range1{Int}) if tM == 'N' - copy_transpose!(B, ir_dest, jr_dest, M, ir_src, jr_src) + Base.copy_transpose!(B, ir_dest, jr_dest, M, ir_src, jr_src) else copy!(B, ir_dest, jr_dest, M, jr_src, ir_src) if tM == 'C' @@ -408,7 +408,7 @@ function generic_matmatmul{T,S,R}(C::StridedMatrix{R}, tA, tB, A::StridedMatrix{ z = zero(R) if mA < tile_size && nA < tile_size && nB < tile_size - copy_transpose!(Atile, 1:nA, 1:mA, tA, A, 1:mA, 1:nA) + Base.copy_transpose!(Atile, 1:nA, 1:mA, tA, A, 1:mA, 1:nA) copy!(Btile, 1:mB, 1:nB, tB, B, 1:mB, 1:nB) for j = 1:nB boff = (j-1)*tile_size @@ -433,7 +433,7 @@ function generic_matmatmul{T,S,R}(C::StridedMatrix{R}, tA, tB, A::StridedMatrix{ for kb = 1:tile_size:nA klim = min(kb+tile_size-1,mB) klen = klim-kb+1 - copy_transpose!(Atile, 1:klen, 1:ilen, tA, A, ib:ilim, kb:klim) + Base.copy_transpose!(Atile, 1:klen, 1:ilen, tA, A, ib:ilim, kb:klim) copy!(Btile, 1:klen, 1:jlen, tB, B, kb:klim, jb:jlim) for j=1:jlen bcoff = (j-1)*tile_size diff --git a/base/linalg/suitesparse.jl b/base/linalg/suitesparse.jl index 4e3daddac0705..c7d12348853f0 100644 --- a/base/linalg/suitesparse.jl +++ b/base/linalg/suitesparse.jl @@ -41,18 +41,20 @@ import Base.(\) import Base.Ac_ldiv_B import Base.At_ldiv_B import Base.SparseMatrixCSC -import Base.chol import Base.copy -import Base.det -import Base.diagmm -import Base.findn_nzs -import Base.lu import Base.nnz +import Base.findn_nzs import Base.show import Base.size -import Base.solve import Base.convert +import LinAlg.Factorization +import LinAlg.chol +import LinAlg.det +import LinAlg.diagmm +import LinAlg.lu +import LinAlg.solve + include("linalg/suitesparse_h.jl") type MatrixIllConditionedException <: Exception end diff --git a/base/sysimg.jl b/base/sysimg.jl index 48d7d7b380b26..d61322e40870a 100644 --- a/base/sysimg.jl +++ b/base/sysimg.jl @@ -149,9 +149,10 @@ include("util.jl") include("test.jl") include("meta.jl") -# linear algebra +# sparse matrices and linear algebra include("sparse.jl") include("linalg/linalg.jl") +importall LinAlg # signal processing include("fftw.jl") diff --git a/test/blas.jl b/test/blas.jl index 2a12ce27baa52..c4aa8e97ececa 100644 --- a/test/blas.jl +++ b/test/blas.jl @@ -14,65 +14,65 @@ for elty in (Float32, Float64, Complex64, Complex128) v14 = convert(Vector{elty}, [1:4]) v41 = convert(Vector{elty}, [4:-1:1]) # gemv - @assert all(BLAS.gemv('N', I4, o4) .== o4) - @assert all(BLAS.gemv('T', I4, o4) .== o4) - @assert all(BLAS.gemv('N', el2, I4, o4) .== el2 * o4) - @assert all(BLAS.gemv('T', el2, I4, o4) .== el2 * o4) + @assert all(LinAlg.BLAS.gemv('N', I4, o4) .== o4) + @assert all(LinAlg.BLAS.gemv('T', I4, o4) .== o4) + @assert all(LinAlg.BLAS.gemv('N', el2, I4, o4) .== el2 * o4) + @assert all(LinAlg.BLAS.gemv('T', el2, I4, o4) .== el2 * o4) o4cp = copy(o4) - @assert all(BLAS.gemv!('N', one(elty), I4, o4, elm1, o4cp) .== z4) + @assert all(LinAlg.BLAS.gemv!('N', one(elty), I4, o4, elm1, o4cp) .== z4) @assert all(o4cp .== z4) o4cp[:] = o4 - @assert all(BLAS.gemv!('T', one(elty), I4, o4, elm1, o4cp) .== z4) + @assert all(LinAlg.BLAS.gemv!('T', one(elty), I4, o4, elm1, o4cp) .== z4) @assert all(o4cp .== z4) - @assert all(BLAS.gemv('N', U4, o4) .== v41) - @assert all(BLAS.gemv('N', U4, o4) .== v41) + @assert all(LinAlg.BLAS.gemv('N', U4, o4) .== v41) + @assert all(LinAlg.BLAS.gemv('N', U4, o4) .== v41) # gemm - @assert all(BLAS.gemm('N', 'N', I4, I4) .== I4) - @assert all(BLAS.gemm('N', 'T', I4, I4) .== I4) - @assert all(BLAS.gemm('T', 'N', I4, I4) .== I4) - @assert all(BLAS.gemm('T', 'T', I4, I4) .== I4) - @assert all(BLAS.gemm('N', 'N', el2, I4, I4) .== el2 * I4) - @assert all(BLAS.gemm('N', 'T', el2, I4, I4) .== el2 * I4) - @assert all(BLAS.gemm('T', 'N', el2, I4, I4) .== el2 * I4) - @assert all(BLAS.gemm('T', 'T', el2, I4, I4) .== el2 * I4) + @assert all(LinAlg.BLAS.gemm('N', 'N', I4, I4) .== I4) + @assert all(LinAlg.BLAS.gemm('N', 'T', I4, I4) .== I4) + @assert all(LinAlg.BLAS.gemm('T', 'N', I4, I4) .== I4) + @assert all(LinAlg.BLAS.gemm('T', 'T', I4, I4) .== I4) + @assert all(LinAlg.BLAS.gemm('N', 'N', el2, I4, I4) .== el2 * I4) + @assert all(LinAlg.BLAS.gemm('N', 'T', el2, I4, I4) .== el2 * I4) + @assert all(LinAlg.BLAS.gemm('T', 'N', el2, I4, I4) .== el2 * I4) + @assert all(LinAlg.BLAS.gemm('T', 'T', el2, I4, I4) .== el2 * I4) I4cp = copy(I4) - @assert all(BLAS.gemm!('N', 'N', one(elty), I4, I4, elm1, I4cp) .== Z4) + @assert all(LinAlg.BLAS.gemm!('N', 'N', one(elty), I4, I4, elm1, I4cp) .== Z4) @assert all(I4cp .== Z4) I4cp[:] = I4 - @assert all(BLAS.gemm!('N', 'T', one(elty), I4, I4, elm1, I4cp) .== Z4) + @assert all(LinAlg.BLAS.gemm!('N', 'T', one(elty), I4, I4, elm1, I4cp) .== Z4) @assert all(I4cp .== Z4) I4cp[:] = I4 - @assert all(BLAS.gemm!('T', 'N', one(elty), I4, I4, elm1, I4cp) .== Z4) + @assert all(LinAlg.BLAS.gemm!('T', 'N', one(elty), I4, I4, elm1, I4cp) .== Z4) @assert all(I4cp .== Z4) I4cp[:] = I4 - @assert all(BLAS.gemm!('T', 'T', one(elty), I4, I4, elm1, I4cp) .== Z4) + @assert all(LinAlg.BLAS.gemm!('T', 'T', one(elty), I4, I4, elm1, I4cp) .== Z4) @assert all(I4cp .== Z4) - @assert all(BLAS.gemm('N', 'N', I4, U4) .== U4) - @assert all(BLAS.gemm('N', 'T', I4, U4) .== L4) + @assert all(LinAlg.BLAS.gemm('N', 'N', I4, U4) .== U4) + @assert all(LinAlg.BLAS.gemm('N', 'T', I4, U4) .== L4) # gemm compared to (sy)(he)rk if iscomplex(elm1) - @assert all(triu(BLAS.herk('U', 'N', U4)) .== triu(BLAS.gemm('N', 'T', U4, U4))) - @assert all(tril(BLAS.herk('L', 'N', U4)) .== tril(BLAS.gemm('N', 'T', U4, U4))) - @assert all(triu(BLAS.herk('U', 'N', L4)) .== triu(BLAS.gemm('N', 'T', L4, L4))) - @assert all(tril(BLAS.herk('L', 'N', L4)) .== tril(BLAS.gemm('N', 'T', L4, L4))) - @assert all(triu(BLAS.herk('U', 'C', U4)) .== triu(BLAS.gemm('T', 'N', U4, U4))) - @assert all(tril(BLAS.herk('L', 'C', U4)) .== tril(BLAS.gemm('T', 'N', U4, U4))) - @assert all(triu(BLAS.herk('U', 'C', L4)) .== triu(BLAS.gemm('T', 'N', L4, L4))) - @assert all(tril(BLAS.herk('L', 'C', L4)) .== tril(BLAS.gemm('T', 'N', L4, L4))) + @assert all(triu(LinAlg.BLAS.herk('U', 'N', U4)) .== triu(LinAlg.BLAS.gemm('N', 'T', U4, U4))) + @assert all(tril(LinAlg.BLAS.herk('L', 'N', U4)) .== tril(LinAlg.BLAS.gemm('N', 'T', U4, U4))) + @assert all(triu(LinAlg.BLAS.herk('U', 'N', L4)) .== triu(LinAlg.BLAS.gemm('N', 'T', L4, L4))) + @assert all(tril(LinAlg.BLAS.herk('L', 'N', L4)) .== tril(LinAlg.BLAS.gemm('N', 'T', L4, L4))) + @assert all(triu(LinAlg.BLAS.herk('U', 'C', U4)) .== triu(LinAlg.BLAS.gemm('T', 'N', U4, U4))) + @assert all(tril(LinAlg.BLAS.herk('L', 'C', U4)) .== tril(LinAlg.BLAS.gemm('T', 'N', U4, U4))) + @assert all(triu(LinAlg.BLAS.herk('U', 'C', L4)) .== triu(LinAlg.BLAS.gemm('T', 'N', L4, L4))) + @assert all(tril(LinAlg.BLAS.herk('L', 'C', L4)) .== tril(LinAlg.BLAS.gemm('T', 'N', L4, L4))) ans = similar(L4) - @assert all(tril(BLAS.herk('L','C', L4)) .== tril(BLAS.herk!('L', 'C', one(elty), L4, zero(elty), ans))) - @assert all(symmetrize!(ans, 'L') .== BLAS.gemm('T', 'N', L4, L4)) + @assert all(tril(LinAlg.BLAS.herk('L','C', L4)) .== tril(LinAlg.BLAS.herk!('L', 'C', one(elty), L4, zero(elty), ans))) + @assert all(symmetrize!(ans, 'L') .== LinAlg.BLAS.gemm('T', 'N', L4, L4)) else - @assert all(triu(BLAS.syrk('U', 'N', U4)) .== triu(BLAS.gemm('N', 'T', U4, U4))) - @assert all(tril(BLAS.syrk('L', 'N', U4)) .== tril(BLAS.gemm('N', 'T', U4, U4))) - @assert all(triu(BLAS.syrk('U', 'N', L4)) .== triu(BLAS.gemm('N', 'T', L4, L4))) - @assert all(tril(BLAS.syrk('L', 'N', L4)) .== tril(BLAS.gemm('N', 'T', L4, L4))) - @assert all(triu(BLAS.syrk('U', 'T', U4)) .== triu(BLAS.gemm('T', 'N', U4, U4))) - @assert all(tril(BLAS.syrk('L', 'T', U4)) .== tril(BLAS.gemm('T', 'N', U4, U4))) - @assert all(triu(BLAS.syrk('U', 'T', L4)) .== triu(BLAS.gemm('T', 'N', L4, L4))) - @assert all(tril(BLAS.syrk('L', 'T', L4)) .== tril(BLAS.gemm('T', 'N', L4, L4))) + @assert all(triu(LinAlg.BLAS.syrk('U', 'N', U4)) .== triu(LinAlg.BLAS.gemm('N', 'T', U4, U4))) + @assert all(tril(LinAlg.BLAS.syrk('L', 'N', U4)) .== tril(LinAlg.BLAS.gemm('N', 'T', U4, U4))) + @assert all(triu(LinAlg.BLAS.syrk('U', 'N', L4)) .== triu(LinAlg.BLAS.gemm('N', 'T', L4, L4))) + @assert all(tril(LinAlg.BLAS.syrk('L', 'N', L4)) .== tril(LinAlg.BLAS.gemm('N', 'T', L4, L4))) + @assert all(triu(LinAlg.BLAS.syrk('U', 'T', U4)) .== triu(LinAlg.BLAS.gemm('T', 'N', U4, U4))) + @assert all(tril(LinAlg.BLAS.syrk('L', 'T', U4)) .== tril(LinAlg.BLAS.gemm('T', 'N', U4, U4))) + @assert all(triu(LinAlg.BLAS.syrk('U', 'T', L4)) .== triu(LinAlg.BLAS.gemm('T', 'N', L4, L4))) + @assert all(tril(LinAlg.BLAS.syrk('L', 'T', L4)) .== tril(LinAlg.BLAS.gemm('T', 'N', L4, L4))) ans = similar(L4) - @assert all(tril(BLAS.syrk('L','T', L4)) .== tril(BLAS.syrk!('L', 'T', one(elty), L4, zero(elty), ans))) - @assert all(symmetrize!(ans, 'L') .== BLAS.gemm('T', 'N', L4, L4)) + @assert all(tril(LinAlg.BLAS.syrk('L','T', L4)) .== tril(LinAlg.BLAS.syrk!('L', 'T', one(elty), L4, zero(elty), ans))) + @assert all(symmetrize!(ans, 'L') .== LinAlg.BLAS.gemm('T', 'N', L4, L4)) end end diff --git a/test/linalg.jl b/test/linalg.jl index 4ba4ed622c4cc..985018d61a9e4 100644 --- a/test/linalg.jl +++ b/test/linalg.jl @@ -352,12 +352,12 @@ for elty in (Float32, Float64, Complex64, Complex128) # syevr! A = convert(Array{elty, 2}, Ainit) Asym = A'A - vals, Z = LAPACK.syevr!('V', copy(Asym)) + vals, Z = LinAlg.LAPACK.syevr!('V', copy(Asym)) @test_approx_eq Z*diagmm(vals, Z') Asym @test all(vals .> 0.0) - @test_approx_eq LAPACK.syevr!('N','V','U',copy(Asym),0.0,1.0,4,5,-1.0)[1] vals[vals .< 1.0] - @test_approx_eq LAPACK.syevr!('N','I','U',copy(Asym),0.0,1.0,4,5,-1.0)[1] vals[4:5] - @test_approx_eq vals LAPACK.syev!('N','U',copy(Asym)) + @test_approx_eq LinAlg.LAPACK.syevr!('N','V','U',copy(Asym),0.0,1.0,4,5,-1.0)[1] vals[vals .< 1.0] + @test_approx_eq LinAlg.LAPACK.syevr!('N','I','U',copy(Asym),0.0,1.0,4,5,-1.0)[1] vals[4:5] + @test_approx_eq vals LinAlg.LAPACK.syev!('N','U',copy(Asym)) end ## Issue related tests diff --git a/test/suitesparse.jl b/test/suitesparse.jl index 4a783e2f8f636..bd53bc28949cb 100644 --- a/test/suitesparse.jl +++ b/test/suitesparse.jl @@ -2,7 +2,7 @@ se33 = speye(3) do33 = ones(3) @test isequal(se33 \ do33, do33) -using Base.SuiteSparse +using Base.LinAlg.SuiteSparse # based on deps/Suitesparse-4.0.2/UMFPACK/Demo/umfpack_di_demo.c @@ -99,7 +99,7 @@ rowval0 = int32([0,1,2,1,2,3,0,2,4,0,1,5,0,4,6,1,3,7,2,8,1,3,7,8,9,0,4,6,8,10,5, 31,35,37,14,15,32,34,38,14,15,33,37,38,39,16,32,34,36,38,40,12,17,31,35,36, 37,41,12,16,17,18,23,36,40,42,13,14,15,19,37,39,43,13,14,15,20,21,38,43,44, 13,14,15,20,21,37,39,43,44,45,12,16,17,22,36,40,42,46,12,16,17,18,23,41,42,46,47]) -A = CholmodSparse{Float64,Int32}(Base.SuiteSparse.c_CholmodSparse{Float64,Int32}(48,48,224, +A = CholmodSparse{Float64,Int32}(Base.LinAlg.SuiteSparse.c_CholmodSparse{Float64,Int32}(48,48,224, convert(Ptr{Int32}, colptr0), convert(Ptr{Int32}, rowval0), C_NULL, @@ -130,7 +130,7 @@ rowval0 = int32([2,3,6,7,8,9,12,13,16,17,18,19,20,21,22,23,24,25,26,0,1,2,23,0,3 6,24,4,5,7,24,4,5,8,24,4,5,9,24,6,20,7,20,8,20,9,20,3,4,4,22,5,26,10,11,12,21, 10,13,10,23,10,20,11,25,14,15,16,22,14,15,17,22,14,15,18,22,14,15,19,22,16,20, 17,20,18,20,19,20,13,15,15,24,14,26,15]) -afiro = CholmodSparse{Float64,Int32}(Base.SuiteSparse.c_CholmodSparse{Float64,Int32}(27,51,102, +afiro = CholmodSparse{Float64,Int32}(Base.LinAlg.SuiteSparse.c_CholmodSparse{Float64,Int32}(27,51,102, convert(Ptr{Int32}, colptr0), convert(Ptr{Int32}, rowval0), C_NULL, From ddd6b8ce32e6498ca4def0a4a34512ee190e92a9 Mon Sep 17 00:00:00 2001 From: "Viral B. Shah" Date: Tue, 12 Mar 2013 18:29:53 +0530 Subject: [PATCH 17/29] Refactor ARPACK interface further with aupd_wrapper and eupd_wrapper. --- base/linalg/arnoldi.jl | 263 ++++++++++++++++++----------------------- test/arpack.jl | 2 +- 2 files changed, 113 insertions(+), 152 deletions(-) diff --git a/base/linalg/arnoldi.jl b/base/linalg/arnoldi.jl index 5c7a40482577b..4d1c8e162e312 100644 --- a/base/linalg/arnoldi.jl +++ b/base/linalg/arnoldi.jl @@ -1,108 +1,80 @@ using ARPACK -# For a dense matrix A is ignored and At is actually A'*A -sarupdate{T}(A::StridedMatrix{T}, At::StridedMatrix{T}, X::StridedVector{T}) = BLAS.symv('U', one(T), At, X) -sarupdate{Tv,Ti}(A::SparseMatrixCSC{Tv,Ti}, At::SparseMatrixCSC{Tv,Ti}, X::StridedVector{Tv}) = At*(A*X) +## eigs -function eigs{T<:Union(Float64,Float32)}(A::AbstractMatrix{T}, nev::Integer, evtype::ASCIIString, rvec::Bool) +function eigs{T <: BlasFloat}(A::AbstractMatrix{T}, nev::Integer, evtype::ASCIIString, rvec::Bool) (m, n) = size(A) - if m != n error("eigs: matrix A is $m by $n but must be square") end - sym = issym(A) - if n <= nev nev = n - 1 end + if m != n; error("Input must be square"); end + sym = issym(A) + cmplx = iscomplex(A) + bmat = "I" - ncv = min(max(nev*2, 20), n) -# if ncv-nev < 2 || ncv > n error("Compute fewer eigenvalues using eigs(A, k)") end + # Compute the Ritz values and Ritz vectors + (select, tol, resid, ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, rwork) = + aupd_wrapper(T, n, sym, cmplx, bmat, nev, evtype, (x) -> A * x) - bmat = "I" - lworkl = sym ? ncv * (ncv + 8) : ncv * (3*ncv + 6) + # Postprocessing to get eigenvalues and eigenvectors + return eupd_wrapper(T, n, sym, cmplx, bmat, nev, evtype, rvec, + select, tol, resid, ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, rwork) - v = Array(T, n, ncv) - workd = Array(T, 3*n) - workl = Array(T, lworkl) - resid = Array(T, n) - select = Array(BlasInt, ncv) - iparam = zeros(BlasInt, 11) - ipntr = zeros(BlasInt, 14) +end - tol = zeros(T, 1) - ido = zeros(BlasInt, 1) - info = zeros(BlasInt, 1) +eigs(A::AbstractMatrix, nev::Integer, typ::ASCIIString) = eigs(A, nev, which, true) +eigs(A::AbstractMatrix, nev::Integer, rvec::Bool) = eigs(A, nev, "LM", rvec) +eigs(A::AbstractMatrix, rvec::Bool) = eigs(A, 6, "LM", rvec) +eigs(A::AbstractMatrix, nev::Integer) = eigs(A, nev, "LM", true) +eigs(A::AbstractMatrix) = eigs(A, 6, "LM", true) - iparam[1] = blas_int(1) # ishifts - iparam[3] = blas_int(1000) # maxitr - iparam[7] = blas_int(1) # mode 1 +## svds - zernm1 = 0:(n-1) +# For a dense matrix A is ignored and At is actually A'*A +sarupdate{T}(A::StridedMatrix{T}, At::StridedMatrix{T}, X::StridedVector{T}) = BLAS.symv('U', one(T), At, X) +sarupdate{Tv,Ti}(A::SparseMatrixCSC{Tv,Ti}, At::SparseMatrixCSC{Tv,Ti}, X::StridedVector{Tv}) = At*(A*X) - while true - if sym - saupd(ido, bmat, n, evtype, nev, tol, resid, ncv, v, n, - iparam, ipntr, workd, workl, lworkl, info) - else - naupd(ido, bmat, n, evtype, nev, tol, resid, ncv, v, n, - iparam, ipntr, workd, workl, lworkl, info) - end - if info[1] != 0; error("error code $(info[1]) from ARPACK aupd"); end - if (ido[1] != -1 && ido[1] != 1); break; end - workd[ipntr[2]+zernm1] = A*getindex(workd, ipntr[1]+zernm1) - end +function svds{T <: Union(Float64,Float32)}(A::AbstractMatrix{T}, nev::Integer, + which::ASCIIString, rvec::Bool) - howmny = "A" + (m, n) = size(A) + if m < n error("m = $m, n = $n and only the m >= n case is implemented") end + sym = true + cmplx = false + bmat = "I" + At = isa(A, StridedMatrix) ? BLAS.syrk('U','T',1.0,A) : A' + + # Compute the Ritz values and Ritz vectors + (select, tol, resid, ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, rwork) = + aupd_wrapper(T, n, sym, cmplx, bmat, nev, which, (x) -> sarupdate(A, At, x)) + + # Postprocessing to get eigenvalues and eigenvectors + (svals, svecs) = eupd_wrapper(T, n, sym, cmplx, bmat, nev, which, rvec, + select, tol, resid, ncv, v, ldv, iparam, ipntr, + workd, workl, lworkl, rwork) - if sym - d = Array(T, nev) - sigma = zeros(T, 1) + svals = sqrt(svals) + rvec ? (A*svecs*diagm(1./svals), svals, v.') : svals +end - seupd(rvec, howmny, select, d, v, n, sigma, - bmat, n, evtype, nev, tol, resid, ncv, v, n, - iparam, ipntr, workd, workl, lworkl, info) - - if info[1] != 0; error("error code $(info[1]) from ARPACK eupd"); end - return rvec ? (d, v[1:n, 1:nev]) : d - end +svds(A::AbstractMatrix, nev::Integer, which::ASCIIString) = svds(A, nev, which, true) +svds(A::AbstractMatrix, nev::Integer, rvec::Bool) = svds(A, nev, "LA", rvec) +svds(A::AbstractMatrix, rvec::Bool) = svds(A, 6, "LA", rvec) +svds(A::AbstractMatrix, nev::Integer) = svds(A, nev, "LA", true) +svds(A::AbstractMatrix) = svds(A, 6, "LA", true) - dr = Array(T, nev+1) - di = Array(T, nev+1) - sigmar = zeros(T, 1) - sigmai = zeros(T, 1) - workev = Array(T, 3*ncv) - - neupd(rvec, howmny, select, dr, di, v, n, sigmar, sigmai, - workev, bmat, n, evtype, nev, tol, resid, ncv, v, n, - iparam, ipntr, workd, workl, lworkl, info) - - if info[1] != 0; error("error code $(info[1]) from ARPACK eupd"); end - evec = complex(zeros(T, n, nev+1), zeros(T, n, nev+1)) - j = 1 - while j <= nev - if di[j] == 0.0 - evec[:,j] = v[:,j] - else - evec[:,j] = v[:,j] + im*v[:,j+1] - evec[:,j+1] = v[:,j] - im*v[:,j+1] - j += 1 - end - j += 1 - end - return (complex(dr[1:nev],di[1:nev]), evec[1:n, 1:nev]) -end +## aupd and eupd wrappers -function eigs{T<:Union(Complex128,Complex64)}(A::AbstractMatrix{T}, nev::Integer, evtype::ASCIIString, rvec::Bool) - (m, n) = size(A) - if m != n error("eigs: matrix A is $m by $n but must be square") end - if n <= nev nev = n - 1 end +function aupd_wrapper(T, n::Integer, sym::Bool, cmplx::Bool, bmat::ASCIIString, + nev::Integer, evtype::ASCIIString, linop::Function) ncv = min(max(nev*2, 20), n) -# if ncv-nev < 2 || ncv > n error("Compute fewer eigenvalues using eigs(A, k)") end bmat = "I" - lworkl = ncv * (3*ncv + 5) + lworkl = cmplx ? ncv * (3*ncv + 5) : ( lworkl = sym ? ncv * (ncv + 8) : ncv * (3*ncv + 6) ) v = Array(T, n, ncv) TR = typeof(real(v[1])) workd = Array(T, 3*n) workl = Array(T, lworkl) - rwork = Array(TR, ncv) + rwork = cmplx ? Array(TR, ncv) : Array(TR, 0) resid = Array(T, n) select = Array(BlasInt, ncv) iparam = zeros(BlasInt, 11) @@ -119,88 +91,77 @@ function eigs{T<:Union(Complex128,Complex64)}(A::AbstractMatrix{T}, nev::Integer zernm1 = 0:(n-1) while true - naupd(ido, bmat, n, evtype, nev, tol, resid, ncv, v, n, - iparam, ipntr, workd, workl, lworkl, rwork, info) - + if cmplx + naupd(ido, bmat, n, evtype, nev, tol, resid, ncv, v, n, + iparam, ipntr, workd, workl, lworkl, rwork, info) + elseif sym + saupd(ido, bmat, n, evtype, nev, tol, resid, ncv, v, n, + iparam, ipntr, workd, workl, lworkl, info) + else + naupd(ido, bmat, n, evtype, nev, tol, resid, ncv, v, n, + iparam, ipntr, workd, workl, lworkl, info) + end if info[1] != 0; error("error code $(info[1]) from ARPACK aupd"); end if (ido[1] != -1 && ido[1] != 1); break; end - workd[ipntr[2]+zernm1] = A*getindex(workd, ipntr[1]+zernm1) + workd[ipntr[2]+zernm1] = linop(getindex(workd, ipntr[1]+zernm1)) end - - howmny = "A" - - d = Array(T, nev+1) - sigma = zeros(T, 1) - workev = Array(T, 2ncv) - neupd(rvec, howmny, select, d, v, n, workev, sigma, - bmat, n, evtype, nev, tol, resid, ncv, v, n, - iparam, ipntr, workd, workl, lworkl, rwork, info) - if info[1] != 0; error("error code $(info[1]) from ARPACK eupd"); end - rvec ? (d, v[1:n, 1:nev]) : d + + return (select, tol, resid, ncv, v, n, iparam, ipntr, workd, workl, lworkl, rwork) end -eigs(A::AbstractMatrix, nev::Integer, typ::ASCIIString) = eigs(A, nev, which, true) -eigs(A::AbstractMatrix, nev::Integer, rvec::Bool) = eigs(A, nev, "LM", rvec) -eigs(A::AbstractMatrix, rvec::Bool) = eigs(A, 6, "LM", rvec) -eigs(A::AbstractMatrix, nev::Integer) = eigs(A, nev, "LM", true) -eigs(A::AbstractMatrix) = eigs(A, 6, "LM", true) +function eupd_wrapper(T, n::Integer, sym::Bool, cmplx::Bool, bmat::ASCIIString, + nev::Integer, evtype::ASCIIString, rvec::Bool, + select, tol, resid, ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, rwork) + howmny = "A" + info = zeros(BlasInt, 1) + + if cmplx -# For a dense matrix A is ignored and At is actually A'*A -sarupdate{T}(A::StridedMatrix{T}, At::StridedMatrix{T}, X::StridedVector{T}) = BLAS.symv('U', one(T), At, X) -sarupdate{Tv,Ti}(A::SparseMatrixCSC{Tv,Ti}, At::SparseMatrixCSC{Tv,Ti}, X::StridedVector{Tv}) = At*(A*X) + d = Array(T, nev+1) + sigma = zeros(T, 1) + workev = Array(T, 2ncv) + neupd(rvec, howmny, select, d, v, ldv, workev, sigma, + bmat, n, evtype, nev, tol, resid, ncv, v, ldv, + iparam, ipntr, workd, workl, lworkl, rwork, info) + if info[1] != 0; error("error code $(info[1]) from ARPACK eupd"); end + return rvec ? (d, v[1:n, 1:nev]) : d -function svds{T<:Union(Float64,Float32)}(A::AbstractMatrix{T}, nev::Integer, which::ASCIIString, rvec::Bool) - (m, n) = size(A) - if m < n error("m = $m, n = $n and only the m >= n case is implemented") end - if n <= nev nev = n - 1 end + elseif sym - At = isa(A, StridedMatrix) ? BLAS.syrk('U','T',1.,A) : A' - - ncv = min(max(nev*2, 20), n) - lworkl = ncv*(ncv+8) + d = Array(T, nev) + sigma = zeros(T, 1) + seupd(rvec, howmny, select, d, v, ldv, sigma, + bmat, n, evtype, nev, tol, resid, ncv, v, ldv, + iparam, ipntr, workd, workl, lworkl, info) + if info[1] != 0; error("error code $(info[1]) from ARPACK eupd"); end + return rvec ? (d, v[1:n, 1:nev]) : d - v = Array(T, n, ncv) - workd = Array(T, 3n) - workl = Array(T, lworkl) - resid = Array(T, n) - select = Array(BlasInt, ncv) - iparam = zeros(BlasInt, 11) - iparam[1] = 1 # ishifts - iparam[3] = 1000 # maxitr - iparam[7] = 1 # mode 1 - ipntr = zeros(BlasInt, 14) - - tol = zeros(T, 1) - sigma = zeros(T, 1) - ido = zeros(BlasInt, 1) - info = Array(BlasInt, 1) - bmat = "I" - zernm1 = 0:(n-1) + else - while true - saupd(ido, bmat, n, which, nev, tol, resid, ncv, v, n, + dr = Array(T, nev+1) + di = Array(T, nev+1) + sigmar = zeros(T, 1) + sigmai = zeros(T, 1) + workev = Array(T, 3*ncv) + neupd(rvec, howmny, select, dr, di, v, ldv, sigmar, sigmai, + workev, bmat, n, evtype, nev, tol, resid, ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info) - if (info[1] < 0) error("error code $(info[1]) from ARPACK saupd") end - if (ido[1] != -1 && ido[1] != 1); break; end - workd[ipntr[2]+zernm1] = sarupdate(A, At, getindex(workd, ipntr[1]+zernm1)) + if info[1] != 0; error("error code $(info[1]) from ARPACK eupd"); end + evec = complex(zeros(T, n, nev+1), zeros(T, n, nev+1)) + j = 1 + while j <= nev + if di[j] == 0.0 + evec[:,j] = v[:,j] + else + evec[:,j] = v[:,j] + im*v[:,j+1] + evec[:,j+1] = v[:,j] - im*v[:,j+1] + j += 1 + end + j += 1 + end + d = complex(dr[1:nev],di[1:nev]) + return rvec ? (d, evec[1:n, 1:nev]) : d end - - d = Array(T, nev) - howmny = "A" - - seupd(rvec, howmny, select, d, v, n, sigma, - bmat, n, which, nev, tol, resid, ncv, v, n, - iparam, ipntr, workd, workl, lworkl, info) - if info[1] != 0; error("error code $(info[1]) from ARPACK eupd"); end - d = sqrt(d) - if !rvec return d end - v = v[1:n, 1:nev] - A*v*diagm(1./d), d, v.' + end - -svds(A::AbstractMatrix, nev::Integer, which::ASCIIString) = svds(A, nev, which, true) -svds(A::AbstractMatrix, nev::Integer, rvec::Bool) = svds(A, nev, "LA", rvec) -svds(A::AbstractMatrix, rvec::Bool) = svds(A, 6, "LA", rvec) -svds(A::AbstractMatrix, nev::Integer) = svds(A, nev, "LA", true) -svds(A::AbstractMatrix) = svds(A, 6, "LA", true) diff --git a/test/arpack.jl b/test/arpack.jl index 7cf29e3889d9f..1d3ac5c018abc 100644 --- a/test/arpack.jl +++ b/test/arpack.jl @@ -2,7 +2,7 @@ begin local n,a,asym,d,v n = 10 a = rand(n,n) - asym = a+a'+n*eye(n) + asym = a' * a (d,v) = eigs(asym, 3) @test sum(asym*v[:,1]-d[1]*v[:,1]) < 1e-8 From dbf37cce90745a400af91d6e8b6a0872aaa790f0 Mon Sep 17 00:00:00 2001 From: Douglas Bates Date: Tue, 12 Mar 2013 16:27:02 -0500 Subject: [PATCH 18/29] Added diag and logdet methods for CholmodSparse and CholmodFactor Corrected the CholmodSparse external constructor from SparseMatrixCSC. --- base/linalg/suitesparse.jl | 93 ++++++++++++++++++++++++++++++++------ 1 file changed, 79 insertions(+), 14 deletions(-) diff --git a/base/linalg/suitesparse.jl b/base/linalg/suitesparse.jl index c7d12348853f0..d25c39d690ae5 100644 --- a/base/linalg/suitesparse.jl +++ b/base/linalg/suitesparse.jl @@ -42,6 +42,7 @@ import Base.Ac_ldiv_B import Base.At_ldiv_B import Base.SparseMatrixCSC import Base.copy + import Base.nnz import Base.findn_nzs import Base.show @@ -51,7 +52,9 @@ import Base.convert import LinAlg.Factorization import LinAlg.chol import LinAlg.det +import LinAlg.diag import LinAlg.diagmm +import LinAlg.logdet import LinAlg.lu import LinAlg.solve @@ -630,9 +633,9 @@ chm_print(cd::CholmodDense) = chm_print(cd, int32(4), "") function CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes}(A::SparseMatrixCSC{Tv,Ti}, stype::Integer) zerobased = A.colptr[1] == 0 - colptr0 = zerobased ? copy(aa.colptr) : decrement(aa.colptr) - rowval0 = zerobased ? copy(aa.rowptr) : decrement(aa.rowval) - nzval = copy(aa.nzval) + colptr0 = zerobased ? copy(A.colptr) : decrement(A.colptr) + rowval0 = zerobased ? copy(A.rowptr) : decrement(A.rowval) + nzval = copy(A.nzval) CholmodSparse{Tv,Ti}(c_CholmodSparse{Tv,Ti}(size(A,1),size(A,2), int(colptr0[end]), convert(Ptr{Ti}, colptr0), @@ -723,25 +726,45 @@ function size{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::CholmodSparse{Tv,Ti}, d::Integer) d == 1 ? cp.c.m : (d == 2 ? cp.c.n : 1) end -for (aat,cop,copsp,freesp,normsp,sdmult,speye,itype) in - (("cholmod_aat","cholmod_copy","cholmod_copy_sparse","cholmod_free_sparse", - "cholmod_norm_sparse","cholmod_sdmult","cholmod_speye",:Int32), - ("cholmod_l_aat","cholmod_l_copy","cholmod_l_copy_sparse","cholmod_l_free_sparse", - "cholmod_norm_sparse","cholmod_l_sdmult","cholmod_l_speye",:Int64)) +for (aat,allocsp,cop,copsp,freesp,normsp,sdmult,speye,transsym,itype) in + (("cholmod_aat","cholmod_allocate_sparse","cholmod_copy","cholmod_copy_sparse", + "cholmod_free_sparse","cholmod_norm_sparse","cholmod_sdmult","cholmod_speye", + "cholmod_transpose_sym",:Int32), + ("cholmod_l_aat","cholmod_l_allocate_sparse","cholmod_l_copy", + "cholmod_l_copy_sparse","cholmod_l_free_sparse","cholmod_norm_sparse", + "cholmod_l_sdmult","cholmod_l_speye","cholmod_l_transpose_sym",:Int64)) @eval begin function chm_aat{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}) cm = cmn(a) - aa = Array(Ptr{c_CholmodSparse{Tv,$itype}}, 1) + ## strangely the matrix returned by $aat is not marked as symmetric + ## all of the code past the call to $aat is to create the symmetric-storage + ## version of the result then transpose it to provide sorted columns + aa = Array(Ptr{c_CholmodSparse{Tv,$itype}}, 2) aa[1] = ccall(($aat, :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Void}, Int, Int32, Ptr{Uint8}), &a, C_NULL, 0, 1, cm) - res = CholmodSparse(ccall(($(string(cop)), :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, - (Ptr{c_CholmodSparse{Tv,$itype}}, Int32, Int32, Ptr{Uint8}), - aa[1], 1, 1, cm)) + ## Create the lower triangle unsorted + aa[2] = ccall(($cop, :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, + (Ptr{c_CholmodSparse{Tv,$itype}}, Int32, Int32, Ptr{Uint8}), + aa[1], -1, 1, cm) status = ccall(($freesp, :libcholmod), Int32, (Ptr{Ptr{c_CholmodSparse{Tv,$itype}}}, Ptr{Uint8}), aa, cm) if status != CHOLMOD_TRUE throw(CholmodException) end - res + aa[1] = aa[2] + r = unsafe_ref(aa[1]) + ## Now transpose the lower triangle to the upper triangle to do the sorting + rpt = ccall(($allocsp,:libcholmod),Ptr{c_CholmodSparse{Tv,$itype}}, + (Csize_t,Csize_t,Csize_t,Cint,Cint,Cint,Cint,Ptr{Cuchar}), + r.m,r.n,r.nzmax,r.sorted,r.packed,-r.stype,r.xtype,cm) + status = ccall(($transsym,:libcholmod),Int32, + (Ptr{c_CholmodSparse{Tv,$itype}}, Int32, Ptr{$itype}, + Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), + aa[1],1,C_NULL,rpt,cm) + if status != CHOLMOD_TRUE throw(CholmodException) end + status = ccall(($freesp, :libcholmod), Int32, + (Ptr{Ptr{c_CholmodSparse{Tv,$itype}}}, Ptr{Uint8}), aa, cm) + if status != CHOLMOD_TRUE throw(CholmodException) end + CholmodSparse(rpt) end function chm_copy_sp{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}) ccall(($copsp,:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, @@ -1015,5 +1038,47 @@ function findn_nzs{Tv,Ti}(A::CholmodSparse{Tv,Ti}) end findn_nzs(L::CholmodFactor) = findn_nzs(chm_fac_to_sp(L)) - + +function diag{Tv}(A::CholmodSparse{Tv}) + minmn = min(size(A)) + res = zeros(Tv,minmn) + cp0 = A.colptr0 + rv0 = A.rowval0 + anz = A.nzval + for j in 1:minmn, k in (cp0[j]+1):cp0[j+1] + if rv0[k] == j-1 + res[j] += anz[k] + end + end + res +end + +function diag{Tv}(L::CholmodFactor{Tv}) + res = zeros(Tv,L.c.n) + if L.c.is_super != 0 error("Method for supernodal factors not yet written") end + c0 = L.p + r0 = L.i + xv = L.x + for j in 1:length(c0)-1 + jj = c0[j]+1 + assert(r0[jj] == j-1) + res[j] = xv[jj] + end + res +end + +function logdet{Tv,Ti}(L::CholmodFactor{Tv,Ti}) + if L.c.is_super != 0 error("Method for supernodal factors not yet written") end + c0 = L.p + r0 = L.i + xv = L.x + res = zero(Tv) + for j in 1:length(c0)-1 + jj = c0[j]+1 + assert(r0[jj] == j-1) + res += log(xv[jj]) + end + L.c.is_ll != 0 ? 2res : res +end + end #module From 96cd5874bac87a0771c4a3d677b6d3c7761254be Mon Sep 17 00:00:00 2001 From: "Viral B. Shah" Date: Wed, 13 Mar 2013 12:56:37 +0530 Subject: [PATCH 19/29] Reinstate lufact, cholfact, cholpfact, qrfact, and qrpfact. Matlab-like factorizations are now provided in lu, chol, and qr. --- base/deprecated.jl | 6 ----- base/exports.jl | 4 +++ base/linalg/dense.jl | 2 +- base/linalg/factorization.jl | 52 +++++++++++++++++++++++++----------- base/linalg/linalg.jl | 4 +++ test/linalg.jl | 12 ++++----- 6 files changed, 52 insertions(+), 28 deletions(-) diff --git a/base/deprecated.jl b/base/deprecated.jl index 50f8b30b86268..5d03feff16a09 100644 --- a/base/deprecated.jl +++ b/base/deprecated.jl @@ -146,12 +146,6 @@ end @deprecate expr(hd, a...) Expr(hd, a...) @deprecate expr(hd, a::Array{Any,1}) Expr(hd, a...) -@deprecate cholfact chol -@deprecate cholpfact cholp -@deprecate lufact lu -@deprecate qrfact qr -@deprecate qrpfact qrp - @deprecate logb exponent @deprecate ref_shape index_shape @deprecate assign_shape_check setindex_shape_check diff --git a/base/exports.jl b/base/exports.jl index 163102b592357..622920171fbac 100644 --- a/base/exports.jl +++ b/base/exports.jl @@ -550,7 +550,11 @@ export # linear algebra chol, + cholfact, + cholfact!, cholp, + cholpfact, + cholpfact!, cond, cross, ctranspose, diff --git a/base/linalg/dense.jl b/base/linalg/dense.jl index a5ab2bb56a45b..6cfc015a0e19b 100644 --- a/base/linalg/dense.jl +++ b/base/linalg/dense.jl @@ -415,7 +415,7 @@ function det(A::Matrix) end det(x::Number) = x -logdet(A::Matrix) = 2.0 * sum(log(diag(chol(A)[:U]))) +logdet(A::Matrix) = 2.0 * sum(log(diag(cholfact(A)[:U]))) function inv(A::StridedMatrix) if istriu(A) return inv(Triangular(A, 'U')) end diff --git a/base/linalg/factorization.jl b/base/linalg/factorization.jl index bcf7217e5851f..b462991ca4c41 100644 --- a/base/linalg/factorization.jl +++ b/base/linalg/factorization.jl @@ -13,10 +13,14 @@ type CholeskyDense{T<:BlasFloat} <: Factorization{T} end CholeskyDense{T<:BlasFloat}(A::Matrix{T}, uplo::Char) = CholeskyDense{T}(A, uplo) -chol(A::Matrix, uplo::Symbol) = CholeskyDense(copy(A), string(uplo)[1]) -chol(A::Matrix) = chol(A, :U) -chol{T<:Integer}(A::Matrix{T}, args...) = chol(float64(A), args...) -chol(x::Number) = imag(x) == 0 && real(x) > 0 ? sqrt(x) : error("Argument not positive-definite") +cholfact!(A::Matrix, uplo::Symbol) = CholeskyDense(A, string(uplo)[1]) +cholfact(A::Matrix, uplo::Symbol) = cholfact!(copy(A), uplo) +cholfact!(A::Matrix) = cholfact!(A, :U) +cholfact(A::Matrix) = cholfact(A, :U) +cholfact{T<:Integer}(A::Matrix{T}, args...) = cholfact(float(A), args...) +cholfact(x::Number) = imag(x) == 0 && real(x) > 0 ? sqrt(x) : error("Argument not positive-definite") + +chol(A) = cholfact(A, :U)[:U] size(C::CholeskyDense) = size(C.UL) size(C::CholeskyDense,d::Integer) = size(C.UL,d) @@ -59,10 +63,13 @@ function CholeskyPivotedDense{T<:BlasFloat}(A::Matrix{T}, uplo::Char, tol::Real) CholeskyPivotedDense{T}(uplo == 'U' ? triu!(A) : tril!(A), uplo, piv, rank, tol, info) end -cholp(A::Matrix, uplo::Symbol, tol::Real) = CholeskyPivotedDense(copy(A), string(uplo)[1], tol) -cholp(A::Matrix, tol::Real) = cholp(A, :U, tol) -cholp(A::Matrix) = cholp(A, -1.) -cholp{T<:Int}(A::Matrix{T}, args...) = cholp(float64(A), args...) +cholpfact!(A::Matrix, uplo::Symbol, tol::Real) = CholeskyPivotedDense(A, string(uplo)[1], tol) +cholpfact(A::Matrix, uplo::Symbol, tol::Real) = cholpfact!(copy(A), uplo, tol) +cholpfact!(A::Matrix, tol::Real) = cholpfact!(A, :U, tol) +cholpfact(A::Matrix, tol::Real) = cholpfact(A, :U, tol) +cholpfact!(A::Matrix) = cholpfact!(A, -1.) +cholpfact(A::Matrix) = cholpfact(A, -1.) +cholpfact{T<:Int}(A::Matrix{T}, args...) = cholpfact(float(A), args...) size(C::CholeskyPivotedDense) = size(C.UL) size(C::CholeskyPivotedDense,d::Integer) = size(C.UL,d) @@ -127,9 +134,16 @@ function LUDense{T<:BlasFloat}(A::Matrix{T}) LUDense{T}(LU, ipiv, info) end -lu(A::Matrix) = LUDense(copy(A)) -lu{T<:Integer}(A::Matrix{T}) = lu(float(A)) -lu(x::Number) = (one(x), x, [1]) +lufact!(A::Matrix) = LUDense(A) +lufact(A::Matrix) = lufact!(copy(A)) +lufact!{T<:Integer}(A::Matrix{T}) = lufact!(float(A)) +lufact{T<:Integer}(A::Matrix{T}) = lufact(float(A)) +lufact(x::Number) = (one(x), x, [1]) + +function lu(A::Matrix) + F = lufact(A) + return (F[:L], F[:U], F[:P]) +end size(A::LUDense) = size(A.LU) size(A::LUDense,n) = size(A.LU,n) @@ -182,9 +196,15 @@ type QRDense{S} <: Factorization{S} end QRDense(A::Matrix) = QRDense(LAPACK.geqrt3!(A)...) -qr(A::Matrix) = QRDense(copy(A)) -qr{T<:Integer}(A::Matrix{T}) = qr(float(A)) -qr(x::Number) = (one(x), x) +qrfact!(A::Matrix) = QRDense(A) +qrfact(A::Matrix) = qrfact!(copy(A)) +qrfact{T<:Integer}(A::Matrix{T}) = qrfact(float(A)) +qrfact(x::Number) = (one(x), x) + +function qr(A::Matrix) + F = qrfact(A) + return (F[:Q], F[:R]) +end size(A::QRDense, args::Integer...) = size(A.vs, args...) @@ -254,7 +274,9 @@ type QRPivotedDense{T} <: Factorization{T} end end QRPivotedDense{T<:BlasFloat}(A::Matrix{T}) = QRPivotedDense{T}(LAPACK.geqp3!(A)...) -qrp(A::Matrix) = QRPivotedDense(copy(A)) + +qrpfact!(A::Matrix) = QRPivotedDense(A) +qrpfact(A::Matrix) = qrpfact!(copy(A)) # QRDenseQ(A::QRPivotedDense) = QRDenseQ(A.hh, A.tau) size(A::QRPivotedDense, args::Integer...) = size(A.hh, args...) diff --git a/base/linalg/linalg.jl b/base/linalg/linalg.jl index b8da036136514..335ee84ff81d4 100644 --- a/base/linalg/linalg.jl +++ b/base/linalg/linalg.jl @@ -26,7 +26,11 @@ export # Functions chol, + cholfact, + cholfact!, cholp, + cholpfact, + cholpfact!, cond, copy!, cross, diff --git a/test/linalg.jl b/test/linalg.jl index 985018d61a9e4..be6fbefd18d1b 100644 --- a/test/linalg.jl +++ b/test/linalg.jl @@ -8,7 +8,7 @@ for elty in (Float32, Float64, Complex64, Complex128) apd = a'*a # symmetric positive-definite b = convert(Vector{elty}, b) - capd = chol(apd) # upper Cholesky factor + capd = cholfact(apd) # upper Cholesky factor r = capd[:U] @test_approx_eq r'*r apd @test_approx_eq b apd * (capd\b) @@ -16,10 +16,10 @@ for elty in (Float32, Float64, Complex64, Complex128) @test_approx_eq a*(capd\(a'*b)) b # least squares soln for square a @test_approx_eq det(capd) det(apd) - l = chol(apd, :L)[:L] # lower Cholesky factor + l = cholfact(apd, :L)[:L] # lower Cholesky factor @test_approx_eq l*l' apd - cpapd = cholp(apd) # pivoted Choleksy decomposition + cpapd = cholpfact(apd) # pivoted Choleksy decomposition @test rank(cpapd) == n @test all(diff(diag(real(cpapd.UL))).<=0.) # diagonal should be non-increasing @test_approx_eq b apd * (cpapd\b) @@ -32,21 +32,21 @@ for elty in (Float32, Float64, Complex64, Complex128) @test_approx_eq inv(bc2) * apd eye(elty, n) @test_approx_eq apd * (bc2\b) b - lua = lu(a) # LU decomposition + lua = lufact(a) # LU decomposition l,u,p = lua[:L], lua[:U], lua[:p] @test_approx_eq l*u a[p,:] @test_approx_eq l[invperm(p),:]*u a @test_approx_eq a * inv(lua) eye(elty, n) @test_approx_eq a*(lua\b) b - qra = qr(a) # QR decomposition + qra = qrfact(a) # QR decomposition q,r = qra[:Q], qra[:R] @test_approx_eq q'*full(q, false) eye(elty, n) @test_approx_eq q*full(q, false)' eye(elty, n) @test_approx_eq q*r a @test_approx_eq a*(qra\b) b - qrpa = qrp(a) # pivoted QR decomposition + qrpa = qrpfact(a) # pivoted QR decomposition q,r,p = qrpa[:Q], qrpa[:R], qrpa[:p] @test_approx_eq q'*full(q, false) eye(elty, n) @test_approx_eq q*full(q, false)' eye(elty, n) From 551ae433eb991bc8da008d2bb2cc3aabc0be5d07 Mon Sep 17 00:00:00 2001 From: "Viral B. Shah" Date: Wed, 13 Mar 2013 19:24:37 +0530 Subject: [PATCH 20/29] Slightly better way to get the real part of a complex type. --- base/linalg/arnoldi.jl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/base/linalg/arnoldi.jl b/base/linalg/arnoldi.jl index 4d1c8e162e312..f598f64f0da26 100644 --- a/base/linalg/arnoldi.jl +++ b/base/linalg/arnoldi.jl @@ -69,9 +69,9 @@ function aupd_wrapper(T, n::Integer, sym::Bool, cmplx::Bool, bmat::ASCIIString, bmat = "I" lworkl = cmplx ? ncv * (3*ncv + 5) : ( lworkl = sym ? ncv * (ncv + 8) : ncv * (3*ncv + 6) ) + TR = cmplx ? T.types[1] : T v = Array(T, n, ncv) - TR = typeof(real(v[1])) workd = Array(T, 3*n) workl = Array(T, lworkl) rwork = cmplx ? Array(TR, ncv) : Array(TR, 0) From 41368ddc7b4fc514ef38a14306a0f337846ddb29 Mon Sep 17 00:00:00 2001 From: Andreas Noack Jensen Date: Wed, 13 Mar 2013 20:48:23 +0100 Subject: [PATCH 21/29] Follow up on Viral's commit in order to reintroduce the 'fact's functions. Introduction of the Eigen type for the eigenvalue decomposition. Allow LU decompositions to be rectangular. --- base/exports.jl | 3 + base/linalg/dense.jl | 46 ++--------- base/linalg/factorization.jl | 154 +++++++++++++++++++++++++---------- base/linalg/hermitian.jl | 13 +-- base/linalg/lapack.jl | 12 +-- base/linalg/linalg.jl | 2 + extras/image.jl | 2 +- test/linalg.jl | 6 +- 8 files changed, 139 insertions(+), 99 deletions(-) diff --git a/base/exports.jl b/base/exports.jl index 0c90aac3c82fb..7b20b9858f785 100644 --- a/base/exports.jl +++ b/base/exports.jl @@ -112,6 +112,7 @@ export BunchKaufman, CholeskyDense, CholeskyPivotedDense, + Eigen, GSVDDense, Hessenberg, LUDense, @@ -565,6 +566,8 @@ export diff, dot, eig, + eigenfact, + eigenfact!, eigs, eigvals, expm, diff --git a/base/linalg/dense.jl b/base/linalg/dense.jl index 6cfc015a0e19b..ff6f46eccf376 100644 --- a/base/linalg/dense.jl +++ b/base/linalg/dense.jl @@ -411,7 +411,7 @@ function det(A::Matrix) m, n = size(A) if m != n; throw(LAPACK.DimensionMismatch("det only defined for square matrices")); end if istriu(A) | istril(A); return det(Triangular(A, 'U', false)); end - return det(LUDense(copy(A))) + return det(lufact(A)) end det(x::Number) = x @@ -421,45 +421,9 @@ function inv(A::StridedMatrix) if istriu(A) return inv(Triangular(A, 'U')) end if istril(A) return inv(Triangular(A, 'L')) end if ishermitian(A) return inv(Hermitian(A)) end - return inv(LUDense(copy(A))) + return inv(lufact(A)) end -function eig{T<:BlasFloat}(A::StridedMatrix{T}) - n = size(A, 2) - if n == 0; return (zeros(T, 0), zeros(T, 0, 0)) end - if ishermitian(A) return eig(Hermitian(A)) end - if iscomplex(A) return LAPACK.geev!('N', 'V', copy(A))[[1,3]] end - - WR, WI, VL, VR = LAPACK.geev!('N', 'V', copy(A)) - if all(WI .== 0.) return WR, VR end - evec = complex(zeros(T, n, n)) - j = 1 - while j <= n - if WI[j] == 0.0 - evec[:,j] = VR[:,j] - else - evec[:,j] = VR[:,j] + im*VR[:,j+1] - evec[:,j+1] = VR[:,j] - im*VR[:,j+1] - j += 1 - end - j += 1 - end - return complex(WR, WI), evec -end - -eig{T<:Integer}(x::StridedMatrix{T}) = eig(float64(x)) -eig(x::Number) = (x, one(x)) - -function eigvals(A::StridedMatrix) - if ishermitian(A) return eigvals(Hermitian(A)) end - if iscomplex(A) return LAPACK.geev!('N', 'N', copy(A))[1] end - valsre, valsim, _, _ = LAPACK.geev!('N', 'N', copy(A)) - if all(valsim .== 0) return valsre end - return complex(valsre, valsim) -end - -eigvals(x::Number) = 1.0 - schur{T<:BlasFloat}(A::StridedMatrix{T}) = LAPACK.gees!('V', copy(A)) function (\){T<:BlasFloat}(A::StridedMatrix{T}, B::StridedVecOrMat{T}) @@ -483,7 +447,7 @@ end ## Moore-Penrose inverse function pinv{T<:BlasFloat}(A::StridedMatrix{T}) - SVD = SVDDense(copy(A), true) + SVD = svdfact(A, true) Sinv = zeros(T, length(SVD[:S])) index = SVD[:S] .> eps(real(one(T)))*max(size(A))*max(SVD[:S]) Sinv[index] = 1.0 ./ SVD[:S][index] @@ -496,7 +460,7 @@ pinv(x::Number) = one(x)/x ## Basis for null space function null{T<:BlasFloat}(A::StridedMatrix{T}) m,n = size(A) - SVD = SVDDense(copy(A)) + SVD = svdfact(A) if m == 0; return eye(T, n); end indstart = sum(SVD[:S] .> max(m,n)*max(SVD[:S])*eps(eltype(SVD[:S]))) + 1 SVD[:V][:,indstart:] @@ -512,7 +476,7 @@ function cond(A::StridedMatrix, p) elseif p == 1 || p == Inf m, n = size(A) if m != n; error("Use 2-norm for non-square matrices"); end - cnd = 1 / LAPACK.gecon!(p == 1 ? '1' : 'I', LUDense(copy(A)).LU, norm(A, p)) + cnd = 1 / LAPACK.gecon!(p == 1 ? '1' : 'I', lufact(A).LU, norm(A, p)) else error("Norm type must be 1, 2 or Inf") end diff --git a/base/linalg/factorization.jl b/base/linalg/factorization.jl index b462991ca4c41..c626c51164dec 100644 --- a/base/linalg/factorization.jl +++ b/base/linalg/factorization.jl @@ -13,14 +13,15 @@ type CholeskyDense{T<:BlasFloat} <: Factorization{T} end CholeskyDense{T<:BlasFloat}(A::Matrix{T}, uplo::Char) = CholeskyDense{T}(A, uplo) -cholfact!(A::Matrix, uplo::Symbol) = CholeskyDense(A, string(uplo)[1]) -cholfact(A::Matrix, uplo::Symbol) = cholfact!(copy(A), uplo) -cholfact!(A::Matrix) = cholfact!(A, :U) -cholfact(A::Matrix) = cholfact(A, :U) -cholfact{T<:Integer}(A::Matrix{T}, args...) = cholfact(float(A), args...) +cholfact!(A::StridedMatrix, uplo::Symbol) = CholeskyDense(A, string(uplo)[1]) +cholfact(A::StridedMatrix, uplo::Symbol) = cholfact!(copy(A), uplo) +cholfact!(A::StridedMatrix) = cholfact!(A, :U) +cholfact(A::StridedMatrix) = cholfact(A, :U) +cholfact{T<:Integer}(A::StridedMatrix{T}, args...) = cholfact(float(A), args...) cholfact(x::Number) = imag(x) == 0 && real(x) > 0 ? sqrt(x) : error("Argument not positive-definite") -chol(A) = cholfact(A, :U)[:U] +chol(A::Union(Number, StridedMatrix), uplo::Symbol) = cholfact(A, uplo)[uplo] +chol(A::Union(Number, StridedMatrix)) = cholfact(A, :U)[:U] size(C::CholeskyDense) = size(C.UL) size(C::CholeskyDense,d::Integer) = size(C.UL,d) @@ -58,18 +59,18 @@ type CholeskyPivotedDense{T<:BlasFloat} <: Factorization{T} tol::Real info::BlasInt end -function CholeskyPivotedDense{T<:BlasFloat}(A::Matrix{T}, uplo::Char, tol::Real) +function CholeskyPivotedDense{T<:BlasFloat}(A::StridedMatrix{T}, uplo::Char, tol::Real) A, piv, rank, info = LAPACK.pstrf!(uplo, A, tol) CholeskyPivotedDense{T}(uplo == 'U' ? triu!(A) : tril!(A), uplo, piv, rank, tol, info) end -cholpfact!(A::Matrix, uplo::Symbol, tol::Real) = CholeskyPivotedDense(A, string(uplo)[1], tol) -cholpfact(A::Matrix, uplo::Symbol, tol::Real) = cholpfact!(copy(A), uplo, tol) -cholpfact!(A::Matrix, tol::Real) = cholpfact!(A, :U, tol) -cholpfact(A::Matrix, tol::Real) = cholpfact(A, :U, tol) -cholpfact!(A::Matrix) = cholpfact!(A, -1.) -cholpfact(A::Matrix) = cholpfact(A, -1.) -cholpfact{T<:Int}(A::Matrix{T}, args...) = cholpfact(float(A), args...) +cholpfact!(A::StridedMatrix, uplo::Symbol, tol::Real) = CholeskyPivotedDense(A, string(uplo)[1], tol) +cholpfact(A::StridedMatrix, uplo::Symbol, tol::Real) = cholpfact!(copy(A), uplo, tol) +cholpfact!(A::StridedMatrix, tol::Real) = cholpfact!(A, :U, tol) +cholpfact(A::StridedMatrix, tol::Real) = cholpfact(A, :U, tol) +cholpfact!(A::StridedMatrix) = cholpfact!(A, -1.) +cholpfact(A::StridedMatrix) = cholpfact(A, -1.) +cholpfact{T<:Int}(A::StridedMatrix{T}, args...) = cholpfact(float(A), args...) size(C::CholeskyPivotedDense) = size(C.UL) size(C::CholeskyPivotedDense,d::Integer) = size(C.UL,d) @@ -124,23 +125,19 @@ type LUDense{T} <: Factorization{T} LU::Matrix{T} ipiv::Vector{BlasInt} info::BlasInt - function LUDense(LU::Matrix{T}, ipiv::Vector{BlasInt}, info::BlasInt) - m, n = size(LU) - m == n ? new(LU, ipiv, info) : throw(LAPACK.DimensionMismatch("LUDense only defined for square matrices")) - end end -function LUDense{T<:BlasFloat}(A::Matrix{T}) +function LUDense{T<:BlasFloat}(A::StridedMatrix{T}) LU, ipiv, info = LAPACK.getrf!(A) LUDense{T}(LU, ipiv, info) end -lufact!(A::Matrix) = LUDense(A) -lufact(A::Matrix) = lufact!(copy(A)) -lufact!{T<:Integer}(A::Matrix{T}) = lufact!(float(A)) -lufact{T<:Integer}(A::Matrix{T}) = lufact(float(A)) +lufact!(A::StridedMatrix) = LUDense(A) +lufact(A::StridedMatrix) = lufact!(copy(A)) +lufact!{T<:Integer}(A::StridedMatrix{T}) = lufact!(float(A)) +lufact{T<:Integer}(A::StridedMatrix{T}) = lufact(float(A)) lufact(x::Number) = (one(x), x, [1]) -function lu(A::Matrix) +function lu(A::Union(Number, StridedMatrix)) F = lufact(A) return (F[:L], F[:U], F[:P]) end @@ -194,17 +191,18 @@ type QRDense{S} <: Factorization{S} vs::Matrix{S} # the elements on and above the diagonal contain the N-by-N upper triangular matrix R; the elements below the diagonal are the columns of V T::Matrix{S} # upper triangular factor of the block reflector. end -QRDense(A::Matrix) = QRDense(LAPACK.geqrt3!(A)...) +QRDense(A::StridedMatrix) = QRDense(LAPACK.geqrt3!(A)...) -qrfact!(A::Matrix) = QRDense(A) -qrfact(A::Matrix) = qrfact!(copy(A)) -qrfact{T<:Integer}(A::Matrix{T}) = qrfact(float(A)) +qrfact!(A::StridedMatrix) = QRDense(A) +qrfact(A::StridedMatrix) = qrfact!(copy(A)) +qrfact{T<:Integer}(A::StridedMatrix{T}) = qrfact(float(A)) qrfact(x::Number) = (one(x), x) -function qr(A::Matrix) +function qr(A::Union(Number, StridedMatrix), thin::Bool) F = qrfact(A) - return (F[:Q], F[:R]) + return (full(F[:Q], thin), F[:R]) end +qr(A::Union(Number, StridedMatrix)) = qr(A, false) size(A::QRDense, args::Integer...) = size(A.vs, args...) @@ -273,11 +271,15 @@ type QRPivotedDense{T} <: Factorization{T} new(hh,tau,jpvt) end end -QRPivotedDense{T<:BlasFloat}(A::Matrix{T}) = QRPivotedDense{T}(LAPACK.geqp3!(A)...) +qrpfact!{T<:BlasFloat}(A::StridedMatrix{T}) = QRPivotedDense{T}(LAPACK.geqp3!(A)...) + +qrpfact(A::StridedMatrix) = qrpfact!(copy(A)) -qrpfact!(A::Matrix) = QRPivotedDense(A) -qrpfact(A::Matrix) = qrpfact!(copy(A)) -# QRDenseQ(A::QRPivotedDense) = QRDenseQ(A.hh, A.tau) +function qrp(A::Union(Number, StridedMatrix), thin::Bool) + F = qrpfact(A) + return full(F[:Q], thin), F[:R], F[:P] +end +qrp(A::StridedMatrix) = qrp(A, false) size(A::QRPivotedDense, args::Integer...) = size(A.hh, args...) @@ -318,6 +320,7 @@ function full{T<:BlasFloat}(A::QRDensePivotedQ{T}, thin::Bool) end end full(A::QRDensePivotedQ) = full(A, true) +print_matrix(io::IO, A::QRDensePivotedQ) = print_matrix(io, full(A)) ## Multiplication by Q from the Pivoted QR decomposition function *{T<:BlasFloat}(A::QRDensePivotedQ{T}, B::StridedVecOrMat{T}) @@ -363,7 +366,7 @@ end Hessenberg{T<:BlasFloat}(hh::Matrix{T}, tau::Vector{T}) = Hessenberg{T}(hh, tau) Hessenberg(A::StridedMatrix) = Hessenberg(LAPACK.gehrd!(A)...) -hess(A::StridedMatrix) = Hessenberg(copy(A)) +hessfact(A::StridedMatrix) = Hessenberg(copy(A)) type HessenbergQ{T} <: AbstractMatrix{T} hh::Matrix{T} @@ -381,13 +384,70 @@ end full(A::HessenbergQ) = LAPACK.orghr!(1, size(A.hh, 1), copy(A.hh), A.tau) +# Eigenvalues +type Eigen{T} <: Factorization{T} + values::Vector + vectors::Matrix{T} +end + +function getindex(A::Eigen, d::Symbol) + if d == :values return A.values end + if d == :vectors return A.vectors end + error("No such property") +end + +function eigenfact!{T<:BlasFloat}(A::StridedMatrix{T}) + n = size(A, 2) + if n == 0; return Eigen(zeros(T, 0), zeros(T, 0, 0)) end + if ishermitian(A) return eigenfact!(Hermitian(A)) end + if iscomplex(A) return Eigen(LAPACK.geev!('N', 'V', A)[[1,3]]...) end + + WR, WI, VL, VR = LAPACK.geev!('N', 'V', A) + if all(WI .== 0.) return Eigen(WR, VR) end + evec = complex(zeros(T, n, n)) + j = 1 + while j <= n + if WI[j] == 0.0 + evec[:,j] = VR[:,j] + else + evec[:,j] = VR[:,j] + im*VR[:,j+1] + evec[:,j+1] = VR[:,j] - im*VR[:,j+1] + j += 1 + end + j += 1 + end + return Eigen(complex(WR, WI), evec) +end + +eigenfact(A::StridedMatrix) = eigenfact!(copy(A)) +eigenfact{T<:Integer}(x::StridedMatrix{T}) = eigenfact(float64(x)) +eigenfact(x::Number) = (x, one(x)) + +function eig(A::Union(Number, StridedMatrix)) + F = eigenfact(A) + return F[:values], F[:vectors] +end + +function eigvals(A::StridedMatrix) + if ishermitian(A) return eigvals(Hermitian(A)) end + if iscomplex(A) return LAPACK.geev!('N', 'N', copy(A))[1] end + valsre, valsim, _, _ = LAPACK.geev!('N', 'N', copy(A)) + if all(valsim .== 0) return valsre end + return complex(valsre, valsim) +end + +eigvals(x::Number) = 1.0 + +inv(A::Eigen) = diagmm(A[:vectors], 1.0/A[:values])*A[:vectors]' +det(A::Eigen) = prod(A[:values]) + # SVD type SVDDense{T,Tr} <: Factorization{T} U::Matrix{T} S::Vector{Tr} Vt::Matrix{T} end -function SVDDense(A::StridedMatrix, thin::Bool) +function svdfact!(A::StridedMatrix, thin::Bool) m,n = size(A) if m == 0 || n == 0 u,s,vt = (eye(m, thin ? n : m), zeros(0), eye(n,n)) @@ -396,10 +456,15 @@ function SVDDense(A::StridedMatrix, thin::Bool) end return SVDDense(u,s,vt) end -SVDDense(A::StridedMatrix) = SVDDense(A, false) -svd(A::StridedMatrix, args...) = SVDDense(copy(A), args...) -svd(a::Vector, args...) = svd(reshape(a, length(a), 1), args...) -svd(x::Number, thin::Bool) = (x==0?one(x):x/abs(x),abs(x),one(x)) +svdfact(A::StridedMatrix, thin::Bool) = svdfact!(copy(A), thin) +svdfact(a::Vector, thin::Bool) = svdfact(reshape(a, length(a), 1), thin) +svdfact(x::Number, thin::Bool) = (x==0?one(x):x/abs(x),abs(x),one(x)) +svdfact(A::Union(Number, StridedVecOrMat)) = svdfact(A, false) + +function svd(A::Union(Number, StridedVecOrMat), args...) + F = svdfact(A, args...) + return F[:U], F[:S], F[:V] +end function getindex(F::SVDDense, d::Symbol) if d == :U return F.U end @@ -437,12 +502,17 @@ type GSVDDense{T} <: Factorization{T} R::Matrix{T} end -function GSVDDense(A::StridedMatrix, B::StridedMatrix) +function svdfact!(A::StridedMatrix, B::StridedMatrix) U, V, Q, a, b, k, l, R = LAPACK.ggsvd!('U', 'V', 'Q', A, B) return GSVDDense(U, V, Q, a, b, int(k), int(l), R) end -svd(A::StridedMatrix, B::StridedMatrix) = GSVDDense(copy(A), copy(B)) +svdfact(A::StridedMatrix, B::StridedMatrix) = svdfact!(copy(A), copy(B)) + +function svd(A::StridedMatrix, B::StridedMatrix) + F = svdfact(A, B) + return F[:U], F[:V], F[:Q]*F[:R0]', F[:D1], F[:D2] +end function getindex{T}(obj::GSVDDense{T}, d::Symbol) if d == :U return obj.U end diff --git a/base/linalg/hermitian.jl b/base/linalg/hermitian.jl index e2b9f2cc17649..1dec75938540b 100644 --- a/base/linalg/hermitian.jl +++ b/base/linalg/hermitian.jl @@ -26,23 +26,24 @@ end inv(A::Hermitian) = inv(BunchKaufman(copy(A.S), A.uplo)) -eig(A::Hermitian) = LAPACK.syevr!('V', 'A', A.uplo, copy(A.S), 0.0, 0.0, 0, 0, -1.0) +eigenfact!(A::Hermitian) = Eigen(LAPACK.syevr!('V', 'A', A.uplo, A.S, 0.0, 0.0, 0, 0, -1.0)...) +eigenfact(A::Hermitian) = Eigen(LAPACK.syevr!('V', 'A', A.uplo, copy(A.S), 0.0, 0.0, 0, 0, -1.0)...) eigvals(A::Hermitian, il::Int, ih::Int) = LAPACK.syevr!('N', 'I', A.uplo, copy(A.S), 0.0, 0.0, il, ih, -1.0)[1] eigvals(A::Hermitian, vl::Real, vh::Real) = LAPACK.syevr!('N', 'V', A.uplo, copy(A.S), vl, vh, 0, 0, -1.0)[1] eigvals(A::Hermitian) = eigvals(A, 1, size(A, 1)) eigmax(A::Hermitian) = eigvals(A, size(A, 1), size(A, 1))[1] function sqrtm(A::Hermitian, cond::Bool) - v, z = eig(A) - vsqrt = sqrt(complex(v)) + F = eigenfact(A) + vsqrt = sqrt(complex(F[:values])) if all(imag(vsqrt) .== 0) - retmat = symmetrize!(diagmm(z, real(vsqrt)) * z') + retmat = symmetrize!(diagmm(F[:vectors], real(vsqrt)) * F[:vectors]') else - zc = complex(z) + zc = complex(F[:vectors]) retmat = symmetrize!(diagmm(zc, vsqrt) * zc') end if cond - return retmat, norm(vsqrt, Inf)^2/norm(v, Inf) + return retmat, norm(vsqrt, Inf)^2/norm(F[:values], Inf) else return retmat end diff --git a/base/linalg/lapack.jl b/base/linalg/lapack.jl index 88cd2183074ba..7ea85cd447616 100644 --- a/base/linalg/lapack.jl +++ b/base/linalg/lapack.jl @@ -37,7 +37,7 @@ end function chksquare(A::Matrix...) for a in A m, n = size(a) - if m != n error("LAPACK: Matrix must be square") end + if m != n throw(DimensionMismatch("Matrix must be square")) end end end @@ -436,7 +436,7 @@ for (gels, gesv, getrs, getri, elty) in function getrs!(trans::BlasChar, A::StridedMatrix{$elty}, ipiv::Vector{BlasInt}, B::StridedVecOrMat{$elty}) chkstride1(A, B) m, n = size(A) - if m != n || size(B, 1) != m error("getrs!: dimension mismatch") end + if m != n || size(B, 1) != m throw(DimensionMismatch("Matrix must be square")) end nrhs = size(B, 2) info = Array(BlasInt, 1) ccall(($(string(getrs)),liblapack), Void, @@ -455,7 +455,7 @@ for (gels, gesv, getrs, getri, elty) in function getri!(A::StridedMatrix{$elty}, ipiv::Vector{BlasInt}) chkstride1(A) m, n = size(A) - if m != n || n != length(ipiv) error("getri!: dimension mismatch") end + if m != n || n != length(ipiv) throw(DimensionMismatch("Matrix must be square")) end lda = stride(A, 2) info = Array(BlasInt, 1) lwork = -1 @@ -465,7 +465,7 @@ for (gels, gesv, getrs, getri, elty) in (Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &n, A, &lda, ipiv, work, &lwork, info) - if info[1] != 0 error("getri!: error $(info[1])") end + if info[1] != 0 throw(LAPACKException(info[1])) end if lwork < 0 lwork = blas_int(real(work[1])) work = Array($elty, lwork) @@ -1130,7 +1130,7 @@ for (posv, potrf, potri, potrs, pstrf, elty, rtyp) in chkstride1(A, B) chksquare(A) n = size(A,2) - if size(B,1) != n error("potrs!: dimension mismatch") end + if size(B,1) != n throw(DimensionMismatch("Left and right hand side does not fit")) end info = Array(BlasInt, 1) ccall(($(string(potrs)),liblapack), Void, (Ptr{Uint8}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, @@ -1280,7 +1280,7 @@ for (trtri, trtrs, elty) in (Ptr{Uint8}, Ptr{Uint8}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}), &uplo, &diag, &n, A, &lda, info) - if info[1] < 0 error("trtri!: error $(info[1])") end + if info[1] < 0 throw(LAPACKException(info[1])) end A, info[1] end # SUBROUTINE DTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, INFO ) diff --git a/base/linalg/linalg.jl b/base/linalg/linalg.jl index 335ee84ff81d4..6925b6ebc412c 100644 --- a/base/linalg/linalg.jl +++ b/base/linalg/linalg.jl @@ -43,6 +43,8 @@ export diff, dot, eig, + eigenfact!, + eigenfact, eigs, eigvals, expm, diff --git a/extras/image.jl b/extras/image.jl index 062f271ca1c12..73fba7d1a3cd6 100644 --- a/extras/image.jl +++ b/extras/image.jl @@ -719,7 +719,7 @@ function imfilter{T}(img::Matrix{T}, filter::Matrix{T}, border::String, value) error("wrong border treatment") end # check if separable - SVD = SVDDense(copy(filter)) + SVD = svdfact(filter) U, S, Vt = SVD[:U], SVD[:S], SVD[:Vt] separable = true; for i = 2:length(S) diff --git a/test/linalg.jl b/test/linalg.jl index be6fbefd18d1b..cd9207f2f455f 100644 --- a/test/linalg.jl +++ b/test/linalg.jl @@ -67,10 +67,10 @@ for elty in (Float32, Float64, Complex64, Complex128) @test_approx_eq sort(imag(v)) sort(imag(d)) @test istriu(u) || isreal(a) - usv = svd(a) # singular value decomposition + usv = svdfact(a) # singular value decomposition @test_approx_eq usv[:U]*diagmm(usv[:S],usv[:Vt]) a - gsvd = svd(a,a[1:5,:]) # Generalized svd + gsvd = svdfact(a,a[1:5,:]) # Generalized svd @test_approx_eq gsvd[:U]*gsvd[:D1]*gsvd[:R]*gsvd[:Q]' a @test_approx_eq gsvd[:V]*gsvd[:D2]*gsvd[:R]*gsvd[:Q]' a[1:5,:] @@ -243,7 +243,7 @@ for elty in (Float32, Float64, Complex64, Complex128) @test_approx_eq expm(A3) eA3 # Hessenberg - @test_approx_eq hess(A1)[:H] convert(Matrix{elty}, + @test_approx_eq hessfact(A1)[:H] convert(Matrix{elty}, [4.000000000000000 -1.414213562373094 -1.414213562373095 -1.414213562373095 4.999999999999996 -0.000000000000000 0 -0.000000000000002 3.000000000000000]) From f93c6dbe87dec5b1df5af3e74064296f89e16f79 Mon Sep 17 00:00:00 2001 From: Douglas Bates Date: Wed, 13 Mar 2013 16:31:38 -0500 Subject: [PATCH 22/29] Separate umfpack and cholmod Julia wrappers. Things were getting too unwieldy trying to keep both together. --- base/linalg/cholmod.jl | 756 ++++++++++++++++++++++++++++++++ base/linalg/linalg.jl | 5 +- base/linalg/suitesparse.jl | 872 +++---------------------------------- test/suitesparse.jl | 12 +- 4 files changed, 835 insertions(+), 810 deletions(-) create mode 100644 base/linalg/cholmod.jl diff --git a/base/linalg/cholmod.jl b/base/linalg/cholmod.jl new file mode 100644 index 0000000000000..a9c0f13c3f72f --- /dev/null +++ b/base/linalg/cholmod.jl @@ -0,0 +1,756 @@ +module CHOLMOD + +using Base.LinAlg.UMFPACK # for decrement, increment, etc. + +export + CholmodDense, + CholmodFactor, + CholmodSparse, + CholmodTriplet + +import Base.(*) +import Base.(\) +import Base.Ac_ldiv_B +import Base.At_ldiv_B +import Base.Ac_mul_B +import Base.convert +import Base.copy +import Base.eltype +import Base.findn_nzs +import Base.getindex +import Base.nnz +import Base.show +import Base.size +import Base.sort! + +import LinAlg.Factorization +import LinAlg.cholfact +import LinAlg.cholfact! +import LinAlg.copy +import LinAlg.diagmm +import LinAlg.diagmm! +import LinAlg.logdet +import LinAlg.solve + +const chm_com_sz = ccall((:jl_cholmod_common_size,:libsuitesparse_wrapper),Int,()) +const chm_com = ones(Uint8, chm_com_sz) + +typealias CHMITypes Union(Int32,Int64) +typealias CHMVTypes Union(Complex64, Complex128, Float32, Float64) + +### A way of examining some of the fields in chm_com +### Probably better to make this a Dict{ASCIIString,Tuple} and +### save the offsets and the lengths and the types. Then the names can be checked. +type ChmCommon + dbound::Float64 + maxrank::Int + supernodal_switch::Float64 + supernodal::Int32 + final_asis::Int32 + final_super::Int32 + final_ll::Int32 + final_pack::Int32 + final_monotonic::Int32 + final_resymbol::Int32 + prefer_zomplex::Int32 # should always be false + prefer_upper::Int32 + print::Int32 # print level. Default: 3 + precise::Int32 # print 16 digits, otherwise 5 + nmethods::Int32 # number of ordering methods + selected::Int32 + postorder::Int32 + itype::Int32 + dtype::Int32 +end + +include(joinpath(JULIA_HOME, "..", "..", "base", "linalg/suitesparse_h.jl")) + +### These offsets should be reconfigured to be less error-prone in matches +const chm_com_offsets = Array(Int, length(ChmCommon.types)) +ccall((:jl_cholmod_common_offsets, :libsuitesparse_wrapper), + Void, (Ptr{Uint8},), chm_com_offsets) +const chm_final_ll_inds = (1:4) + chm_com_offsets[7] +const chm_prt_inds = (1:4) + chm_com_offsets[13] +const chm_ityp_inds = (1:4) + chm_com_offsets[18] + +### there must be an easier way but at least this works. +function ChmCommon(aa::Array{Uint8,1}) + typs = ChmCommon.types + sz = map(sizeof, typs) + args = map(i->reinterpret(typs[i], aa[chm_com_offsets[i] + (1:sz[i])])[1], 1:length(sz)) + eval(Expr(:call, unshift!(args, :ChmCommon), Any)) +end +function chm_itype{Tv<:CHMVTypes,Ti<:CHMITypes}(S::SparseMatrixCSC{Tv,Ti}) + int32(Ti<:Int64 ? CHOLMOD_LONG : CHOLMOD_INT) +end +function chm_xtype{T<:CHMVTypes}(S::SparseMatrixCSC{T}) + int32(T<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL) +end +function chm_dtype{T<:CHMVTypes}(S::SparseMatrixCSC{T}) + int32(T<:Union(Float32, Complex64) ? CHOLMOD_SINGLE : CHOLMOD_DOUBLE) +end + +function set_chm_prt_lev(cm::Array{Uint8}, lev::Integer) + cm[(1:4) + chm_com_offsets[13]] = reinterpret(Uint8, [int32(lev)]) +end + +## cholmod_dense pointers passed to or returned from C functions are of Julia type +## Ptr{c_CholmodDense}. The CholmodDense type contains a c_CholmodDense object and other +## fields then ensure the memory pointed to is freed when it should be and not before. +immutable c_CholmodDense{T<:CHMVTypes} + m::Int + n::Int + nzmax::Int + lda::Int + xpt::Ptr{T} + zpt::Ptr{Void} + xtype::Cint + dtype::Cint +end + +immutable CholmodDense{T<:CHMVTypes} + c::c_CholmodDense + mat::Matrix{T} +end + +immutable c_CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes} + n::Int + minor::Int + Perm::Ptr{Ti} + ColCount::Ptr{Ti} + nzmax::Int + p::Ptr{Ti} + i::Ptr{Ti} + x::Ptr{Tv} + z::Ptr{Void} + nz::Ptr{Ti} + next::Ptr{Ti} + prev::Ptr{Ti} + nsuper::Int + ssize::Int + xsize::Int + maxcsize::Int + maxesize::Int + super::Ptr{Ti} + pi::Ptr{Ti} + px::Ptr{Tv} + s::Ptr{Ti} + ordering::Cint + is_ll::Cint + is_super::Cint + is_monotonic::Cint + itype::Cint + xtype::Cint + dtype::Cint +end + +immutable CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes} + c::c_CholmodFactor{Tv,Ti} + Perm::Vector{Ti} + ColCount::Vector{Ti} + p::Vector{Ti} + i::Vector{Ti} + x::Vector{Tv} + nz::Vector{Ti} + next::Vector{Ti} + prev::Vector{Ti} + super::Vector{Ti} + pi::Vector{Ti} + px::Vector{Tv} + s::Vector{Ti} +end + +immutable c_CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes} + m::Int + n::Int + nzmax::Int + ppt::Ptr{Ti} + ipt::Ptr{Ti} + nzpt::Ptr{Void} + xpt::Ptr{Tv} + zpt::Ptr{Void} + stype::Cint + itype::Cint + xtype::Cint + dtype::Cint + sorted::Cint + packed::Cint +end + +immutable CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes} + c::c_CholmodSparse{Tv,Ti} + colptr0::Vector{Ti} + rowval0::Vector{Ti} + nzval::Vector{Tv} +end + +immutable c_CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes} + m::Int + n::Int + nzmax::Int + nnz::Int + i::Ptr{Ti} + j::Ptr{Ti} + x::Ptr{Tv} + z::Ptr{Void} + stype:Cint + itype::Cint + xtype::Cint + dtype::Cint +end + +immutable CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes} + c::c_CholmodTriplet{Tv,Ti} + i::Vector{Ti} + j::Vector{Ti} + x::Vector{Tv} +end + +eltype{T<:CHMVTypes}(CholmodDense{T}) = T +eltype{T<:CHMVTypes}(CholmodFactor{T}) = T +eltype{T<:CHMVTypes}(CholmodSparse{T}) = T +eltype{T<:CHMVTypes}(CholmodTriplet{T}) = T + +function CholmodDense{T<:CHMVTypes}(aa::VecOrMat{T}) + m = size(aa,1); n = size(aa,2) + CholmodDense(c_CholmodDense{T}(m, n, m*n, stride(aa,2), + convert(Ptr{T}, aa), C_NULL, + T<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, + T<:Union(Float32,Complex64) ? CHOLMOD_SINGLE : CHOLMOD_DOUBLE), + length(size(aa)) == 2 ? aa : reshape(aa, (m,n))) +end + +function CholmodDense{T<:CHMVTypes}(c::Ptr{c_CholmodDense{T}}) + cp = unsafe_ref(c) + if cp.lda != cp.m || cp.nzmax != cp.m * cp.n + error("overallocated cholmod_dense returned object of size $(cp.m) by $(cp.n) with leading dim $(cp.lda) and nzmax $(cp.nzmax)") + end + ## the true in the call to pointer_to_array means Julia will free the memory + val = CholmodDense(cp, pointer_to_array(cp.xpt, (cp.m,cp.n), true)) + c_free(c) + val +end +show(io::IO, cd::CholmodDense) = show(io, cd.mat) + +function chm_check{T<:CHMVTypes}(cd::CholmodDense{T}) + status = ccall((:cholmod_check_dense, :libcholmod), Cint, + (Ptr{c_CholmodDense{T}}, Ptr{Uint8}), &cd.c, chm_com) + if status != CHOLMOD_TRUE throw(CholmodException) end +end + +function chm_ones{T<:Union(Float64,Complex128)}(m::Integer, n::Integer, t::T) + CholmodDense(ccall((:cholmod_ones, :libcholmod), Ptr{c_CholmodDense{T}}, + (Int, Int, Cint, Ptr{Uint8}), + m, n, + T<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, + chm_com)) +end +chm_ones(m::Integer, n::Integer) = chm_ones(m, n, 1.) + +function chm_zeros{T<:Union(Float64,Complex128)}(m::Integer, n::Integer, t::T) + CholmodDense(ccall((:cholmod_zeros, :libcholmod), Ptr{c_CholmodDense{T}}, + (Int, Int, Cint, Ptr{Uint8}), + m, n, + T<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, + chm_com)) +end +chm_zeros(m::Integer, n::Integer) = chm_zeros(m, n, 1.) + +function chm_eye{T<:Union(Float64,Complex128)}(m::Integer, n::Integer, t::T) + CholmodDense(ccall((:cholmod_eye, :libcholmod), Ptr{c_CholmodDense{T}}, + (Int, Int, Cint, Ptr{Uint8}), + m, n, + T<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, + chm_com)) +end +chm_eye(m::Integer, n::Integer) = chm_eye(m, n, 1.) +chm_eye(n::Integer) = chm_eye(n, n, 1.) + +function chm_print{T<:CHMVTypes}(cd::CholmodDense{T}, lev::Integer, nm::ASCIIString) + orig = chm_com[chm_prt_inds] + chm_com[chm_prt_inds] = reinterpret(Uint8, [int32(lev)]) + status = ccall((:cholmod_print_dense, :libcholmod), Cint, + (Ptr{c_CholmodDense{T}}, Ptr{Uint8}, Ptr{Uint8}), + &cd.c, nm, chm_com) + chm_com[chm_prt_inds] = orig + if status != CHOLMOD_TRUE throw(CholmodException) end +end +chm_print(cd::CholmodDense, lev::Integer) = chm_print(cd, lev, "") +chm_print(cd::CholmodDense) = chm_print(cd, int32(4), "") + +function CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes}(A::SparseMatrixCSC{Tv,Ti}, stype::Integer) + zerobased = A.colptr[1] == 0 + colptr0 = zerobased ? copy(A.colptr) : decrement(A.colptr) + rowval0 = zerobased ? copy(A.rowptr) : decrement(A.rowval) + nzval = copy(A.nzval) + CholmodSparse{Tv,Ti}(c_CholmodSparse{Tv,Ti}(size(A,1),size(A,2), + int(colptr0[end]), + convert(Ptr{Ti}, colptr0), + convert(Ptr{Ti}, rowval0), C_NULL, + convert(Ptr{Tv}, nzval), C_NULL, + int32(stype), chm_itype(A), + chm_xtype(A), chm_dtype(A), +### Assuming that a SparseMatrixCSC always has sorted row indices. Need to check. + CHOLMOD_TRUE, CHOLMOD_TRUE), + colptr0, rowval0, nzval) +end +function CholmodSparse(A::SparseMatrixCSC) + stype = ishermitian(A) ? 1 : 0 + CholmodSparse(stype > 0 ? triu(A) : A, stype) +end +function CholmodSparse!{Tv<:CHMVTypes,Ti<:CHMITypes}(A::SparseMatrixCSC{Tv,Ti}, stype::Integer) + zerobased = A.colptr[1] == 0 + colptr0 = zerobased ? A.colptr : decrement!(A.colptr) + rowval0 = zerobased ? A.rowptr : decrement!(A.rowval) + nzval = A.nzval + CholmodSparse{Tv,Ti}(c_CholmodSparse{Tv,Ti}(size(A,1),size(A,2), + int(colptr0[end]), + convert(Ptr{Ti}, colptr0), + convert(Ptr{Ti}, rowval0), C_NULL, + convert(Ptr{Tv}, nzval), C_NULL, + int32(stype), chm_itype(A), + chm_xtype(A), chm_dtype(A), +### Assuming that a SparseMatrixCSC always has sorted row indices. Need to check. + CHOLMOD_TRUE, CHOLMOD_TRUE), + colptr0, rowval0, nzval) +end +function CholmodSparse!(A::SparseMatrixCSC) + stype = ishermitian(A) ? 1 : 0 + CholmodSparse!(stype > 0 ? triu(A) : A, stype) +end + +function cmn{Ti<:CHMITypes}(i::Ti) # turns out this is as fast as checking for initialization + if Ti <: Int64 + ccall((:cholmod_l_start, :libcholmod), Cint, (Ptr{Uint8},), chm_com) + else + ccall((:cholmod_start, :libcholmod), Cint, (Ptr{Uint8},), chm_com) + end + chm_com +end +cmn{Tv,Ti<:CHMITypes}(A::CholmodSparse{Tv,Ti}) = cmn(one(Ti)) +cmn{Tv,Ti<:CHMITypes}(a::c_CholmodSparse{Tv,Ti}) = cmn(one(Ti)) +cmn{Tv,Ti<:CHMITypes}(ap::Ptr{c_CholmodSparse{Tv,Ti}}) = cmn(one(Ti)) +cmn{Tv,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti}) = cmn(one(Ti)) +cmn{Tv,Ti<:CHMITypes}(l::c_CholmodFactor{Tv,Ti}) = cmn(one(Ti)) +cmn{Tv,Ti<:CHMITypes}(lp::Ptr{c_CholmodFactor{Tv,Ti}}) = cmn(one(Ti)) + +function chm_rdsp(fnm::String) + fd = ccall(:fopen, Ptr{Void}, (Ptr{Uint8},Ptr{Uint8}), fnm, "r") + res = ccall((:cholmod_read_sparse,:libcholmod), Ptr{c_CholmodSparse{Float64,Int32}}, + (Ptr{Void},Ptr{Uint8}),fd,cmn(one(Cint))) + ccall(:fclose, Cint, (Ptr{Void},), fd) + CholmodSparse(res) +end + +function CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::Ptr{c_CholmodSparse{Tv,Ti}}) + csp = unsafe_ref(cp) + colptr0 = pointer_to_array(csp.ppt, (csp.n + 1,), true) + nnz = int(colptr0[end]) + cms = CholmodSparse{Tv,Ti}(csp, colptr0, + pointer_to_array(csp.ipt, (nnz,), true), + pointer_to_array(csp.xpt, (nnz,), true)) + c_free(cp) + cms +end + +for (chk,prt,srt,itype) in + (("cholmod_check_sparse","cholmod_print_sparse","cholmod_sort",:Int32), + ("cholmod_l_check_sparse","cholmod_l_print_sparse","cholmod_l_sort",:Int64)) + @eval begin + function chm_check{Tv<:CHMVTypes}(cs::CholmodSparse{Tv,$itype}) + cmn(cs) + status = ccall(($chk,:libcholmod), Cint, + (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), + &cs.c, chm_com) + if status != CHOLMOD_TRUE throw(CholmodException) end + end + function chm_print{Tv<:CHMVTypes}(cs::CholmodSparse{Tv,$itype},lev,nm) + cmn(cs) # initialize if necessary + orig = chm_com[chm_prt_inds] + chm_com[chm_prt_inds] = reinterpret(Uint8, [int32(lev)]) + status = ccall(($prt,:libcholmod), Cint, + (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}, Ptr{Uint8}), + &cs.c, nm, chm_com) + chm_com[chm_prt_inds] = orig + if status != CHOLMOD_TRUE throw(CholmodException) end + end + function sort!{Tv<:CHMVTypes}(cs::CholmodSparse{Tv,$itype}) + status = ccall(($srt,:libcholmod), Cint, + (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), + &cs.c, cmn(cs)) + if status != CHOLMOD_TRUE throw(CholmodException) end + cs + end + end +end +chm_print(cd::CholmodSparse, lev::Integer) = chm_print(cd, lev, "") +show(io::IO,cd::CholmodSparse) = chm_print(cd, int32(4), "") + +nnz{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::CholmodSparse{Tv,Ti}) = int(cp.colptr0[end]) +size{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::CholmodSparse{Tv,Ti}) = (int(cp.c.m), int(cp.c.n)) +function size{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::CholmodSparse{Tv,Ti}, d::Integer) + d == 1 ? cp.c.m : (d == 2 ? cp.c.n : 1) +end + +for (aat,allocsp,cop,copsp,freesp,normsp,scl,sdmult,speye,ssmult,transsym,itype) in + (("cholmod_aat","cholmod_allocate_sparse","cholmod_copy","cholmod_copy_sparse", + "cholmod_free_sparse","cholmod_norm_sparse","cholmod_scale", "cholmod_sdmult", + "cholmod_speye", "cholmod_ssmult","cholmod_transpose_sym",:Int32), + ("cholmod_l_aat","cholmod_l_allocate_sparse","cholmod_l_copy","cholmod_l_copy_sparse", + "cholmod_l_free_sparse","cholmod_l_norm_sparse","cholmod_l_scale", + "cholmod_l_sdmult","cholmod_l_speye","cholmod_l_ssmult","cholmod_l_transpose_sym",:Int64)) + @eval begin + function chm_aat{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}) + cm = cmn(a) + ## strangely the matrix returned by $aat is not marked as symmetric + ## all of the code past the call to $aat is to create the symmetric-storage + ## version of the result then transpose it to provide sorted columns + aa = Array(Ptr{c_CholmodSparse{Tv,$itype}}, 2) + aa[1] = ccall(($aat, :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, + (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Void}, Int, Cint, Ptr{Uint8}), + &a, C_NULL, 0, 1, cm) + ## Create the lower triangle unsorted + aa[2] = ccall(($cop, :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, + (Ptr{c_CholmodSparse{Tv,$itype}}, Cint, Cint, Ptr{Uint8}), + aa[1], -1, 1, cm) + status = ccall(($freesp, :libcholmod), Cint, + (Ptr{Ptr{c_CholmodSparse{Tv,$itype}}}, Ptr{Uint8}), aa, cm) + if status != CHOLMOD_TRUE throw(CholmodException) end + aa[1] = aa[2] + r = unsafe_ref(aa[1]) + ## Now transpose the lower triangle to the upper triangle to do the sorting + rpt = ccall(($allocsp,:libcholmod),Ptr{c_CholmodSparse{Tv,$itype}}, + (Csize_t,Csize_t,Csize_t,Cint,Cint,Cint,Cint,Ptr{Cuchar}), + r.m,r.n,r.nzmax,r.sorted,r.packed,-r.stype,r.xtype,cm) + status = ccall(($transsym,:libcholmod),Cint, + (Ptr{c_CholmodSparse{Tv,$itype}}, Cint, Ptr{$itype}, + Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), + aa[1],1,C_NULL,rpt,cm) + if status != CHOLMOD_TRUE throw(CholmodException) end + status = ccall(($freesp, :libcholmod), Cint, + (Ptr{Ptr{c_CholmodSparse{Tv,$itype}}}, Ptr{Uint8}), aa, cm) + if status != CHOLMOD_TRUE throw(CholmodException) end + CholmodSparse(rpt) + end + function chm_copy_sp{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}) + ccall(($copsp,:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, + (Ptr{c_CholmodSparse{Tv,$itype}},Ptr{Uint8}), &a, cmn(a)) + end + function norm{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype},p::Number) + ccall(($normsp, :libcholmod), Float64, + (Ptr{c_CholmodSparse{Tv,$itype}}, Cint, Ptr{Uint8}), + &a,p == 1 ? 1 :(p == Inf ? 1 : error("p must be 1 or Inf")),cmn(a)) + end + function chm_sdmult{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}, + trans::Bool, + alpha::Real, + beta::Real, + x::c_CholmodDense{Tv}) + nc = trans ? a.m : a.n + nr = trans ? a.n : a.m + if nc != x.m + error("Incompatible dimensions, $nc and $(x.m), in sdmult") + end + Y = CholmodDense(Array(Tv,nr,x.n)) + status = ccall(($sdmult,:libcholmod), Cint, + (Ptr{c_CholmodSparse{Tv,$itype}},Cint,Cdouble,Cdouble, + Ptr{c_CholmodDense{Tv}}, Ptr{c_CholmodDense{Tv}}, Ptr{Uint8}), + &a,trans,&alpha,&beta,&x,&Y.c,cmn(a)) + if status != CHOLMOD_TRUE throw(CholmodException) end + Y + end + function chm_speye{Tv<:Union(Float64,Complex128)}(m::Integer, n::Integer, t::Tv, i::$itype) + CholmodSparse(ccall(($speye, :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, + (Int, Int, Cint, Ptr{Uint8}), + m, n, + Tv<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, + cmn(one($itype)))) + end + function (*){Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}, + b::c_CholmodSparse{Tv,$itype}) + CholmodSparse(ccall(($ssmult, :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, + (Ptr{c_CholmodSparse{Tv,$itype}},Ptr{c_CholmodSparse{Tv,$itype}}, + Cint,Cint,Cint,Ptr{Uint8}), &a,&b,0,true,true,cmn(a))) + end + function chm_scale!{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}, + s::c_CholmodDense{Tv}, + typ::Integer) + status = ccall(($scl,:libcholmod), Cint, + (Ptr{c_CholmodDense{Tv}},Cint,Ptr{c_CholmodSparse{Tv,$itype}}, + Ptr{Uint8}), &s, typ, &a, cmn(a)) + if status != CHOLMOD_TRUE throw(CholmodException) end + end + end +end +(*){Tv<:CHMVTypes}(a::c_CholmodSparse{Tv},b::c_CholmodDense{Tv}) = chm_sdmult(a,false,1.,0.,b) +(*){Tv<:CHMVTypes}(A::CholmodSparse{Tv},B::CholmodDense{Tv}) = chm_sdmult(A.c,false,1.,0.,B.c) +Ac_mul_B{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv},b::c_CholmodDense{Tv}) = chm_sdmult(a,true,1.,0.,b) +Ac_mul_B{Tv<:CHMVTypes}(A::CholmodSparse{Tv},B::CholmodDense{Tv}) = chm_sdmult(A.c,true,1.,0.,B.c) +(*){Tv<:CHMVTypes,Ti<:CHMITypes}(A::CholmodSparse{Tv,Ti},B::CholmodSparse{Tv,Ti}) = A.c * B.c +chm_speye(m::Integer, n::Integer) = chm_speye(m, n, 1., 1) +chm_speye(n::Integer) = chm_speye(n, n, 1., 1) +chm_aat(A::CholmodSparse) = chm_aat(A.c) +chm_aat(A::SparseMatrixCSC) = chm_aat(CholmodSparse(A).c) +norm(A::CholmodSparse,p::Number) = norm(A.c,p) +norm(A::CholmodSparse) = norm(A.c,1) +copy(A::CholmodSparse) = CholmodSparse(chm_copy_sp(A.c)) +function chm_scale!{T<:CHMVTypes}(A::CholmodSparse{T},S::CholmodDense{T},typ::Integer) + chm_scale!(A.c,S.c,typ) +end +function diagmm{T<:CHMVTypes}(b::Vector{T}, A::CholmodSparse{T}) + Acp = copy(A) + chm_scale!(Acp,CholmodDense(b),CHOLMOD_ROW) + Acp +end +function diagmm!{T<:CHMVTypes}(b::Vector{T}, A::CholmodSparse{T}) + chm_scale!(A,CholmodDense(b),CHOLMOD_ROW) + A +end +function diagmm{T<:CHMVTypes}(A::CholmodSparse{T},b::Vector{T}) + Acp = copy(A) + chm_scale!(Acp,CholmodDense(b),CHOLMOD_COL) + Acp +end +function diagmm!{T<:CHMVTypes}(A::CholmodSparse{T},b::Vector{T}) + chm_scale!(A,CholmodDense(b),CHOLMOD_COL) + A +end + +function CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::Ptr{c_CholmodFactor{Tv,Ti}}) + cfp = unsafe_ref(cp) + Perm = pointer_to_array(cfp.Perm, (cfp.n,), true) + ColCount = pointer_to_array(cfp.ColCount, (cfp.n,), true) + p = pointer_to_array(cfp.p, (cfp.p == C_NULL ? 0 : cfp.n + 1,), true) + i = pointer_to_array(cfp.i, (cfp.i == C_NULL ? 0 : cfp.nzmax,), true) + x = pointer_to_array(cfp.x, (cfp.x == C_NULL ? 0 : cfp.nzmax,), true) + nz = pointer_to_array(cfp.nz, (cfp.nz == C_NULL ? 0 : cfp.n,), true) + next = pointer_to_array(cfp.next, (cfp.next == C_NULL ? 0 : cfp.n + 2,), true) + prev = pointer_to_array(cfp.prev, (cfp.prev == C_NULL ? 0 : cfp.n + 2,), true) + super = pointer_to_array(cfp.super, (cfp.super == C_NULL ? 0 : cfp.nsuper + 1,), true) + pi = pointer_to_array(cfp.pi, (cfp.pi == C_NULL ? 0 : cfp.nsuper + 1,), true) + px = pointer_to_array(cfp.px, (cfp.px == C_NULL ? 0 : cfp.nsuper + 1,), true) + s = pointer_to_array(cfp.s, (cfp.s == C_NULL ? 0 : cfp.ssize + 1,), true) + cf = CholmodFactor{Tv,Ti}(cfp, Perm, ColCount, p, i, x, nz, next, prev, + super, pi, px, s) + c_free(cp) + cf +end + +for (anl,chng,fac,slv,spslv,itype) in + (("cholmod_analyze","cholmod_change_factor","cholmod_factorize", + "cholmod_solve","cholmod_spsolve",:Int32), + ("cholmod_l_analyze","cholmod_l_change_factor","cholmod_l_factorize", + "cholmod_l_solve","cholmod_l_spsolve",:Int64)) + @eval begin + function chm_analyze{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}) + ccall(($anl,:libcholmod), Ptr{c_CholmodFactor{Tv,$itype}}, + (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), &a, cmn(a)) + end + # update the factorization + function chm_factorize!{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}, + a::c_CholmodSparse{Tv,$itype}) + status = ccall(($fac,:libcholmod), Cint, + (Ptr{c_CholmodSparse{Tv,$itype}}, + Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), + &a, &l, cmn(a)) + if status != CHOLMOD_TRUE throw(CholmodException) end + end + # initialize a factorization + function cholfact{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}, ll::Bool) + cmn(a) +## may need to change final_asis as well as final_ll + if ll chm_com[chm_final_ll_inds] = reinterpret(Uint8, [one(Cint)]) end + Lpt = ccall(($anl,:libcholmod), Ptr{c_CholmodFactor{Tv,$itype}}, + (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), &a, chm_com) + status = ccall(($fac,:libcholmod), Cint, + (Ptr{c_CholmodSparse{Tv,$itype}}, + Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), + &a, Lpt, chm_com) + if status != CHOLMOD_TRUE throw(CholmodException) end + CholmodFactor(Lpt) + end + function solve{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}, + b::c_CholmodDense{Tv}, typ::Integer) + ccall(($slv,:libcholmod), Ptr{c_CholmodDense{Tv}}, + (Cint, Ptr{c_CholmodFactor{Tv,$itype}}, + Ptr{c_CholmodDense{Tv}}, Ptr{Uint8}), + typ, &l, &b, cmn(l)) + end + function solve{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}, + b::c_CholmodSparse{Tv,$itype}, + typ::Integer) + ccall(($spslv,:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, + (Cint, Ptr{c_CholmodFactor{Tv,$itype}}, + Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), + typ, &l, &b, cmn(l)) + end + end +end +chm_analyze(ap::Ptr{c_CholmodSparse}) = chm_analyze(unsafe_ref(ap)) +chm_analyze(A::CholmodSparse) = chm_analyze(A.c) +chm_analyze(A::SparseMatrixCSC) = chm_analyze(CholmodSparse(A).c) + +cholfact(a::c_CholmodSparse) = cholfact(a,false) # LDL by default +cholfact(A::CholmodSparse,ll::Bool) = cholfact(A.c,ll) +cholfact(A::CholmodSparse) = cholfact(A.c,false) +cholfact(A::SparseMatrixCSC,ll::Bool) = cholfact(CholmodSparse(A).c,ll) +cholfact(A::SparseMatrixCSC) = cholfact(CholmodSparse(A).c,false) +cholfact!(A::SparseMatrixCSC,ll::Bool) = cholfact(CholmodSparse!(A).c,ll) +cholfact!(A::SparseMatrixCSC) = cholfact(CholmodSparse!(A).c,false) + +solve{T<:CHMVTypes}(l::c_CholmodFactor{T},b::c_CholmodDense{T}) = solve(l,b,CHOLMOD_A) +solve{T<:CHMVTypes}(L::CholmodFactor{T},B::CholmodDense{T}) = solve(L.c,B.c,CHOLMOD_A) +solve{Tv<:CHMVTypes,Ti<:CHMITypes}(l::c_CholmodFactor{Tv,Ti},b::c_CholmodSparse{Tv,Ti})= + solve(l,b,CHOLMOD_A) +solve{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::CholmodSparse{Tv,Ti})=solve(L.c,B.c,CHOLMOD_A) +solve{T<:CHMVTypes}(l::c_CholmodFactor{T},b::VecOrMat{T},typ::Integer)=solve(l,CholmodDense(b),typ) +solve{T<:CHMVTypes}(l::c_CholmodFactor{T},b::VecOrMat{T})=solve(l,CholmodDense(b),CHOLMOD_A) +solve{T<:CHMVTypes}(L::CholmodFactor{T},b::VecOrMat{T},typ::Integer)=solve(L.c,CholmodDense(b),typ) +solve{T<:CHMVTypes}(L::CholmodFactor{T},b::VecOrMat{T})=solve(L.c,CholmodDense(b),CHOLMOD_A) + +for (chng,pack,cop,xtyp,f2s,itype) in + ((:cholmod_change_factor,:cholmod_pack_factor, + :cholmod_copy_factor,:cholmod_factor_xtype, + :cholmod_factor_to_sparse,:Int32), + (:cholmod_l_change_factor,:cholmod_l_pack_factor, + :cholmod_l_copy_factor,:cholmod_l_factor_xtype, + :cholmod_l_factor_to_sparse,:Int64)) + @eval begin + ## changing the factor is problematic because it reallocates the storage + ## for the arrays and frees the old arrays but Julia retains the old pointers + ## in the vectors (May get around this by passing an array of length 1 and not &l?) + ## function chm_chng_fac!{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}, + ## xt,ll,super,packed,monotonic) + ## status = ccall(($(string(chng)),:libcholmod), Cint, + ## (Cint,Cint,Cint,Cint,Cint, + ## Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), + ## xt,ll,super,packed,monotonic,&l,cmn(l)) + ## if status != CHOLMOD_TRUE throw(CholmodException) end + ## end + function chm_copy_fac{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}) + ccall(($(string(cop)),:libcholmod), Ptr{c_CholmodFactor{Tv,$itype}}, + (Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), &l,cmn(l)) + end + function chm_fac_to_sp{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}) + ccall(($(string(f2s)),:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, + (Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), &l,cmn(l)) + end + function chm_fac_xtype!{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype},to_xtype) + status = ccall(($(string(xtyp)),:libcholmod), Cint, + (Cint, Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), + to_xtype,&l,cmn(l)) + if status != CHOLMOD_TRUE throw(CholmodException) end + end + function chm_pack_fac!{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}) + status = ccall(($(string(pack)),:libcholmod), Cint, + (Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), + &l,cmn(l)) + if status != CHOLMOD_TRUE throw(CholmodException) end + end + end +end +## function chm_chng_fac!(L::CholmodFactor,xt,ll,super,packed,monotonic) +## chm_chng_fac!(L.c, xt,ll,super,packed,monotonic) +## end + +copy(L::CholmodFactor) = CholmodFactor(chm_copy_fac(L.c)) +CholmodSparse(L::CholmodFactor) = CholmodSparse(chm_fac_to_sp(L.c)) + +function chm_fac_xtype!{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},to_xtype) + chm_fac_xtype(L.c,to_xtype) +end + +function CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes}(tp::Ptr{c_CholmodTriplet{Tv,Ti}}) + ctp = unsafe_ref(tp) + i = pointer_to_array(ctp.i, (ctp.nnz,), true) + j = pointer_to_array(ctp.j, (ctp.nnz,), true) + x = pointer_to_array(ctp.x, (ctp.x == C_NULL ? 0 : ctp.nnz), true) + ct = CholmodTriplet{Tv,Ti}(ctp, i, j, x) + c_free(tp) + ct +end + +for (s2t,t2s,itype) in + (("colmod_sparse_to_triplet","cholmod_triplet_to_sparse",:Int32), + ("cholmod_l_sparse_to_triplet","cholmod_l_triplet_to_sparse",:Int64)) + @eval begin + function convert{Tv<:CHMVTypes}(::Type{CholmodTriplet{Tv,$itype}}, + A::CholmodSparse{Tv,$itype}) + CholmodTriplet(ccall(($s2t, :libcholmod), Ptr{c_CholmodTriplet{Tv,$itype}}, + (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), &A, cmn(A))) + end + function convert{Tv<:CHMVTypes}(::Type{CholmodSparse{Tv,$itype}}, + A::CholmodTriplet{Tv,$itype}) + CholmodSparse(ccall(($t2s, :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, + (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), &A, cmn(A))) + end + end +end + +function findn_nzs{Tv,Ti}(A::CholmodSparse{Tv,Ti}) + jj = similar(A.rowval0) # expand A.colptr0 to a vector of indices + for j in 1:A.c.n, k in (A.colptr0[j]+1):A.colptr0[j+1] + jj[k] = j + end + + ind = similar(A.rowval0) + ipos = 1 + count = 0 + for k in 1:length(A.nzval) + if A.nzval[k] != 0 + ind[ipos] = k + ipos += 1 + count += 1 + else + println("Warning: sparse matrix contains explicitly stored zeros.") + end + end + ind = ind[1:count] # ind is the indices of nonzeros in A.nzval + (increment!(A.rowval0[ind]), jj[ind], A.nzval[ind]) +end + +findn_nzs(L::CholmodFactor) = findn_nzs(chm_fac_to_sp(L)) + +function diag{Tv}(A::CholmodSparse{Tv}) + minmn = min(size(A)) + res = zeros(Tv,minmn) + cp0 = A.colptr0 + rv0 = A.rowval0 + anz = A.nzval + for j in 1:minmn, k in (cp0[j]+1):cp0[j+1] + if rv0[k] == j-1 + res[j] += anz[k] + end + end + res +end + +function diag{Tv}(L::CholmodFactor{Tv}) + res = zeros(Tv,L.c.n) + if L.c.is_super != 0 error("Method for supernodal factors not yet written") end + c0 = L.p + r0 = L.i + xv = L.x + for j in 1:length(c0)-1 + jj = c0[j]+1 + assert(r0[jj] == j-1) + res[j] = xv[jj] + end + res +end + +function logdet{Tv,Ti}(L::CholmodFactor{Tv,Ti}) + if L.c.is_super != 0 error("Method for supernodal factors not yet written") end + c0 = L.p + r0 = L.i + xv = L.x + res = zero(Tv) + for j in 1:length(c0)-1 + jj = c0[j]+1 + assert(r0[jj] == j-1) + res += log(xv[jj]) + end + L.c.is_ll != 0 ? 2res : res +end + +end #module diff --git a/base/linalg/linalg.jl b/base/linalg/linalg.jl index 6925b6ebc412c..6a4c18e0b7d64 100644 --- a/base/linalg/linalg.jl +++ b/base/linalg/linalg.jl @@ -154,9 +154,10 @@ include("linalg/rectfullpacked.jl") include("linalg/bitarray.jl") include("linalg/sparse.jl") -include("linalg/suitesparse.jl") +include("linalg/umfpack.jl") +include("linalg/cholmod.jl") include("linalg/arpack.jl") include("linalg/arnoldi.jl") -end # module LinAlg \ No newline at end of file +end # module LinAlg diff --git a/base/linalg/suitesparse.jl b/base/linalg/suitesparse.jl index d25c39d690ae5..01b21f54577e5 100644 --- a/base/linalg/suitesparse.jl +++ b/base/linalg/suitesparse.jl @@ -1,61 +1,25 @@ -module SuiteSparse +module UMFPACK + +export UmfpackLU, -export ChmCommon, - CholmodDense, # types - CholmodFactor, - CholmodSparse, - CholmodTriplet, - UmfpackLU, - # methods - chm_aat, - chm_analyze, - chm_check, - chm_chng_fac!, - chm_eye, - chm_fac_xtype!, - chm_factorize, - chm_factorize!, - chm_norm, - chm_ones, - chm_pack_fac!, - chm_print, - chm_scale!, - chm_sdmult, - chm_solve, - chm_sort, - chm_speye, - chm_spsolve, - chm_sp_to_tr, - chm_zeros, decrement, decrement!, increment, - increment!, - indtype, - show_umf_ctrl, - show_umf_info, - umf_extract, - umf_lunz + increment! import Base.(\) import Base.Ac_ldiv_B import Base.At_ldiv_B -import Base.SparseMatrixCSC -import Base.copy - -import Base.nnz import Base.findn_nzs +import Base.getindex +import Base.nnz import Base.show import Base.size -import Base.convert import LinAlg.Factorization -import LinAlg.chol import LinAlg.det -import LinAlg.diag -import LinAlg.diagmm -import LinAlg.logdet -import LinAlg.lu +import LinAlg.lufact +import LinAlg.lufact! import LinAlg.solve include("linalg/suitesparse_h.jl") @@ -74,15 +38,14 @@ function increment!{T<:Integer}(A::AbstractArray{T}) end increment{T<:Integer}(A::AbstractArray{T}) = increment!(copy(A)) -typealias CHMITypes Union(Int32,Int64) # also ITypes for UMFPACK -typealias CHMVTypes Union(Complex64, Complex128, Float32, Float64) typealias UMFVTypes Union(Float64,Complex128) +typealias UMFITypes Union(Int32,Int64) ## UMFPACK # the control and info arrays const umf_ctrl = Array(Float64, UMFPACK_CONTROL) -ccall((:umfpack_dl_defaults, :libumfpack), Void, (Ptr{Float64},), umf_ctrl) +ccall((:umfpack_dl_defaults,:libumfpack), Void, (Ptr{Float64},), umf_ctrl) const umf_info = Array(Float64, UMFPACK_INFO) function show_umf_ctrl(level::Real) @@ -102,7 +65,8 @@ function show_umf_info(level::Real) end show_umf_info() = show_umf_info(2.) -type UmfpackLU{Tv<:UMFVTypes,Ti<:CHMITypes} <: Factorization{Tv} +## Should this type be immutable? +type UmfpackLU{Tv<:UMFVTypes,Ti<:UMFITypes} <: Factorization{Tv} symbolic::Ptr{Void} numeric::Ptr{Void} m::Int @@ -112,7 +76,7 @@ type UmfpackLU{Tv<:UMFVTypes,Ti<:CHMITypes} <: Factorization{Tv} nzval::Vector{Tv} end -function lu{Tv<:UMFVTypes,Ti<:CHMITypes}(S::SparseMatrixCSC{Tv,Ti}) +function lufact{Tv<:UMFVTypes,Ti<:UMFITypes}(S::SparseMatrixCSC{Tv,Ti}) zerobased = S.colptr[1] == 0 res = UmfpackLU(C_NULL, C_NULL, S.m, S.n, zerobased ? copy(S.colptr) : decrement(S.colptr), @@ -122,7 +86,7 @@ function lu{Tv<:UMFVTypes,Ti<:CHMITypes}(S::SparseMatrixCSC{Tv,Ti}) umfpack_numeric!(res) end -function lu!{Tv<:UMFVTypes,Ti<:CHMITypes}(S::SparseMatrixCSC{Tv,Ti}) +function lufact!{Tv<:UMFVTypes,Ti<:UMFITypes}(S::SparseMatrixCSC{Tv,Ti}) zerobased = S.colptr[1] == 0 res = UmfpackLU(C_NULL, C_NULL, S.m, S.n, zerobased ? S.colptr : decrement!(S.colptr), @@ -138,35 +102,24 @@ function show(io::IO, f::UmfpackLU) if f.numeric != C_NULL println(f.numeric) end end -### Solve with Factorization - -(\){T<:UMFVTypes}(fact::UmfpackLU{T}, b::Vector{T}) = umfpack_solve(fact, b) -(\){Ts<:UMFVTypes,Tb<:Number}(fact::UmfpackLU{Ts}, b::Vector{Tb}) = fact\convert(Vector{Ts},b) +## Wrappers for UMFPACK functions -### Solve directly with matrix - -(\)(S::SparseMatrixCSC, b::Vector) = lu(S) \ b -At_ldiv_B{T<:UMFVTypes}(S::SparseMatrixCSC{T}, b::Vector{T}) = umfpack_solve(lu(S), b, UMFPACK_Aat) -function At_ldiv_B{Ts<:UMFVTypes,Tb<:Number}(S::SparseMatrixCSC{Ts}, b::Vector{Tb}) - ## should be more careful here in case Ts<:Real and Tb<:Complex - At_ldiv_B(S, convert(Vector{Ts}, b)) -end -Ac_ldiv_B{T<:UMFVTypes}(S::SparseMatrixCSC{T}, b::Vector{T}) = umfpack_solve(lu(S), b, UMFPACK_At) -function Ac_ldiv_B{Ts<:UMFVTypes,Tb<:Number}(S::SparseMatrixCSC{Ts}, b::Vector{Tb}) - ## should be more careful here in case Ts<:Real and Tb<:Complex - Ac_ldiv_B(S, convert(Vector{Ts}, b)) -end - -## Wrappers around UMFPACK routines - -for (f_sym_r, f_num_r, f_sym_c, f_num_c, itype) in - (("umfpack_di_symbolic","umfpack_di_numeric","umfpack_zi_symbolic","umfpack_zi_numeric",:Int32), - ("umfpack_dl_symbolic","umfpack_dl_numeric","umfpack_zl_symbolic","umfpack_zl_numeric",:Int64)) +for (sym_r,sym_c,num_r,num_c,sol_r,sol_c,det_r,det_z,lunz,get_num_r,get_num_z,itype) in + (("umfpack_di_symbolic","umfpack_zi_symbolic", + "umfpack_di_numeric","umfpack_zi_numeric", + "umfpack_di_solve","umfpack_zi_solve", + "umfpack_di_get_determinant","umfpack_zi_get_determinant", + "umfpack_di_get_lunz","umfpack_di_get_numeric","umfpack_zi_get_numeric",:Int32), + ("umfpack_dl_symbolic","umfpack_zl_symbolic", + "umfpack_dl_numeric","umfpack_zl_numeric", + "umfpack_dl_solve","umfpack_zl_solve", + "umfpack_dl_get_determinant","umfpack_zl_get_determinant", + "umfpack_dl_get_lunz","umfpack_dl_get_numeric","umfpack_zl_get_numeric",:Int64)) @eval begin function umfpack_symbolic!{Tv<:Float64,Ti<:$itype}(U::UmfpackLU{Tv,Ti}) if U.symbolic != C_NULL return U end tmp = Array(Ptr{Void},1) - status = ccall(($f_sym_r, :libumfpack), Ti, + status = ccall(($sym_r, :libumfpack), Ti, (Ti, Ti, Ptr{Ti}, Ptr{Ti}, Ptr{Tv}, Ptr{Void}, Ptr{Float64}, Ptr{Float64}), U.m, U.n, U.colptr, U.rowval, U.nzval, tmp, @@ -175,11 +128,10 @@ for (f_sym_r, f_num_r, f_sym_c, f_num_c, itype) in U.symbolic = tmp[1] U end - function umfpack_symbolic!{Tv<:Complex128,Ti<:$itype}(U::UmfpackLU{Tv,Ti}) if U.symbolic != C_NULL return U end tmp = Array(Ptr{Void},1) - status = ccall(($f_sym_r, :libumfpack), Ti, + status = ccall(($sym_r, :libumfpack), Ti, (Ti, Ti, Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Float64}, Ptr{Void}, Ptr{Float64}, Ptr{Float64}), U.m, U.n, U.colptr, U.rowval, real(U.nzval), imag(U.nzval), tmp, @@ -188,12 +140,11 @@ for (f_sym_r, f_num_r, f_sym_c, f_num_c, itype) in U.symbolic = tmp[1] U end - function umfpack_numeric!{Tv<:Float64,Ti<:$itype}(U::UmfpackLU{Tv,Ti}) if U.numeric != C_NULL return U end if U.symbolic == C_NULL umfpack_symbolic!(U) end tmp = Array(Ptr{Void}, 1) - status = ccall(($f_num_r, :libumfpack), Ti, + status = ccall(($num_r, :libumfpack), Ti, (Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Void}, Ptr{Void}, Ptr{Float64}, Ptr{Float64}), U.colptr, U.rowval, U.nzval, U.symbolic, tmp, @@ -203,12 +154,11 @@ for (f_sym_r, f_num_r, f_sym_c, f_num_c, itype) in U.numeric = tmp[1] U end - function umfpack_numeric!{Tv<:Complex128,Ti<:$itype}(U::UmfpackLU{Tv,Ti}) if U.numeric != C_NULL return U end if U.symbolic == C_NULL umfpack_symbolic!(U) end tmp = Array(Ptr{Void}, 1) - status = ccall(($f_num_r, :libumfpack), Ti, + status = ccall(($num_r, :libumfpack), Ti, (Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Float64}, Ptr{Void}, Ptr{Void}, Ptr{Float64}, Ptr{Float64}), U.colptr, U.rowval, real(U.nzval), imag(U.nzval), U.symbolic, tmp, @@ -218,31 +168,21 @@ for (f_sym_r, f_num_r, f_sym_c, f_num_c, itype) in U.numeric = tmp[1] U end - end -end - -for (f_sol_r, f_sol_c, itype) in - (("umfpack_di_solve","umfpack_zi_solve",:Int32), - ("umfpack_dl_solve","umfpack_zl_solve",:Int64)) - @eval begin - function umfpack_solve{Tv<:Float64,Ti<:$itype}(lu::UmfpackLU{Tv,Ti}, - b::Vector{Tv}, typ::Integer) + function solve{Tv<:Float64,Ti<:$itype}(lu::UmfpackLU{Tv,Ti}, b::Vector{Tv}, typ::Integer) umfpack_numeric!(lu) x = similar(b) - status = ccall(($f_sol_r, :libumfpack), Ti, + status = ccall(($sol_r, :libumfpack), Ti, (Ti, Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Float64}, Ptr{Float64}, Ptr{Void}, Ptr{Float64}, Ptr{Float64}), typ, lu.colptr, lu.rowval, lu.nzval, x, b, lu.numeric, umf_ctrl, umf_info) if status != UMFPACK_OK; error("Error code $status in umfpack_solve"); end return x end - - function umfpack_solve{Tv<:Complex128,Ti<:$itype}(lu::UmfpackLU{Tv,Ti}, - b::Vector{Tv}, typ::Integer) + function solve{Tv<:Complex128,Ti<:$itype}(lu::UmfpackLU{Tv,Ti}, b::Vector{Tv}, typ::Integer) umfpack_numeric!(lu) xr = similar(b, Float64) xi = similar(b, Float64) - status = ccall(($f_sol_c, :libumfpack), + status = ccall(($sol_c, :libumfpack), Ti, (Ti, Ptr{Ti}, Ptr{Ti}, Ptr{Float64}, Ptr{Float64}, Ptr{Float64}, Ptr{Float64}, Ptr{Float64}, Ptr{Float64}, @@ -253,16 +193,6 @@ for (f_sol_r, f_sol_c, itype) in if status != UMFPACK_OK; error("Error code $status from umfpack_solve"); end return complex(xr,xi) end - end -end -show_umf_ctrl() = show_umf_ctrl(2.) - -umfpack_solve(lu::UmfpackLU, b::Vector) = umfpack_solve(lu, b, UMFPACK_A) - -for (det_r,det_z,itype) in - (("umfpack_di_get_determinant","umfpack_zi_get_determinant",:Int32), - ("umfpack_dl_get_determinant","umfpack_zl_get_determinant",:Int64)) - @eval begin function det{Tv<:Float64,Ti<:$itype}(lu::UmfpackLU{Tv,Ti}) mx = Array(Tv,1) status = ccall(($det_r,:libumfpack), Ti, @@ -280,13 +210,6 @@ for (det_r,det_z,itype) in if status != UMFPACK_OK error("Error code $status from umfpack_get_determinant") end complex(mx[1], mz[1]) end - end -end - -for (lunz,get_numeric_r,get_numeric_z,itype) in - (("umfpack_di_get_lunz","umfpack_di_get_numeric","umfpack_zi_get_numeric",:Int32), - ("umfpack_dl_get_lunz","umfpack_dl_get_numeric","umfpack_zl_get_numeric",:Int64)) - @eval begin function umf_lunz{Tv<:UMFVTypes,Ti<:$itype}(lu::UmfpackLU{Tv,Ti}) lnz = Array(Ti, 1) unz = Array(Ti, 1) @@ -311,7 +234,7 @@ for (lunz,get_numeric_r,get_numeric_z,itype) in P = Array(Ti, n_row) Q = Array(Ti, n_col) Rs = Array(Tv, n_row) - status = ccall(($get_numeric_r,:libumfpack), Ti, + status = ccall(($get_num_r,:libumfpack), Ti, (Ptr{Ti},Ptr{Ti},Ptr{Tv}, Ptr{Ti},Ptr{Ti},Ptr{Tv}, Ptr{Ti},Ptr{Ti},Ptr{Void}, @@ -328,6 +251,38 @@ for (lunz,get_numeric_r,get_numeric_z,itype) in end end +### Solve with Factorization + +(\){T<:UMFVTypes}(fact::UmfpackLU{T}, b::Vector{T}) = solve(fact, b) +(\){Ts<:UMFVTypes,Tb<:Number}(fact::UmfpackLU{Ts}, b::Vector{Tb}) = fact\convert(Vector{Ts},b) + +### Solve directly with matrix + +(\)(S::SparseMatrixCSC, b::Vector) = lufact(S) \ b +At_ldiv_B{T<:UMFVTypes}(S::SparseMatrixCSC{T}, b::Vector{T}) = solve(lufact(S), b, UMFPACK_Aat) +function At_ldiv_B{Ts<:UMFVTypes,Tb<:Number}(S::SparseMatrixCSC{Ts}, b::Vector{Tb}) + ## should be more careful here in case Ts<:Real and Tb<:Complex + At_ldiv_B(S, convert(Vector{Ts}, b)) +end +Ac_ldiv_B{T<:UMFVTypes}(S::SparseMatrixCSC{T}, b::Vector{T}) = solve(lufact(S), b, UMFPACK_At) +function Ac_ldiv_B{Ts<:UMFVTypes,Tb<:Number}(S::SparseMatrixCSC{Ts}, b::Vector{Tb}) + ## should be more careful here in case Ts<:Real and Tb<:Complex + Ac_ldiv_B(S, convert(Vector{Ts}, b)) +end + +solve(lu::UmfpackLU, b::Vector) = solve(lu, b, UMFPACK_A) + +function getindex(lu::UmfpackLU, d::Symbol) + L,U,P,Q,Rs = umf_extract(lu) + d == :L ? L : + (d == :U ? U : + (d == :P ? P : + (d == :Q ? Q : + (d == :Rs ? Rs : + (d == :(:) ? (L,U,P,Q,Rs) : + error("No component for symbol $d")))))) +end + ## The C functions called by these Julia functions do not depend on ## the numeric and index types, even though the umfpack names indicate ## they do. The umfpack_free_* functions can be called on C_NULL without harm. @@ -388,697 +343,10 @@ end umfpack_report_numeric(num::Ptr{Void}) = umfpack_report_numeric(num, 4.) function umfpack_report_numeric(lu::UmfpackLU, level::Real) - umfpack_report_numeric(umfpack_numeric!(lu).symbolic, level) -end - -umfpack_report_numeric(lu::UmfpackLU) = umfpack_report_numeric(lu.symbolic,4.) - -## CHOLMOD - -const chm_com_sz = ccall((:jl_cholmod_common_size,:libsuitesparse_wrapper),Int,()) -const chm_com = ones(Uint8, chm_com_sz) - -### A way of examining some of the fields in chm_com -### Probably better to make this a Dict{ASCIIString,Tuple} and -### save the offsets and the lengths and the types. Then the names can be checked. -type ChmCommon - dbound::Float64 - maxrank::Int - supernodal_switch::Float64 - supernodal::Int32 - final_asis::Int32 - final_super::Int32 - final_ll::Int32 - final_pack::Int32 - final_monotonic::Int32 - final_resymbol::Int32 - prefer_zomplex::Int32 # should always be false - prefer_upper::Int32 - print::Int32 # print level. Default: 3 - precise::Int32 # print 16 digits, otherwise 5 - nmethods::Int32 # number of ordering methods - selected::Int32 - postorder::Int32 - itype::Int32 - dtype::Int32 -end - -### These offsets should be reconfigured to be less error-prone in matches -const chm_com_offsets = Array(Int, length(ChmCommon.types)) -ccall((:jl_cholmod_common_offsets, :libsuitesparse_wrapper), - Void, (Ptr{Uint8},), chm_com_offsets) -const chm_prt_inds = (1:4) + chm_com_offsets[13] -const chm_ityp_inds = (1:4) + chm_com_offsets[18] - -### there must be an easier way but at least this works. -function ChmCommon(aa::Array{Uint8,1}) - typs = ChmCommon.types - sz = map(sizeof, typs) - args = map(i->reinterpret(typs[i], aa[chm_com_offsets[i] + (1:sz[i])])[1], 1:length(sz)) - eval(Expr(:call, unshift!(args, :ChmCommon), Any)) -end -function chm_itype{Tv<:CHMVTypes,Ti<:CHMITypes}(S::SparseMatrixCSC{Tv,Ti}) - int32(Ti<:Int64 ? CHOLMOD_LONG : CHOLMOD_INT) -end -function chm_xtype{T<:CHMVTypes}(S::SparseMatrixCSC{T}) - int32(T<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL) -end -function chm_dtype{T<:CHMVTypes}(S::SparseMatrixCSC{T}) - int32(T<:Union(Float32, Complex64) ? CHOLMOD_SINGLE : CHOLMOD_DOUBLE) -end - -function set_chm_prt_lev(cm::Array{Uint8}, lev::Integer) - cm[(1:4) + chm_com_offsets[13]] = reinterpret(Uint8, [int32(lev)]) -end - -## cholmod_dense pointers passed to or returned from C functions are of Julia type -## Ptr{c_CholmodDense}. The CholmodDense type contains a c_CholmodDense object and other -## fields then ensure the memory pointed to is freed when it should be and not before. -immutable c_CholmodDense{T<:CHMVTypes} - m::Int - n::Int - nzmax::Int - lda::Int - xpt::Ptr{T} - zpt::Ptr{Void} - xtype::Int32 - dtype::Int32 -end - -immutable CholmodDense{T<:CHMVTypes} - c::c_CholmodDense - mat::Matrix{T} + umfpack_report_numeric(umfpack_numeric!(lu).numeric, level) end -immutable c_CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes} - n::Int - minor::Int - Perm::Ptr{Ti} - ColCount::Ptr{Ti} - nzmax::Int - p::Ptr{Ti} - i::Ptr{Ti} - x::Ptr{Tv} - z::Ptr{Void} - nz::Ptr{Ti} - next::Ptr{Ti} - prev::Ptr{Ti} - nsuper::Int - ssize::Int - xsize::Int - maxcsize::Int - maxesize::Int - super::Ptr{Ti} - pi::Ptr{Ti} - px::Ptr{Tv} - s::Ptr{Ti} - ordering::Int32 - is_ll::Int32 - is_super::Int32 - is_monotonic::Int32 - itype::Int32 - xtype::Int32 - dtype::Int32 -end - -immutable CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes} - c::c_CholmodFactor{Tv,Ti} - Perm::Vector{Ti} - ColCount::Vector{Ti} - p::Vector{Ti} - i::Vector{Ti} - x::Vector{Tv} - nz::Vector{Ti} - next::Vector{Ti} - prev::Vector{Ti} - super::Vector{Ti} - pi::Vector{Ti} - px::Vector{Tv} - s::Vector{Ti} -end - -immutable c_CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes} - m::Int - n::Int - nzmax::Int - ppt::Ptr{Ti} - ipt::Ptr{Ti} - nzpt::Ptr{Void} - xpt::Ptr{Tv} - zpt::Ptr{Void} - stype::Int32 - itype::Int32 - xtype::Int32 - dtype::Int32 - sorted::Int32 - packed::Int32 -end - -immutable CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes} - c::c_CholmodSparse{Tv,Ti} - colptr0::Vector{Ti} - rowval0::Vector{Ti} - nzval::Vector{Tv} -end - -immutable c_CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes} - m::Int - n::Int - nzmax::Int - nnz::Int - i::Ptr{Ti} - j::Ptr{Ti} - x::Ptr{Tv} - z::Ptr{Void} - stype:Int32 - itype::Int32 - xtype::Int32 - dtype::Int32 -end - -immutable CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes} - c::c_CholmodTriplet{Tv,Ti} - i::Vector{Ti} - j::Vector{Ti} - x::Vector{Tv} -end - -function CholmodDense{T<:CHMVTypes}(aa::VecOrMat{T}) - m = size(aa,1); n = size(aa,2) - CholmodDense(c_CholmodDense{T}(m, n, m*n, stride(aa,2), - convert(Ptr{T}, aa), C_NULL, - T<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, - T<:Union(Float32,Complex64) ? CHOLMOD_SINGLE : CHOLMOD_DOUBLE), - length(size(aa)) == 2 ? aa : reshape(aa, (m,n))) -end - -function CholmodDense{T<:CHMVTypes}(c::Ptr{c_CholmodDense{T}}) - cp = unsafe_ref(c) - if cp.lda != cp.m || cp.nzmax != cp.m * cp.n - error("overallocated cholmod_sparse returned object of size $(cp.m) by $(cp.n) with leading dim $(cp.lda) and nzmax $(cp.nzmax)") - end - ## the true in the call to pointer_to_array means Julia will free the memory - val = CholmodDense(cp, pointer_to_array(cp.xpt, (cp.m,cp.n), true)) - c_free(c) - val -end -show(io::IO, cd::CholmodDense) = show(io, cd.mat) - -function chm_check{T<:CHMVTypes}(cd::CholmodDense{T}) - status = ccall((:cholmod_check_dense, :libcholmod), Int32, - (Ptr{c_CholmodDense{T}}, Ptr{Uint8}), &cd.c, chm_com) - if status != CHOLMOD_TRUE throw(CholmodException) end -end +umfpack_report_numeric(lu::UmfpackLU) = umfpack_report_numeric(lu,4.) -function chm_ones{T<:Union(Float64,Complex128)}(m::Integer, n::Integer, t::T) - CholmodDense(ccall((:cholmod_ones, :libcholmod), Ptr{c_CholmodDense{T}}, - (Int, Int, Int32, Ptr{Uint8}), - m, n, - T<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, - chm_com)) -end -chm_ones(m::Integer, n::Integer) = chm_ones(m, n, 1.) - -function chm_zeros{T<:Union(Float64,Complex128)}(m::Integer, n::Integer, t::T) - CholmodDense(ccall((:cholmod_zeros, :libcholmod), Ptr{c_CholmodDense{T}}, - (Int, Int, Int32, Ptr{Uint8}), - m, n, - T<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, - chm_com)) -end -chm_zeros(m::Integer, n::Integer) = chm_zeros(m, n, 1.) - -function chm_eye{T<:Union(Float64,Complex128)}(m::Integer, n::Integer, t::T) - CholmodDense(ccall((:cholmod_eye, :libcholmod), Ptr{c_CholmodDense{T}}, - (Int, Int, Int32, Ptr{Uint8}), - m, n, - T<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, - chm_com)) -end -chm_eye(m::Integer, n::Integer) = chm_eye(m, n, 1.) -chm_eye(n::Integer) = chm_eye(n, n, 1.) - - -function chm_print{T<:CHMVTypes}(cd::CholmodDense{T}, lev::Integer, nm::ASCIIString) - orig = chm_com[chm_prt_inds] - chm_com[chm_prt_inds] = reinterpret(Uint8, [int32(lev)]) - status = ccall((:cholmod_print_dense, :libcholmod), Int32, - (Ptr{c_CholmodDense{T}}, Ptr{Uint8}, Ptr{Uint8}), - &cd.c, nm, chm_com) - chm_com[chm_prt_inds] = orig - if status != CHOLMOD_TRUE throw(CholmodException) end -end -chm_print(cd::CholmodDense, lev::Integer) = chm_print(cd, lev, "") -chm_print(cd::CholmodDense) = chm_print(cd, int32(4), "") - -function CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes}(A::SparseMatrixCSC{Tv,Ti}, stype::Integer) - zerobased = A.colptr[1] == 0 - colptr0 = zerobased ? copy(A.colptr) : decrement(A.colptr) - rowval0 = zerobased ? copy(A.rowptr) : decrement(A.rowval) - nzval = copy(A.nzval) - CholmodSparse{Tv,Ti}(c_CholmodSparse{Tv,Ti}(size(A,1),size(A,2), - int(colptr0[end]), - convert(Ptr{Ti}, colptr0), - convert(Ptr{Ti}, rowval0), C_NULL, - convert(Ptr{Tv}, nzval), C_NULL, - int32(stype), chm_itype(A), - chm_xtype(A), chm_dtype(A), -### Assuming that a SparseMatrixCSC always has sorted row indices. Need to check. - CHOLMOD_TRUE, CHOLMOD_TRUE), - colptr0, rowval0, nzval) -end -function CholmodSparse(A::SparseMatrixCSC) - stype = ishermitian(A) ? 1 : 0 - CholmodSparse(stype > 0 ? triu(A) : A, stype) -end - -function cmn{Ti<:CHMITypes}(i::Ti) # turns out this is as fast as checking for initialization - if Ti <: Int64 - ccall((:cholmod_l_start, :libcholmod), Int32, (Ptr{Uint8},), chm_com) - else - ccall((:cholmod_start, :libcholmod), Int32, (Ptr{Uint8},), chm_com) - end - chm_com -end -cmn{Tv,Ti<:CHMITypes}(A::CholmodSparse{Tv,Ti}) = cmn(one(Ti)) -cmn{Tv,Ti<:CHMITypes}(a::c_CholmodSparse{Tv,Ti}) = cmn(one(Ti)) -cmn{Tv,Ti<:CHMITypes}(ap::Ptr{c_CholmodSparse{Tv,Ti}}) = cmn(one(Ti)) -cmn{Tv,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti}) = cmn(one(Ti)) -cmn{Tv,Ti<:CHMITypes}(l::c_CholmodFactor{Tv,Ti}) = cmn(one(Ti)) -cmn{Tv,Ti<:CHMITypes}(lp::Ptr{c_CholmodFactor{Tv,Ti}}) = cmn(one(Ti)) - -function chm_rdsp(fnm::String) - fd = ccall(:fopen, Ptr{Void}, (Ptr{Uint8},Ptr{Uint8}), fnm, "r") - res = ccall((:cholmod_read_sparse,:libcholmod), Ptr{c_CholmodSparse{Float64,Int32}}, - (Ptr{Void},Ptr{Uint8}),fd,cmn(one(Int32))) - ccall(:fclose, Cint, (Ptr{Void},), fd) - CholmodSparse(res) -end - -function CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::Ptr{c_CholmodSparse{Tv,Ti}}) - csp = unsafe_ref(cp) - colptr0 = pointer_to_array(csp.ppt, (csp.n + 1,), true) - nnz = int(colptr0[end]) - cms = CholmodSparse{Tv,Ti}(csp, colptr0, - pointer_to_array(csp.ipt, (nnz,), true), - pointer_to_array(csp.xpt, (nnz,), true)) - c_free(cp) - cms -end - -for (chk,prt,srt,itype) in - (("cholmod_check_sparse","cholmod_print_sparse","cholmod_sort",:Int32), - ("cholmod_l_check_sparse","cholmod_l_print_sparse","cholmod_l_sort",:Int64)) - @eval begin - function chm_check{Tv<:CHMVTypes}(cs::CholmodSparse{Tv,$itype}) - cmn(cs) - status = ccall(($chk,:libcholmod), Int32, - (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), - &cs.c, chm_com) - if status != CHOLMOD_TRUE throw(CholmodException) end - end - function chm_print{Tv<:CHMVTypes}(cs::CholmodSparse{Tv,$itype},lev,nm) - cmn(cs) # initialize if necessary - orig = chm_com[chm_prt_inds] - chm_com[chm_prt_inds] = reinterpret(Uint8, [int32(lev)]) - status = ccall(($prt,:libcholmod), Int32, - (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}, Ptr{Uint8}), - &cs.c, nm, chm_com) - chm_com[chm_prt_inds] = orig - if status != CHOLMOD_TRUE throw(CholmodException) end - end - function chm_sort{Tv<:CHMVTypes}(cs::CholmodSparse{Tv,$itype}) - status = ccall(($srt,:libcholmod), Int32, - (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), - &cs.c, cmn(cs)) - if status != CHOLMOD_TRUE throw(CholmodException) end - cs - end - end -end - -chm_print(cd::CholmodSparse, lev::Integer) = chm_print(cd, lev, "") -chm_print(cd::CholmodSparse) = chm_print(cd, int32(4), "") - -nnz{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::CholmodSparse{Tv,Ti}) = int(cp.colptr0[end]) -size{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::CholmodSparse{Tv,Ti}) = (int(cp.c.m), int(cp.c.n)) -function size{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::CholmodSparse{Tv,Ti}, d::Integer) - d == 1 ? cp.c.m : (d == 2 ? cp.c.n : 1) -end - -for (aat,allocsp,cop,copsp,freesp,normsp,sdmult,speye,transsym,itype) in - (("cholmod_aat","cholmod_allocate_sparse","cholmod_copy","cholmod_copy_sparse", - "cholmod_free_sparse","cholmod_norm_sparse","cholmod_sdmult","cholmod_speye", - "cholmod_transpose_sym",:Int32), - ("cholmod_l_aat","cholmod_l_allocate_sparse","cholmod_l_copy", - "cholmod_l_copy_sparse","cholmod_l_free_sparse","cholmod_norm_sparse", - "cholmod_l_sdmult","cholmod_l_speye","cholmod_l_transpose_sym",:Int64)) - @eval begin - function chm_aat{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}) - cm = cmn(a) - ## strangely the matrix returned by $aat is not marked as symmetric - ## all of the code past the call to $aat is to create the symmetric-storage - ## version of the result then transpose it to provide sorted columns - aa = Array(Ptr{c_CholmodSparse{Tv,$itype}}, 2) - aa[1] = ccall(($aat, :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, - (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Void}, Int, Int32, Ptr{Uint8}), - &a, C_NULL, 0, 1, cm) - ## Create the lower triangle unsorted - aa[2] = ccall(($cop, :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, - (Ptr{c_CholmodSparse{Tv,$itype}}, Int32, Int32, Ptr{Uint8}), - aa[1], -1, 1, cm) - status = ccall(($freesp, :libcholmod), Int32, - (Ptr{Ptr{c_CholmodSparse{Tv,$itype}}}, Ptr{Uint8}), aa, cm) - if status != CHOLMOD_TRUE throw(CholmodException) end - aa[1] = aa[2] - r = unsafe_ref(aa[1]) - ## Now transpose the lower triangle to the upper triangle to do the sorting - rpt = ccall(($allocsp,:libcholmod),Ptr{c_CholmodSparse{Tv,$itype}}, - (Csize_t,Csize_t,Csize_t,Cint,Cint,Cint,Cint,Ptr{Cuchar}), - r.m,r.n,r.nzmax,r.sorted,r.packed,-r.stype,r.xtype,cm) - status = ccall(($transsym,:libcholmod),Int32, - (Ptr{c_CholmodSparse{Tv,$itype}}, Int32, Ptr{$itype}, - Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), - aa[1],1,C_NULL,rpt,cm) - if status != CHOLMOD_TRUE throw(CholmodException) end - status = ccall(($freesp, :libcholmod), Int32, - (Ptr{Ptr{c_CholmodSparse{Tv,$itype}}}, Ptr{Uint8}), aa, cm) - if status != CHOLMOD_TRUE throw(CholmodException) end - CholmodSparse(rpt) - end - function chm_copy_sp{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}) - ccall(($copsp,:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, - (Ptr{c_CholmodSparse{Tv,$itype}},Ptr{Uint8}), &a, cmn(a)) - end - function chm_norm{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}, norm::Integer) - ccall(($normsp, :libcholmod), Float64, - (Ptr{c_CholmodSparse{Tv,$itype}}, Int32, Ptr{Uint8}), - &a,norm,cmn(a)) - end - function chm_sdmult{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}, - trans::Bool, - alpha::Tv, - beta::Tv, - x::c_CholmodDense{Tv}) - nc = trans ? a.m : a.n - nr = trans ? a.n : a.m - if nc != x.m - error("Incompatible dimensions, $nc and $(x.m), in sdmult") - end - Y = CholmodDense(Array(Tv,nr,x.n)) - status = ccall(($sdmult,:libcholmod), Int32, - (Ptr{c_CholmodSparse{Tv,$itype}},Int32,Ptr{Tv},Ptr{Tv}, - Ptr{c_CholmodDense{Tv}}, Ptr{c_CholmodDense{Tv}}, Ptr{Uint8}), - &a,trans,&alpha,&beta,&x,&Y.c,cmn(a)) - if status != CHOLMOD_TRUE throw(CholmodException) end - Y - end - function chm_speye{Tv<:Union(Float64,Complex128)}(m::Integer, n::Integer, t::Tv, i::$itype) - CholmodSparse(ccall(($speye, :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, - (Int, Int, Int32, Ptr{Uint8}), - m, n, - Tv<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, - cmn(one($itype)))) - end - end -end -chm_speye(m::Integer, n::Integer) = chm_speye(m, n, 1., 1) -chm_speye(n::Integer) = chm_speye(n, n, 1., 1) -chm_aat(A::CholmodSparse) = chm_aat(A.c) -chm_aat(A::SparseMatrixCSC) = chm_aat(CholmodSparse(A).c) -chm_norm(A::CholmodSparse,norm::Integer) = chm_norm(A.c,norm) -chm_norm(A::SparseMatrixCSC,norm::Integer) = chm_norm(CholmodSparse(A).c,norm) -chm_norm(A::CholmodSparse) = chm_norm(A.c,one(Int32)) -chm_norm(A::SparseMatrixCSC) = chm_norm(CholmodSparse(A).c,one(Int32)) -copy(A::CholmodSparse) = CholmodSparse(chm_copy_sp(A.c)) - -for (scl,itype) in - (("cholmod_scale",:Int32), - ("cholmod_l_scale",:Int64)) - @eval begin - function chm_scale!{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}, - s::c_CholmodDense{Tv}, - typ::Integer) - status = ccall(($scl,:libcholmod), Int32, - (Ptr{c_CholmodDense{Tv}},Int32,Ptr{c_CholmodSparse{Tv,$itype}}, - Ptr{Uint8}), &s, typ, &a, cmn(a)) - if status != CHOLMOD_TRUE throw(CholmodException) end - end - end -end -function chm_scale!{T<:CHMVTypes}(A::CholmodSparse{T},S::CholmodDense{T},typ::Integer) - chm_scale!(A.c,S.c,typ) -end -function diagmm{T<:CHMVTypes}(b::Vector{T}, A::CholmodSparse{T}) - Acp = copy(A) - chm_scale!(Acp,CholmodDense(b),CHOLMOD_ROW) - Acp -end -function diagmm{T<:CHMVTypes}(A::CholmodSparse{T},b::Vector{T}) - Acp = copy(A) - chm_scale!(copy(A),CholmodDense(b),CHOLMOD_COL) - Acp -end - -function CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::Ptr{c_CholmodFactor{Tv,Ti}}) - cfp = unsafe_ref(cp) - Perm = pointer_to_array(cfp.Perm, (cfp.n,), true) - ColCount = pointer_to_array(cfp.ColCount, (cfp.n,), true) - p = pointer_to_array(cfp.p, (cfp.p == C_NULL ? 0 : cfp.n + 1,), true) - i = pointer_to_array(cfp.i, (cfp.i == C_NULL ? 0 : cfp.nzmax,), true) - x = pointer_to_array(cfp.x, (cfp.x == C_NULL ? 0 : cfp.nzmax,), true) - nz = pointer_to_array(cfp.nz, (cfp.nz == C_NULL ? 0 : cfp.n,), true) - next = pointer_to_array(cfp.next, (cfp.next == C_NULL ? 0 : cfp.n + 2,), true) - prev = pointer_to_array(cfp.prev, (cfp.prev == C_NULL ? 0 : cfp.n + 2,), true) - super = pointer_to_array(cfp.super, (cfp.super == C_NULL ? 0 : cfp.nsuper + 1,), true) - pi = pointer_to_array(cfp.pi, (cfp.pi == C_NULL ? 0 : cfp.nsuper + 1,), true) - px = pointer_to_array(cfp.px, (cfp.px == C_NULL ? 0 : cfp.nsuper + 1,), true) - s = pointer_to_array(cfp.s, (cfp.s == C_NULL ? 0 : cfp.ssize + 1,), true) - cf = CholmodFactor{Tv,Ti}(cfp, Perm, ColCount, p, i, x, nz, next, prev, - super, pi, px, s) - c_free(cp) - cf -end - -for (anl,chng,fac,slv,spslv,itype) in - ((:cholmod_analyze,:cholmod_change_factor,:cholmod_factorize, - :cholmod_solve,:cholmod_spsolve,:Int32), - (:cholmod_l_analyze,:cholmod_l_change_factor,:cholmod_l_factorize, - :cholmod_l_solve,:cholmod_l_spsolve,:Int64)) - @eval begin - function chm_analyze{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}) - ccall(($(string(anl)),:libcholmod), Ptr{c_CholmodFactor{Tv,$itype}}, - (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), &a, cmn(a)) - end - # update the factorization - function chm_factorize!{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}, - a::c_CholmodSparse{Tv,$itype}) - status = ccall(($(string(fac)),:libcholmod), Int32, - (Ptr{c_CholmodSparse{Tv,$itype}}, - Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), - &a, &l, cmn(a)) - if status != CHOLMOD_TRUE throw(CholmodException) end - end - # initialize a factorization - function chm_factorize{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}, ll::Bool) - Lpt = ccall(($(string(anl)),:libcholmod), Ptr{c_CholmodFactor{Tv,$itype}}, - (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), &a, cmn(a)) - status = ccall(($(string(fac)),:libcholmod), Int32, - (Ptr{c_CholmodSparse{Tv,$itype}}, - Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), - &a, Lpt, cmn(a)) - if status != CHOLMOD_TRUE throw(CholmodException) end - l = unsafe_ref(Lpt) - if int32(ll) != l.is_ll - status = ccall(($(string(chng)),:libcholmod), Int32, - (Int32,Int32,Int32,Int32,Int32, - Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), - l.xtype,ll,l.is_super,true,true,Lpt,cmn(l)) - if status != CHOLMOD_TRUE throw(CholmodException) end - end - CholmodFactor(Lpt) - end - function chm_solve{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}, - b::c_CholmodDense{Tv}, typ::Integer) - ccall(($(string(slv)),:libcholmod), Ptr{c_CholmodDense{Tv}}, - (Int32, Ptr{c_CholmodFactor{Tv,$itype}}, - Ptr{c_CholmodDense{Tv}}, Ptr{Uint8}), - typ, &l, &b, cmn(l)) - end - function chm_spsolve{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}, - b::c_CholmodSparse{Tv,$itype}, - typ::Integer) - ccall(($(string(spslv)),:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, - (Int32, Ptr{c_CholmodFactor{Tv,$itype}}, - Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), - typ, &l, &b, cmn(l)) - end - end -end -chm_analyze(ap::Ptr{c_CholmodSparse}) = chm_analyze(unsafe_ref(ap)) -chm_analyze(A::CholmodSparse) = chm_analyze(A.c) -chm_analyze(A::SparseMatrixCSC) = chm_analyze(CholmodSparse(A).c) - -chm_factorize(a::c_CholmodSparse) = chm_factorize(a,false) -chm_factorize(A::CholmodSparse) = chm_factorize(A.c,false) -chm_factorize(A::CholmodSparse,ll::Bool) = chm_factorize(A.c,ll) -chm_factorize(A::SparseMatrixCSC) = chm_factorize(CholmodSparse(A).c,false) -chm_factorize(A::SparseMatrixCSC,ll::Bool) = chm_factorize(CholmodSparse(A).c,ll) +end # UMFPACK module -function chm_solve{T<:CHMVTypes}(l::c_CholmodFactor{T},b::c_CholmodDense{T}) - chm_solve(l,b,CHOLMOD_A) -end -function chm_solve{T<:CHMVTypes}(L::CholmodFactor{T},B::CholmodDense{T}) - chm_solve(L.c,B.c,CHOLMOD_A) -end - -function chm_spsolve{Tv<:CHMVTypes,Ti<:CHMITypes}(l::c_CholmodFactor{Tv,Ti}, - b::c_CholmodSparse{Tv,Ti}) - chm_spsolve(l,b,CHOLMOD_A) -end -function chm_spsolve{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti}, - B::CholmodSparse{Tv,Ti}) - chm_spsolve(L.c,B.c,CHOLMOD_A) -end - -for (chng,pack,cop,xtyp,f2s,itype) in - ((:cholmod_change_factor,:cholmod_pack_factor, - :cholmod_copy_factor,:cholmod_factor_xtype, - :cholmod_factor_to_sparse,:Int32), - (:cholmod_l_change_factor,:cholmod_l_pack_factor, - :cholmod_l_copy_factor,:cholmod_l_factor_xtype, - :cholmod_l_factor_to_sparse,:Int64)) - @eval begin - ## changing the factor is problematic because it reallocates the storage - ## for the arrays and frees the old arrays but Julia retains the old pointers - ## in the vectors - ## function chm_chng_fac!{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}, - ## xt,ll,super,packed,monotonic) - ## status = ccall(($(string(chng)),:libcholmod), Int32, - ## (Int32,Int32,Int32,Int32,Int32, - ## Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), - ## xt,ll,super,packed,monotonic,&l,cmn(l)) - ## if status != CHOLMOD_TRUE throw(CholmodException) end - ## end - function chm_copy_fac{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}) - ccall(($(string(cop)),:libcholmod), Ptr{c_CholmodFactor{Tv,$itype}}, - (Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), &l,cmn(l)) - end - function chm_fac_to_sp{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}) - ccall(($(string(f2s)),:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, - (Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), &l,cmn(l)) - end - function chm_fac_xtype!{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype},to_xtype) - status = ccall(($(string(xtyp)),:libcholmod), Int32, - (Int32, Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), - to_xtype,&l,cmn(l)) - if status != CHOLMOD_TRUE throw(CholmodException) end - end - function chm_pack_fac!{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}) - status = ccall(($(string(pack)),:libcholmod), Int32, - (Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), - &l,cmn(l)) - if status != CHOLMOD_TRUE throw(CholmodException) end - end - end -end -function chm_chng_fac!(L::CholmodFactor,xt,ll,super,packed,monotonic) - chm_chng_fac!(L.c, xt,ll,super,packed,monotonic) -end - -copy(L::CholmodFactor) = CholmodFactor(chm_copy_fac(L.c)) -CholmodSparse(L::CholmodFactor) = CholmodSparse(chm_fac_to_sp(L.c)) - -function chm_fac_xtype!{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},to_xtype) - chm_fac_xtype(L.c,to_xtype) -end - -function CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes}(tp::Ptr{c_CholmodTriplet{Tv,Ti}}) - ctp = unsafe_ref(tp) - i = pointer_to_array(ctp.i, (ctp.nnz,), true) - j = pointer_to_array(ctp.j, (ctp.nnz,), true) - x = pointer_to_array(ctp.x, (ctp.x == C_NULL ? 0 : ctp.nnz), true) - ct = CholmodTriplet{Tv,Ti}(ctp, i, j, x) - c_free(tp) - ct -end - -for (s2t,itype) in - ((:cholmod_sparse_to_triplet, :Int32), - (:cholmod_l_sparse_to_triplet, :Int64)) - @eval begin - function chm_sp_to_tr{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}) - ccall(($(string(s2t)), :libcholmod), Ptr{c_CholmodTriplet{Tv,$itype}}, - (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), &a, chm(a)) - end - end -end -chm_sp_to_tr(A::CholmodSparse) = chm_sp_to_tr(A.c) - -function findn_nzs{Tv,Ti}(A::CholmodSparse{Tv,Ti}) - jj = similar(A.rowval0) # expand A.colptr0 to a vector of indices - for j in 1:A.c.n, k in (A.colptr0[j]+1):A.colptr0[j+1] - jj[k] = j - end - - ind = similar(A.rowval0) - ipos = 1 - count = 0 - for k in 1:length(A.nzval) - if A.nzval[k] != 0 - ind[ipos] = k - ipos += 1 - count += 1 - else - println("Warning: sparse matrix contains explicitly stored zeros.") - end - end - ind = ind[1:count] # ind is the indices of nonzeros in A.nzval - (increment!(A.rowval0[ind]), jj[ind], A.nzval[ind]) -end - -findn_nzs(L::CholmodFactor) = findn_nzs(chm_fac_to_sp(L)) - -function diag{Tv}(A::CholmodSparse{Tv}) - minmn = min(size(A)) - res = zeros(Tv,minmn) - cp0 = A.colptr0 - rv0 = A.rowval0 - anz = A.nzval - for j in 1:minmn, k in (cp0[j]+1):cp0[j+1] - if rv0[k] == j-1 - res[j] += anz[k] - end - end - res -end - -function diag{Tv}(L::CholmodFactor{Tv}) - res = zeros(Tv,L.c.n) - if L.c.is_super != 0 error("Method for supernodal factors not yet written") end - c0 = L.p - r0 = L.i - xv = L.x - for j in 1:length(c0)-1 - jj = c0[j]+1 - assert(r0[jj] == j-1) - res[j] = xv[jj] - end - res -end - -function logdet{Tv,Ti}(L::CholmodFactor{Tv,Ti}) - if L.c.is_super != 0 error("Method for supernodal factors not yet written") end - c0 = L.p - r0 = L.i - xv = L.x - res = zero(Tv) - for j in 1:length(c0)-1 - jj = c0[j]+1 - assert(r0[jj] == j-1) - res += log(xv[jj]) - end - L.c.is_ll != 0 ? 2res : res -end - -end #module diff --git a/test/suitesparse.jl b/test/suitesparse.jl index bd53bc28949cb..224a8f44e0a06 100644 --- a/test/suitesparse.jl +++ b/test/suitesparse.jl @@ -2,15 +2,15 @@ se33 = speye(3) do33 = ones(3) @test isequal(se33 \ do33, do33) -using Base.LinAlg.SuiteSparse +using Base.LinAlg.UMFPACK # based on deps/Suitesparse-4.0.2/UMFPACK/Demo/umfpack_di_demo.c A = sparse(increment!([0,4,1,1,2,2,0,1,2,3,4,4]), increment!([0,4,0,2,1,2,1,4,3,2,1,2]), [2.,1.,3.,4.,-1.,-3.,3.,6.,2.,1.,4.,2.], 5, 5) -lua = lu(A) -umf_lunz(lua) +lua = lufact(A) +#umf_lunz(lua) @test_approx_eq det(lua) det(full(A)) b = [8., 45., -3., 3., 19.] @@ -19,7 +19,7 @@ x = lua\b @test norm(A*x-b,1) < eps(1e4) -L,U,P,Q,Rs = umf_extract(lua) +L,U,P,Q,Rs = lua[:(:)] @test_approx_eq diagmm(Rs,A)[P,Q] L*U # based on deps/SuiteSparse-4.0.2/CHOLMOD/Demo/ @@ -109,8 +109,8 @@ A = CholmodSparse{Float64,Int32}(Base.LinAlg.SuiteSparse.c_CholmodSparse{Float64 one(Int32), zero(Int32), one(Int32), one(Int32)), colptr0, rowval0, nzval) -@test_approx_eq chm_norm(A,0) 3.570948074697437e9 -@test_approx_eq chm_norm(A,1) 3.570948074697437e9 +@test_approx_eq norm(A,Inf) 3.570948074697437e9 +@test_approx_eq norm(A) 3.570948074697437e9 chm_print(A,3) B = chm_sdmult(A.c, false, 1., 0., CholmodDense(ones(size(A,2))).c) chm_print(B,3) From 566d79c999cbf1ef4475ba4f1af20400f6725bfb Mon Sep 17 00:00:00 2001 From: Douglas Bates Date: Wed, 13 Mar 2013 16:35:41 -0500 Subject: [PATCH 23/29] Rename the old base/linalg/suitesparse.jl to umfpack.jl For the time being I have kept all the const definitions in suitesparse_h.jl --- base/linalg/{suitesparse.jl => umfpack.jl} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename base/linalg/{suitesparse.jl => umfpack.jl} (100%) diff --git a/base/linalg/suitesparse.jl b/base/linalg/umfpack.jl similarity index 100% rename from base/linalg/suitesparse.jl rename to base/linalg/umfpack.jl From 72a3ebefb6e9fdf644cb927e5b3d17472414dfd5 Mon Sep 17 00:00:00 2001 From: Douglas Bates Date: Wed, 13 Mar 2013 16:43:28 -0500 Subject: [PATCH 24/29] Use proper form of function arguments. --- base/linalg/cholmod.jl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/base/linalg/cholmod.jl b/base/linalg/cholmod.jl index a9c0f13c3f72f..2aa64ae0e45d0 100644 --- a/base/linalg/cholmod.jl +++ b/base/linalg/cholmod.jl @@ -206,10 +206,10 @@ immutable CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes} x::Vector{Tv} end -eltype{T<:CHMVTypes}(CholmodDense{T}) = T -eltype{T<:CHMVTypes}(CholmodFactor{T}) = T -eltype{T<:CHMVTypes}(CholmodSparse{T}) = T -eltype{T<:CHMVTypes}(CholmodTriplet{T}) = T +eltype{T<:CHMVTypes}(A::CholmodDense{T}) = T +eltype{T<:CHMVTypes}(A::CholmodFactor{T}) = T +eltype{T<:CHMVTypes}(A::CholmodSparse{T}) = T +eltype{T<:CHMVTypes}(A::CholmodTriplet{T}) = T function CholmodDense{T<:CHMVTypes}(aa::VecOrMat{T}) m = size(aa,1); n = size(aa,2) From 9dad70008a5a5da6b46291e19b57167dcc772634 Mon Sep 17 00:00:00 2001 From: Douglas Bates Date: Thu, 14 Mar 2013 11:04:16 -0500 Subject: [PATCH 25/29] Cleaned up the cholmod interface with ityp, xtyp and dtyp functions. Commented out a couple of tests. The cholmod_sdmult calls throw exceptions but I haven't been able to determine why. --- base/linalg/cholmod.jl | 188 +++++++++++++++++------------------ base/linalg/suitesparse_h.jl | 14 --- base/linalg/umfpack.jl | 1 - test/suitesparse.jl | 19 ++-- 4 files changed, 103 insertions(+), 119 deletions(-) diff --git a/base/linalg/cholmod.jl b/base/linalg/cholmod.jl index 2aa64ae0e45d0..cb3767f1d7d5e 100644 --- a/base/linalg/cholmod.jl +++ b/base/linalg/cholmod.jl @@ -30,6 +30,7 @@ import LinAlg.copy import LinAlg.diagmm import LinAlg.diagmm! import LinAlg.logdet +import LinAlg.norm import LinAlg.solve const chm_com_sz = ccall((:jl_cholmod_common_size,:libsuitesparse_wrapper),Int,()) @@ -38,6 +39,8 @@ const chm_com = ones(Uint8, chm_com_sz) typealias CHMITypes Union(Int32,Int64) typealias CHMVTypes Union(Complex64, Complex128, Float32, Float64) +type CholmodException <: Exception end + ### A way of examining some of the fields in chm_com ### Probably better to make this a Dict{ASCIIString,Tuple} and ### save the offsets and the lengths and the types. Then the names can be checked. @@ -63,7 +66,7 @@ type ChmCommon dtype::Int32 end -include(joinpath(JULIA_HOME, "..", "..", "base", "linalg/suitesparse_h.jl")) +include("linalg/suitesparse_h.jl") ### These offsets should be reconfigured to be less error-prone in matches const chm_com_offsets = Array(Int, length(ChmCommon.types)) @@ -80,24 +83,48 @@ function ChmCommon(aa::Array{Uint8,1}) args = map(i->reinterpret(typs[i], aa[chm_com_offsets[i] + (1:sz[i])])[1], 1:length(sz)) eval(Expr(:call, unshift!(args, :ChmCommon), Any)) end -function chm_itype{Tv<:CHMVTypes,Ti<:CHMITypes}(S::SparseMatrixCSC{Tv,Ti}) - int32(Ti<:Int64 ? CHOLMOD_LONG : CHOLMOD_INT) -end -function chm_xtype{T<:CHMVTypes}(S::SparseMatrixCSC{T}) - int32(T<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL) -end -function chm_dtype{T<:CHMVTypes}(S::SparseMatrixCSC{T}) - int32(T<:Union(Float32, Complex64) ? CHOLMOD_SINGLE : CHOLMOD_DOUBLE) -end -function set_chm_prt_lev(cm::Array{Uint8}, lev::Integer) +function set_chm_prt_lev(cm::Array{Uint8}, lev::Integer) # can probably be removed cm[(1:4) + chm_com_offsets[13]] = reinterpret(Uint8, [int32(lev)]) end +function cmn(::Type{Int32}) + ccall((:cholmod_start, :libcholmod), Cint, (Ptr{Uint8},), chm_com) + chm_com +end +function cmn(::Type{Int64}) + ccall((:cholmod_l_start, :libcholmod), Cint, (Ptr{Uint8},), chm_com) + chm_com +end + +## itype defines the types of integer used: +const CHOLMOD_INT = int32(0) # all integer arrays are int +const CHOLMOD_LONG = int32(2) # all integer arrays are UF_long +ityp(::Type{Int32}) = CHOLMOD_INT +ityp(::Type{Int64}) = CHOLMOD_LONG + +## dtype defines what the numerical type is (double or float): +const CHOLMOD_DOUBLE = int32(0) # all numerical values are double +const CHOLMOD_SINGLE = int32(1) # all numerical values are float +dtyp(::Type{Float32}) = CHOLMOD_SINGLE +dtyp(::Type{Float64}) = CHOLMOD_DOUBLE +dtyp(::Type{Complex64}) = CHOLMOD_SINGLE +dtyp(::Type{Complex128}) = CHOLMOD_DOUBLE + +## xtype defines the kind of numerical values used: +const CHOLMOD_PATTERN = int32(0) # pattern only, no numerical values +const CHOLMOD_REAL = int32(1) # a real matrix +const CHOLMOD_COMPLEX = int32(2) # a complex matrix (ANSI C99 compatible) +const CHOLMOD_ZOMPLEX = int32(3) # a complex matrix (MATLAB compatible) +xtyp(::Type{Float32}) = CHOLMOD_REAL +xtyp(::Type{Float64}) = CHOLMOD_REAL +xtyp(::Type{Complex64}) = CHOLMOD_COMPLEX +xtyp(::Type{Complex128}) = CHOLMOD_COMPLEX + ## cholmod_dense pointers passed to or returned from C functions are of Julia type ## Ptr{c_CholmodDense}. The CholmodDense type contains a c_CholmodDense object and other ## fields then ensure the memory pointed to is freed when it should be and not before. -immutable c_CholmodDense{T<:CHMVTypes} +type c_CholmodDense{T<:CHMVTypes} m::Int n::Int nzmax::Int @@ -108,12 +135,12 @@ immutable c_CholmodDense{T<:CHMVTypes} dtype::Cint end -immutable CholmodDense{T<:CHMVTypes} +type CholmodDense{T<:CHMVTypes} c::c_CholmodDense mat::Matrix{T} end -immutable c_CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes} +type c_CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes} n::Int minor::Int Perm::Ptr{Ti} @@ -144,7 +171,7 @@ immutable c_CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes} dtype::Cint end -immutable CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes} +type CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes} c::c_CholmodFactor{Tv,Ti} Perm::Vector{Ti} ColCount::Vector{Ti} @@ -160,7 +187,7 @@ immutable CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes} s::Vector{Ti} end -immutable c_CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes} +type c_CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes} m::Int n::Int nzmax::Int @@ -177,14 +204,14 @@ immutable c_CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes} packed::Cint end -immutable CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes} +type CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes} c::c_CholmodSparse{Tv,Ti} colptr0::Vector{Ti} rowval0::Vector{Ti} nzval::Vector{Tv} end -immutable c_CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes} +type c_CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes} m::Int n::Int nzmax::Int @@ -199,7 +226,7 @@ immutable c_CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes} dtype::Cint end -immutable CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes} +type CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes} c::c_CholmodTriplet{Tv,Ti} i::Vector{Ti} j::Vector{Ti} @@ -213,10 +240,8 @@ eltype{T<:CHMVTypes}(A::CholmodTriplet{T}) = T function CholmodDense{T<:CHMVTypes}(aa::VecOrMat{T}) m = size(aa,1); n = size(aa,2) - CholmodDense(c_CholmodDense{T}(m, n, m*n, stride(aa,2), - convert(Ptr{T}, aa), C_NULL, - T<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, - T<:Union(Float32,Complex64) ? CHOLMOD_SINGLE : CHOLMOD_DOUBLE), + CholmodDense(c_CholmodDense{T}(m, n, m*n, stride(aa,2), convert(Ptr{T}, aa), + C_NULL, xtyp(T), dtyp(T)), length(size(aa)) == 2 ? aa : reshape(aa, (m,n))) end @@ -288,8 +313,8 @@ function CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes}(A::SparseMatrixCSC{Tv,Ti}, s convert(Ptr{Ti}, colptr0), convert(Ptr{Ti}, rowval0), C_NULL, convert(Ptr{Tv}, nzval), C_NULL, - int32(stype), chm_itype(A), - chm_xtype(A), chm_dtype(A), + int32(stype), ityp(Ti), + xtyp(Tv), dtyp(Tv), ### Assuming that a SparseMatrixCSC always has sorted row indices. Need to check. CHOLMOD_TRUE, CHOLMOD_TRUE), colptr0, rowval0, nzval) @@ -298,46 +323,11 @@ function CholmodSparse(A::SparseMatrixCSC) stype = ishermitian(A) ? 1 : 0 CholmodSparse(stype > 0 ? triu(A) : A, stype) end -function CholmodSparse!{Tv<:CHMVTypes,Ti<:CHMITypes}(A::SparseMatrixCSC{Tv,Ti}, stype::Integer) - zerobased = A.colptr[1] == 0 - colptr0 = zerobased ? A.colptr : decrement!(A.colptr) - rowval0 = zerobased ? A.rowptr : decrement!(A.rowval) - nzval = A.nzval - CholmodSparse{Tv,Ti}(c_CholmodSparse{Tv,Ti}(size(A,1),size(A,2), - int(colptr0[end]), - convert(Ptr{Ti}, colptr0), - convert(Ptr{Ti}, rowval0), C_NULL, - convert(Ptr{Tv}, nzval), C_NULL, - int32(stype), chm_itype(A), - chm_xtype(A), chm_dtype(A), -### Assuming that a SparseMatrixCSC always has sorted row indices. Need to check. - CHOLMOD_TRUE, CHOLMOD_TRUE), - colptr0, rowval0, nzval) -end -function CholmodSparse!(A::SparseMatrixCSC) - stype = ishermitian(A) ? 1 : 0 - CholmodSparse!(stype > 0 ? triu(A) : A, stype) -end - -function cmn{Ti<:CHMITypes}(i::Ti) # turns out this is as fast as checking for initialization - if Ti <: Int64 - ccall((:cholmod_l_start, :libcholmod), Cint, (Ptr{Uint8},), chm_com) - else - ccall((:cholmod_start, :libcholmod), Cint, (Ptr{Uint8},), chm_com) - end - chm_com -end -cmn{Tv,Ti<:CHMITypes}(A::CholmodSparse{Tv,Ti}) = cmn(one(Ti)) -cmn{Tv,Ti<:CHMITypes}(a::c_CholmodSparse{Tv,Ti}) = cmn(one(Ti)) -cmn{Tv,Ti<:CHMITypes}(ap::Ptr{c_CholmodSparse{Tv,Ti}}) = cmn(one(Ti)) -cmn{Tv,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti}) = cmn(one(Ti)) -cmn{Tv,Ti<:CHMITypes}(l::c_CholmodFactor{Tv,Ti}) = cmn(one(Ti)) -cmn{Tv,Ti<:CHMITypes}(lp::Ptr{c_CholmodFactor{Tv,Ti}}) = cmn(one(Ti)) function chm_rdsp(fnm::String) fd = ccall(:fopen, Ptr{Void}, (Ptr{Uint8},Ptr{Uint8}), fnm, "r") - res = ccall((:cholmod_read_sparse,:libcholmod), Ptr{c_CholmodSparse{Float64,Int32}}, - (Ptr{Void},Ptr{Uint8}),fd,cmn(one(Cint))) + res = ccall((:cholmod_read_sparse,:libcholmod), Ptr{c_CholmodSparse{Float64,Cint}}, + (Ptr{Void},Ptr{Uint8}),fd,cmn(Cint)) ccall(:fclose, Cint, (Ptr{Void},), fd) CholmodSparse(res) end @@ -358,14 +348,13 @@ for (chk,prt,srt,itype) in ("cholmod_l_check_sparse","cholmod_l_print_sparse","cholmod_l_sort",:Int64)) @eval begin function chm_check{Tv<:CHMVTypes}(cs::CholmodSparse{Tv,$itype}) - cmn(cs) status = ccall(($chk,:libcholmod), Cint, (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), - &cs.c, chm_com) + &cs.c, cmn($itype)) if status != CHOLMOD_TRUE throw(CholmodException) end end function chm_print{Tv<:CHMVTypes}(cs::CholmodSparse{Tv,$itype},lev,nm) - cmn(cs) # initialize if necessary + cmn($itype) orig = chm_com[chm_prt_inds] chm_com[chm_prt_inds] = reinterpret(Uint8, [int32(lev)]) status = ccall(($prt,:libcholmod), Cint, @@ -377,7 +366,7 @@ for (chk,prt,srt,itype) in function sort!{Tv<:CHMVTypes}(cs::CholmodSparse{Tv,$itype}) status = ccall(($srt,:libcholmod), Cint, (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), - &cs.c, cmn(cs)) + &cs.c, cmn($itype)) if status != CHOLMOD_TRUE throw(CholmodException) end cs end @@ -401,7 +390,7 @@ for (aat,allocsp,cop,copsp,freesp,normsp,scl,sdmult,speye,ssmult,transsym,itype) "cholmod_l_sdmult","cholmod_l_speye","cholmod_l_ssmult","cholmod_l_transpose_sym",:Int64)) @eval begin function chm_aat{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}) - cm = cmn(a) + cm = cmn($itype) ## strangely the matrix returned by $aat is not marked as symmetric ## all of the code past the call to $aat is to create the symmetric-storage ## version of the result then transpose it to provide sorted columns @@ -434,12 +423,12 @@ for (aat,allocsp,cop,copsp,freesp,normsp,scl,sdmult,speye,ssmult,transsym,itype) end function chm_copy_sp{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}) ccall(($copsp,:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, - (Ptr{c_CholmodSparse{Tv,$itype}},Ptr{Uint8}), &a, cmn(a)) + (Ptr{c_CholmodSparse{Tv,$itype}},Ptr{Uint8}), &a, cmn($itype)) end function norm{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype},p::Number) ccall(($normsp, :libcholmod), Float64, (Ptr{c_CholmodSparse{Tv,$itype}}, Cint, Ptr{Uint8}), - &a,p == 1 ? 1 :(p == Inf ? 1 : error("p must be 1 or Inf")),cmn(a)) + &a,p == 1 ? 1 :(p == Inf ? 1 : error("p must be 1 or Inf")),cmn($itype)) end function chm_sdmult{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}, trans::Bool, @@ -449,13 +438,15 @@ for (aat,allocsp,cop,copsp,freesp,normsp,scl,sdmult,speye,ssmult,transsym,itype) nc = trans ? a.m : a.n nr = trans ? a.n : a.m if nc != x.m - error("Incompatible dimensions, $nc and $(x.m), in sdmult") + error("Incompatible dimensions, $nc and $(x.m), in chm_sdmult") end - Y = CholmodDense(Array(Tv,nr,x.n)) + aa = float64([alpha, 0.]) + bb = float64([beta, 0.]) + Y = CholmodDense(zeros(Tv,nr,x.n)) status = ccall(($sdmult,:libcholmod), Cint, - (Ptr{c_CholmodSparse{Tv,$itype}},Cint,Cdouble,Cdouble, + (Ptr{c_CholmodSparse{Tv,$itype}},Cint,Ptr{Cdouble},Ptr{Cdouble}, Ptr{c_CholmodDense{Tv}}, Ptr{c_CholmodDense{Tv}}, Ptr{Uint8}), - &a,trans,&alpha,&beta,&x,&Y.c,cmn(a)) + &a,trans,aa,bb,&x,[Y.c],cmn($itype)) if status != CHOLMOD_TRUE throw(CholmodException) end Y end @@ -464,20 +455,20 @@ for (aat,allocsp,cop,copsp,freesp,normsp,scl,sdmult,speye,ssmult,transsym,itype) (Int, Int, Cint, Ptr{Uint8}), m, n, Tv<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, - cmn(one($itype)))) + cmn($itype))) end function (*){Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}, b::c_CholmodSparse{Tv,$itype}) CholmodSparse(ccall(($ssmult, :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, (Ptr{c_CholmodSparse{Tv,$itype}},Ptr{c_CholmodSparse{Tv,$itype}}, - Cint,Cint,Cint,Ptr{Uint8}), &a,&b,0,true,true,cmn(a))) + Cint,Cint,Cint,Ptr{Uint8}), &a,&b,0,true,true,cmn($itype))) end function chm_scale!{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}, s::c_CholmodDense{Tv}, typ::Integer) status = ccall(($scl,:libcholmod), Cint, (Ptr{c_CholmodDense{Tv}},Cint,Ptr{c_CholmodSparse{Tv,$itype}}, - Ptr{Uint8}), &s, typ, &a, cmn(a)) + Ptr{Uint8}), &s, typ, &a, cmn($itype)) if status != CHOLMOD_TRUE throw(CholmodException) end end end @@ -544,7 +535,7 @@ for (anl,chng,fac,slv,spslv,itype) in @eval begin function chm_analyze{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}) ccall(($anl,:libcholmod), Ptr{c_CholmodFactor{Tv,$itype}}, - (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), &a, cmn(a)) + (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), &a, cmn($itype)) end # update the factorization function chm_factorize!{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}, @@ -552,12 +543,12 @@ for (anl,chng,fac,slv,spslv,itype) in status = ccall(($fac,:libcholmod), Cint, (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), - &a, &l, cmn(a)) + &a, &l, cmn($itype)) if status != CHOLMOD_TRUE throw(CholmodException) end end # initialize a factorization function cholfact{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}, ll::Bool) - cmn(a) + cmn($itype) ## may need to change final_asis as well as final_ll if ll chm_com[chm_final_ll_inds] = reinterpret(Uint8, [one(Cint)]) end Lpt = ccall(($anl,:libcholmod), Ptr{c_CholmodFactor{Tv,$itype}}, @@ -574,7 +565,7 @@ for (anl,chng,fac,slv,spslv,itype) in ccall(($slv,:libcholmod), Ptr{c_CholmodDense{Tv}}, (Cint, Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{c_CholmodDense{Tv}}, Ptr{Uint8}), - typ, &l, &b, cmn(l)) + typ, &l, &b, cmn($itype)) end function solve{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}, b::c_CholmodSparse{Tv,$itype}, @@ -582,7 +573,7 @@ for (anl,chng,fac,slv,spslv,itype) in ccall(($spslv,:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, (Cint, Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), - typ, &l, &b, cmn(l)) + typ, &l, &b, cmn($itype)) end end end @@ -600,6 +591,7 @@ cholfact!(A::SparseMatrixCSC) = cholfact(CholmodSparse!(A).c,false) solve{T<:CHMVTypes}(l::c_CholmodFactor{T},b::c_CholmodDense{T}) = solve(l,b,CHOLMOD_A) solve{T<:CHMVTypes}(L::CholmodFactor{T},B::CholmodDense{T}) = solve(L.c,B.c,CHOLMOD_A) +(\){T<:CHMVTypes}(L::CholmodFactor{T},B::CholmodDense{T}) = solve(L.c,B.c,CHOLMOD_A) solve{Tv<:CHMVTypes,Ti<:CHMITypes}(l::c_CholmodFactor{Tv,Ti},b::c_CholmodSparse{Tv,Ti})= solve(l,b,CHOLMOD_A) solve{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::CholmodSparse{Tv,Ti})=solve(L.c,B.c,CHOLMOD_A) @@ -608,13 +600,13 @@ solve{T<:CHMVTypes}(l::c_CholmodFactor{T},b::VecOrMat{T})=solve(l,CholmodDense(b solve{T<:CHMVTypes}(L::CholmodFactor{T},b::VecOrMat{T},typ::Integer)=solve(L.c,CholmodDense(b),typ) solve{T<:CHMVTypes}(L::CholmodFactor{T},b::VecOrMat{T})=solve(L.c,CholmodDense(b),CHOLMOD_A) -for (chng,pack,cop,xtyp,f2s,itype) in - ((:cholmod_change_factor,:cholmod_pack_factor, - :cholmod_copy_factor,:cholmod_factor_xtype, - :cholmod_factor_to_sparse,:Int32), - (:cholmod_l_change_factor,:cholmod_l_pack_factor, - :cholmod_l_copy_factor,:cholmod_l_factor_xtype, - :cholmod_l_factor_to_sparse,:Int64)) +for (chng,pack,cop,chg_xtyp,f2s,itype) in + (("cholmod_change_factor","cholmod_pack_factor", + "cholmod_copy_factor","cholmod_factor_xtype", + "cholmod_factor_to_sparse",:Int32), + ("cholmod_l_change_factor","cholmod_l_pack_factor", + "cholmod_l_copy_factor","cholmod_l_factor_xtype", + "cholmod_l_factor_to_sparse",:Int64)) @eval begin ## changing the factor is problematic because it reallocates the storage ## for the arrays and frees the old arrays but Julia retains the old pointers @@ -628,23 +620,23 @@ for (chng,pack,cop,xtyp,f2s,itype) in ## if status != CHOLMOD_TRUE throw(CholmodException) end ## end function chm_copy_fac{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}) - ccall(($(string(cop)),:libcholmod), Ptr{c_CholmodFactor{Tv,$itype}}, - (Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), &l,cmn(l)) + ccall(($cop,:libcholmod), Ptr{c_CholmodFactor{Tv,$itype}}, + (Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), &l,cmn($itype)) end function chm_fac_to_sp{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}) - ccall(($(string(f2s)),:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, - (Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), &l,cmn(l)) + ccall(($f2s,:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, + (Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), &l,cmn($itype)) end function chm_fac_xtype!{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype},to_xtype) - status = ccall(($(string(xtyp)),:libcholmod), Cint, + status = ccall(($chg_xtyp,:libcholmod), Cint, (Cint, Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), - to_xtype,&l,cmn(l)) + to_xtype,[l],cmn($itype)) if status != CHOLMOD_TRUE throw(CholmodException) end end function chm_pack_fac!{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}) - status = ccall(($(string(pack)),:libcholmod), Cint, + status = ccall(($pack,:libcholmod), Cint, (Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), - &l,cmn(l)) + &l,cmn($itype)) if status != CHOLMOD_TRUE throw(CholmodException) end end end @@ -677,12 +669,12 @@ for (s2t,t2s,itype) in function convert{Tv<:CHMVTypes}(::Type{CholmodTriplet{Tv,$itype}}, A::CholmodSparse{Tv,$itype}) CholmodTriplet(ccall(($s2t, :libcholmod), Ptr{c_CholmodTriplet{Tv,$itype}}, - (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), &A, cmn(A))) + (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), &A, cmn($itype))) end function convert{Tv<:CHMVTypes}(::Type{CholmodSparse{Tv,$itype}}, A::CholmodTriplet{Tv,$itype}) CholmodSparse(ccall(($t2s, :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, - (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), &A, cmn(A))) + (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), &A, cmn($itype))) end end end diff --git a/base/linalg/suitesparse_h.jl b/base/linalg/suitesparse_h.jl index 7e675d8bc855b..25cbbdd1d7d1e 100644 --- a/base/linalg/suitesparse_h.jl +++ b/base/linalg/suitesparse_h.jl @@ -14,20 +14,6 @@ const CHOLMOD_D = int32(6) # solve Dx=b const CHOLMOD_P = int32(7) # permute x=Px const CHOLMOD_Pt = int32(8) # permute x=P'x -# itype defines the types of integer used: -const CHOLMOD_INT = int32(0) # all integer arrays are int -const CHOLMOD_LONG = int32(2) # all integer arrays are UF_long - -# dtype defines what the numerical type is (double or float): -const CHOLMOD_DOUBLE = int32(0) # all numerical values are double -const CHOLMOD_SINGLE = int32(1) # all numerical values are float - -# xtype defines the kind of numerical values used: -const CHOLMOD_PATTERN = int32(0) # pattern only, no numerical values -const CHOLMOD_REAL = int32(1) # a real matrix -const CHOLMOD_COMPLEX = int32(2) # a complex matrix (ANSI C99 compatible) -const CHOLMOD_ZOMPLEX = int32(3) # a complex matrix (MATLAB compatible) - # Definitions for cholmod_common: const CHOLMOD_MAXMETHODS = int32(9) # maximum number of different methods that # cholmod_analyze can try. Must be >= 9. diff --git a/base/linalg/umfpack.jl b/base/linalg/umfpack.jl index 01b21f54577e5..f8b94950f6cca 100644 --- a/base/linalg/umfpack.jl +++ b/base/linalg/umfpack.jl @@ -25,7 +25,6 @@ import LinAlg.solve include("linalg/suitesparse_h.jl") type MatrixIllConditionedException <: Exception end -type CholmodException <: Exception end function decrement!{T<:Integer}(A::AbstractArray{T}) for i in 1:length(A) A[i] -= one(T) end diff --git a/test/suitesparse.jl b/test/suitesparse.jl index 224a8f44e0a06..f3eaae01dd356 100644 --- a/test/suitesparse.jl +++ b/test/suitesparse.jl @@ -22,6 +22,8 @@ x = lua\b L,U,P,Q,Rs = lua[:(:)] @test_approx_eq diagmm(Rs,A)[P,Q] L*U +using Base.LinAlg.CHOLMOD + # based on deps/SuiteSparse-4.0.2/CHOLMOD/Demo/ # use inline values instead of @@ -99,7 +101,7 @@ rowval0 = int32([0,1,2,1,2,3,0,2,4,0,1,5,0,4,6,1,3,7,2,8,1,3,7,8,9,0,4,6,8,10,5, 31,35,37,14,15,32,34,38,14,15,33,37,38,39,16,32,34,36,38,40,12,17,31,35,36, 37,41,12,16,17,18,23,36,40,42,13,14,15,19,37,39,43,13,14,15,20,21,38,43,44, 13,14,15,20,21,37,39,43,44,45,12,16,17,22,36,40,42,46,12,16,17,18,23,41,42,46,47]) -A = CholmodSparse{Float64,Int32}(Base.LinAlg.SuiteSparse.c_CholmodSparse{Float64,Int32}(48,48,224, +A = CholmodSparse{Float64,Int32}(Base.LinAlg.CHOLMOD.c_CholmodSparse{Float64,Int32}(48,48,224, convert(Ptr{Int32}, colptr0), convert(Ptr{Int32}, rowval0), C_NULL, @@ -111,9 +113,13 @@ A = CholmodSparse{Float64,Int32}(Base.LinAlg.SuiteSparse.c_CholmodSparse{Float64 colptr0, rowval0, nzval) @test_approx_eq norm(A,Inf) 3.570948074697437e9 @test_approx_eq norm(A) 3.570948074697437e9 -chm_print(A,3) -B = chm_sdmult(A.c, false, 1., 0., CholmodDense(ones(size(A,2))).c) -chm_print(B,3) +show(A) +## the call to cholmod_sdmult is giving problems right now +#B = A * CholmodDense(ones(size(A,2))) +#Base.LinAlg.CHOLMOD.chm_print(B,3) +chma = cholfact(A) +#x = chma\B +#@test_approx_eq x ones(size(A,2))' #lp_afiro example @@ -130,8 +136,8 @@ rowval0 = int32([2,3,6,7,8,9,12,13,16,17,18,19,20,21,22,23,24,25,26,0,1,2,23,0,3 6,24,4,5,7,24,4,5,8,24,4,5,9,24,6,20,7,20,8,20,9,20,3,4,4,22,5,26,10,11,12,21, 10,13,10,23,10,20,11,25,14,15,16,22,14,15,17,22,14,15,18,22,14,15,19,22,16,20, 17,20,18,20,19,20,13,15,15,24,14,26,15]) -afiro = CholmodSparse{Float64,Int32}(Base.LinAlg.SuiteSparse.c_CholmodSparse{Float64,Int32}(27,51,102, - convert(Ptr{Int32}, colptr0), +afiro = CholmodSparse{Float64,Int32}(Base.LinAlg.CHOLMOD.c_CholmodSparse{Float64,Int32}(27,51,102, + convert(Ptr{Int32}, colptr0), convert(Ptr{Int32}, rowval0), C_NULL, convert(Ptr{Float64}, nzval), @@ -141,3 +147,4 @@ afiro = CholmodSparse{Float64,Int32}(Base.LinAlg.SuiteSparse.c_CholmodSparse{Flo one(Int32), one(Int32)), colptr0, rowval0, nzval) +show(afiro) From be9db6a8c98b1fab9fadbd499866fa14c820dd85 Mon Sep 17 00:00:00 2001 From: Douglas Bates Date: Thu, 14 Mar 2013 14:41:30 -0500 Subject: [PATCH 26/29] Add CholmodSparse constructor from vectors, modify tests. Also added a show method for the CholmodFactor type. --- base/linalg/cholmod.jl | 86 ++++++++++++++++------- test/suitesparse.jl | 152 +++++++++++++++++++---------------------- 2 files changed, 133 insertions(+), 105 deletions(-) diff --git a/base/linalg/cholmod.jl b/base/linalg/cholmod.jl index cb3767f1d7d5e..71efc2599777e 100644 --- a/base/linalg/cholmod.jl +++ b/base/linalg/cholmod.jl @@ -2,11 +2,13 @@ module CHOLMOD using Base.LinAlg.UMFPACK # for decrement, increment, etc. -export +export # types CholmodDense, CholmodFactor, CholmodSparse, - CholmodTriplet + CholmodTriplet, + + CholmodSparse! # destructive constructor import Base.(*) import Base.(\) @@ -323,7 +325,34 @@ function CholmodSparse(A::SparseMatrixCSC) stype = ishermitian(A) ? 1 : 0 CholmodSparse(stype > 0 ? triu(A) : A, stype) end - +## this should probably be the base call for SparseMatrixCSC too +function CholmodSparse!{Tv<:CHMVTypes,Ti<:CHMITypes}(colpt::Vector{Ti}, + rowval::Vector{Ti}, + nzval::Vector{Tv}, + m::Integer, + n::Integer, + stype::Signed) + bb = colpt[1] + if bb != 0 && bb != 1 error("colpt[1] is $bb, must be 0 or 1") end + if any(diff(colpt) .< 0) error("elements of colpt must be non-decreasing") end + if length(colpt) != n + 1 error("length(colptr) = $(length(colpt)), should be $(n+1)") end + if bool(bb) # one-based + decrement!(colpt) + decrement!(rowval) + end + nz = colpt[end] + if length(rowval) != nz || length(nzval) != nz + error("length(rowval) = $(length(rowval)) and length(nzval) = $(length(nzval)) should be $nz") + end + if any(rowval .< 0) || any(rowval .>= m) + error("all elements of rowval must be in the range [0,$(m-1)]") + end + sort!(CholmodSparse(c_CholmodSparse{Tv,Ti}(m,n,int(nz),convert(Ptr{Ti},colpt), + convert(Ptr{Ti},rowval), C_NULL, + convert(Ptr{Tv},nzval), C_NULL, + int32(stype), ityp(Ti), xtyp(Tv), dtyp(Tv), + CHOLMOD_FALSE,CHOLMOD_TRUE),colpt,rowval,nzval)) +end function chm_rdsp(fnm::String) fd = ccall(:fopen, Ptr{Void}, (Ptr{Uint8},Ptr{Uint8}), fnm, "r") res = ccall((:cholmod_read_sparse,:libcholmod), Ptr{c_CholmodSparse{Float64,Cint}}, @@ -343,37 +372,49 @@ function CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::Ptr{c_CholmodSparse{Tv,T cms end -for (chk,prt,srt,itype) in - (("cholmod_check_sparse","cholmod_print_sparse","cholmod_sort",:Int32), - ("cholmod_l_check_sparse","cholmod_l_print_sparse","cholmod_l_sort",:Int64)) +for (chk,faprt,spprt,srt,itype) in + (("cholmod_check_sparse","cholmod_print_factor","cholmod_print_sparse","cholmod_sort",:Int32), + ("cholmod_l_check_sparse","cholmod_l_print_factor","cholmod_l_print_sparse", + "cholmod_l_sort",:Int64)) @eval begin - function chm_check{Tv<:CHMVTypes}(cs::CholmodSparse{Tv,$itype}) - status = ccall(($chk,:libcholmod), Cint, - (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), - &cs.c, cmn($itype)) + function chm_check{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$itype}) + bool(ccall(($chk,:libcholmod), Cint, + (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), + &A.c, cmn($itype))) + end + function chm_print{Tv<:CHMVTypes}(L::CholmodFactor{Tv,$itype},lev,nm) + cmn($itype) + orig = chm_com[chm_prt_inds] + chm_com[chm_prt_inds] = reinterpret(Uint8, [int32(lev)]) + status = ccall(($faprt,:libcholmod), Cint, + (Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}, Ptr{Uint8}), + &L.c, nm, chm_com) + chm_com[chm_prt_inds] = orig if status != CHOLMOD_TRUE throw(CholmodException) end end - function chm_print{Tv<:CHMVTypes}(cs::CholmodSparse{Tv,$itype},lev,nm) + function chm_print{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$itype},lev,nm) cmn($itype) orig = chm_com[chm_prt_inds] chm_com[chm_prt_inds] = reinterpret(Uint8, [int32(lev)]) - status = ccall(($prt,:libcholmod), Cint, + status = ccall(($spprt,:libcholmod), Cint, (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}, Ptr{Uint8}), - &cs.c, nm, chm_com) + &A.c, nm, chm_com) chm_com[chm_prt_inds] = orig if status != CHOLMOD_TRUE throw(CholmodException) end end - function sort!{Tv<:CHMVTypes}(cs::CholmodSparse{Tv,$itype}) + function sort!{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$itype}) status = ccall(($srt,:libcholmod), Cint, (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), - &cs.c, cmn($itype)) + &A.c, cmn($itype)) if status != CHOLMOD_TRUE throw(CholmodException) end - cs + A end end end -chm_print(cd::CholmodSparse, lev::Integer) = chm_print(cd, lev, "") -show(io::IO,cd::CholmodSparse) = chm_print(cd, int32(4), "") +chm_print(A::CholmodSparse, lev::Integer) = chm_print(A, lev, "") +chm_print(A::CholmodFactor, lev::Integer) = chm_print(L, lev, "") +show(io::IO,L::CholmodFactor) = chm_print(L,int32(4),"") +show(io::IO,A::CholmodSparse) = chm_print(A,int32(4),"") nnz{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::CholmodSparse{Tv,Ti}) = int(cp.colptr0[end]) size{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::CholmodSparse{Tv,Ti}) = (int(cp.c.m), int(cp.c.n)) @@ -586,8 +627,8 @@ cholfact(A::CholmodSparse,ll::Bool) = cholfact(A.c,ll) cholfact(A::CholmodSparse) = cholfact(A.c,false) cholfact(A::SparseMatrixCSC,ll::Bool) = cholfact(CholmodSparse(A).c,ll) cholfact(A::SparseMatrixCSC) = cholfact(CholmodSparse(A).c,false) -cholfact!(A::SparseMatrixCSC,ll::Bool) = cholfact(CholmodSparse!(A).c,ll) -cholfact!(A::SparseMatrixCSC) = cholfact(CholmodSparse!(A).c,false) +#cholfact!(A::SparseMatrixCSC,ll::Bool) = cholfact(CholmodSparse!(A).c,ll) +#cholfact!(A::SparseMatrixCSC) = cholfact(CholmodSparse!(A).c,false) solve{T<:CHMVTypes}(l::c_CholmodFactor{T},b::c_CholmodDense{T}) = solve(l,b,CHOLMOD_A) solve{T<:CHMVTypes}(L::CholmodFactor{T},B::CholmodDense{T}) = solve(L.c,B.c,CHOLMOD_A) @@ -613,7 +654,7 @@ for (chng,pack,cop,chg_xtyp,f2s,itype) in ## in the vectors (May get around this by passing an array of length 1 and not &l?) ## function chm_chng_fac!{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}, ## xt,ll,super,packed,monotonic) - ## status = ccall(($(string(chng)),:libcholmod), Cint, + ## status = ccall(($chng,:libcholmod), Cint, ## (Cint,Cint,Cint,Cint,Cint, ## Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), ## xt,ll,super,packed,monotonic,&l,cmn(l)) @@ -641,9 +682,6 @@ for (chng,pack,cop,chg_xtyp,f2s,itype) in end end end -## function chm_chng_fac!(L::CholmodFactor,xt,ll,super,packed,monotonic) -## chm_chng_fac!(L.c, xt,ll,super,packed,monotonic) -## end copy(L::CholmodFactor) = CholmodFactor(chm_copy_fac(L.c)) CholmodSparse(L::CholmodFactor) = CholmodSparse(chm_fac_to_sp(L.c)) diff --git a/test/suitesparse.jl b/test/suitesparse.jl index f3eaae01dd356..db133a1c09602 100644 --- a/test/suitesparse.jl +++ b/test/suitesparse.jl @@ -56,95 +56,85 @@ using Base.LinAlg.CHOLMOD ## residual 1.3e-19 (|Ax-b|/(|A||x|+|b|)) after iterative refinement ## rcond 9.5e-06 -nzval = - [2.83226851852e6,1.63544753086e6,1.72436728395e6,-2.0e6,-2.08333333333e6,1.00333333333e9,1.0e6, - -2.77777777778e6,1.0675e9,2.08333333333e6,5.55555555555e6,1.53533333333e9,-3333.33333333,-1.0e6, - 2.83226851852e6,-6666.66666667,2.0e6,1.63544753086e6,-1.68e6,1.72436728395e6,-2.0e6,4.0e8,2.0e6, - -2.08333333333e6,1.00333333333e9,1.0e6,2.0e8,-1.0e6,-2.77777777778e6,1.0675e9,-2.0e6, - 2.08333333333e6,5.55555555555e6,1.53533333333e9,-2.8e6,2.8360994695e6,-30864.1975309, - -5.55555555555e6,1.76741074446e6,-15432.0987654,2.77777777778e6,517922.131816,3.89003806848e6, - -3.33333333333e6,4.29857058902e6,-2.6349902747e6,1.97572063531e9,-2.77777777778e6,3.33333333333e8, - -2.14928529451e6,2.77777777778e6,1.52734651547e9,5.55555555555e6,6.66666666667e8,2.35916180402e6, - -5.55555555555e6,-1.09779731332e8,1.56411143711e9,-2.8e6,-3333.33333333,1.0e6,2.83226851852e6, - -30864.1975309,-5.55555555555e6,-6666.66666667,-2.0e6,1.63544753086e6,-15432.0987654, - 2.77777777778e6,-1.68e6,1.72436728395e6,-3.33333333333e6,2.0e6,4.0e8,-2.0e6,-2.08333333333e6, - 1.00333333333e9,-2.77777777778e6,3.33333333333e8,-1.0e6,2.0e8,1.0e6,2.77777777778e6,1.0675e9, - 5.55555555555e6,6.66666666667e8,-2.0e6,2.08333333333e6,-5.55555555555e6,1.53533333333e9, - -28935.1851852,-2.08333333333e6,60879.6296296,-1.59791666667e6,3.37291666667e6,-28935.1851852, - 2.08333333333e6,2.41171296296e6,-2.08333333333e6,1.0e8,-2.5e6,-416666.666667,1.5e9,-833333.333333, - 1.25e6,5.01833333333e8,2.08333333333e6,1.0e8,416666.666667,5.025e8,-28935.1851852,-2.08333333333e6, - -4166.66666667,-1.25e6,3.98587962963e6,-1.59791666667e6,-8333.33333333,2.5e6,3.41149691358e6, - -28935.1851852,2.08333333333e6,-2.355e6,2.43100308642e6,-2.08333333333e6,1.0e8,-2.5e6,5.0e8,2.5e6, - -416666.666667,1.50416666667e9,-833333.333333,1.25e6,2.5e8,-1.25e6,-3.47222222222e6,1.33516666667e9, - 2.08333333333e6,1.0e8,-2.5e6,416666.666667,6.94444444444e6,2.16916666667e9,-28935.1851852, - -2.08333333333e6,-3.925e6,3.98587962963e6,-1.59791666667e6,-38580.2469136,-6.94444444444e6, - 3.41149691358e6,-28935.1851852,2.08333333333e6,-19290.1234568,3.47222222222e6,2.43100308642e6, - -2.08333333333e6,1.0e8,-4.16666666667e6,2.5e6,-416666.666667,1.50416666667e9,-833333.333333, - -3.47222222222e6,4.16666666667e8,-1.25e6,3.47222222222e6,1.33516666667e9,2.08333333333e6,1.0e8, - 6.94444444445e6,8.33333333333e8,416666.666667,-6.94444444445e6,2.16916666667e9,-3830.95098171, - 1.14928529451e6,-275828.470683,-28935.1851852,-2.08333333333e6,-4166.66666667,1.25e6,64710.5806113, - -131963.213599,-517922.131816,-2.29857058902e6,-1.59791666667e6,-8333.33333333,-2.5e6, - 3.50487988027e6,-517922.131816,-2.16567078453e6,551656.941366,-28935.1851852,2.08333333333e6, - -2.355e6,517922.131816,4.57738374749e6,2.29857058902e6,-551656.941367,4.8619365099e8, - -2.08333333333e6,1.0e8,2.5e6,5.0e8,-4.79857058902e6,134990.2747,2.47238730198e9,-1.14928529451e6, - 2.29724661236e8,-5.57173510779e7,-833333.333333,-1.25e6,2.5e8,2.39928529451e6,9.61679848804e8, - 275828.470683,-5.57173510779e7,1.09411960038e7,2.08333333333e6,1.0e8,-2.5e6,140838.195984, - -1.09779731332e8,5.31278103775e8] -colptr0 = int32([0,1,2,3,6,9,12,15,18,20,25,30,34,36,39,43,47,52,58,62,67,71,77,84,90,93,95, - 98,103,106,110,115,119,123,130,136,142,146,150,155,161,167,174,182,189,197, - 207,215,224]) -rowval0 = int32([0,1,2,1,2,3,0,2,4,0,1,5,0,4,6,1,3,7,2,8,1,3,7,8,9,0,4,6,8,10,5,6,7,11,6,12, - 7,11,13,8,10,13,14,9,13,14,15,8,10,12,14,16,7,11,12,13,16,17,0,12,16,18,1,5, - 13,15,19,2,4,14,20,3,13,15,19,20,21,2,4,12,16,18,20,22,1,5,17,18,19,23,0,5, - 24,1,25,2,3,26,2,3,25,26,27,4,24,28,0,5,24,29,6,11,24,28,30,7,25,27,31,8,9, - 26,32,8,9,25,27,31,32,33,10,24,28,30,32,34,6,11,29,30,31,35,12,17,30,36,13, - 31,35,37,14,15,32,34,38,14,15,33,37,38,39,16,32,34,36,38,40,12,17,31,35,36, - 37,41,12,16,17,18,23,36,40,42,13,14,15,19,37,39,43,13,14,15,20,21,38,43,44, - 13,14,15,20,21,37,39,43,44,45,12,16,17,22,36,40,42,46,12,16,17,18,23,41,42,46,47]) -A = CholmodSparse{Float64,Int32}(Base.LinAlg.CHOLMOD.c_CholmodSparse{Float64,Int32}(48,48,224, - convert(Ptr{Int32}, colptr0), - convert(Ptr{Int32}, rowval0), - C_NULL, - convert(Ptr{Float64}, nzval), - C_NULL, - one(Int32), zero(Int32), - one(Int32), zero(Int32), - one(Int32), one(Int32)), - colptr0, rowval0, nzval) +A = CholmodSparse!(int32([0,1,2,3,6,9,12,15,18,20,25,30,34,36,39,43,47,52,58,62,67,71,77,84,90,93,95, + 98,103,106,110,115,119,123,130,136,142,146,150,155,161,167,174,182,189,197, + 207,215,224]), # zero-based column pointers + int32([0,1,2,1,2,3,0,2,4,0,1,5,0,4,6,1,3,7,2,8,1,3,7,8,9,0,4,6,8,10,5,6,7,11,6,12, + 7,11,13,8,10,13,14,9,13,14,15,8,10,12,14,16,7,11,12,13,16,17,0,12,16,18,1, + 5,13,15,19,2,4,14,20,3,13,15,19,20,21,2,4,12,16,18,20,22,1,5,17,18,19,23,0, + 5,24,1,25,2,3,26,2,3,25,26,27,4,24,28,0,5,24,29,6,11,24,28,30,7,25,27,31,8, + 9,26,32,8,9,25,27,31,32,33,10,24,28,30,32,34,6,11,29,30,31,35,12,17,30,36, + 13,31,35,37,14,15,32,34,38,14,15,33,37,38,39,16,32,34,36,38,40,12,17,31,35, + 36,37,41,12,16,17,18,23,36,40,42,13,14,15,19,37,39,43,13,14,15,20,21,38,43, + 44,13,14,15,20,21,37,39,43,44,45,12,16,17,22,36,40,42,46,12,16,17,18,23,41, + 42,46,47]), + [2.83226851852e6,1.63544753086e6,1.72436728395e6,-2.0e6,-2.08333333333e6, + 1.00333333333e9,1.0e6, -2.77777777778e6,1.0675e9,2.08333333333e6, + 5.55555555555e6,1.53533333333e9,-3333.33333333,-1.0e6,2.83226851852e6, + -6666.66666667,2.0e6,1.63544753086e6,-1.68e6,1.72436728395e6,-2.0e6,4.0e8,2.0e6, + -2.08333333333e6,1.00333333333e9,1.0e6,2.0e8,-1.0e6,-2.77777777778e6,1.0675e9, + -2.0e6,2.08333333333e6,5.55555555555e6,1.53533333333e9,-2.8e6,2.8360994695e6, + -30864.1975309,-5.55555555555e6,1.76741074446e6,-15432.0987654,2.77777777778e6, + 517922.131816,3.89003806848e6,-3.33333333333e6,4.29857058902e6,-2.6349902747e6, + 1.97572063531e9,-2.77777777778e6,3.33333333333e8,-2.14928529451e6, + 2.77777777778e6,1.52734651547e9,5.55555555555e6,6.66666666667e8,2.35916180402e6, + -5.55555555555e6,-1.09779731332e8,1.56411143711e9,-2.8e6,-3333.33333333,1.0e6, + 2.83226851852e6,-30864.1975309,-5.55555555555e6,-6666.66666667,-2.0e6, + 1.63544753086e6,-15432.0987654,2.77777777778e6,-1.68e6,1.72436728395e6, + -3.33333333333e6,2.0e6,4.0e8,-2.0e6,-2.08333333333e6,1.00333333333e9, + -2.77777777778e6,3.33333333333e8,-1.0e6,2.0e8,1.0e6,2.77777777778e6,1.0675e9, + 5.55555555555e6,6.66666666667e8,-2.0e6,2.08333333333e6,-5.55555555555e6, + 1.53533333333e9,-28935.1851852,-2.08333333333e6,60879.6296296,-1.59791666667e6, + 3.37291666667e6,-28935.1851852,2.08333333333e6,2.41171296296e6,-2.08333333333e6, + 1.0e8,-2.5e6,-416666.666667,1.5e9,-833333.333333,1.25e6,5.01833333333e8, + 2.08333333333e6,1.0e8,416666.666667,5.025e8,-28935.1851852,-2.08333333333e6, + -4166.66666667,-1.25e6,3.98587962963e6,-1.59791666667e6,-8333.33333333,2.5e6, + 3.41149691358e6,-28935.1851852,2.08333333333e6,-2.355e6,2.43100308642e6, + -2.08333333333e6,1.0e8,-2.5e6,5.0e8,2.5e6,-416666.666667,1.50416666667e9, + -833333.333333,1.25e6,2.5e8,-1.25e6,-3.47222222222e6,1.33516666667e9, + 2.08333333333e6,1.0e8,-2.5e6,416666.666667,6.94444444444e6,2.16916666667e9, + -28935.1851852,-2.08333333333e6,-3.925e6,3.98587962963e6,-1.59791666667e6, + -38580.2469136,-6.94444444444e6,3.41149691358e6,-28935.1851852,2.08333333333e6, + -19290.1234568,3.47222222222e6,2.43100308642e6,-2.08333333333e6,1.0e8, + -4.16666666667e6,2.5e6,-416666.666667,1.50416666667e9,-833333.333333, + -3.47222222222e6,4.16666666667e8,-1.25e6,3.47222222222e6,1.33516666667e9, + 2.08333333333e6,1.0e8,6.94444444445e6,8.33333333333e8,416666.666667, + -6.94444444445e6,2.16916666667e9,-3830.95098171,1.14928529451e6,-275828.470683, + -28935.1851852,-2.08333333333e6,-4166.66666667,1.25e6,64710.5806113, + -131963.213599,-517922.131816,-2.29857058902e6,-1.59791666667e6,-8333.33333333, + -2.5e6,3.50487988027e6,-517922.131816,-2.16567078453e6,551656.941366, + -28935.1851852,2.08333333333e6,-2.355e6,517922.131816,4.57738374749e6, + 2.29857058902e6,-551656.941367,4.8619365099e8,-2.08333333333e6,1.0e8,2.5e6, + 5.0e8,-4.79857058902e6,134990.2747,2.47238730198e9,-1.14928529451e6, + 2.29724661236e8,-5.57173510779e7,-833333.333333,-1.25e6,2.5e8,2.39928529451e6, + 9.61679848804e8,275828.470683,-5.57173510779e7,1.09411960038e7,2.08333333333e6, + 1.0e8,-2.5e6,140838.195984,-1.09779731332e8,5.31278103775e8], 48, 48, 1) +show(A) @test_approx_eq norm(A,Inf) 3.570948074697437e9 @test_approx_eq norm(A) 3.570948074697437e9 -show(A) ## the call to cholmod_sdmult is giving problems right now #B = A * CholmodDense(ones(size(A,2))) #Base.LinAlg.CHOLMOD.chm_print(B,3) chma = cholfact(A) +show(chma) #x = chma\B #@test_approx_eq x ones(size(A,2))' #lp_afiro example - -nzval = [1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0, - -1.0,-1.06,1.0,0.301,1.0,-1.0,1.0,-1.0,1.0,1.0,-1.0,-1.06,1.0,0.301,-1.0,-1.06, - 1.0,0.313,-1.0,-0.96,1.0,0.313,-1.0,-0.86,1.0,0.326,-1.0,2.364,-1.0,2.386,-1.0, - 2.408,-1.0,2.429,1.4,1.0,1.0,-1.0,1.0,1.0,-1.0,-0.43,1.0,0.109,1.0,-1.0,1.0, - -1.0,1.0,-1.0,1.0,1.0,-0.43,1.0,1.0,0.109,-0.43,1.0,1.0,0.108,-0.39,1.0,1.0, - 0.108,-0.37,1.0,1.0,0.107,-1.0,2.191,-1.0,2.219,-1.0,2.249,-1.0,2.279,1.4, - -1.0,1.0,-1.0,1.0,1.0,1.0] -colptr0 = int32([0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,23,25,27,29,33,37,41,45,47, - 49,51,53,55,57,59,63,65,67,69,71,75,79,83,87,89,91,93,95,97,99,101,102]) -rowval0 = int32([2,3,6,7,8,9,12,13,16,17,18,19,20,21,22,23,24,25,26,0,1,2,23,0,3,0,21,1,25,4,5, - 6,24,4,5,7,24,4,5,8,24,4,5,9,24,6,20,7,20,8,20,9,20,3,4,4,22,5,26,10,11,12,21, - 10,13,10,23,10,20,11,25,14,15,16,22,14,15,17,22,14,15,18,22,14,15,19,22,16,20, - 17,20,18,20,19,20,13,15,15,24,14,26,15]) -afiro = CholmodSparse{Float64,Int32}(Base.LinAlg.CHOLMOD.c_CholmodSparse{Float64,Int32}(27,51,102, - convert(Ptr{Int32}, colptr0), - convert(Ptr{Int32}, rowval0), - C_NULL, - convert(Ptr{Float64}, nzval), - C_NULL, - zero(Int32), zero(Int32), - one(Int32), zero(Int32), - one(Int32), one(Int32)), - colptr0, rowval0, nzval) - +afiro = CholmodSparse!(int32([0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,23,25,27,29,33,37, + 41,45,47,49,51,53,55,57,59,63,65,67,69,71,75,79,83,87,89,91,93,95,97, + 99,101,102]), + int32([2,3,6,7,8,9,12,13,16,17,18,19,20,21,22,23,24,25,26,0,1,2,23,0,3,0,21, + 1,25,4,5,6,24,4,5,7,24,4,5,8,24,4,5,9,24,6,20,7,20,8,20,9,20,3,4,4,22, + 5,26,10,11,12,21,10,13,10,23,10,20,11,25,14,15,16,22,14,15,17,22,14, + 15,18,22,14,15,19,22,16,20,17,20,18,20,19,20,13,15,15,24,14,26,15]), + [1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0, + -1.0,-1.06,1.0,0.301,1.0,-1.0,1.0,-1.0,1.0,1.0,-1.0,-1.06,1.0,0.301,-1.0, + -1.06,1.0,0.313,-1.0,-0.96,1.0,0.313,-1.0,-0.86,1.0,0.326,-1.0,2.364,-1.0, + 2.386,-1.0,2.408,-1.0,2.429,1.4,1.0,1.0,-1.0,1.0,1.0,-1.0,-0.43,1.0,0.109, + 1.0,-1.0,1.0,-1.0,1.0,-1.0,1.0,1.0,-0.43,1.0,1.0,0.109,-0.43,1.0,1.0,0.108, + -0.39,1.0,1.0,0.108,-0.37,1.0,1.0,0.107,-1.0,2.191,-1.0,2.219,-1.0,2.249, + -1.0,2.279,1.4,-1.0,1.0,-1.0,1.0,1.0,1.0], 27, 51, 0) show(afiro) +chmaf = cholfact(afiro) +show(chmaf) From 3e16bb5bf48efebd5b90260ac34321635ef271db Mon Sep 17 00:00:00 2001 From: Douglas Bates Date: Thu, 14 Mar 2013 16:57:44 -0500 Subject: [PATCH 27/29] Added more method definitions to cholmod.jl. CholmodSparse/CholmodDense multiplication and \ now working. Added tests but still need a lot more. --- base/linalg/cholmod.jl | 145 ++++++++++++++++++++++++----------------- test/suitesparse.jl | 14 ++-- 2 files changed, 95 insertions(+), 64 deletions(-) diff --git a/base/linalg/cholmod.jl b/base/linalg/cholmod.jl index 71efc2599777e..6989c2e923fde 100644 --- a/base/linalg/cholmod.jl +++ b/base/linalg/cholmod.jl @@ -17,6 +17,7 @@ import Base.At_ldiv_B import Base.Ac_mul_B import Base.convert import Base.copy +import Base.ctranspose import Base.eltype import Base.findn_nzs import Base.getindex @@ -24,6 +25,7 @@ import Base.nnz import Base.show import Base.size import Base.sort! +import Base.transpose import LinAlg.Factorization import LinAlg.cholfact @@ -416,19 +418,22 @@ chm_print(A::CholmodFactor, lev::Integer) = chm_print(L, lev, "") show(io::IO,L::CholmodFactor) = chm_print(L,int32(4),"") show(io::IO,A::CholmodSparse) = chm_print(A,int32(4),"") -nnz{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::CholmodSparse{Tv,Ti}) = int(cp.colptr0[end]) -size{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::CholmodSparse{Tv,Ti}) = (int(cp.c.m), int(cp.c.n)) -function size{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::CholmodSparse{Tv,Ti}, d::Integer) - d == 1 ? cp.c.m : (d == 2 ? cp.c.n : 1) +nnz(A::CholmodSparse) = int(A.colptr0[end]) +size(A::CholmodSparse) = (int(A.c.m), int(A.c.n)) +function size(A::CholmodSparse, d::Integer) + d == 1 ? A.c.m : (d == 2 ? A.c.n : 1) end +size(B::CholmodDense) = size(B.mat) +size(B::CholmodDense,d) = size(B.mat,d) -for (aat,allocsp,cop,copsp,freesp,normsp,scl,sdmult,speye,ssmult,transsym,itype) in +for (aat,allocsp,cop,copsp,freesp,normsp,scl,sdmult,speye,ssmult,transsym,trans,itype) in (("cholmod_aat","cholmod_allocate_sparse","cholmod_copy","cholmod_copy_sparse", "cholmod_free_sparse","cholmod_norm_sparse","cholmod_scale", "cholmod_sdmult", - "cholmod_speye", "cholmod_ssmult","cholmod_transpose_sym",:Int32), + "cholmod_speye", "cholmod_ssmult","cholmod_transpose_sym","cholmod_transpose",:Int32), ("cholmod_l_aat","cholmod_l_allocate_sparse","cholmod_l_copy","cholmod_l_copy_sparse", "cholmod_l_free_sparse","cholmod_l_norm_sparse","cholmod_l_scale", - "cholmod_l_sdmult","cholmod_l_speye","cholmod_l_ssmult","cholmod_l_transpose_sym",:Int64)) + "cholmod_l_sdmult","cholmod_l_speye","cholmod_l_ssmult","cholmod_l_transpose_sym", + "cholmod_l_transpose",:Int64)) @eval begin function chm_aat{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}) cm = cmn($itype) @@ -462,32 +467,33 @@ for (aat,allocsp,cop,copsp,freesp,normsp,scl,sdmult,speye,ssmult,transsym,itype) if status != CHOLMOD_TRUE throw(CholmodException) end CholmodSparse(rpt) end - function chm_copy_sp{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}) - ccall(($copsp,:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, - (Ptr{c_CholmodSparse{Tv,$itype}},Ptr{Uint8}), &a, cmn($itype)) + function copy{Tv<:CHMVTypes}(A::c_CholmodSparse{Tv,$itype}) + CholmodSparse(ccall(($copsp,:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, + (Ptr{c_CholmodSparse{Tv,$itype}},Ptr{Uint8}), &A.c, cmn($itype))) end - function norm{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype},p::Number) + function norm{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$itype},p::Number) ccall(($normsp, :libcholmod), Float64, (Ptr{c_CholmodSparse{Tv,$itype}}, Cint, Ptr{Uint8}), - &a,p == 1 ? 1 :(p == Inf ? 1 : error("p must be 1 or Inf")),cmn($itype)) + &A.c,p == 1 ? 1 :(p == Inf ? 1 : error("p must be 1 or Inf")),cmn($itype)) end - function chm_sdmult{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}, + function chm_sdmult{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$itype}, trans::Bool, alpha::Real, beta::Real, - x::c_CholmodDense{Tv}) - nc = trans ? a.m : a.n - nr = trans ? a.n : a.m - if nc != x.m - error("Incompatible dimensions, $nc and $(x.m), in chm_sdmult") + X::CholmodDense{Tv}) + m,n = size(A) + nc = trans ? m : n + nr = trans ? n : m + if nc != size(X,1) + error("Incompatible dimensions, $nc and $(size(X,1)), in chm_sdmult") end aa = float64([alpha, 0.]) bb = float64([beta, 0.]) - Y = CholmodDense(zeros(Tv,nr,x.n)) - status = ccall(($sdmult,:libcholmod), Cint, + Y = CholmodDense(zeros(Tv,nr,size(X,2))) + status = ccall((:cholmod_sdmult,:libcholmod), Cint, (Ptr{c_CholmodSparse{Tv,$itype}},Cint,Ptr{Cdouble},Ptr{Cdouble}, Ptr{c_CholmodDense{Tv}}, Ptr{c_CholmodDense{Tv}}, Ptr{Uint8}), - &a,trans,aa,bb,&x,[Y.c],cmn($itype)) + &A.c,trans,aa,bb,&X.c,&Y.c,cmn($itype)) if status != CHOLMOD_TRUE throw(CholmodException) end Y end @@ -498,11 +504,11 @@ for (aat,allocsp,cop,copsp,freesp,normsp,scl,sdmult,speye,ssmult,transsym,itype) Tv<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, cmn($itype))) end - function (*){Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}, - b::c_CholmodSparse{Tv,$itype}) + function (*){Tv<:CHMVTypes}(A::CholmodSparse{Tv,$itype}, + B::CholmodSparse{Tv,$itype}) CholmodSparse(ccall(($ssmult, :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, (Ptr{c_CholmodSparse{Tv,$itype}},Ptr{c_CholmodSparse{Tv,$itype}}, - Cint,Cint,Cint,Ptr{Uint8}), &a,&b,0,true,true,cmn($itype))) + Cint,Cint,Cint,Ptr{Uint8}), &A.c,&B.c,0,true,true,cmn($itype))) end function chm_scale!{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}, s::c_CholmodDense{Tv}, @@ -512,20 +518,27 @@ for (aat,allocsp,cop,copsp,freesp,normsp,scl,sdmult,speye,ssmult,transsym,itype) Ptr{Uint8}), &s, typ, &a, cmn($itype)) if status != CHOLMOD_TRUE throw(CholmodException) end end + function transpose{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$itype}) + CholmodSparse(ccall(($trans,:libcholmod),Ptr{c_CholmodSparse{Tv,$itype}}, + (Ptr{c_CholmodSparse{Tv,$itype}}, Cint, Ptr{Uint8}), + &A.c, 1, cmn($itype))) + end + function ctranspose{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$itype}) + CholmodSparse(ccall(($trans,:libcholmod),Ptr{c_CholmodSparse{Tv,$itype}}, + (Ptr{c_CholmodSparse{Tv,$itype}}, Cint, Ptr{Uint8}), + &A.c, 2, cmn($itype))) + end end end -(*){Tv<:CHMVTypes}(a::c_CholmodSparse{Tv},b::c_CholmodDense{Tv}) = chm_sdmult(a,false,1.,0.,b) -(*){Tv<:CHMVTypes}(A::CholmodSparse{Tv},B::CholmodDense{Tv}) = chm_sdmult(A.c,false,1.,0.,B.c) -Ac_mul_B{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv},b::c_CholmodDense{Tv}) = chm_sdmult(a,true,1.,0.,b) -Ac_mul_B{Tv<:CHMVTypes}(A::CholmodSparse{Tv},B::CholmodDense{Tv}) = chm_sdmult(A.c,true,1.,0.,B.c) -(*){Tv<:CHMVTypes,Ti<:CHMITypes}(A::CholmodSparse{Tv,Ti},B::CholmodSparse{Tv,Ti}) = A.c * B.c +(*){Tv<:CHMVTypes}(A::CholmodSparse{Tv},B::CholmodDense{Tv}) = chm_sdmult(A,false,1.,0.,B) +(*){Tv<:CHMVTypes}(A::CholmodSparse{Tv},B::VecOrMat{Tv}) = chm_sdmult(A,false,1.,0.,CholmodDense(B)) +Ac_mul_B{Tv<:CHMVTypes}(A::CholmodSparse{Tv},B::CholmodDense{Tv}) = chm_sdmult(A,true,1.,0.,B) +Ac_mul_B{Tv<:CHMVTypes}(A::CholmodSparse{Tv},B::VecOrMat{Tv}) = chm_sdmult(A,true,1.,0.,CholmodDense(B)) chm_speye(m::Integer, n::Integer) = chm_speye(m, n, 1., 1) chm_speye(n::Integer) = chm_speye(n, n, 1., 1) chm_aat(A::CholmodSparse) = chm_aat(A.c) chm_aat(A::SparseMatrixCSC) = chm_aat(CholmodSparse(A).c) -norm(A::CholmodSparse,p::Number) = norm(A.c,p) -norm(A::CholmodSparse) = norm(A.c,1) -copy(A::CholmodSparse) = CholmodSparse(chm_copy_sp(A.c)) +norm(A::CholmodSparse) = norm(A,1) function chm_scale!{T<:CHMVTypes}(A::CholmodSparse{T},S::CholmodDense{T},typ::Integer) chm_scale!(A.c,S.c,typ) end @@ -601,20 +614,20 @@ for (anl,chng,fac,slv,spslv,itype) in if status != CHOLMOD_TRUE throw(CholmodException) end CholmodFactor(Lpt) end - function solve{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}, - b::c_CholmodDense{Tv}, typ::Integer) - ccall(($slv,:libcholmod), Ptr{c_CholmodDense{Tv}}, - (Cint, Ptr{c_CholmodFactor{Tv,$itype}}, - Ptr{c_CholmodDense{Tv}}, Ptr{Uint8}), - typ, &l, &b, cmn($itype)) + function solve{Tv<:CHMVTypes}(L::CholmodFactor{Tv,$itype}, + B::CholmodDense{Tv}, typ::Integer) + CholmodDense(ccall(($slv,:libcholmod), Ptr{c_CholmodDense{Tv}}, + (Cint, Ptr{c_CholmodFactor{Tv,$itype}}, + Ptr{c_CholmodDense{Tv}}, Ptr{Uint8}), + typ, &L.c, &B.c, cmn($itype))) end - function solve{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}, - b::c_CholmodSparse{Tv,$itype}, + function solve{Tv<:CHMVTypes}(L::CholmodFactor{Tv,$itype}, + B::CholmodSparse{Tv,$itype}, typ::Integer) - ccall(($spslv,:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, - (Cint, Ptr{c_CholmodFactor{Tv,$itype}}, - Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), - typ, &l, &b, cmn($itype)) + CholmodSparse(ccall(($spslv,:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, + (Cint, Ptr{c_CholmodFactor{Tv,$itype}}, + Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), + typ, &L.c, &B.c, cmn($itype))) end end end @@ -627,20 +640,36 @@ cholfact(A::CholmodSparse,ll::Bool) = cholfact(A.c,ll) cholfact(A::CholmodSparse) = cholfact(A.c,false) cholfact(A::SparseMatrixCSC,ll::Bool) = cholfact(CholmodSparse(A).c,ll) cholfact(A::SparseMatrixCSC) = cholfact(CholmodSparse(A).c,false) -#cholfact!(A::SparseMatrixCSC,ll::Bool) = cholfact(CholmodSparse!(A).c,ll) -#cholfact!(A::SparseMatrixCSC) = cholfact(CholmodSparse!(A).c,false) - -solve{T<:CHMVTypes}(l::c_CholmodFactor{T},b::c_CholmodDense{T}) = solve(l,b,CHOLMOD_A) -solve{T<:CHMVTypes}(L::CholmodFactor{T},B::CholmodDense{T}) = solve(L.c,B.c,CHOLMOD_A) -(\){T<:CHMVTypes}(L::CholmodFactor{T},B::CholmodDense{T}) = solve(L.c,B.c,CHOLMOD_A) -solve{Tv<:CHMVTypes,Ti<:CHMITypes}(l::c_CholmodFactor{Tv,Ti},b::c_CholmodSparse{Tv,Ti})= - solve(l,b,CHOLMOD_A) -solve{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::CholmodSparse{Tv,Ti})=solve(L.c,B.c,CHOLMOD_A) -solve{T<:CHMVTypes}(l::c_CholmodFactor{T},b::VecOrMat{T},typ::Integer)=solve(l,CholmodDense(b),typ) -solve{T<:CHMVTypes}(l::c_CholmodFactor{T},b::VecOrMat{T})=solve(l,CholmodDense(b),CHOLMOD_A) -solve{T<:CHMVTypes}(L::CholmodFactor{T},b::VecOrMat{T},typ::Integer)=solve(L.c,CholmodDense(b),typ) -solve{T<:CHMVTypes}(L::CholmodFactor{T},b::VecOrMat{T})=solve(L.c,CholmodDense(b),CHOLMOD_A) - + +solve{T<:CHMVTypes}(L::CholmodFactor{T},B::CholmodDense{T}) = solve(L,B,CHOLMOD_A) +(\){T<:CHMVTypes}(L::CholmodFactor{T},B::CholmodDense{T}) = solve(L,B,CHOLMOD_A) +(\){T<:CHMVTypes}(L::CholmodFactor{T},B::VecOrMat{T}) = solve(L,CholmodDense(B),CHOLMOD_A) +Ac_ldiv_B{T<:CHMVTypes}(L::CholmodFactor{T},B::CholmodDense{T}) = solve(L,B,CHOLMOD_A) +Ac_ldiv_B{T<:CHMVTypes}(L::CholmodFactor{T},B::VecOrMat{T}) = solve(L,CholmodDense(B),CHOLMOD_A) +function solve{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::CholmodSparse{Tv,Ti}) + solve(L,B,CHOLMOD_A) +end +function (\){Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::CholmodSparse{Tv,Ti}) + solve(L,B,CHOLMOD_A) +end +function Ac_ldiv_B{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::CholmodSparse{Tv,Ti}) + solve(L,B,CHOLMOD_A) +end +function solve{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::SparseMatrixCSC{Tv,Ti}) + solve(L,CholmodSparse(B),CHOLMOD_A) +end +function (\){Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::SparseMatrixCSC{Tv,Ti}) + solve(L,CholmodSparse(B),CHOLMOD_A) +end +function Ac_ldiv_B{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::SparseMatrixCSC{Tv,Ti}) + solve(L,CholmodSparse(B),CHOLMOD_A) +end +solve{T<:CHMVTypes}(L::CholmodFactor{T},B::VecOrMat{T},typ::Integer)=solve(L,CholmodDense(B),typ) +function solve{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti}, + B::SparseMatrixCSC{Tv,Ti},typ::Integer) + solve(L,CholmodSparse(B),typ) +end + for (chng,pack,cop,chg_xtyp,f2s,itype) in (("cholmod_change_factor","cholmod_pack_factor", "cholmod_copy_factor","cholmod_factor_xtype", diff --git a/test/suitesparse.jl b/test/suitesparse.jl index db133a1c09602..e9fac17c7b3ae 100644 --- a/test/suitesparse.jl +++ b/test/suitesparse.jl @@ -3,6 +3,7 @@ do33 = ones(3) @test isequal(se33 \ do33, do33) using Base.LinAlg.UMFPACK +import Base.(*) # based on deps/Suitesparse-4.0.2/UMFPACK/Demo/umfpack_di_demo.c @@ -26,7 +27,6 @@ using Base.LinAlg.CHOLMOD # based on deps/SuiteSparse-4.0.2/CHOLMOD/Demo/ -# use inline values instead of # chm_rdsp(joinpath(JULIA_HOME, "../../deps/SuiteSparse-4.0.2/CHOLMOD/Demo/Matrix/bcsstk01.tri")) # because the file may not exist in binary distributions and when a system suitesparse library # is used @@ -112,13 +112,13 @@ A = CholmodSparse!(int32([0,1,2,3,6,9,12,15,18,20,25,30,34,36,39,43,47,52,58,62, show(A) @test_approx_eq norm(A,Inf) 3.570948074697437e9 @test_approx_eq norm(A) 3.570948074697437e9 -## the call to cholmod_sdmult is giving problems right now -#B = A * CholmodDense(ones(size(A,2))) -#Base.LinAlg.CHOLMOD.chm_print(B,3) + +B = A * ones(size(A,2)) chma = cholfact(A) show(chma) -#x = chma\B -#@test_approx_eq x ones(size(A,2))' +x = chma\B +show(x) +@test_approx_eq x.mat ones(size(x)) #lp_afiro example afiro = CholmodSparse!(int32([0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,23,25,27,29,33,37, @@ -138,3 +138,5 @@ afiro = CholmodSparse!(int32([0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19, show(afiro) chmaf = cholfact(afiro) show(chmaf) +sol = solve(chmaf,afiro * ones(size(afiro,2))) # least squares solution +show(sol) From cecd879dc407ac3b6caba7da68e85705f8058d46 Mon Sep 17 00:00:00 2001 From: Douglas Bates Date: Fri, 15 Mar 2013 09:29:31 -0500 Subject: [PATCH 28/29] Trim unused C functions, comment out show() calls in tests --- deps/SuiteSparse_wrapper.c | 125 ------------------------------------- test/suitesparse.jl | 27 ++++---- 2 files changed, 13 insertions(+), 139 deletions(-) diff --git a/deps/SuiteSparse_wrapper.c b/deps/SuiteSparse_wrapper.c index 2ad9fbb45ce13..ec7e6f2560eb0 100644 --- a/deps/SuiteSparse_wrapper.c +++ b/deps/SuiteSparse_wrapper.c @@ -26,128 +26,3 @@ extern void jl_cholmod_common_offsets(size_t *vv) { vv[17] = offsetof(cholmod_common, itype); vv[18] = offsetof(cholmod_common, dtype); } - -extern void -jl_cholmod_common(void **cm) -{ - cholmod_common *c = (cholmod_common *) malloc (sizeof(cholmod_common)); - *cm = c; -} - -extern void -jl_cholmod_dense( void **cd, /* Store return value in here */ - size_t nrow, /* the matrix is nrow-by-ncol */ - size_t ncol, - size_t nzmax, /* maximum number of entries in the matrix */ - size_t d, /* leading dimension (d >= nrow must hold) */ - void *x, /* size nzmax or 2*nzmax, if present */ - void *z, /* size nzmax, if present */ - int xtype, /* pattern, real, complex, or zomplex */ - int dtype /* x and z double or float */ - ) -{ - cholmod_dense *mat = (cholmod_dense *) malloc (sizeof(cholmod_dense)); - mat->nrow = nrow; - mat->ncol = ncol; - mat->nzmax = nzmax; - mat->d = d; - mat->x = x; - mat->z = z; - mat->xtype = xtype; - mat->dtype = dtype; - - *cd = mat; -} - -extern void -jl_cholmod_dense_copy_out(cholmod_dense *cd, - void *p - ) -{ - size_t elsize = (cd->xtype == CHOLMOD_COMPLEX ? 2 : 1) * - (cd->dtype == CHOLMOD_DOUBLE ? sizeof(double) : sizeof(float)); - - memcpy(p, cd->x, cd->nzmax*elsize); -} - -extern void -jl_cholmod_sparse( void **cs, /* Store return value in here */ - size_t nrow, /* # of rows of A */ - size_t ncol, /* # of columns of A */ - size_t nzmax, /* max # of nonzeros of A */ - void *p, /* p [0..ncol], the column pointers */ - void *i, /* i [0..nzmax-1], the row indices */ - void *nz, /* nz [0..ncol-1], the # of nonzeros in each col if unpacked */ - void *x, /* size nzmax or 2*nzmax, if present */ - void *z, /* size nzmax, if present */ - int stype, /* 0: matrix is unsymmetric and possibly rectangular - >0: matrix is square and upper triangular - <0: matrix is square and lower triangular - */ - int itype, /* CHOLMOD_INT: p, i, and nz are int. - * CHOLMOD_INTLONG: p is UF_long, i and nz are int. - * CHOLMOD_LONG: p, i, and nz are UF_long. */ - int xtype, /* pattern, real, complex, or zomplex */ - int dtype, /* x and z are double or float */ - int sorted, /* TRUE if columns are sorted, FALSE otherwise */ - int packed /* TRUE if packed (nz ignored), FALSE if unpacked - * (nz is required) */ -) -{ - cholmod_sparse *s = (cholmod_sparse *) malloc (sizeof(cholmod_sparse)); - s->nrow = nrow; - s->ncol = ncol; - s->nzmax = nzmax; - s->p = p; - s->i = i; - s->nz = nz; - s->x = x; - s->z = z; - s->stype = stype; - s->itype = itype; - s->xtype = xtype; - s->dtype = dtype; - s->sorted = sorted; - s->packed = packed; - - *cs = s; - return; -} - -extern int -jl_cholmod_sparse_copy_out(cholmod_sparse *cs, - void *cp, /* column pointers */ - void *ri, /* row indices */ - void *nzp, - cholmod_common *cm) /* non-zero values */ -{ - /* error return if cs is not packed */ - if (!cs->packed) return 1; /* FIXME: If non-packed becomes a problem, write code to do packing */ - if (!cs->sorted) /* sort it */ - if (!cholmod_sort(cs, cm)) return 2; - - size_t isize; - switch(cs->itype) { - case CHOLMOD_INT: - case CHOLMOD_INTLONG: - isize = sizeof(int); break; - case CHOLMOD_LONG: - isize = sizeof(SuiteSparse_long); break; - default: - return 3; - } - size_t elsize = (cs->xtype == CHOLMOD_COMPLEX ? 2 : 1) * - (cs->dtype == CHOLMOD_DOUBLE ? sizeof(double) : sizeof(float)); - - if (cs->itype == CHOLMOD_INTLONG) { - int i, *dpt = (int *) cp; - SuiteSparse_long *spt = (SuiteSparse_long *) cs->p; - for (i = 0; i <= cs->ncol; ++i) dpt[i] = spt[i]; - } else { - memcpy(cp, cs->p, (cs->ncol + 1) * isize); - } - - memcpy(ri, cs->i, cs->nzmax * isize); - memcpy(nzp, cs->x, cs->nzmax * elsize); - return 0; -} diff --git a/test/suitesparse.jl b/test/suitesparse.jl index e9fac17c7b3ae..feb3daa3891af 100644 --- a/test/suitesparse.jl +++ b/test/suitesparse.jl @@ -2,16 +2,17 @@ se33 = speye(3) do33 = ones(3) @test isequal(se33 \ do33, do33) -using Base.LinAlg.UMFPACK -import Base.(*) - # based on deps/Suitesparse-4.0.2/UMFPACK/Demo/umfpack_di_demo.c +using Base.LinAlg.UMFPACK.increment! + A = sparse(increment!([0,4,1,1,2,2,0,1,2,3,4,4]), increment!([0,4,0,2,1,2,1,4,3,2,1,2]), [2.,1.,3.,4.,-1.,-3.,3.,6.,2.,1.,4.,2.], 5, 5) lua = lufact(A) -#umf_lunz(lua) +L,U,P,Q,Rs = lua[:(:)] +@test_approx_eq diagmm(Rs,A)[P,Q] L*U + @test_approx_eq det(lua) det(full(A)) b = [8., 45., -3., 3., 19.] @@ -20,9 +21,6 @@ x = lua\b @test norm(A*x-b,1) < eps(1e4) -L,U,P,Q,Rs = lua[:(:)] -@test_approx_eq diagmm(Rs,A)[P,Q] L*U - using Base.LinAlg.CHOLMOD # based on deps/SuiteSparse-4.0.2/CHOLMOD/Demo/ @@ -109,15 +107,15 @@ A = CholmodSparse!(int32([0,1,2,3,6,9,12,15,18,20,25,30,34,36,39,43,47,52,58,62, 2.29724661236e8,-5.57173510779e7,-833333.333333,-1.25e6,2.5e8,2.39928529451e6, 9.61679848804e8,275828.470683,-5.57173510779e7,1.09411960038e7,2.08333333333e6, 1.0e8,-2.5e6,140838.195984,-1.09779731332e8,5.31278103775e8], 48, 48, 1) -show(A) +#show(A) @test_approx_eq norm(A,Inf) 3.570948074697437e9 @test_approx_eq norm(A) 3.570948074697437e9 B = A * ones(size(A,2)) chma = cholfact(A) -show(chma) +#show(chma) x = chma\B -show(x) +#show(x) @test_approx_eq x.mat ones(size(x)) #lp_afiro example @@ -135,8 +133,9 @@ afiro = CholmodSparse!(int32([0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19, 1.0,-1.0,1.0,-1.0,1.0,-1.0,1.0,1.0,-0.43,1.0,1.0,0.109,-0.43,1.0,1.0,0.108, -0.39,1.0,1.0,0.108,-0.37,1.0,1.0,0.107,-1.0,2.191,-1.0,2.219,-1.0,2.249, -1.0,2.279,1.4,-1.0,1.0,-1.0,1.0,1.0,1.0], 27, 51, 0) -show(afiro) +#show(afiro) chmaf = cholfact(afiro) -show(chmaf) -sol = solve(chmaf,afiro * ones(size(afiro,2))) # least squares solution -show(sol) +#show(chmaf) +sol = solve(chmaf, afiro*ones(size(afiro,2))) # least squares solution +# ToDo: check for the residual being orthogonal to the rows of afiro +#show(sol) From 99c099a5a73bdc4942e28e0028984ecdd584289a Mon Sep 17 00:00:00 2001 From: Douglas Bates Date: Fri, 15 Mar 2013 17:11:44 -0500 Subject: [PATCH 29/29] Massive changes in structure of cholmod.jl, changed tests and definitions of constants. The biggest change in cholmod.jl is defining and using a macro "chm_nm" instead of writing out all those tedious names explicitly. --- base/linalg/cholmod.jl | 839 ++++++++++++++++++++--------------- base/linalg/suitesparse_h.jl | 48 -- test/suitesparse.jl | 15 +- 3 files changed, 494 insertions(+), 408 deletions(-) diff --git a/base/linalg/cholmod.jl b/base/linalg/cholmod.jl index 6989c2e923fde..9c36fbe5b592f 100644 --- a/base/linalg/cholmod.jl +++ b/base/linalg/cholmod.jl @@ -1,17 +1,23 @@ module CHOLMOD -using Base.LinAlg.UMFPACK # for decrement, increment, etc. - export # types CholmodDense, CholmodFactor, CholmodSparse, CholmodTriplet, - CholmodSparse! # destructive constructor + CholmodSparse!, # destructive constructors + CholmodDense!, +# CholmodTriplet! + + etree +using Base.LinAlg.UMFPACK # for decrement, increment, etc. + import Base.(*) import Base.(\) +import Base.A_mul_Bc +import Base.A_mul_Bt import Base.Ac_ldiv_B import Base.At_ldiv_B import Base.Ac_mul_B @@ -21,12 +27,15 @@ import Base.ctranspose import Base.eltype import Base.findn_nzs import Base.getindex +import Base.hcat +import Base.isvalid import Base.nnz import Base.show import Base.size import Base.sort! import Base.transpose - +import Base.vcat + import LinAlg.Factorization import LinAlg.cholfact import LinAlg.cholfact! @@ -38,13 +47,35 @@ import LinAlg.norm import LinAlg.solve const chm_com_sz = ccall((:jl_cholmod_common_size,:libsuitesparse_wrapper),Int,()) -const chm_com = ones(Uint8, chm_com_sz) +const chm_com = fill(0xff, chm_com_sz) +const chm_l_com = fill(0xff, chm_com_sz) +const CHOLMOD_TRUE = int32(1) +const CHOLMOD_FALSE = int32(0) +## chm_com and chm_l_com must be initialized at runtime because they contain pointers +## to functions in libc.so, whose addresses can change +function cmn(::Type{Int32}) + if isnan(reinterpret(Float64,chm_com[1:8])[1]) + status = ccall((:cholmod_start, :libcholmod), Cint, (Ptr{Uint8},), chm_com) + if status != CHOLMOD_TRUE throw(CholmodException) end + end + chm_com +end +function cmn(::Type{Int64}) + if isnan(reinterpret(Float64,chm_l_com[1:8])[1]) + status = ccall((:cholmod_l_start, :libcholmod), Cint, (Ptr{Uint8},), chm_l_com) + if status != CHOLMOD_TRUE throw(CholmodException) end + end + chm_l_com +end typealias CHMITypes Union(Int32,Int64) typealias CHMVTypes Union(Complex64, Complex128, Float32, Float64) type CholmodException <: Exception end +## macro to generate the name of the C function according to the integer type +macro chm_nm(nm,typ) string("cholmod_", eval(typ) == :Int64 ? "l_" : "", nm) end + ### A way of examining some of the fields in chm_com ### Probably better to make this a Dict{ASCIIString,Tuple} and ### save the offsets and the lengths and the types. Then the names can be checked. @@ -70,7 +101,7 @@ type ChmCommon dtype::Int32 end -include("linalg/suitesparse_h.jl") +#include("linalg/suitesparse_h.jl") ### These offsets should be reconfigured to be less error-prone in matches const chm_com_offsets = Array(Int, length(ChmCommon.types)) @@ -92,15 +123,6 @@ function set_chm_prt_lev(cm::Array{Uint8}, lev::Integer) # can probably be remov cm[(1:4) + chm_com_offsets[13]] = reinterpret(Uint8, [int32(lev)]) end -function cmn(::Type{Int32}) - ccall((:cholmod_start, :libcholmod), Cint, (Ptr{Uint8},), chm_com) - chm_com -end -function cmn(::Type{Int64}) - ccall((:cholmod_l_start, :libcholmod), Cint, (Ptr{Uint8},), chm_com) - chm_com -end - ## itype defines the types of integer used: const CHOLMOD_INT = int32(0) # all integer arrays are int const CHOLMOD_LONG = int32(2) # all integer arrays are UF_long @@ -124,6 +146,17 @@ xtyp(::Type{Float32}) = CHOLMOD_REAL xtyp(::Type{Float64}) = CHOLMOD_REAL xtyp(::Type{Complex64}) = CHOLMOD_COMPLEX xtyp(::Type{Complex128}) = CHOLMOD_COMPLEX + +## Types of systems to solve +const CHOLMOD_A = int32(0) # solve Ax=b +const CHOLMOD_LDLt = int32(1) # solve LDL'x=b +const CHOLMOD_LD = int32(2) # solve LDx=b +const CHOLMOD_DLt = int32(3) # solve DL'x=b +const CHOLMOD_L = int32(4) # solve Lx=b +const CHOLMOD_Lt = int32(5) # solve L'x=b +const CHOLMOD_D = int32(6) # solve Dx=b +const CHOLMOD_P = int32(7) # permute x=Px +const CHOLMOD_Pt = int32(8) # permute x=P'x ## cholmod_dense pointers passed to or returned from C functions are of Julia type ## Ptr{c_CholmodDense}. The CholmodDense type contains a c_CholmodDense object and other @@ -242,13 +275,23 @@ eltype{T<:CHMVTypes}(A::CholmodFactor{T}) = T eltype{T<:CHMVTypes}(A::CholmodSparse{T}) = T eltype{T<:CHMVTypes}(A::CholmodTriplet{T}) = T -function CholmodDense{T<:CHMVTypes}(aa::VecOrMat{T}) +## The CholmodDense! constructor does not copy the contents, which is generally what you +## want as most uses of CholmodDense objects are read-only. +function CholmodDense!{T<:CHMVTypes}(aa::VecOrMat{T}) # uses the memory from Julia m = size(aa,1); n = size(aa,2) CholmodDense(c_CholmodDense{T}(m, n, m*n, stride(aa,2), convert(Ptr{T}, aa), C_NULL, xtyp(T), dtyp(T)), length(size(aa)) == 2 ? aa : reshape(aa, (m,n))) end +## The CholmodDense constructor copies the contents +function CholmodDense{T<:CHMVTypes}(aa::VecOrMat{T}) + m = size(aa,1); n = size(aa,2) + acp = length(size(aa)) == 2 ? copy(aa) : reshape(copy(aa), (m,n)) + CholmodDense(c_CholmodDense{T}(m, n, m*n, stride(aa,2), convert(Ptr{T}, acp), + C_NULL, xtyp(T), dtyp(T)), acp) +end + function CholmodDense{T<:CHMVTypes}(c::Ptr{c_CholmodDense{T}}) cp = unsafe_ref(c) if cp.lda != cp.m || cp.nzmax != cp.m * cp.n @@ -259,41 +302,40 @@ function CholmodDense{T<:CHMVTypes}(c::Ptr{c_CholmodDense{T}}) c_free(c) val end -show(io::IO, cd::CholmodDense) = show(io, cd.mat) +CholmodDense!{T<:CHMVTypes}(c::Ptr{c_CholmodDense{T}}) = CholmodDense(c) # no distinction -function chm_check{T<:CHMVTypes}(cd::CholmodDense{T}) - status = ccall((:cholmod_check_dense, :libcholmod), Cint, - (Ptr{c_CholmodDense{T}}, Ptr{Uint8}), &cd.c, chm_com) - if status != CHOLMOD_TRUE throw(CholmodException) end +function isvalid{T<:CHMVTypes}(cd::CholmodDense{T}) + bool(ccall((:cholmod_check_dense, :libcholmod), Cint, + (Ptr{c_CholmodDense{T}}, Ptr{Uint8}), &cd.c, chm_com)) end -function chm_ones{T<:Union(Float64,Complex128)}(m::Integer, n::Integer, t::T) - CholmodDense(ccall((:cholmod_ones, :libcholmod), Ptr{c_CholmodDense{T}}, +function chm_eye{T<:Union(Float64,Complex128)}(m::Integer, n::Integer, t::T) + CholmodDense(ccall((:cholmod_eye, :libcholmod), Ptr{c_CholmodDense{T}}, (Int, Int, Cint, Ptr{Uint8}), m, n, T<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, chm_com)) end -chm_ones(m::Integer, n::Integer) = chm_ones(m, n, 1.) +chm_eye(m::Integer, n::Integer) = chm_eye(m, n, 1.) +chm_eye(n::Integer) = chm_eye(n, n, 1.) -function chm_zeros{T<:Union(Float64,Complex128)}(m::Integer, n::Integer, t::T) - CholmodDense(ccall((:cholmod_zeros, :libcholmod), Ptr{c_CholmodDense{T}}, +function chm_ones{T<:Union(Float64,Complex128)}(m::Integer, n::Integer, t::T) + CholmodDense(ccall((:cholmod_ones, :libcholmod), Ptr{c_CholmodDense{T}}, (Int, Int, Cint, Ptr{Uint8}), m, n, T<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, chm_com)) end -chm_zeros(m::Integer, n::Integer) = chm_zeros(m, n, 1.) +chm_ones(m::Integer, n::Integer) = chm_ones(m, n, 1.) -function chm_eye{T<:Union(Float64,Complex128)}(m::Integer, n::Integer, t::T) - CholmodDense(ccall((:cholmod_eye, :libcholmod), Ptr{c_CholmodDense{T}}, +function chm_zeros{T<:Union(Float64,Complex128)}(m::Integer, n::Integer, t::T) + CholmodDense(ccall((:cholmod_zeros, :libcholmod), Ptr{c_CholmodDense{T}}, (Int, Int, Cint, Ptr{Uint8}), m, n, T<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, chm_com)) end -chm_eye(m::Integer, n::Integer) = chm_eye(m, n, 1.) -chm_eye(n::Integer) = chm_eye(n, n, 1.) +chm_zeros(m::Integer, n::Integer) = chm_zeros(m, n, 1.) function chm_print{T<:CHMVTypes}(cd::CholmodDense{T}, lev::Integer, nm::ASCIIString) orig = chm_com[chm_prt_inds] @@ -306,28 +348,40 @@ function chm_print{T<:CHMVTypes}(cd::CholmodDense{T}, lev::Integer, nm::ASCIIStr end chm_print(cd::CholmodDense, lev::Integer) = chm_print(cd, lev, "") chm_print(cd::CholmodDense) = chm_print(cd, int32(4), "") +show(io::IO,cd::CholmodDense) = chm_print(cd, int32(4), "") -function CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes}(A::SparseMatrixCSC{Tv,Ti}, stype::Integer) - zerobased = A.colptr[1] == 0 - colptr0 = zerobased ? copy(A.colptr) : decrement(A.colptr) - rowval0 = zerobased ? copy(A.rowptr) : decrement(A.rowval) - nzval = copy(A.nzval) - CholmodSparse{Tv,Ti}(c_CholmodSparse{Tv,Ti}(size(A,1),size(A,2), - int(colptr0[end]), - convert(Ptr{Ti}, colptr0), - convert(Ptr{Ti}, rowval0), C_NULL, - convert(Ptr{Tv}, nzval), C_NULL, - int32(stype), ityp(Ti), - xtyp(Tv), dtyp(Tv), -### Assuming that a SparseMatrixCSC always has sorted row indices. Need to check. - CHOLMOD_TRUE, CHOLMOD_TRUE), - colptr0, rowval0, nzval) +function copy{Tv<:CHMVTypes}(B::CholmodDense{Tv}) + CholmodDense(ccall((:cholmod_copy_dense,:libcholmod), Ptr{c_CholmodDense{Tv}}, + (Ptr{c_CholmodDense{Tv}},Ptr{Uint8}), &B.c, cmn(Int32))) end -function CholmodSparse(A::SparseMatrixCSC) - stype = ishermitian(A) ? 1 : 0 - CholmodSparse(stype > 0 ? triu(A) : A, stype) + +function norm{Tv<:CHMVTypes}(D::CholmodDense{Tv},p::Number) + ccall((:cholmod_norm_dense, :libcholmod), Float64, + (Ptr{c_CholmodDense{Tv}}, Cint, Ptr{Uint8}), + &D.c, p == 1 ? 1 :(p == Inf ? 1 : error("p must be 1 or Inf")),cmn(Int32)) end -## this should probably be the base call for SparseMatrixCSC too +norm{Tv<:CHMVTypes}(D::CholmodDense{Tv}) = norm(D,1) + +function CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::Ptr{c_CholmodFactor{Tv,Ti}}) + cfp = unsafe_ref(cp) + Perm = pointer_to_array(cfp.Perm, (cfp.n,), true) + ColCount = pointer_to_array(cfp.ColCount, (cfp.n,), true) + p = pointer_to_array(cfp.p, (cfp.p == C_NULL ? 0 : cfp.n + 1,), true) + i = pointer_to_array(cfp.i, (cfp.i == C_NULL ? 0 : cfp.nzmax,), true) + x = pointer_to_array(cfp.x, (cfp.x == C_NULL ? 0 : cfp.nzmax,), true) + nz = pointer_to_array(cfp.nz, (cfp.nz == C_NULL ? 0 : cfp.n,), true) + next = pointer_to_array(cfp.next, (cfp.next == C_NULL ? 0 : cfp.n + 2,), true) + prev = pointer_to_array(cfp.prev, (cfp.prev == C_NULL ? 0 : cfp.n + 2,), true) + super = pointer_to_array(cfp.super, (cfp.super == C_NULL ? 0 : cfp.nsuper + 1,), true) + pi = pointer_to_array(cfp.pi, (cfp.pi == C_NULL ? 0 : cfp.nsuper + 1,), true) + px = pointer_to_array(cfp.px, (cfp.px == C_NULL ? 0 : cfp.nsuper + 1,), true) + s = pointer_to_array(cfp.s, (cfp.s == C_NULL ? 0 : cfp.ssize + 1,), true) + cf = CholmodFactor{Tv,Ti}(cfp, Perm, ColCount, p, i, x, nz, next, prev, + super, pi, px, s) + c_free(cp) + cf +end + function CholmodSparse!{Tv<:CHMVTypes,Ti<:CHMITypes}(colpt::Vector{Ti}, rowval::Vector{Ti}, nzval::Vector{Tv}, @@ -355,14 +409,24 @@ function CholmodSparse!{Tv<:CHMVTypes,Ti<:CHMITypes}(colpt::Vector{Ti}, int32(stype), ityp(Ti), xtyp(Tv), dtyp(Tv), CHOLMOD_FALSE,CHOLMOD_TRUE),colpt,rowval,nzval)) end -function chm_rdsp(fnm::String) - fd = ccall(:fopen, Ptr{Void}, (Ptr{Uint8},Ptr{Uint8}), fnm, "r") - res = ccall((:cholmod_read_sparse,:libcholmod), Ptr{c_CholmodSparse{Float64,Cint}}, - (Ptr{Void},Ptr{Uint8}),fd,cmn(Cint)) - ccall(:fclose, Cint, (Ptr{Void},), fd) - CholmodSparse(res) +function CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes}(colpt::Vector{Ti}, + rowval::Vector{Ti}, + nzval::Vector{Tv}, + m::Integer, + n::Integer, + stype::Signed) + CholmodSparse!(copy(colpt),copy(rowval),copy(nzval),m,n,stype) +end +function CholmodSparse!{Tv<:CHMVTypes,Ti<:CHMITypes}(A::SparseMatrixCSC{Tv,Ti}, stype::Signed) + CholmodSparse!(A.colptr,A.rowval,A.nzval,size(A,1),size(A,2),stype) +end +function CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes}(A::SparseMatrixCSC{Tv,Ti}, stype::Signed) + CholmodSparse!(copy(A.colptr),copy(A.rowval),copy(A.nzval),size(A,1),size(A,2),stype) +end +function CholmodSparse(A::SparseMatrixCSC) + stype = ishermitian(A) ? 1 : 0 + CholmodSparse(stype > 0 ? triu(A) : A, stype) end - function CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::Ptr{c_CholmodSparse{Tv,Ti}}) csp = unsafe_ref(cp) colptr0 = pointer_to_array(csp.ppt, (csp.n + 1,), true) @@ -373,110 +437,226 @@ function CholmodSparse{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::Ptr{c_CholmodSparse{Tv,T c_free(cp) cms end +CholmodSparse!{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::Ptr{c_CholmodSparse{Tv,Ti}}) = CholmodSparse(cp) +CholmodSparse{Tv<:CHMVTypes}(D::CholmodDense{Tv}) = CholmodSparse(D,1) # default Ti is Int -for (chk,faprt,spprt,srt,itype) in - (("cholmod_check_sparse","cholmod_print_factor","cholmod_print_sparse","cholmod_sort",:Int32), - ("cholmod_l_check_sparse","cholmod_l_print_factor","cholmod_l_print_sparse", - "cholmod_l_sort",:Int64)) - @eval begin - function chm_check{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$itype}) - bool(ccall(($chk,:libcholmod), Cint, - (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), - &A.c, cmn($itype))) - end - function chm_print{Tv<:CHMVTypes}(L::CholmodFactor{Tv,$itype},lev,nm) - cmn($itype) - orig = chm_com[chm_prt_inds] - chm_com[chm_prt_inds] = reinterpret(Uint8, [int32(lev)]) - status = ccall(($faprt,:libcholmod), Cint, - (Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}, Ptr{Uint8}), - &L.c, nm, chm_com) - chm_com[chm_prt_inds] = orig - if status != CHOLMOD_TRUE throw(CholmodException) end - end - function chm_print{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$itype},lev,nm) - cmn($itype) - orig = chm_com[chm_prt_inds] - chm_com[chm_prt_inds] = reinterpret(Uint8, [int32(lev)]) - status = ccall(($spprt,:libcholmod), Cint, - (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}, Ptr{Uint8}), - &A.c, nm, chm_com) - chm_com[chm_prt_inds] = orig - if status != CHOLMOD_TRUE throw(CholmodException) end - end - function sort!{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$itype}) - status = ccall(($srt,:libcholmod), Cint, - (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), - &A.c, cmn($itype)) - if status != CHOLMOD_TRUE throw(CholmodException) end - A - end - end +function CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes}(tp::Ptr{c_CholmodTriplet{Tv,Ti}}) + ctp = unsafe_ref(tp) + i = pointer_to_array(ctp.i, (ctp.nnz,), true) + j = pointer_to_array(ctp.j, (ctp.nnz,), true) + x = pointer_to_array(ctp.x, (ctp.x == C_NULL ? 0 : ctp.nnz), true) + ct = CholmodTriplet{Tv,Ti}(ctp, i, j, x) + c_free(tp) + ct end -chm_print(A::CholmodSparse, lev::Integer) = chm_print(A, lev, "") -chm_print(A::CholmodFactor, lev::Integer) = chm_print(L, lev, "") -show(io::IO,L::CholmodFactor) = chm_print(L,int32(4),"") -show(io::IO,A::CholmodSparse) = chm_print(A,int32(4),"") -nnz(A::CholmodSparse) = int(A.colptr0[end]) -size(A::CholmodSparse) = (int(A.c.m), int(A.c.n)) -function size(A::CholmodSparse, d::Integer) - d == 1 ? A.c.m : (d == 2 ? A.c.n : 1) +function chm_rdsp(fnm::String) + fd = ccall(:fopen, Ptr{Void}, (Ptr{Uint8},Ptr{Uint8}), fnm, "r") + res = ccall((:cholmod_read_sparse,:libcholmod), Ptr{c_CholmodSparse{Float64,Cint}}, + (Ptr{Void},Ptr{Uint8}),fd,cmn(Cint)) + ccall(:fclose, Cint, (Ptr{Void},), fd) # should do this in try/finally/end + CholmodSparse(res) end -size(B::CholmodDense) = size(B.mat) -size(B::CholmodDense,d) = size(B.mat,d) -for (aat,allocsp,cop,copsp,freesp,normsp,scl,sdmult,speye,ssmult,transsym,trans,itype) in - (("cholmod_aat","cholmod_allocate_sparse","cholmod_copy","cholmod_copy_sparse", - "cholmod_free_sparse","cholmod_norm_sparse","cholmod_scale", "cholmod_sdmult", - "cholmod_speye", "cholmod_ssmult","cholmod_transpose_sym","cholmod_transpose",:Int32), - ("cholmod_l_aat","cholmod_l_allocate_sparse","cholmod_l_copy","cholmod_l_copy_sparse", - "cholmod_l_free_sparse","cholmod_l_norm_sparse","cholmod_l_scale", - "cholmod_l_sdmult","cholmod_l_speye","cholmod_l_ssmult","cholmod_l_transpose_sym", - "cholmod_l_transpose",:Int64)) +for Ti in (:Int32,:Int64) @eval begin - function chm_aat{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}) - cm = cmn($itype) - ## strangely the matrix returned by $aat is not marked as symmetric - ## all of the code past the call to $aat is to create the symmetric-storage - ## version of the result then transpose it to provide sorted columns - aa = Array(Ptr{c_CholmodSparse{Tv,$itype}}, 2) - aa[1] = ccall(($aat, :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, - (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Void}, Int, Cint, Ptr{Uint8}), - &a, C_NULL, 0, 1, cm) + function (*){Tv<:CHMVTypes}(A::CholmodSparse{Tv,$Ti}, + B::CholmodSparse{Tv,$Ti}) + CholmodSparse(ccall((@chm_nm "ssmult" $Ti + , :libcholmod), Ptr{c_CholmodSparse{Tv,$Ti}}, + (Ptr{c_CholmodSparse{Tv,$Ti}},Ptr{c_CholmodSparse{Tv,$Ti}}, + Cint,Cint,Cint,Ptr{Uint8}), &A.c,&B.c,0,true,true,cmn($Ti))) + end + function A_mul_Bc{Tv<:Union(Float32,Float64)}(A::CholmodSparse{Tv,$Ti}, + B::CholmodSparse{Tv,$Ti}) + cm = cmn($Ti) + aa = Array(Ptr{c_CholmodSparse{Tv,$Ti}}, 2) + if !is(A,B) + aa[1] = ccall((@chm_nm "transpose" $Ti + ,:libcholmod), Ptr{c_CholmodSparse{Tv,$Ti}}, + (Ptr{c_CholmodSparse{Tv,$Ti}}, Ptr{Uint8}), + &B.c,cm) + aa[2] = ccall((@chm_nm "ssmult" $Ti + ,:libcholmod), Ptr{c_CholmodSparse{Tv,$Ti}}, + (Ptr{c_CholmodSparse{Tv,$Ti}}, + Ptr{c_CholmodSparse{Tv,$Ti}}, Ptr{Uint8}), + &A.c, aa[1], cmn($Ti)) + status = ccall((@chm_nm "free_sparse" $Ti + ,:libcholmod), Cint, + (Ptr{Ptr{c_CholmodSparse{Tv,$Ti}}}, Ptr{Uint8}), aa, cm) + if status != CHOLMOD_TRUE throw(CholmodException) end + return CholmodSparse(aa[2]) + end + ## The A*A' case is handled by cholmod_aat. Strangely the matrix returned by + ## cholmod_aat is not marked as symmetric. The code following the call to + ## cholmod_aat is to create the symmetric-storage version of the result then + ## transpose it to provide sorted columns. The result is stored in the upper + ## triangle + aa[1] = ccall((@chm_nm "aat" $Ti + , :libcholmod), Ptr{c_CholmodSparse{Tv,$Ti}}, + (Ptr{c_CholmodSparse{Tv,$Ti}}, Ptr{Void}, Int, Cint, Ptr{Uint8}), + &A.c, C_NULL, 0, 1, cm) ## Create the lower triangle unsorted - aa[2] = ccall(($cop, :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, - (Ptr{c_CholmodSparse{Tv,$itype}}, Cint, Cint, Ptr{Uint8}), + aa[2] = ccall((@chm_nm "copy" $Ti + , :libcholmod), Ptr{c_CholmodSparse{Tv,$Ti}}, + (Ptr{c_CholmodSparse{Tv,$Ti}}, Cint, Cint, Ptr{Uint8}), aa[1], -1, 1, cm) - status = ccall(($freesp, :libcholmod), Cint, - (Ptr{Ptr{c_CholmodSparse{Tv,$itype}}}, Ptr{Uint8}), aa, cm) + status = ccall((@chm_nm "free_sparse" $Ti + , :libcholmod), Cint, + (Ptr{Ptr{c_CholmodSparse{Tv,$Ti}}}, Ptr{Uint8}), aa, cm) if status != CHOLMOD_TRUE throw(CholmodException) end aa[1] = aa[2] r = unsafe_ref(aa[1]) ## Now transpose the lower triangle to the upper triangle to do the sorting - rpt = ccall(($allocsp,:libcholmod),Ptr{c_CholmodSparse{Tv,$itype}}, + rpt = ccall((@chm_nm "allocate_sparse" $Ti + ,:libcholmod),Ptr{c_CholmodSparse{Tv,$Ti}}, (Csize_t,Csize_t,Csize_t,Cint,Cint,Cint,Cint,Ptr{Cuchar}), r.m,r.n,r.nzmax,r.sorted,r.packed,-r.stype,r.xtype,cm) - status = ccall(($transsym,:libcholmod),Cint, - (Ptr{c_CholmodSparse{Tv,$itype}}, Cint, Ptr{$itype}, - Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), + status = ccall((@chm_nm "transpose_sym" $Ti + ,:libcholmod),Cint, + (Ptr{c_CholmodSparse{Tv,$Ti}}, Cint, Ptr{$Ti}, + Ptr{c_CholmodSparse{Tv,$Ti}}, Ptr{Uint8}), aa[1],1,C_NULL,rpt,cm) if status != CHOLMOD_TRUE throw(CholmodException) end - status = ccall(($freesp, :libcholmod), Cint, - (Ptr{Ptr{c_CholmodSparse{Tv,$itype}}}, Ptr{Uint8}), aa, cm) + status = ccall((@chm_nm "free_sparse" $Ti + , :libcholmod), Cint, + (Ptr{Ptr{c_CholmodSparse{Tv,$Ti}}}, Ptr{Uint8}), aa, cm) if status != CHOLMOD_TRUE throw(CholmodException) end CholmodSparse(rpt) end - function copy{Tv<:CHMVTypes}(A::c_CholmodSparse{Tv,$itype}) - CholmodSparse(ccall(($copsp,:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, - (Ptr{c_CholmodSparse{Tv,$itype}},Ptr{Uint8}), &A.c, cmn($itype))) + function Ac_mul_B{Tv<:Union(Float32,Float64)}(A::CholmodSparse{Tv,$Ti}, + B::CholmodSparse{Tv,$Ti}) + cm = cmn($Ti) + aa = Array(Ptr{c_CholmodSparse{Tv,$Ti}}, 2) + aa[1] = ccall((@chm_nm "transpose" $Ti + ,:libcholmod), Ptr{c_CholmodSparse{Tv,$Ti}}, + (Ptr{c_CholmodSparse{Tv,$Ti}}, Ptr{Uint8}), + &B.c,cm) + if is(A,B) + Ac = CholmodSparse(aa[1]) + return A_mul_Bc(Ac,Ac) + end + aa[2] = ccall((@chm_nm "ssmult" $Ti + ,:libcholmod), Ptr{c_CholmodSparse{Tv,$Ti}}, + (Ptr{c_CholmodSparse{Tv,$Ti}}, + Ptr{c_CholmodSparse{Tv,$Ti}}, Ptr{Uint8}), + aa[1],&B.c,cm) + status = ccall((@chm_nm "free_sparse" $Ti + , :libcholmod), Cint, + (Ptr{Ptr{c_CholmodSparse{Tv,$Ti}}}, Ptr{Uint8}), aa, cm) + if status != CHOLMOD_TRUE throw(CholmodException) end + CholmodSparse(aa[2]) + end + function CholmodDense{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$Ti}) + CholmodDense(ccall((@chm_nm "sparse_to_dense" $Ti + ,:libcholmod), Ptr{c_CholmodDense{Tv,$Ti}}, + (Ptr{c_CholmodSparse{Tv,Ti}},Ptr{Uint8}), + &A.c,chm{$Ti})) + end + function CholmodSparse{Tv<:CHMVTypes}(D::CholmodDense{Tv},i::$Ti) + CholmodSparse(ccall((@chm_nm "dense_to_sparse" $Ti + ,:libcholmod), Ptr{c_CholmodSparse{Tv,Ti}}, + (Ptr{c_CholmodDense{Tv,Ti}},Ptr{Uint8}), + &D.c,chm{$Ti})) + end + function CholmodSparse{Tv<:CHMVTypes,Ti<:$Ti}(L::CholmodFactor{Tv,Ti}) + CholmodSparse(ccall((@chm_nm "factor_to_sparse" $Ti + ,:libcholmod), Ptr{c_CholmodSparse{Tv,Ti}}, + (Ptr{c_CholmodFactor{Tv,Ti}},Ptr{Uint8}), + &L.c,chm{$Ti})) + end + function CholmodSparse{Tv<:CHMVTypes,Ti<:$Ti}(T::CholmodTriplet{Tv,Ti}) + CholmodSparse(ccall((@chm_nm "triplet_to_sparse" $Ti + ,:libcholmod), Ptr{c_CholmodSparse{Tv,Ti}}, + (Ptr{c_CholmodTriplet{Tv,Ti}},Ptr{Uint8}), + &T.c,chm{$Ti})) + end + function CholmodTriplet{Tv<:CHMVTypes,Ti<:$Ti}(A::CholmodSparse{Tv,Ti}) + CholmodTriplet(ccall((@chm_nm "sparse_to_triplet" $Ti + ,:libcholmod), Ptr{c_CholmodTriplet{Tv,Ti}}, + (Ptr{c_CholmodSparse{Tv,Ti}},Ptr{Uint8}), + &A.c,chm{$Ti})) + end + function isvalid{Tv<:CHMVTypes}(L::CholmodFactor{Tv,$Ti}) + bool(ccall((@chm_nm "check_factor" $Ti + ,:libcholmod), Cint, + (Ptr{c_CholmodFactor{Tv,$Ti}}, Ptr{Uint8}), + &L.c, cmn($Ti))) end - function norm{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$itype},p::Number) - ccall(($normsp, :libcholmod), Float64, - (Ptr{c_CholmodSparse{Tv,$itype}}, Cint, Ptr{Uint8}), - &A.c,p == 1 ? 1 :(p == Inf ? 1 : error("p must be 1 or Inf")),cmn($itype)) + function isvalid{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$Ti}) + bool(ccall((@chm_nm "check_sparse" $Ti + ,:libcholmod), Cint, + (Ptr{c_CholmodSparse{Tv,$Ti}}, Ptr{Uint8}), + &A.c, cmn($Ti))) + end + function isvalid{Tv<:CHMVTypes}(T::CholmodTriplet{Tv,$Ti}) + bool(ccall((@chm_nm "check_triplet" $Ti + ,:libcholmod), Cint, + (Ptr{c_CholmodTriplet{Tv,$Ti}}, Ptr{Uint8}), + &T.c, cmn($Ti))) + end + function cholfact{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$Ti}, ll::Bool) + cm = cmn($Ti) + ## may need to change final_asis as well as final_ll + if ll cm[chm_final_ll_inds] = reinterpret(Uint8, [one(Cint)]) end + Lpt = ccall((@chm_nm "analyze" $Ti + ,:libcholmod), Ptr{c_CholmodFactor{Tv,$Ti}}, + (Ptr{c_CholmodSparse{Tv,$Ti}}, Ptr{Uint8}), &A.c, chm_com) + status = ccall((@chm_nm "factorize" $Ti + ,:libcholmod), Cint, + (Ptr{c_CholmodSparse{Tv,$Ti}}, + Ptr{c_CholmodFactor{Tv,$Ti}}, Ptr{Uint8}), + &A.c, Lpt, chm_com) + if status != CHOLMOD_TRUE throw(CholmodException) end + CholmodFactor(Lpt) + end + function chm_analyze{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$Ti}) + CholmodFactor(ccall((@chm_nm "analyze" $Ti + ,:libcholmod), Ptr{c_CholmodFactor{Tv,$Ti}}, + (Ptr{c_CholmodSparse{Tv,$Ti}}, Ptr{Uint8}), &A.c, cmn($Ti))) + end + # update the factorization - need a better name, "update"? + function chm_factorize!{Tv<:CHMVTypes}(L::CholmodFactor{Tv,$Ti}, + A::CholmodSparse{Tv,$Ti}) + status = ccall((@chm_nm "factorize" $Ti + ,:libcholmod), Cint, + (Ptr{c_CholmodSparse{Tv,$Ti}}, + Ptr{c_CholmodFactor{Tv,$Ti}}, Ptr{Uint8}), + &A.c, &L.c, cmn($Ti)) + if status != CHOLMOD_TRUE throw(CholmodException) end + end + function chm_print{Tv<:CHMVTypes}(L::CholmodFactor{Tv,$Ti},lev,nm) + cmn($Ti) + orig = chm_com[chm_prt_inds] + chm_com[chm_prt_inds] = reinterpret(Uint8, [int32(lev)]) + status = ccall((@chm_nm "print_factor" $Ti + ,:libcholmod), Cint, + (Ptr{c_CholmodFactor{Tv,$Ti}}, Ptr{Uint8}, Ptr{Uint8}), + &L.c, nm, chm_com) + chm_com[chm_prt_inds] = orig + if status != CHOLMOD_TRUE throw(CholmodException) end + end + function chm_print{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$Ti},lev,nm) + cmn($Ti) + orig = chm_com[chm_prt_inds] + chm_com[chm_prt_inds] = reinterpret(Uint8, [int32(lev)]) + status = ccall((@chm_nm "print_sparse" $Ti + ,:libcholmod), Cint, + (Ptr{c_CholmodSparse{Tv,$Ti}}, Ptr{Uint8}, Ptr{Uint8}), + &A.c, nm, chm_com) + chm_com[chm_prt_inds] = orig + if status != CHOLMOD_TRUE throw(CholmodException) end end - function chm_sdmult{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$itype}, + function chm_scale!{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$Ti}, + S::CholmodDense{Tv}, + typ::Integer) + status = ccall((@chm_nm "scale" $Ti + ,:libcholmod), Cint, + (Ptr{c_CholmodDense{Tv}},Cint,Ptr{c_CholmodSparse{Tv,$Ti}}, + Ptr{Uint8}), &S.c, typ, &A.c, cmn($Ti)) + if status != CHOLMOD_TRUE throw(CholmodException) end + end + function chm_sdmult{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$Ti}, trans::Bool, alpha::Real, beta::Real, @@ -490,58 +670,165 @@ for (aat,allocsp,cop,copsp,freesp,normsp,scl,sdmult,speye,ssmult,transsym,trans, aa = float64([alpha, 0.]) bb = float64([beta, 0.]) Y = CholmodDense(zeros(Tv,nr,size(X,2))) - status = ccall((:cholmod_sdmult,:libcholmod), Cint, - (Ptr{c_CholmodSparse{Tv,$itype}},Cint,Ptr{Cdouble},Ptr{Cdouble}, + status = ccall((@chm_nm "sdmult" $Ti + ,:libcholmod), Cint, + (Ptr{c_CholmodSparse{Tv,$Ti}},Cint,Ptr{Cdouble},Ptr{Cdouble}, Ptr{c_CholmodDense{Tv}}, Ptr{c_CholmodDense{Tv}}, Ptr{Uint8}), - &A.c,trans,aa,bb,&X.c,&Y.c,cmn($itype)) + &A.c,trans,aa,bb,&X.c,&Y.c,cmn($Ti)) if status != CHOLMOD_TRUE throw(CholmodException) end Y end - function chm_speye{Tv<:Union(Float64,Complex128)}(m::Integer, n::Integer, t::Tv, i::$itype) - CholmodSparse(ccall(($speye, :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, + function chm_speye{Tv<:CHMVTypes,Ti<:$Ti}(m::Ti, n::Ti, x::Tv) + CholmodSparse(ccall((@chm_nm "speye" $Ti + , :libcholmod), Ptr{c_CholmodSparse{Tv,$Ti}}, (Int, Int, Cint, Ptr{Uint8}), - m, n, - Tv<:Complex ? CHOLMOD_COMPLEX : CHOLMOD_REAL, - cmn($itype))) - end - function (*){Tv<:CHMVTypes}(A::CholmodSparse{Tv,$itype}, - B::CholmodSparse{Tv,$itype}) - CholmodSparse(ccall(($ssmult, :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, - (Ptr{c_CholmodSparse{Tv,$itype}},Ptr{c_CholmodSparse{Tv,$itype}}, - Cint,Cint,Cint,Ptr{Uint8}), &A.c,&B.c,0,true,true,cmn($itype))) - end - function chm_scale!{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}, - s::c_CholmodDense{Tv}, - typ::Integer) - status = ccall(($scl,:libcholmod), Cint, - (Ptr{c_CholmodDense{Tv}},Cint,Ptr{c_CholmodSparse{Tv,$itype}}, - Ptr{Uint8}), &s, typ, &a, cmn($itype)) + m, n, xtyp{Tv}, cmn($Ti))) + end + function chm_spzeros{Tv<:Union(Float64,Complex128)}(m::$Ti, n::$Ti, nzmax::$Ti, x::Tv) + CholmodSparse(ccall((@chm_nm "spzeros" $Ti + , :libcholmod), Ptr{c_CholmodSparse{Tv,$Ti}}, + (Int, Int, Int, Ptr{Uint8}), + m, n, nzmax, xtyp{Tv}, cmn($Ti))) + end +## add chm_xtype and chm_pack + function copy{Tv<:CHMVTypes}(L::CholmodFactor{Tv,$Ti}) + CholmodFactor(ccall((@chm_nm "copy_factor" $Ti + ,:libcholmod), Ptr{c_CholmodFactor{Tv,$Ti}}, + (Ptr{c_CholmodFactor{Tv,$Ti}},Ptr{Uint8}), &L.c, cmn($Ti))) + end + function copy{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$Ti}) + CholmodSparse(ccall((@chm_nm "copy_sparse" $Ti + ,:libcholmod), Ptr{c_CholmodSparse{Tv,$Ti}}, + (Ptr{c_CholmodSparse{Tv,$Ti}},Ptr{Uint8}), &A.c, cmn($Ti))) + end + function copy{Tv<:CHMVTypes}(T::CholmodTriplet{Tv,$Ti}) + CholmodTriplet(ccall((@chm_nm "copy_triplet" $Ti + ,:libcholmod), Ptr{c_CholmodTriplet{Tv,$Ti}}, + (Ptr{c_CholmodTriplet{Tv,$Ti}},Ptr{Uint8}), &T.c, cmn($Ti))) + end + function ctranspose{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$Ti}) + CholmodSparse(ccall((@chm_nm "transpose" $Ti + ,:libcholmod),Ptr{c_CholmodSparse{Tv,$Ti}}, + (Ptr{c_CholmodSparse{Tv,$Ti}}, Cint, Ptr{Uint8}), + &A.c, 2, cmn($Ti))) + end + function etree{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$Ti}) + tr = Array($Ti,size(A,2)) + status = ccall((@chm_nm "etree" $Ti + ,:libcholmod), Cint, + (Ptr{c_CholmodSparse{Tv,$Ti}},Ptr{$Ti},Ptr{Uint8}), + &A.c,tr,cmn($Ti)) if status != CHOLMOD_TRUE throw(CholmodException) end + tr end - function transpose{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$itype}) - CholmodSparse(ccall(($trans,:libcholmod),Ptr{c_CholmodSparse{Tv,$itype}}, - (Ptr{c_CholmodSparse{Tv,$itype}}, Cint, Ptr{Uint8}), - &A.c, 1, cmn($itype))) + function hcat{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$Ti},B::CholmodSparse{Tv,$Ti}) + ccall((@chm_nm "horzcat" $Ti + , :libcholmod), Ptr{c_CholmodSparse{Tv,$Ti}}, + (Ptr{c_CholmodSparse{Tv,$Ti}},Ptr{c_CholmodSparse{Tv,$Ti}},Cint,Ptr{Uint8}), + &A.c,&B.c,true,cmn($Ti)) + end + function nnz{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$Ti}) + ccall((@chm_nm "nnz" $Ti + ,:libcholmod), Int, (Ptr{c_CholmodSparse{Tv,$Ti}},Ptr{Uint8}),&A.c,cmn($Ti)) + end + function norm{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$Ti},p::Number) + ccall((@chm_nm "norm_sparse" $Ti + , :libcholmod), Float64, + (Ptr{c_CholmodSparse{Tv,$Ti}}, Cint, Ptr{Uint8}), + &A.c,p == 1 ? 1 :(p == Inf ? 1 : error("p must be 1 or Inf")),cmn($Ti)) + end + function solve{Tv<:CHMVTypes}(L::CholmodFactor{Tv,$Ti}, + B::CholmodDense{Tv}, typ::Integer) + CholmodDense(ccall((@chm_nm "solve" $Ti + ,:libcholmod), Ptr{c_CholmodDense{Tv}}, + (Cint, Ptr{c_CholmodFactor{Tv,$Ti}}, + Ptr{c_CholmodDense{Tv}}, Ptr{Uint8}), + typ, &L.c, &B.c, cmn($Ti))) + end + function solve{Tv<:CHMVTypes}(L::CholmodFactor{Tv,$Ti}, + B::CholmodSparse{Tv,$Ti}, + typ::Integer) + CholmodSparse(ccall((@chm_nm "spsolve" $Ti + ,:libcholmod), Ptr{c_CholmodSparse{Tv,$Ti}}, + (Cint, Ptr{c_CholmodFactor{Tv,$Ti}}, + Ptr{c_CholmodSparse{Tv,$Ti}}, Ptr{Uint8}), + typ, &L.c, &B.c, cmn($Ti))) + end + function sort!{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$Ti}) + status = ccall((@chm_nm "sort" $Ti + ,:libcholmod), Cint, + (Ptr{c_CholmodSparse{Tv,$Ti}}, Ptr{Uint8}), + &A.c, cmn($Ti)) + if status != CHOLMOD_TRUE throw(CholmodException) end + A end - function ctranspose{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$itype}) - CholmodSparse(ccall(($trans,:libcholmod),Ptr{c_CholmodSparse{Tv,$itype}}, - (Ptr{c_CholmodSparse{Tv,$itype}}, Cint, Ptr{Uint8}), - &A.c, 2, cmn($itype))) + function transpose{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$Ti}) + CholmodSparse(ccall((@chm_nm "transpose" $Ti + ,:libcholmod),Ptr{c_CholmodSparse{Tv,$Ti}}, + (Ptr{c_CholmodSparse{Tv,$Ti}}, Cint, Ptr{Uint8}), + &A.c, 1, cmn($Ti))) + end + function vcat{Tv<:CHMVTypes}(A::CholmodSparse{Tv,$Ti},B::CholmodSparse{Tv,$Ti}) + ccall((@chm_nm "vertcat" $Ti + , :libcholmod), Ptr{c_CholmodSparse{Tv,$Ti}}, + (Ptr{c_CholmodSparse{Tv,$Ti}},Ptr{c_CholmodSparse{Tv,$Ti}},Cint,Ptr{Uint8}), + &A.c,&B.c,true,cmn($Ti)) end end end (*){Tv<:CHMVTypes}(A::CholmodSparse{Tv},B::CholmodDense{Tv}) = chm_sdmult(A,false,1.,0.,B) (*){Tv<:CHMVTypes}(A::CholmodSparse{Tv},B::VecOrMat{Tv}) = chm_sdmult(A,false,1.,0.,CholmodDense(B)) -Ac_mul_B{Tv<:CHMVTypes}(A::CholmodSparse{Tv},B::CholmodDense{Tv}) = chm_sdmult(A,true,1.,0.,B) -Ac_mul_B{Tv<:CHMVTypes}(A::CholmodSparse{Tv},B::VecOrMat{Tv}) = chm_sdmult(A,true,1.,0.,CholmodDense(B)) -chm_speye(m::Integer, n::Integer) = chm_speye(m, n, 1., 1) -chm_speye(n::Integer) = chm_speye(n, n, 1., 1) -chm_aat(A::CholmodSparse) = chm_aat(A.c) -chm_aat(A::SparseMatrixCSC) = chm_aat(CholmodSparse(A).c) -norm(A::CholmodSparse) = norm(A,1) -function chm_scale!{T<:CHMVTypes}(A::CholmodSparse{T},S::CholmodDense{T},typ::Integer) - chm_scale!(A.c,S.c,typ) + +(\){T<:CHMVTypes}(L::CholmodFactor{T},B::CholmodDense{T}) = solve(L,B,CHOLMOD_A) +(\){T<:CHMVTypes}(L::CholmodFactor{T},B::VecOrMat{T}) = solve(L,CholmodDense(B),CHOLMOD_A) +function (\){Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::CholmodSparse{Tv,Ti}) + solve(L,B,CHOLMOD_A) end +function (\){Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::SparseMatrixCSC{Tv,Ti}) + solve(L,CholmodSparse(B),CHOLMOD_A) +end + +function A_mul_Bt{Tv<:Union(Float32,Float64),Ti<:CHMITypes}(A::CholmodSparse{Tv,Ti}, + B::CholmodSparse{Tv,Ti}) + A_mul_Bc(A,B) # in the unlikely event of writing A*B.' instead of A*B' +end + +Ac_ldiv_B{T<:CHMVTypes}(L::CholmodFactor{T},B::CholmodDense{T}) = solve(L,B,CHOLMOD_A) +Ac_ldiv_B{T<:CHMVTypes}(L::CholmodFactor{T},B::VecOrMat{T}) = solve(L,CholmodDense(B),CHOLMOD_A) +function Ac_ldiv_B{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::CholmodSparse{Tv,Ti}) + solve(L,B,CHOLMOD_A) +end +function Ac_ldiv_B{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::SparseMatrixCSC{Tv,Ti}) + solve(L,CholmodSparse(B),CHOLMOD_A) +end + +function Ac_mul_B{Tv<:CHMVTypes}(A::CholmodSparse{Tv},B::CholmodDense{Tv}) + chm_sdmult(A,true,1.,0.,B) +end +function Ac_mul_B{Tv<:CHMVTypes}(A::CholmodSparse{Tv},B::VecOrMat{Tv}) + chm_sdmult(A,true,1.,0.,CholmodDense(B)) +end + +function At_mul_B{Tv<:Union(Float32,Float64),Ti<:CHMITypes}(A::CholmodSparse{Tv,Ti}, + B::CholmodSparse{Tv,Ti}) + Ac_mul_B(A,B) # in the unlikely event of writing A.'*B instead of A'*B +end + +cholfact(A::CholmodSparse,ll::Bool) = cholfact(A,ll) +cholfact(A::CholmodSparse) = cholfact(A,false) +cholfact(A::SparseMatrixCSC,ll::Bool) = cholfact(CholmodSparse(A),ll) +cholfact(A::SparseMatrixCSC) = cholfact(CholmodSparse(A),false) + +chm_analyze(A::SparseMatrixCSC) = chm_analyze(CholmodSparse(A)) + +chm_print(A::CholmodSparse, lev::Integer) = chm_print(A, lev, "") +chm_print(A::CholmodFactor, lev::Integer) = chm_print(L, lev, "") + +chm_speye(m::Integer, n::Integer) = chm_speye(m, n, 1., 1) # default element type is Float32 +chm_speye(n::Integer) = chm_speye(n, n, 1.) # default shape is square + +chm_spzeros(m::Integer,n::Integer,nzmax::Integer) = chm_spzeros(m,n,nzmax,1.) + function diagmm{T<:CHMVTypes}(b::Vector{T}, A::CholmodSparse{T}) Acp = copy(A) chm_scale!(Acp,CholmodDense(b),CHOLMOD_ROW) @@ -561,190 +848,38 @@ function diagmm!{T<:CHMVTypes}(A::CholmodSparse{T},b::Vector{T}) A end -function CholmodFactor{Tv<:CHMVTypes,Ti<:CHMITypes}(cp::Ptr{c_CholmodFactor{Tv,Ti}}) - cfp = unsafe_ref(cp) - Perm = pointer_to_array(cfp.Perm, (cfp.n,), true) - ColCount = pointer_to_array(cfp.ColCount, (cfp.n,), true) - p = pointer_to_array(cfp.p, (cfp.p == C_NULL ? 0 : cfp.n + 1,), true) - i = pointer_to_array(cfp.i, (cfp.i == C_NULL ? 0 : cfp.nzmax,), true) - x = pointer_to_array(cfp.x, (cfp.x == C_NULL ? 0 : cfp.nzmax,), true) - nz = pointer_to_array(cfp.nz, (cfp.nz == C_NULL ? 0 : cfp.n,), true) - next = pointer_to_array(cfp.next, (cfp.next == C_NULL ? 0 : cfp.n + 2,), true) - prev = pointer_to_array(cfp.prev, (cfp.prev == C_NULL ? 0 : cfp.n + 2,), true) - super = pointer_to_array(cfp.super, (cfp.super == C_NULL ? 0 : cfp.nsuper + 1,), true) - pi = pointer_to_array(cfp.pi, (cfp.pi == C_NULL ? 0 : cfp.nsuper + 1,), true) - px = pointer_to_array(cfp.px, (cfp.px == C_NULL ? 0 : cfp.nsuper + 1,), true) - s = pointer_to_array(cfp.s, (cfp.s == C_NULL ? 0 : cfp.ssize + 1,), true) - cf = CholmodFactor{Tv,Ti}(cfp, Perm, ColCount, p, i, x, nz, next, prev, - super, pi, px, s) - c_free(cp) - cf -end - -for (anl,chng,fac,slv,spslv,itype) in - (("cholmod_analyze","cholmod_change_factor","cholmod_factorize", - "cholmod_solve","cholmod_spsolve",:Int32), - ("cholmod_l_analyze","cholmod_l_change_factor","cholmod_l_factorize", - "cholmod_l_solve","cholmod_l_spsolve",:Int64)) - @eval begin - function chm_analyze{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}) - ccall(($anl,:libcholmod), Ptr{c_CholmodFactor{Tv,$itype}}, - (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), &a, cmn($itype)) - end - # update the factorization - function chm_factorize!{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}, - a::c_CholmodSparse{Tv,$itype}) - status = ccall(($fac,:libcholmod), Cint, - (Ptr{c_CholmodSparse{Tv,$itype}}, - Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), - &a, &l, cmn($itype)) - if status != CHOLMOD_TRUE throw(CholmodException) end - end - # initialize a factorization - function cholfact{Tv<:CHMVTypes}(a::c_CholmodSparse{Tv,$itype}, ll::Bool) - cmn($itype) -## may need to change final_asis as well as final_ll - if ll chm_com[chm_final_ll_inds] = reinterpret(Uint8, [one(Cint)]) end - Lpt = ccall(($anl,:libcholmod), Ptr{c_CholmodFactor{Tv,$itype}}, - (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), &a, chm_com) - status = ccall(($fac,:libcholmod), Cint, - (Ptr{c_CholmodSparse{Tv,$itype}}, - Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), - &a, Lpt, chm_com) - if status != CHOLMOD_TRUE throw(CholmodException) end - CholmodFactor(Lpt) - end - function solve{Tv<:CHMVTypes}(L::CholmodFactor{Tv,$itype}, - B::CholmodDense{Tv}, typ::Integer) - CholmodDense(ccall(($slv,:libcholmod), Ptr{c_CholmodDense{Tv}}, - (Cint, Ptr{c_CholmodFactor{Tv,$itype}}, - Ptr{c_CholmodDense{Tv}}, Ptr{Uint8}), - typ, &L.c, &B.c, cmn($itype))) - end - function solve{Tv<:CHMVTypes}(L::CholmodFactor{Tv,$itype}, - B::CholmodSparse{Tv,$itype}, - typ::Integer) - CholmodSparse(ccall(($spslv,:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, - (Cint, Ptr{c_CholmodFactor{Tv,$itype}}, - Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), - typ, &L.c, &B.c, cmn($itype))) - end - end -end -chm_analyze(ap::Ptr{c_CholmodSparse}) = chm_analyze(unsafe_ref(ap)) -chm_analyze(A::CholmodSparse) = chm_analyze(A.c) -chm_analyze(A::SparseMatrixCSC) = chm_analyze(CholmodSparse(A).c) - -cholfact(a::c_CholmodSparse) = cholfact(a,false) # LDL by default -cholfact(A::CholmodSparse,ll::Bool) = cholfact(A.c,ll) -cholfact(A::CholmodSparse) = cholfact(A.c,false) -cholfact(A::SparseMatrixCSC,ll::Bool) = cholfact(CholmodSparse(A).c,ll) -cholfact(A::SparseMatrixCSC) = cholfact(CholmodSparse(A).c,false) +norm(A::CholmodSparse) = norm(A,1) + +show(io::IO,L::CholmodFactor) = chm_print(L,int32(4),"") +show(io::IO,A::CholmodSparse) = chm_print(A,int32(4),"") -solve{T<:CHMVTypes}(L::CholmodFactor{T},B::CholmodDense{T}) = solve(L,B,CHOLMOD_A) -(\){T<:CHMVTypes}(L::CholmodFactor{T},B::CholmodDense{T}) = solve(L,B,CHOLMOD_A) -(\){T<:CHMVTypes}(L::CholmodFactor{T},B::VecOrMat{T}) = solve(L,CholmodDense(B),CHOLMOD_A) -Ac_ldiv_B{T<:CHMVTypes}(L::CholmodFactor{T},B::CholmodDense{T}) = solve(L,B,CHOLMOD_A) -Ac_ldiv_B{T<:CHMVTypes}(L::CholmodFactor{T},B::VecOrMat{T}) = solve(L,CholmodDense(B),CHOLMOD_A) -function solve{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::CholmodSparse{Tv,Ti}) - solve(L,B,CHOLMOD_A) -end -function (\){Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::CholmodSparse{Tv,Ti}) - solve(L,B,CHOLMOD_A) -end -function Ac_ldiv_B{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::CholmodSparse{Tv,Ti}) - solve(L,B,CHOLMOD_A) -end -function solve{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::SparseMatrixCSC{Tv,Ti}) - solve(L,CholmodSparse(B),CHOLMOD_A) -end -function (\){Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::SparseMatrixCSC{Tv,Ti}) - solve(L,CholmodSparse(B),CHOLMOD_A) +size(B::CholmodDense) = size(B.mat) +size(B::CholmodDense,d) = size(B.mat,d) +size(A::CholmodSparse) = (int(A.c.m), int(A.c.n)) +function size(A::CholmodSparse, d::Integer) + d == 1 ? A.c.m : (d == 2 ? A.c.n : 1) end -function Ac_ldiv_B{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::SparseMatrixCSC{Tv,Ti}) - solve(L,CholmodSparse(B),CHOLMOD_A) +size(L::CholmodFactor) = (n = int(L.c.n); (n,n)) +size(L::CholmodFactor,d::Integer) = d < 1 ? error("dimension out of range") : (d <= 2 ? int(L.c.n) : 1) +function chm_scale!{T<:CHMVTypes}(A::CholmodSparse{T},S::CholmodDense{T},typ::Integer) + chm_scale!(A.c,S.c,typ) end -solve{T<:CHMVTypes}(L::CholmodFactor{T},B::VecOrMat{T},typ::Integer)=solve(L,CholmodDense(B),typ) + function solve{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti}, B::SparseMatrixCSC{Tv,Ti},typ::Integer) solve(L,CholmodSparse(B),typ) end - -for (chng,pack,cop,chg_xtyp,f2s,itype) in - (("cholmod_change_factor","cholmod_pack_factor", - "cholmod_copy_factor","cholmod_factor_xtype", - "cholmod_factor_to_sparse",:Int32), - ("cholmod_l_change_factor","cholmod_l_pack_factor", - "cholmod_l_copy_factor","cholmod_l_factor_xtype", - "cholmod_l_factor_to_sparse",:Int64)) - @eval begin - ## changing the factor is problematic because it reallocates the storage - ## for the arrays and frees the old arrays but Julia retains the old pointers - ## in the vectors (May get around this by passing an array of length 1 and not &l?) - ## function chm_chng_fac!{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}, - ## xt,ll,super,packed,monotonic) - ## status = ccall(($chng,:libcholmod), Cint, - ## (Cint,Cint,Cint,Cint,Cint, - ## Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), - ## xt,ll,super,packed,monotonic,&l,cmn(l)) - ## if status != CHOLMOD_TRUE throw(CholmodException) end - ## end - function chm_copy_fac{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}) - ccall(($cop,:libcholmod), Ptr{c_CholmodFactor{Tv,$itype}}, - (Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), &l,cmn($itype)) - end - function chm_fac_to_sp{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}) - ccall(($f2s,:libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, - (Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), &l,cmn($itype)) - end - function chm_fac_xtype!{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype},to_xtype) - status = ccall(($chg_xtyp,:libcholmod), Cint, - (Cint, Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), - to_xtype,[l],cmn($itype)) - if status != CHOLMOD_TRUE throw(CholmodException) end - end - function chm_pack_fac!{Tv<:CHMVTypes}(l::c_CholmodFactor{Tv,$itype}) - status = ccall(($pack,:libcholmod), Cint, - (Ptr{c_CholmodFactor{Tv,$itype}}, Ptr{Uint8}), - &l,cmn($itype)) - if status != CHOLMOD_TRUE throw(CholmodException) end - end - end -end - -copy(L::CholmodFactor) = CholmodFactor(chm_copy_fac(L.c)) -CholmodSparse(L::CholmodFactor) = CholmodSparse(chm_fac_to_sp(L.c)) - -function chm_fac_xtype!{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},to_xtype) - chm_fac_xtype(L.c,to_xtype) +function solve{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::SparseMatrixCSC{Tv,Ti}) + solve(L,CholmodSparse(B),CHOLMOD_A) end - -function CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes}(tp::Ptr{c_CholmodTriplet{Tv,Ti}}) - ctp = unsafe_ref(tp) - i = pointer_to_array(ctp.i, (ctp.nnz,), true) - j = pointer_to_array(ctp.j, (ctp.nnz,), true) - x = pointer_to_array(ctp.x, (ctp.x == C_NULL ? 0 : ctp.nnz), true) - ct = CholmodTriplet{Tv,Ti}(ctp, i, j, x) - c_free(tp) - ct +function solve{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::CholmodSparse{Tv,Ti}) + solve(L,B,CHOLMOD_A) end - -for (s2t,t2s,itype) in - (("colmod_sparse_to_triplet","cholmod_triplet_to_sparse",:Int32), - ("cholmod_l_sparse_to_triplet","cholmod_l_triplet_to_sparse",:Int64)) - @eval begin - function convert{Tv<:CHMVTypes}(::Type{CholmodTriplet{Tv,$itype}}, - A::CholmodSparse{Tv,$itype}) - CholmodTriplet(ccall(($s2t, :libcholmod), Ptr{c_CholmodTriplet{Tv,$itype}}, - (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), &A, cmn($itype))) - end - function convert{Tv<:CHMVTypes}(::Type{CholmodSparse{Tv,$itype}}, - A::CholmodTriplet{Tv,$itype}) - CholmodSparse(ccall(($t2s, :libcholmod), Ptr{c_CholmodSparse{Tv,$itype}}, - (Ptr{c_CholmodSparse{Tv,$itype}}, Ptr{Uint8}), &A, cmn($itype))) - end - end +function (\){Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::CholmodSparse{Tv,Ti}) + solve(L,B,CHOLMOD_A) end +solve{T<:CHMVTypes}(L::CholmodFactor{T},B::VecOrMat{T},typ::Integer)=solve(L,CholmodDense(B),typ) +solve{T<:CHMVTypes}(L::CholmodFactor{T},B::CholmodDense{T}) = solve(L,B,CHOLMOD_A) function findn_nzs{Tv,Ti}(A::CholmodSparse{Tv,Ti}) jj = similar(A.rowval0) # expand A.colptr0 to a vector of indices diff --git a/base/linalg/suitesparse_h.jl b/base/linalg/suitesparse_h.jl index 25cbbdd1d7d1e..467e595617444 100644 --- a/base/linalg/suitesparse_h.jl +++ b/base/linalg/suitesparse_h.jl @@ -1,51 +1,3 @@ -## CHOLMOD - -const CHOLMOD_TRUE = int32(1) -const CHOLMOD_FALSE = int32(0) - -# Types of systems to solve -const CHOLMOD_A = int32(0) # solve Ax=b -const CHOLMOD_LDLt = int32(1) # solve LDL'x=b -const CHOLMOD_LD = int32(2) # solve LDx=b -const CHOLMOD_DLt = int32(3) # solve DL'x=b -const CHOLMOD_L = int32(4) # solve Lx=b -const CHOLMOD_Lt = int32(5) # solve L'x=b -const CHOLMOD_D = int32(6) # solve Dx=b -const CHOLMOD_P = int32(7) # permute x=Px -const CHOLMOD_Pt = int32(8) # permute x=P'x - -# Definitions for cholmod_common: -const CHOLMOD_MAXMETHODS = int32(9) # maximum number of different methods that - # cholmod_analyze can try. Must be >= 9. - -# Common->status values. zero means success, negative means a fatal error, positive is a warning. -const CHOLMOD_OK = int32(0) # success -const CHOLMOD_NOT_INSTALLED = int32(-1) # failure: method not installed -const CHOLMOD_OUT_OF_MEMORY = int32(-2) # failure: out of memory -const CHOLMOD_TOO_LARGE = int32(-3) # failure: integer overflow occured -const CHOLMOD_INVALID = int32(-4) # failure: invalid input -const CHOLMOD_NOT_POSDEF = int32(1) # warning: matrix not pos. def. -const CHOLMOD_DSMALL = int32(2) # warning: D for LDL' or diag(L) or LL' has tiny absolute value - -# ordering method (also used for L->ordering) -const CHOLMOD_NATURAL = int32(0) # use natural ordering -const CHOLMOD_GIVEN = int32(1) # use given permutation -const CHOLMOD_AMD = int32(2) # use minimum degree (AMD) -const CHOLMOD_METIS = int32(3) # use METIS' nested dissection -const CHOLMOD_NESDIS = int32(4) # use CHOLMOD's version of nested dissection: - # node bisector applied recursively, followed - # by constrained minimum degree (CSYMAMD or CCOLAMD) -const CHOLMOD_COLAMD = int32(5) # use AMD for A, COLAMD for A*A' - -# POSTORDERED is not a method, but a result of natural ordering followed by a -# weighted postorder. It is used for L->ordering, not method [ ].ordering. -const CHOLMOD_POSTORDERED = int32(6) # natural ordering, postordered. - -# supernodal strategy (for Common->supernodal) -const CHOLMOD_SIMPLICIAL = int32(0) # always do simplicial -const CHOLMOD_AUTO = int32(1) # select simpl/super depending on matrix -const CHOLMOD_SUPERNODAL = int32(2) # always do supernodal - ## UMFPACK ## Type of solve diff --git a/test/suitesparse.jl b/test/suitesparse.jl index feb3daa3891af..4ad9298f1091e 100644 --- a/test/suitesparse.jl +++ b/test/suitesparse.jl @@ -107,15 +107,14 @@ A = CholmodSparse!(int32([0,1,2,3,6,9,12,15,18,20,25,30,34,36,39,43,47,52,58,62, 2.29724661236e8,-5.57173510779e7,-833333.333333,-1.25e6,2.5e8,2.39928529451e6, 9.61679848804e8,275828.470683,-5.57173510779e7,1.09411960038e7,2.08333333333e6, 1.0e8,-2.5e6,140838.195984,-1.09779731332e8,5.31278103775e8], 48, 48, 1) -#show(A) @test_approx_eq norm(A,Inf) 3.570948074697437e9 @test_approx_eq norm(A) 3.570948074697437e9 +@test isvalid(A) B = A * ones(size(A,2)) chma = cholfact(A) -#show(chma) +@test isvalid(chma) x = chma\B -#show(x) @test_approx_eq x.mat ones(size(x)) #lp_afiro example @@ -133,9 +132,9 @@ afiro = CholmodSparse!(int32([0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19, 1.0,-1.0,1.0,-1.0,1.0,-1.0,1.0,1.0,-0.43,1.0,1.0,0.109,-0.43,1.0,1.0,0.108, -0.39,1.0,1.0,0.108,-0.37,1.0,1.0,0.107,-1.0,2.191,-1.0,2.219,-1.0,2.249, -1.0,2.279,1.4,-1.0,1.0,-1.0,1.0,1.0,1.0], 27, 51, 0) -#show(afiro) chmaf = cholfact(afiro) -#show(chmaf) -sol = solve(chmaf, afiro*ones(size(afiro,2))) # least squares solution -# ToDo: check for the residual being orthogonal to the rows of afiro -#show(sol) +y = afiro'*ones(size(afiro,1)) +sol = solve(chmaf, afiro*y) # least squares solution +@test isvalid(sol) +pred = afiro'*sol +@test norm(afiro * (y.mat - pred.mat)) < 1e-8