diff --git a/Makefile b/Makefile index 663e3ed50996b..b2feeede4fd69 100644 --- a/Makefile +++ b/Makefile @@ -32,7 +32,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/deprecated.jl b/base/deprecated.jl index e4dfa3515c813..7feb016748e87 100644 --- a/base/deprecated.jl +++ b/base/deprecated.jl @@ -152,6 +152,7 @@ export PipeString @deprecate localize localpart @deprecate expr(hd, a...) Expr(hd, a...) @deprecate expr(hd, a::Array{Any,1}) Expr(hd, a...) + @deprecate logb exponent @deprecate ilogb exponent @deprecate ref_shape index_shape diff --git a/base/exports.jl b/base/exports.jl index 872f4fc2dc65c..9ef16e979ed94 100644 --- a/base/exports.jl +++ b/base/exports.jl @@ -3,8 +3,10 @@ export PCRE, FFTW, DSP, - LAPACK, + LinAlg, BLAS, + LAPACK, + ARPACK, LibRandom, Random, Math, @@ -108,13 +110,17 @@ export BunchKaufman, CholeskyDense, CholeskyPivotedDense, + Eigen, + GSVDDense, + Hessenberg, LUDense, LUTridiagonal, LDLTTridiagonal, QRDense, QRPivotedDense, SVDDense, - GSVDDense, + Hermitian, + Triangular, InsertionSort, QuickSort, MergeSort, @@ -234,6 +240,7 @@ export A_rdiv_Bt, Ac_ldiv_B, Ac_ldiv_Bc, + Ac_mul_b_RFP, Ac_mul_B, Ac_mul_Bc, Ac_rdiv_B, @@ -458,7 +465,6 @@ export cumsum_kbn, cummin, cummax, - diff, fill, fill!, find, @@ -544,6 +550,7 @@ export chol, cholfact, cholfact!, + cholp, cholpfact, cholpfact!, cond, @@ -554,8 +561,12 @@ export diagm, diagmm, diagmm!, + diff, dot, eig, + eigenfact, + eigenfact!, + eigs, eigvals, expm, sqrtm, @@ -598,7 +609,7 @@ export svd, svdfact!, svdfact, - svdt, + svds, svdvals!, svdvals, symmetrize!, 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/arnoldi.jl b/base/linalg/arnoldi.jl new file mode 100644 index 0000000000000..f598f64f0da26 --- /dev/null +++ b/base/linalg/arnoldi.jl @@ -0,0 +1,167 @@ +using ARPACK + +## eigs + +function eigs{T <: BlasFloat}(A::AbstractMatrix{T}, nev::Integer, evtype::ASCIIString, rvec::Bool) + (m, n) = size(A) + if m != n; error("Input must be square"); end + sym = issym(A) + cmplx = iscomplex(A) + bmat = "I" + + # 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) + + # 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) + +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) + +## svds + +# 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 + 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) + + svals = sqrt(svals) + rvec ? (A*svecs*diagm(1./svals), svals, v.') : svals +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) + +## aupd and eupd wrappers + +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) + + 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) + workd = Array(T, 3*n) + workl = Array(T, lworkl) + rwork = cmplx ? Array(TR, ncv) : Array(TR, 0) + 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 + 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] = linop(getindex(workd, ipntr[1]+zernm1)) + end + + return (select, tol, resid, ncv, v, n, iparam, ipntr, workd, workl, lworkl, rwork) +end + +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 + + 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 + + elseif sym + + 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 + + else + + 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 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 + +end diff --git a/base/linalg/arpack.jl b/base/linalg/arpack.jl new file mode 100644 index 0000000000000..0640387318b4a --- /dev/null +++ b/base/linalg/arpack.jl @@ -0,0 +1,108 @@ +module ARPACK + +const libarpack = "libarpack" + +export naupd, neupd, saupd, seupd + +import LinAlg.BlasInt +import LinAlg.blas_int + +for (T, saupd_name, seupd_name, naupd_name, neupd_name) in + ((:Float64, :dsaupd_, :dseupd_, :dnaupd_, :dneupd_), + (:Float32, :ssaupd_, :sseupd_, :snaupd_, :sneupd_)) + @eval begin + + 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 + + end +end + +for (T, TR, naupd_name, neupd_name) in + ((:Complex128, :Float64, :znaupd_, :zneupd_), + (:Complex64, :Float32, :cnaupd_, :cneupd_)) + @eval begin + + 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 + +end # module ARPACK diff --git a/base/linalg_bitarray.jl b/base/linalg/bitarray.jl similarity index 95% rename from base/linalg_bitarray.jl rename to 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/blas.jl b/base/linalg/blas.jl similarity index 88% rename from base/blas.jl rename to base/linalg/blas.jl index 724e94679efa9..65bc539a3e75e 100644 --- a/base/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), @@ -452,6 +443,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/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/cholmod.jl b/base/linalg/cholmod.jl new file mode 100644 index 0000000000000..9c36fbe5b592f --- /dev/null +++ b/base/linalg/cholmod.jl @@ -0,0 +1,950 @@ +module CHOLMOD + +export # types + CholmodDense, + CholmodFactor, + CholmodSparse, + CholmodTriplet, + + 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 +import Base.convert +import Base.copy +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! +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,()) +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. +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("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 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 + +## 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 + +## 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 +## 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::Cint + dtype::Cint +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::Cint + is_ll::Cint + is_super::Cint + is_monotonic::Cint + itype::Cint + xtype::Cint + dtype::Cint +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::Cint + itype::Cint + xtype::Cint + dtype::Cint + sorted::Cint + packed::Cint +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:Cint + itype::Cint + xtype::Cint + dtype::Cint +end + +type CholmodTriplet{Tv<:CHMVTypes,Ti<:CHMITypes} + c::c_CholmodTriplet{Tv,Ti} + i::Vector{Ti} + j::Vector{Ti} + x::Vector{Tv} +end + +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 + +## 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 + 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 +CholmodDense!{T<:CHMVTypes}(c::Ptr{c_CholmodDense{T}}) = CholmodDense(c) # no distinction + +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_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_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_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), "") +show(io::IO,cd::CholmodDense) = chm_print(cd, int32(4), "") + +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 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 +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}, + 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 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) + 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 +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 + +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 + +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 + +for Ti in (:Int32,:Int64) + @eval begin + 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((@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((@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((@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((@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((@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 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 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_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, + 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,size(X,2))) + 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($Ti)) + if status != CHOLMOD_TRUE throw(CholmodException) end + Y + end + 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, 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 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 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)) + +(\){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) + 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 + +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),"") + +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 +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 + +function solve{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti}, + B::SparseMatrixCSC{Tv,Ti},typ::Integer) + solve(L,CholmodSparse(B),typ) +end +function solve{Tv<:CHMVTypes,Ti<:CHMITypes}(L::CholmodFactor{Tv,Ti},B::SparseMatrixCSC{Tv,Ti}) + solve(L,CholmodSparse(B),CHOLMOD_A) +end +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 +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 + 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/dense.jl b/base/linalg/dense.jl new file mode 100644 index 0000000000000..ff6f46eccf376 --- /dev/null +++ b/base/linalg/dense.jl @@ -0,0 +1,485 @@ +# Linear algebra functions for dense matrices in column major format + +scale!(X::Array{Float32}, s::Real) = BLAS.scal!(length(X), float32(s), X, 1) +scale!(X::Array{Float64}, s::Real) = BLAS.scal!(length(X), float64(s), X, 1) +scale!(X::Array{Complex64}, s::Real) = (ccall(("sscal_",Base.libblas_name), Void, (Ptr{BlasInt}, Ptr{Float32}, Ptr{Complex64}, Ptr{BlasInt}), &(2*length(X)), &s, X, &1); X) +scale!(X::Array{Complex128}, s::Real) = (ccall(("dscal_",Base.libblas_name), Void, (Ptr{BlasInt}, Ptr{Float64}, Ptr{Complex128}, Ptr{BlasInt}), &(2*length(X)), &s, X, &1); X) + +#Test whether a matrix is positive-definite + +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::Char) = isposdef!(copy(A), UL) +isposdef{T<:BlasFloat}(A::Matrix{T}) = isposdef!(copy(A)) +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 + +norm{T<:BlasFloat}(x::Vector{T}) = BLAS.nrm2(length(x), x, 1) + +function norm{T<:BlasFloat, TI<:Integer}(x::Vector{T}, rx::Union(Range1{TI},Range{TI})) + if min(rx) < 1 || max(rx) > length(x) + throw(BoundsError()) + end + BLAS.nrm2(length(rx), pointer(x)+(first(rx)-1)*sizeof(T), step(rx)) +end + +function norm{T<:BlasFloat}(x::Vector{T}, p::Number) + n = length(x) + if n == 0 + a = zero(T) + elseif p == 2 + BLAS.nrm2(n, x, 1) + elseif p == 1 + BLAS.asum(n, x, 1) + elseif p == Inf + max(abs(x)) + elseif p == -Inf + min(abs(x)) + elseif p == 0 + convert(T, nnz(x)) + else + absx = abs(x) + dx = max(absx) + if dx != zero(T) + scale!(absx, 1/dx) + a = dx * (sum(absx.^p).^(1/p)) + else + zero(T) + end + end +end + +function triu!{T}(M::Matrix{T}, k::Integer) + m, n = size(M) + idx = 1 + for j = 0:n-1 + ii = min(max(0, j+1-k), m) + for i = (idx+ii):(idx+m-1) + M[i] = zero(T) + end + idx += m + end + return M +end + +triu(M::Matrix, k::Integer) = triu!(copy(M), k) + +function tril!{T}(M::Matrix{T}, k::Integer) + m, n = size(M) + idx = 1 + for j = 0:n-1 + ii = min(max(0, j-k), m) + for i = idx:(idx+ii-1) + M[i] = zero(T) + end + idx += m + end + return M +end + +tril(M::Matrix, k::Integer) = tril!(copy(M), k) + +diff(a::Vector) = [ a[i+1] - a[i] for i=1:length(a)-1 ] + +function diff(a::Matrix, dim::Integer) + if dim == 1 + [ a[i+1,j] - a[i,j] for i=1:size(a,1)-1, j=1:size(a,2) ] + else + [ a[i,j+1] - a[i,j] for i=1:size(a,1), j=1:size(a,2)-1 ] + end +end + +function gradient(F::Vector, h::Vector) + n = length(F) + g = similar(F) + if n > 0 + g[1] = 0 + end + if n > 1 + g[1] = (F[2] - F[1]) / (h[2] - h[1]) + g[n] = (F[n] - F[n-1]) / (h[end] - h[end-1]) + end + if n > 2 + h = h[3:n] - h[1:n-2] + g[2:n-1] = (F[3:n] - F[1:n-2]) ./ h + end + return g +end + +function diag{T}(A::Matrix{T}, k::Integer) + m, n = size(A) + if k >= 0 && k < n + nV = min(m, n-k) + elseif k < 0 && -k < m + nV = min(m+k, n) + else + throw(BoundsError()) + end + + V = zeros(T, nV) + + if k > 0 + for i=1:nV + V[i] = A[i, i+k] + end + else + for i=1:nV + V[i] = A[i-k, i] + end + end + + return V +end + +diag(A) = diag(A, 0) + +function diagm{T}(v::VecOrMat{T}, k::Integer) + if isa(v, Matrix) + if (size(v,1) != 1 && size(v,2) != 1) + error("Input should be nx1 or 1xn") + end + end + + n = length(v) + if k >= 0 + a = zeros(T, n+k, n+k) + for i=1:n + a[i,i+k] = v[i] + end + else + a = zeros(T, n-k, n-k) + for i=1:n + a[i-k,i] = v[i] + end + end + + return a +end + +diagm(v) = diagm(v, 0) + +diagm(x::Number) = (X = Array(typeof(x),1,1); X[1,1] = x; X) + +function trace{T}(A::Matrix{T}) + t = zero(T) + for i=1:min(size(A)) + t += A[i,i] + end + return t +end + +kron(a::Vector, b::Vector) = [ a[i]*b[j] for i=1:length(a), j=1:length(b) ] + +function kron{T,S}(a::Matrix{T}, b::Matrix{S}) + R = Array(promote_type(T,S), size(a,1)*size(b,1), size(a,2)*size(b,2)) + + m = 1 + for j = 1:size(a,2) + for l = 1:size(b,2) + for i = 1:size(a,1) + aij = a[i,j] + for k = 1:size(b,1) + R[m] = aij*b[k,l] + m += 1 + end + end + end + end + R +end + +kron(a::Number, b::Number) = a * b +kron(a::Vector, b::Number) = a * b +kron(a::Number, b::Vector) = a * b +kron(a::Matrix, b::Number) = a * b +kron(a::Number, b::Matrix) = a * b + +randsym(n) = symmetrize!(randn(n,n)) + +^(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(Base.power_by_squaring(A, -ip)) + else + return Base.power_by_squaring(A, ip) + end + end + if size(A,1) != size(A,2) + error("matrix must be square") + end + (v, X) = eig(A) + if isreal(v) && any(v.<0) + v = complex(v) + end + if ishermitian(A) + Xinv = X' + else + Xinv = inv(X) + end + diagmm(X, v.^p)*Xinv +end + +function rref{T}(A::Matrix{T}) + nr, nc = size(A) + U = copy!(similar(A, T <: Complex ? Complex128 : Float64), A) + e = eps(norm(U,Inf)) + i = j = 1 + while i <= nr && j <= nc + (m, mi) = findmax(abs(U[i:nr,j])) + mi = mi+i - 1 + if m <= e + U[i:nr,j] = 0 + j += 1 + else + for k=j:nc + U[i, k], U[mi, k] = U[mi, k], U[i, k] + end + d = U[i,j] + for k = j:nc + U[i,k] /= d + end + for k = 1:nr + if k != i + d = U[k,j] + for l = j:nc + U[k,l] -= d*U[i,l] + end + end + end + i += 1 + j += 1 + end + end + return U +end + +rref(x::Number) = one(x) + +## Destructive matrix exponential using algorithm from Higham, 2008, +## "Functions of Matrices: Theory and Computation", SIAM +function expm!{T<:BlasFloat}(A::StridedMatrix{T}) + m, n = size(A) + if m != n error("expm!: Matrix A must be square") end + if m < 2 return exp(A) end + ilo, ihi, scale = LAPACK.gebal!('B', A) # modifies A + nA = norm(A, 1) + I = eye(T,n) + ## For sufficiently small nA, use lower order Padé-Approximations + if (nA <= 2.1) + if nA > 0.95 + C = T[17643225600.,8821612800.,2075673600.,302702400., + 30270240., 2162160., 110880., 3960., + 90., 1.] + elseif nA > 0.25 + C = T[17297280.,8648640.,1995840.,277200., + 25200., 1512., 56., 1.] + elseif nA > 0.015 + C = T[30240.,15120.,3360., + 420., 30., 1.] + else + C = T[120.,60.,12.,1.] + end + A2 = A * A + P = copy(I) + U = C[2] * P + V = C[1] * P + for k in 1:(div(size(C, 1), 2) - 1) + k2 = 2 * k + P *= A2 + U += C[k2 + 2] * P + V += C[k2 + 1] * P + end + U = A * U + X = V + U + LAPACK.gesv!(V-U, X) + else + s = log2(nA/5.4) # power of 2 later reversed by squaring + if s > 0 + si = iceil(s) + A /= oftype(T,2^si) + end + CC = T[64764752532480000.,32382376266240000.,7771770303897600., + 1187353796428800., 129060195264000., 10559470521600., + 670442572800., 33522128640., 1323241920., + 40840800., 960960., 16380., + 182., 1.] + A2 = A * A + A4 = A2 * A2 + A6 = A2 * A4 + U = A * (A6 * (CC[14]*A6 + CC[12]*A4 + CC[10]*A2) + + CC[8]*A6 + CC[6]*A4 + CC[4]*A2 + CC[2]*I) + V = A6 * (CC[13]*A6 + CC[11]*A4 + CC[9]*A2) + + CC[7]*A6 + CC[5]*A4 + CC[3]*A2 + CC[1]*I + + X = V + U + LAPACK.gesv!(V-U, X) + + if s > 0 # squaring to reverse dividing by power of 2 + for t in 1:si X *= X end + end + end + # Undo the balancing + doscale = false # check if rescaling is needed + for i = ilo:ihi + if scale[i] != 1. + doscale = true + break + end + end + if doscale + for j = ilo:ihi + scj = scale[j] + if scj != 1. # is this overkill? + for i = ilo:ihi + X[i,j] *= scale[i]/scj + end + else + for i = ilo:ihi + X[i,j] *= scale[i] + end + end + end + end + if ilo > 1 # apply lower permutations in reverse order + for j in (ilo-1):1:-1 rcswap!(j, int(scale[j]), X) end + end + if ihi < n # apply upper permutations in forward order + for j in (ihi+1):n rcswap!(j, int(scale[j]), X) end + end + X +end + +## Swap rows j and jp and columns j and jp in X +function rcswap!{T<:Number}(j::Integer, jp::Integer, X::StridedMatrix{T}) + for k in 1:size(X, 2) + tmp = X[k,j] + X[k,j] = X[k,jp] + X[k,jp] = tmp + tmp = X[j,k] + X[j,k] = X[jp,k] + X[jp,k] = tmp + end +end + +# Matrix exponential +expm{T<:Union(Float32,Float64,Complex64,Complex128)}(A::StridedMatrix{T}) = expm!(copy(A)) +expm{T<:Integer}(A::StridedMatrix{T}) = expm!(float(A)) +expm(x::Number) = exp(x) + +function sqrtm(A::StridedMatrix, cond::Bool) + m, n = size(A) + if m != n error("DimentionMismatch") end + if ishermitian(A) + return sqrtm(Hermitian(A), cond) + else + T,Q,_ = schur(complex(A)) + R = zeros(eltype(T), n, n) + for j = 1:n + R[j,j] = sqrt(T[j,j]) + for i = j - 1:-1:1 + r = T[i,j] + for k = i + 1:j - 1 + r -= R[i,k]*R[k,j] + end + if r != 0 + R[i,j] = r / (R[i,i] + R[j,j]) + end + 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) + 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 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(lufact(A)) +end +det(x::Number) = x + +logdet(A::Matrix) = 2.0 * sum(log(diag(cholfact(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(lufact(A)) +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::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 = 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] + 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 = 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:] +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', lufact(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..c626c51164dec --- /dev/null +++ b/base/linalg/factorization.jl @@ -0,0 +1,557 @@ +## 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) + +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::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) + +function getindex(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::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::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) + +getindex(C::CholeskyPivotedDense) = C.UL, C.piv +function getindex{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 +end +function LUDense{T<:BlasFloat}(A::StridedMatrix{T}) + LU, ipiv, info = LAPACK.getrf!(A) + LUDense{T}(LU, ipiv, info) +end + +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::Union(Number, StridedMatrix)) + 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) + +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 + 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::StridedMatrix) = QRDense(LAPACK.geqrt3!(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::Union(Number, StridedMatrix), thin::Bool) + F = qrfact(A) + 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...) + +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") +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 +qrpfact!{T<:BlasFloat}(A::StridedMatrix{T}) = QRPivotedDense{T}(LAPACK.geqp3!(A)...) + +qrpfact(A::StridedMatrix) = qrpfact!(copy(A)) + +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...) + +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 + 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) +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}) + 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)...) + +hessfact(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...) +getindex(A::HessenbergQ, args...) = getindex(full(A), args...) + +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") +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 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)) + else + u,s,vt = LAPACK.gesdd!(thin ? 'S' : 'A', A) + end + return SVDDense(u,s,vt) +end +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 + 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 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 + +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 + 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 diff --git a/base/linalg.jl b/base/linalg/generic.jl similarity index 100% rename from base/linalg.jl rename to base/linalg/generic.jl diff --git a/base/linalg/hermitian.jl b/base/linalg/hermitian.jl new file mode 100644 index 0000000000000..1dec75938540b --- /dev/null +++ b/base/linalg/hermitian.jl @@ -0,0 +1,50 @@ +## 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)) + +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) + F = eigenfact(A) + vsqrt = sqrt(complex(F[:values])) + if all(imag(vsqrt) .== 0) + retmat = symmetrize!(diagmm(F[:vectors], real(vsqrt)) * F[:vectors]') + else + zc = complex(F[:vectors]) + retmat = symmetrize!(diagmm(zc, vsqrt) * zc') + end + if cond + return retmat, norm(vsqrt, Inf)^2/norm(F[:values], Inf) + else + return retmat + end +end diff --git a/base/lapack.jl b/base/linalg/lapack.jl similarity index 91% rename from base/lapack.jl rename to base/linalg/lapack.jl index cb3df8590b5b8..7ea85cd447616 100644 --- a/base/lapack.jl +++ b/base/linalg/lapack.jl @@ -3,12 +3,12 @@ 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 +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 @@ -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 @@ -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 ) @@ -436,14 +436,14 @@ 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, (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 ) @@ -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) @@ -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) @@ -1010,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 @@ -1060,13 +1076,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 +1100,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 +1117,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 ) @@ -1114,13 +1130,13 @@ 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}, 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 +1159,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 +1181,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 +1197,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 +1219,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 +1245,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,14 +1273,14 @@ 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) - 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 ) @@ -1278,14 +1294,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 +1392,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 +1420,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 +1453,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 +1473,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 +1484,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 +1512,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 +1539,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 +1564,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 +1580,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 +1597,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 +1609,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 +1644,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 +1652,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 +1660,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 +1674,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 +1682,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 +1711,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 +1721,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 +1756,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 +1790,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 +1824,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 +1834,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 +1852,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 +1864,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 +1910,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 +1959,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) @@ -2028,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) @@ -2037,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/linalg.jl b/base/linalg/linalg.jl new file mode 100644 index 0000000000000..6a4c18e0b7d64 --- /dev/null +++ b/base/linalg/linalg.jl @@ -0,0 +1,163 @@ +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, + cholfact, + cholfact!, + cholp, + cholpfact, + cholpfact!, + cond, + copy!, + cross, + ctranspose, + det, + diag, + diagm, + diagmm, + diagmm!, + diff, + dot, + eig, + eigenfact!, + eigenfact, + 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/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/umfpack.jl") +include("linalg/cholmod.jl") + +include("linalg/arpack.jl") +include("linalg/arnoldi.jl") + +end # module LinAlg diff --git a/base/matmul.jl b/base/linalg/matmul.jl similarity index 98% rename from base/matmul.jl rename to base/linalg/matmul.jl index 01487e801a091..018920ff7e0a5 100644 --- a/base/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/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_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/linalg/suitesparse_h.jl b/base/linalg/suitesparse_h.jl new file mode 100644 index 0000000000000..467e595617444 --- /dev/null +++ b/base/linalg/suitesparse_h.jl @@ -0,0 +1,73 @@ +## UMFPACK + +## Type of solve +const UMFPACK_A = 0 # Ax=b +const UMFPACK_At = 1 # A'x=b +const UMFPACK_Aat = 2 # A.'x=b +const UMFPACK_Pt_L = 3 # P'Lx=b +const UMFPACK_L = 4 # Lx=b +const UMFPACK_Lt_P = 5 # L'Px=b +const UMFPACK_Lat_P = 6 # L.'Px=b +const UMFPACK_Lt = 7 # L'x=b +const UMFPACK_Lat = 8 # L.'x=b +const UMFPACK_U_Qt = 9 # UQ'x=b +const UMFPACK_U = 10 # Ux=b +const UMFPACK_Q_Ut = 11 # QU'x=b +const UMFPACK_Q_Uat = 12 # QU.'x=b +const UMFPACK_Ut = 13 # U'x=b +const UMFPACK_Uat = 14 # U.'x=b + +## Sizes of Control and Info arrays for returning information from solver +const UMFPACK_INFO = 90 +const UMFPACK_CONTROL = 20 +const UMFPACK_PRL = 1 + +## Status codes +const UMFPACK_OK = 0 +const UMFPACK_WARNING_singular_matrix = 1 +const UMFPACK_WARNING_determinant_underflow = 2 +const UMFPACK_WARNING_determinant_overflow = 3 +const UMFPACK_ERROR_out_of_memory = -1 +const UMFPACK_ERROR_invalid_Numeric_object = -3 +const UMFPACK_ERROR_invalid_Symbolic_object = -4 +const UMFPACK_ERROR_argument_missing = -5 +const UMFPACK_ERROR_n_nonpositive = -6 +const UMFPACK_ERROR_invalid_matrix = -8 +const UMFPACK_ERROR_different_pattern = -11 +const UMFPACK_ERROR_invalid_system = -13 +const UMFPACK_ERROR_invalid_permutation = -15 +const UMFPACK_ERROR_internal_error = -911 +const UMFPACK_ERROR_file_IO = -17 +const UMFPACK_ERROR_ordering_failed = -18 + +## SuiteSparseQR + +## ordering options +const SPQR_ORDERING_FIXED = int32(0) +const SPQR_ORDERING_NATURAL = int32(1) +const SPQR_ORDERING_COLAMD = int32(2) +const SPQR_ORDERING_GIVEN = int32(3) # only used for C/C++ interface +const SPQR_ORDERING_CHOLMOD = int32(4) # CHOLMOD best-effort (COLAMD, METIS,...) +const SPQR_ORDERING_AMD = int32(5) # AMD(A'*A) +const SPQR_ORDERING_METIS = int32(6) # metis(A'*A) +const SPQR_ORDERING_DEFAULT = int32(7) # SuiteSparseQR default ordering +const SPQR_ORDERING_BEST = int32(8) # try COLAMD, AMD, and METIS; pick best +const SPQR_ORDERING_BESTAMD = int32(9) # try COLAMD and AMD; pick best + +# Let [m n] = size of the matrix after pruning singletons. The default +# ordering strategy is to use COLAMD if m <= 2*n. Otherwise, AMD(A'A) is +# tried. If there is a high fill-in with AMD then try METIS(A'A) and take +# the best of AMD and METIS. METIS is not tried if it isn't installed. + +## Operations in qmult +const SPQR_QTX = int32(0) # Y = Q'*X +const SPQR_QX = int32(1) # Y = Q*X +const SPQR_XQT = int32(2) # Y = X*Q' +const SPQR_XQ = int32(3) # Y = X*Q + +## Types of systems to solve +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/base/linalg/tridiag.jl b/base/linalg/tridiag.jl new file mode 100644 index 0000000000000..5439b80cc6acf --- /dev/null +++ b/base/linalg/tridiag.jl @@ -0,0 +1,370 @@ +#### 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) + for j = 1:n + r = Range1((j-1)*m+1,m) + 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) + for j = 1:n + r = Range1((j-1)*m+1,m) + 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/umfpack.jl b/base/linalg/umfpack.jl new file mode 100644 index 0000000000000..f8b94950f6cca --- /dev/null +++ b/base/linalg/umfpack.jl @@ -0,0 +1,351 @@ +module UMFPACK + +export UmfpackLU, + + decrement, + decrement!, + increment, + increment! + +import Base.(\) +import Base.Ac_ldiv_B +import Base.At_ldiv_B +import Base.findn_nzs +import Base.getindex +import Base.nnz +import Base.show +import Base.size + +import LinAlg.Factorization +import LinAlg.det +import LinAlg.lufact +import LinAlg.lufact! +import LinAlg.solve + +include("linalg/suitesparse_h.jl") + +type MatrixIllConditionedException <: 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 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) +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.) + +## Should this type be immutable? +type UmfpackLU{Tv<:UMFVTypes,Ti<:UMFITypes} <: 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 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), + zerobased ? copy(S.rowval) : decrement(S.rowval), + copy(S.nzval)) + finalizer(res, umfpack_free_symbolic) + umfpack_numeric!(res) +end + +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), + zerobased ? S.rowval : decrement!(S.rowval), + S.nzval) + finalizer(res, umfpack_free_symbolic) + umfpack_numeric!(res) +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 + +## Wrappers for UMFPACK functions + +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(($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] + 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(($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] + 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(($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] + 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(($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] + U + end + function solve{Tv<:Float64,Ti<:$itype}(lu::UmfpackLU{Tv,Ti}, b::Vector{Tv}, typ::Integer) + umfpack_numeric!(lu) + x = similar(b) + 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 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(($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 + 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 + 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 + 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_num_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 + +### 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. +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_numeric(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).numeric, level) +end + +umfpack_report_numeric(lu::UmfpackLU) = umfpack_report_numeric(lu,4.) + +end # UMFPACK module + 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/linalg_dense.jl b/base/linalg_dense.jl deleted file mode 100644 index d916b346d120c..0000000000000 --- a/base/linalg_dense.jl +++ /dev/null @@ -1,1396 +0,0 @@ -# Linear algebra functions for dense matrices in column major format - -scale!(X::Array{Float32}, s::Real) = BLAS.scal!(length(X), float32(s), X, 1) -scale!(X::Array{Float64}, s::Real) = BLAS.scal!(length(X), float64(s), X, 1) -scale!(X::Array{Complex64}, s::Real) = (ccall(("sscal_",Base.libblas_name), Void, (Ptr{BlasInt}, Ptr{Float32}, Ptr{Complex64}, Ptr{BlasInt}), &(2*length(X)), &s, X, &1); X) -scale!(X::Array{Complex128}, s::Real) = (ccall(("dscal_",Base.libblas_name), Void, (Ptr{BlasInt}, Ptr{Float64}, Ptr{Complex128}, Ptr{BlasInt}), &(2*length(X)), &s, X, &1); X) - -#Test whether a matrix is positive-definite - -isposdef!{T<:BlasFloat}(A::Matrix{T}, UL::BlasChar) = 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}) = isposdef!(copy(A)) -isposdef{T<:Number}(A::Matrix{T}, UL::BlasChar) = isposdef!(float64(A), UL) -isposdef{T<:Number}(A::Matrix{T}) = isposdef!(float64(A)) - -isposdef(x::Number) = imag(x)==0 && real(x) > 0 - -norm{T<:BlasFloat}(x::Vector{T}) = BLAS.nrm2(length(x), x, 1) - -function norm{T<:BlasFloat, TI<:Integer}(x::Vector{T}, rx::Union(Range1{TI},Range{TI})) - if min(rx) < 1 || max(rx) > length(x) - throw(BoundsError()) - end - BLAS.nrm2(length(rx), pointer(x)+(first(rx)-1)*sizeof(T), step(rx)) -end - -function norm{T<:BlasFloat}(x::Vector{T}, p::Number) - n = length(x) - if n == 0 - a = zero(T) - elseif p == 2 - BLAS.nrm2(n, x, 1) - elseif p == 1 - BLAS.asum(n, x, 1) - elseif p == Inf - max(abs(x)) - elseif p == -Inf - min(abs(x)) - elseif p == 0 - convert(T, nnz(x)) - else - absx = abs(x) - dx = max(absx) - if dx != zero(T) - scale!(absx, 1/dx) - a = dx * (sum(absx.^p).^(1/p)) - else - zero(T) - end - end -end - -function triu!{T}(M::Matrix{T}, k::Integer) - m, n = size(M) - idx = 1 - for j = 0:n-1 - ii = min(max(0, j+1-k), m) - for i = (idx+ii):(idx+m-1) - M[i] = zero(T) - end - idx += m - end - return M -end - -triu(M::Matrix, k::Integer) = triu!(copy(M), k) - -function tril!{T}(M::Matrix{T}, k::Integer) - m, n = size(M) - idx = 1 - for j = 0:n-1 - ii = min(max(0, j-k), m) - for i = idx:(idx+ii-1) - M[i] = zero(T) - end - idx += m - end - return M -end - -tril(M::Matrix, k::Integer) = tril!(copy(M), k) - -diff(a::Vector) = [ a[i+1] - a[i] for i=1:length(a)-1 ] - -function diff(a::Matrix, dim::Integer) - if dim == 1 - [ a[i+1,j] - a[i,j] for i=1:size(a,1)-1, j=1:size(a,2) ] - else - [ a[i,j+1] - a[i,j] for i=1:size(a,1), j=1:size(a,2)-1 ] - end -end - -function gradient(F::Vector, h::Vector) - n = length(F) - g = similar(F) - if n > 0 - g[1] = 0 - end - if n > 1 - g[1] = (F[2] - F[1]) / (h[2] - h[1]) - g[n] = (F[n] - F[n-1]) / (h[end] - h[end-1]) - end - if n > 2 - h = h[3:n] - h[1:n-2] - g[2:n-1] = (F[3:n] - F[1:n-2]) ./ h - end - return g -end - -function diag{T}(A::Matrix{T}, k::Integer) - m, n = size(A) - if k >= 0 && k < n - nV = min(m, n-k) - elseif k < 0 && -k < m - nV = min(m+k, n) - else - throw(BoundsError()) - end - - V = zeros(T, nV) - - if k > 0 - for i=1:nV - V[i] = A[i, i+k] - end - else - for i=1:nV - V[i] = A[i-k, i] - end - end - - return V -end - -diag(A) = diag(A, 0) - -function diagm{T}(v::VecOrMat{T}, k::Integer) - if isa(v, Matrix) - if (size(v,1) != 1 && size(v,2) != 1) - error("Input should be nx1 or 1xn") - end - end - - n = length(v) - if k >= 0 - a = zeros(T, n+k, n+k) - for i=1:n - a[i,i+k] = v[i] - end - else - a = zeros(T, n-k, n-k) - for i=1:n - a[i-k,i] = v[i] - end - end - - return a -end - -diagm(v) = diagm(v, 0) - -diagm(x::Number) = (X = Array(typeof(x),1,1); X[1,1] = x; X) - -function trace{T}(A::Matrix{T}) - t = zero(T) - for i=1:min(size(A)) - t += A[i,i] - end - return t -end - -kron(a::Vector, b::Vector) = [ a[i]*b[j] for i=1:length(a), j=1:length(b) ] - -function kron{T,S}(a::Matrix{T}, b::Matrix{S}) - R = Array(promote_type(T,S), size(a,1)*size(b,1), size(a,2)*size(b,2)) - - m = 1 - for j = 1:size(a,2) - for l = 1:size(b,2) - for i = 1:size(a,1) - aij = a[i,j] - for k = 1:size(b,1) - R[m] = aij*b[k,l] - m += 1 - end - end - end - end - R -end - -kron(a::Number, b::Number) = a * b -kron(a::Vector, b::Number) = a * b -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 - -^(A::Matrix, p::Integer) = p < 0 ? inv(A^-p) : 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)) - else - return power_by_squaring(A, ip) - end - end - if size(A,1) != size(A,2) - error("matrix must be square") - end - (v, X) = eig(A) - if isreal(v) && any(v.<0) - v = complex(v) - end - if ishermitian(A) - Xinv = X' - else - Xinv = inv(X) - end - diagmm(X, v.^p)*Xinv -end - -function rref{T}(A::Matrix{T}) - nr, nc = size(A) - if T <: Rational - U = copy(A) - e = 0 - else - U = copy!(similar(A, T <: Complex ? Complex128 : Float64), A) - e = eps(norm(U,Inf)) - end - i = j = 1 - while i <= nr && j <= nc - (m, mi) = findmax(abs(U[i:nr,j])) - mi = mi+i - 1 - if m <= e - U[i:nr,j] = 0 - j += 1 - else - for k=j:nc - U[i, k], U[mi, k] = U[mi, k], U[i, k] - end - d = U[i,j] - for k = j:nc - U[i,k] /= d - end - for k = 1:nr - if k != i - d = U[k,j] - for l = j:nc - U[k,l] -= d*U[i,l] - end - end - end - i += 1 - j += 1 - end - end - return U -end - -rref(x::Number) = one(x) - -## Destructive matrix exponential using algorithm from Higham, 2008, -## "Functions of Matrices: Theory and Computation", SIAM -function expm!{T<:BlasFloat}(A::StridedMatrix{T}) - m, n = size(A) - if m != n error("expm!: Matrix A must be square") end - if m < 2 return exp(A) end - ilo, ihi, scale = LAPACK.gebal!('B', A) # modifies A - nA = norm(A, 1) - I = eye(T,n) - ## For sufficiently small nA, use lower order Padé-Approximations - if (nA <= 2.1) - if nA > 0.95 - C = T[17643225600.,8821612800.,2075673600.,302702400., - 30270240., 2162160., 110880., 3960., - 90., 1.] - elseif nA > 0.25 - C = T[17297280.,8648640.,1995840.,277200., - 25200., 1512., 56., 1.] - elseif nA > 0.015 - C = T[30240.,15120.,3360., - 420., 30., 1.] - else - C = T[120.,60.,12.,1.] - end - A2 = A * A - P = copy(I) - U = C[2] * P - V = C[1] * P - for k in 1:(div(size(C, 1), 2) - 1) - k2 = 2 * k - P *= A2 - U += C[k2 + 2] * P - V += C[k2 + 1] * P - end - U = A * U - X = V + U - LAPACK.gesv!(V-U, X) - else - s = log2(nA/5.4) # power of 2 later reversed by squaring - if s > 0 - si = iceil(s) - A /= oftype(T,2^si) - end - CC = T[64764752532480000.,32382376266240000.,7771770303897600., - 1187353796428800., 129060195264000., 10559470521600., - 670442572800., 33522128640., 1323241920., - 40840800., 960960., 16380., - 182., 1.] - A2 = A * A - A4 = A2 * A2 - A6 = A2 * A4 - U = A * (A6 * (CC[14]*A6 + CC[12]*A4 + CC[10]*A2) + - CC[8]*A6 + CC[6]*A4 + CC[4]*A2 + CC[2]*I) - V = A6 * (CC[13]*A6 + CC[11]*A4 + CC[9]*A2) + - CC[7]*A6 + CC[5]*A4 + CC[3]*A2 + CC[1]*I - - X = V + U - LAPACK.gesv!(V-U, X) - - if s > 0 # squaring to reverse dividing by power of 2 - for t in 1:si X *= X end - end - end - # Undo the balancing - doscale = false # check if rescaling is needed - for i = ilo:ihi - if scale[i] != 1. - doscale = true - break - end - end - if doscale - for j = ilo:ihi - scj = scale[j] - if scj != 1. # is this overkill? - for i = ilo:ihi - X[i,j] *= scale[i]/scj - end - else - for i = ilo:ihi - X[i,j] *= scale[i] - end - end - end - end - if ilo > 1 # apply lower permutations in reverse order - for j in (ilo-1):1:-1 rcswap!(j, int(scale[j]), X) end - end - if ihi < n # apply upper permutations in forward order - for j in (ihi+1):n rcswap!(j, int(scale[j]), X) end - end - X -end - -## Swap rows j and jp and columns j and jp in X -function rcswap!{T<:Number}(j::Integer, jp::Integer, X::StridedMatrix{T}) - for k in 1:size(X, 2) - tmp = X[k,j] - X[k,j] = X[k,jp] - X[k,jp] = tmp - tmp = X[j,k] - X[j,k] = X[jp,k] - X[jp,k] = tmp - end -end - -# Matrix exponential -expm{T<:Union(Float32,Float64,Complex64,Complex128)}(A::StridedMatrix{T}) = expm!(copy(A)) -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, LR 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) - 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<: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) -end - -\{T<:BlasFloat}(B::BunchKaufman{T}, R::StridedVecOrMat{T}) = - LAPACK.sytrs!(B.UL, 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 - end -end - -size(C::CholeskyDense) = size(C.LR) -size(C::CholeskyDense,d::Integer) = size(C.LR,d) - -factors(C::CholeskyDense) = C.LR - -\{T<:BlasFloat}(C::CholeskyDense{T}, B::StridedVecOrMat{T}) = - LAPACK.potrs!(C.UL, C.LR, 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 - dd -end - -function inv(C::CholeskyDense) - Ci, info = LAPACK.potri!(C.UL, copy(C.LR)) - if info != 0; throw(LAPACK.SingularException(info)); end - symmetrize!(Ci, C.UL) -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") - -type CholeskyPivotedDense{T<:BlasFloat} <: Factorization{T} - LR::Matrix{T} - UL::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'") - end - end -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)] -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),:] -end - -rank(C::CholeskyPivotedDense) = C.rank - -function det{T}(C::CholeskyPivotedDense{T}) - if C.rank < size(C.LR, 1) - return real(zero(T)) - else - return prod(abs2(diag(C.LR))) - 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 - 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.) - -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) : 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 - end - L, U, P -end - -function lufact!{T<:BlasFloat}(A::Matrix{T}) - lu, ipiv, info = LAPACK.getrf!(A) - LUDense{T}(lu, ipiv, info) -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)) -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)) -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)) -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) -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) - -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)) - -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 -end - -qr{T<:Number}(x::StridedMatrix{T}) = factors(qrfact(x)) -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 -end - -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 - error("QRPivotedDense: mismatched dimensions") - 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)) - -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)) - -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 -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 - -##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} - H::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 - 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] - -### 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)) -end -det(x::Number) = x - -logdet(A::Matrix) = 2.0 * sum(log(diag(chol(A)))) - -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 - - if ishermitian(A) - if vecs - Z = similar(A) - W = LAPACK.syevr!(copy(A), Z) - return W, Z - else - W = LAPACK.syevr!(copy(A)) - return W - end - 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 - - 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) -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) - -# SVD -type SVDDense{T,Tr} <: Factorization{T} - U::Matrix{T} - S::Vector{Tr} - V::Matrix{T} -end - -factors(F::SVDDense) = (F.U, F.S, F.V) - -function svdfact!{T<:BlasFloat}(A::StridedMatrix{T}, thin::Bool) - m,n = size(A) - if m == 0 || n == 0 - u,s,v = (eye(m, thin ? n : m), zeros(0), eye(n,n)) - else - u,s,v = LAPACK.gesdd!(thin ? 'S' : 'A', A) - end - return SVDDense(u,s,v) -end - -svdfact!(A::StridedMatrix) = svdfact(A, false) - -svdfact(A::StridedMatrix, thin::Bool) = svdfact!(copy(A), thin) -svdfact(A::StridedMatrix) = svdfact(A, false) - -function svdvals!(A::StridedMatrix) - 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 -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') -end - -svd(A::StridedMatrix) = svd(A, false) -svd(x::Number, thin::Bool) = (x==0?one(x):x/abs(x),abs(x),one(x)) - - -# 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)))} - 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)) - return GSVDDense(U, V, Q, a, b, int(k), int(l), R) -end - -svd(A::StridedMatrix, B::StridedMatrix) = factors(svdfact(A, B)) - -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] - end - return obj.U, obj.V, obj.Q, D1, D2, R0 -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 - 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 - else - T,Q,_ = schur(complex(A)) - R = zeros(eltype(T), n, n) - for j = 1:n - R[j,j] = sqrt(T[j,j]) - for i = j - 1:-1:1 - r = T[i,j] - for k = i + 1:j - 1 - r -= R[i,k]*R[k,j] - end - if r != 0 - 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) - end - 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 - end - LAPACK.gelsd!(Acopy, X)[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}) - 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') -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) - _,s,vt = svdt(A) - if m == 0; return eye(T, n); end - indstart = sum(s .> max(m,n)*max(s)*eps(eltype(s))) + 1 - vt[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', lufact(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) - -#### Specialized matrix types #### - -## Symmetric 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, 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] - -## 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 - -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) - for j = 1:n - r = Range1((j-1)*m+1,m) - 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) - for j = 1:n - r = Range1((j-1)*m+1,m) - 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 - -#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)) - -(\){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) - for j = 1:n - r = Range1((j-1)*m+1,m) - 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 2693d388cbca0..40af82014a5db 100644 --- a/base/sysimg.jl +++ b/base/sysimg.jl @@ -149,15 +149,10 @@ include("util.jl") include("test.jl") include("meta.jl") -# linear algebra -include("blas.jl") -include("lapack.jl") -include("matmul.jl") +# sparse matrices and linear algebra include("sparse.jl") -include("linalg.jl") -include("linalg_dense.jl") -include("linalg_bitarray.jl") -include("linalg_sparse.jl") +include("linalg/linalg.jl") +importall LinAlg # signal processing include("fftw.jl") 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/extras/arpack.jl b/extras/arpack.jl deleted file mode 100644 index 40cdaad530d2e..0000000000000 --- a/extras/arpack.jl +++ /dev/null @@ -1,263 +0,0 @@ -module ARPACK - -export eigs, svds - -const libarpack = "libarpack" - -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 - ((: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) - - 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 - -for (T, TR, naupd, neupd) 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" - - 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 -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/extras/image.jl b/extras/image.jl index d369031660c30..73fba7d1a3cd6 100644 --- a/extras/image.jl +++ b/extras/image.jl @@ -719,7 +719,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 = svdfact(filter) + U, S, Vt = SVD[:U], SVD[:S], SVD[:Vt] separable = true; for i = 2:length(S) # assumption that <10^-7 \approx 0 @@ -729,7 +730,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/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 diff --git a/extras/suitesparse_h.jl b/extras/suitesparse_h.jl deleted file mode 100644 index 8bc3a623477e9..0000000000000 --- a/extras/suitesparse_h.jl +++ /dev/null @@ -1,140 +0,0 @@ -## 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 - -# 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. - -# 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 - -# 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 -const UMFPACK_A = 0 # Ax=b -const UMFPACK_At = 1 # A'x=b -const UMFPACK_Aat = 2 # A.'x=b -const UMFPACK_Pt_L = 3 # P'Lx=b -const UMFPACK_L = 4 # Lx=b -const UMFPACK_Lt_P = 5 # L'Px=b -const UMFPACK_Lat_P = 6 # L.'Px=b -const UMFPACK_Lt = 7 # L'x=b -const UMFPACK_Lat = 8 # L.'x=b -const UMFPACK_U_Qt = 9 # UQ'x=b -const UMFPACK_U = 10 # Ux=b -const UMFPACK_Q_Ut = 11 # QU'x=b -const UMFPACK_Q_Uat = 12 # QU.'x=b -const UMFPACK_Ut = 13 # U'x=b -const UMFPACK_Uat = 14 # U.'x=b - -## Sizes of Control and Info arrays for returning information from solver -const UMFPACK_INFO = 90 -const UMFPACK_CONTROL = 20 -const UMFPACK_PRL = 1 - -## Status codes -const UMFPACK_OK = 0 -const UMFPACK_WARNING_singular_matrix = 1 -const UMFPACK_WARNING_determinant_underflow = 2 -const UMFPACK_WARNING_determinant_overflow = 3 -const UMFPACK_ERROR_out_of_memory = -1 -const UMFPACK_ERROR_invalid_Numeric_object = -3 -const UMFPACK_ERROR_invalid_Symbolic_object = -4 -const UMFPACK_ERROR_argument_missing = -5 -const UMFPACK_ERROR_n_nonpositive = -6 -const UMFPACK_ERROR_invalid_matrix = -8 -const UMFPACK_ERROR_different_pattern = -11 -const UMFPACK_ERROR_invalid_system = -13 -const UMFPACK_ERROR_invalid_permutation = -15 -const UMFPACK_ERROR_internal_error = -911 -const UMFPACK_ERROR_file_IO = -17 -const UMFPACK_ERROR_ordering_failed = -18 - -## SuiteSparseQR - -## ordering options -const SPQR_ORDERING_FIXED = int32(0) -const SPQR_ORDERING_NATURAL = int32(1) -const SPQR_ORDERING_COLAMD = int32(2) -const SPQR_ORDERING_GIVEN = int32(3) # only used for C/C++ interface -const SPQR_ORDERING_CHOLMOD = int32(4) # CHOLMOD best-effort (COLAMD, METIS,...) -const SPQR_ORDERING_AMD = int32(5) # AMD(A'*A) -const SPQR_ORDERING_METIS = int32(6) # metis(A'*A) -const SPQR_ORDERING_DEFAULT = int32(7) # SuiteSparseQR default ordering -const SPQR_ORDERING_BEST = int32(8) # try COLAMD, AMD, and METIS; pick best -const SPQR_ORDERING_BESTAMD = int32(9) # try COLAMD and AMD; pick best - -# Let [m n] = size of the matrix after pruning singletons. The default -# ordering strategy is to use COLAMD if m <= 2*n. Otherwise, AMD(A'A) is -# tried. If there is a high fill-in with AMD then try METIS(A'A) and take -# the best of AMD and METIS. METIS is not tried if it isn't installed. - -## Operations in qmult -const SPQR_QTX = int32(0) # Y = Q'*X -const SPQR_QX = int32(1) # Y = Q*X -const SPQR_XQT = int32(2) # Y = X*Q' -const SPQR_XQ = int32(3) # Y = X*Q - -## Types of systems to solve -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/test/arpack.jl b/test/arpack.jl index 7c9aac87c8dab..1d3ac5c018abc 100644 --- a/test/arpack.jl +++ b/test/arpack.jl @@ -1,13 +1,8 @@ -require("arpack") - -using ARPACK - -# arpack 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 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 0f88c94194848..cd9207f2f455f 100644 --- a/test/linalg.jl +++ b/test/linalg.jl @@ -9,19 +9,19 @@ for elty in (Float32, Float64, Complex64, Complex128) b = convert(Vector{elty}, b) capd = cholfact(apd) # upper Cholesky factor - r = factors(capd) + 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 = cholfact(apd, :L)[:L] # lower Cholesky factor @test_approx_eq l*l' apd - cpapd = cholpfact(apd) # pivoted Choleksy decomposition + cpapd = cholpfact(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) @@ -33,31 +33,23 @@ for elty in (Float32, Float64, Complex64, Complex128) @test_approx_eq apd * (bc2\b) b lua = lufact(a) # LU decomposition - l,u,p = lu(a) - L,U,P = factors(lua) - @test l == L && u == U && p == P + 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 = qrfact(a) # QR decomposition - q,r = factors(qra) - @test_approx_eq q'*q eye(elty, n) - @test_approx_eq q*q' eye(elty, n) - Q,R = qr(a) - @test q == Q && r == R + 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 qmulQR(qra,b) Q*b - @test_approx_eq qTmulQR(qra,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 + 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,19 +60,19 @@ 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 + 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 - @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,:] + 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,:] x = a \ b @test_approx_eq a*x b @@ -251,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 hessfact(A1)[:H] convert(Matrix{elty}, [4.000000000000000 -1.414213562373094 -1.414213562373095 -1.414213562373095 4.999999999999996 -0.000000000000000 0 -0.000000000000002 3.000000000000000]) @@ -296,7 +288,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 +321,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,13 +352,12 @@ 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 = 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,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 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 c2756429c93f1..4ad9298f1091e 100644 --- a/test/suitesparse.jl +++ b/test/suitesparse.jl @@ -1,7 +1,140 @@ -require("suitesparse") - -using SuiteSparse - se33 = speye(3) do33 = ones(3) @test isequal(se33 \ do33, do33) + +# 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) +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.] +x = lua\b +@test_approx_eq x float([1:5]) + +@test norm(A*x-b,1) < eps(1e4) + +using Base.LinAlg.CHOLMOD + +# based on deps/SuiteSparse-4.0.2/CHOLMOD/Demo/ + +# 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 + +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) +@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) +@test isvalid(chma) +x = chma\B +@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, + 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) +chmaf = cholfact(afiro) +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