Mercurial > hg > octave-avbm
changeset 5785:6b9cec830d72
[project @ 2006-05-03 19:32:46 by dbateman]
line wrap: on
line diff
--- a/libcruft/ChangeLog +++ b/libcruft/ChangeLog @@ -1,3 +1,9 @@ +2006-05-03 David Bateman <dbateman@free.fr> + + * lapack/dpocon.f, lapack/zpocon.f, lapack/dpotrs.f, + lapack/zpotrs.f, lapack/dtrcon.f, lapack/ztrcon.f, + lapack/dtrtrs.f, lapack/ztrtrs.f: New files. + 2006-04-29 John W. Eaton <jwe@octave.org> * misc/lo-error.c (set_liboctave_warning_with_id_handler,
new file mode 100644 --- /dev/null +++ b/libcruft/lapack/dpocon.f @@ -0,0 +1,173 @@ + SUBROUTINE DPOCON( UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK, + $ INFO ) +* +* -- LAPACK routine (version 3.0) -- +* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +* Courant Institute, Argonne National Lab, and Rice University +* March 31, 1993 +* +* .. Scalar Arguments .. + CHARACTER UPLO + INTEGER INFO, LDA, N + DOUBLE PRECISION ANORM, RCOND +* .. +* .. Array Arguments .. + INTEGER IWORK( * ) + DOUBLE PRECISION A( LDA, * ), WORK( * ) +* .. +* +* Purpose +* ======= +* +* DPOCON estimates the reciprocal of the condition number (in the +* 1-norm) of a real symmetric positive definite matrix using the +* Cholesky factorization A = U**T*U or A = L*L**T computed by DPOTRF. +* +* An estimate is obtained for norm(inv(A)), and the reciprocal of the +* condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). +* +* Arguments +* ========= +* +* UPLO (input) CHARACTER*1 +* = 'U': Upper triangle of A is stored; +* = 'L': Lower triangle of A is stored. +* +* N (input) INTEGER +* The order of the matrix A. N >= 0. +* +* A (input) DOUBLE PRECISION array, dimension (LDA,N) +* The triangular factor U or L from the Cholesky factorization +* A = U**T*U or A = L*L**T, as computed by DPOTRF. +* +* LDA (input) INTEGER +* The leading dimension of the array A. LDA >= max(1,N). +* +* ANORM (input) DOUBLE PRECISION +* The 1-norm (or infinity-norm) of the symmetric matrix A. +* +* RCOND (output) DOUBLE PRECISION +* The reciprocal of the condition number of the matrix A, +* computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an +* estimate of the 1-norm of inv(A) computed in this routine. +* +* WORK (workspace) DOUBLE PRECISION array, dimension (3*N) +* +* IWORK (workspace) INTEGER array, dimension (N) +* +* INFO (output) INTEGER +* = 0: successful exit +* < 0: if INFO = -i, the i-th argument had an illegal value +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ONE, ZERO + PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) +* .. +* .. Local Scalars .. + LOGICAL UPPER + CHARACTER NORMIN + INTEGER IX, KASE + DOUBLE PRECISION AINVNM, SCALE, SCALEL, SCALEU, SMLNUM +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER IDAMAX + DOUBLE PRECISION DLAMCH + EXTERNAL LSAME, IDAMAX, DLAMCH +* .. +* .. External Subroutines .. + EXTERNAL DLACON, DLATRS, DRSCL, XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, MAX +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + INFO = 0 + UPPER = LSAME( UPLO, 'U' ) + IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + INFO = -1 + ELSE IF( N.LT.0 ) THEN + INFO = -2 + ELSE IF( LDA.LT.MAX( 1, N ) ) THEN + INFO = -4 + ELSE IF( ANORM.LT.ZERO ) THEN + INFO = -5 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'DPOCON', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + RCOND = ZERO + IF( N.EQ.0 ) THEN + RCOND = ONE + RETURN + ELSE IF( ANORM.EQ.ZERO ) THEN + RETURN + END IF +* + SMLNUM = DLAMCH( 'Safe minimum' ) +* +* Estimate the 1-norm of inv(A). +* + KASE = 0 + NORMIN = 'N' + 10 CONTINUE + CALL DLACON( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE ) + IF( KASE.NE.0 ) THEN + IF( UPPER ) THEN +* +* Multiply by inv(U'). +* + CALL DLATRS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N, A, + $ LDA, WORK, SCALEL, WORK( 2*N+1 ), INFO ) + NORMIN = 'Y' +* +* Multiply by inv(U). +* + CALL DLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, + $ A, LDA, WORK, SCALEU, WORK( 2*N+1 ), INFO ) + ELSE +* +* Multiply by inv(L). +* + CALL DLATRS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N, + $ A, LDA, WORK, SCALEL, WORK( 2*N+1 ), INFO ) + NORMIN = 'Y' +* +* Multiply by inv(L'). +* + CALL DLATRS( 'Lower', 'Transpose', 'Non-unit', NORMIN, N, A, + $ LDA, WORK, SCALEU, WORK( 2*N+1 ), INFO ) + END IF +* +* Multiply by 1/SCALE if doing so will not cause overflow. +* + SCALE = SCALEL*SCALEU + IF( SCALE.NE.ONE ) THEN + IX = IDAMAX( N, WORK, 1 ) + IF( SCALE.LT.ABS( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO ) + $ GO TO 20 + CALL DRSCL( N, SCALE, WORK, 1 ) + END IF + GO TO 10 + END IF +* +* Compute the estimate of the reciprocal condition number. +* + IF( AINVNM.NE.ZERO ) + $ RCOND = ( ONE / AINVNM ) / ANORM +* + 20 CONTINUE + RETURN +* +* End of DPOCON +* + END
new file mode 100644 --- /dev/null +++ b/libcruft/lapack/dpotrs.f @@ -0,0 +1,133 @@ + SUBROUTINE DPOTRS( UPLO, N, NRHS, A, LDA, B, LDB, INFO ) +* +* -- LAPACK routine (version 3.0) -- +* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +* Courant Institute, Argonne National Lab, and Rice University +* March 31, 1993 +* +* .. Scalar Arguments .. + CHARACTER UPLO + INTEGER INFO, LDA, LDB, N, NRHS +* .. +* .. Array Arguments .. + DOUBLE PRECISION A( LDA, * ), B( LDB, * ) +* .. +* +* Purpose +* ======= +* +* DPOTRS solves a system of linear equations A*X = B with a symmetric +* positive definite matrix A using the Cholesky factorization +* A = U**T*U or A = L*L**T computed by DPOTRF. +* +* Arguments +* ========= +* +* UPLO (input) CHARACTER*1 +* = 'U': Upper triangle of A is stored; +* = 'L': Lower triangle of A is stored. +* +* N (input) INTEGER +* The order of the matrix A. N >= 0. +* +* NRHS (input) INTEGER +* The number of right hand sides, i.e., the number of columns +* of the matrix B. NRHS >= 0. +* +* A (input) DOUBLE PRECISION array, dimension (LDA,N) +* The triangular factor U or L from the Cholesky factorization +* A = U**T*U or A = L*L**T, as computed by DPOTRF. +* +* LDA (input) INTEGER +* The leading dimension of the array A. LDA >= max(1,N). +* +* B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) +* On entry, the right hand side matrix B. +* On exit, the solution matrix X. +* +* LDB (input) INTEGER +* The leading dimension of the array B. LDB >= max(1,N). +* +* INFO (output) INTEGER +* = 0: successful exit +* < 0: if INFO = -i, the i-th argument had an illegal value +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ONE + PARAMETER ( ONE = 1.0D+0 ) +* .. +* .. Local Scalars .. + LOGICAL UPPER +* .. +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL DTRSM, XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + INFO = 0 + UPPER = LSAME( UPLO, 'U' ) + IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + INFO = -1 + ELSE IF( N.LT.0 ) THEN + INFO = -2 + ELSE IF( NRHS.LT.0 ) THEN + INFO = -3 + ELSE IF( LDA.LT.MAX( 1, N ) ) THEN + INFO = -5 + ELSE IF( LDB.LT.MAX( 1, N ) ) THEN + INFO = -7 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'DPOTRS', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( N.EQ.0 .OR. NRHS.EQ.0 ) + $ RETURN +* + IF( UPPER ) THEN +* +* Solve A*X = B where A = U'*U. +* +* Solve U'*X = B, overwriting B with X. +* + CALL DTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS, + $ ONE, A, LDA, B, LDB ) +* +* Solve U*X = B, overwriting B with X. +* + CALL DTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N, + $ NRHS, ONE, A, LDA, B, LDB ) + ELSE +* +* Solve A*X = B where A = L*L'. +* +* Solve L*X = B, overwriting B with X. +* + CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', N, + $ NRHS, ONE, A, LDA, B, LDB ) +* +* Solve L'*X = B, overwriting B with X. +* + CALL DTRSM( 'Left', 'Lower', 'Transpose', 'Non-unit', N, NRHS, + $ ONE, A, LDA, B, LDB ) + END IF +* + RETURN +* +* End of DPOTRS +* + END
new file mode 100644 --- /dev/null +++ b/libcruft/lapack/dtrcon.f @@ -0,0 +1,193 @@ + SUBROUTINE DTRCON( NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK, + $ IWORK, INFO ) +* +* -- LAPACK routine (version 3.0) -- +* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +* Courant Institute, Argonne National Lab, and Rice University +* March 31, 1993 +* +* .. Scalar Arguments .. + CHARACTER DIAG, NORM, UPLO + INTEGER INFO, LDA, N + DOUBLE PRECISION RCOND +* .. +* .. Array Arguments .. + INTEGER IWORK( * ) + DOUBLE PRECISION A( LDA, * ), WORK( * ) +* .. +* +* Purpose +* ======= +* +* DTRCON estimates the reciprocal of the condition number of a +* triangular matrix A, in either the 1-norm or the infinity-norm. +* +* The norm of A is computed and an estimate is obtained for +* norm(inv(A)), then the reciprocal of the condition number is +* computed as +* RCOND = 1 / ( norm(A) * norm(inv(A)) ). +* +* Arguments +* ========= +* +* NORM (input) CHARACTER*1 +* Specifies whether the 1-norm condition number or the +* infinity-norm condition number is required: +* = '1' or 'O': 1-norm; +* = 'I': Infinity-norm. +* +* UPLO (input) CHARACTER*1 +* = 'U': A is upper triangular; +* = 'L': A is lower triangular. +* +* DIAG (input) CHARACTER*1 +* = 'N': A is non-unit triangular; +* = 'U': A is unit triangular. +* +* N (input) INTEGER +* The order of the matrix A. N >= 0. +* +* A (input) DOUBLE PRECISION array, dimension (LDA,N) +* The triangular matrix A. If UPLO = 'U', the leading N-by-N +* upper triangular part of the array A contains the upper +* triangular matrix, and the strictly lower triangular part of +* A is not referenced. If UPLO = 'L', the leading N-by-N lower +* triangular part of the array A contains the lower triangular +* matrix, and the strictly upper triangular part of A is not +* referenced. If DIAG = 'U', the diagonal elements of A are +* also not referenced and are assumed to be 1. +* +* LDA (input) INTEGER +* The leading dimension of the array A. LDA >= max(1,N). +* +* RCOND (output) DOUBLE PRECISION +* The reciprocal of the condition number of the matrix A, +* computed as RCOND = 1/(norm(A) * norm(inv(A))). +* +* WORK (workspace) DOUBLE PRECISION array, dimension (3*N) +* +* IWORK (workspace) INTEGER array, dimension (N) +* +* INFO (output) INTEGER +* = 0: successful exit +* < 0: if INFO = -i, the i-th argument had an illegal value +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ONE, ZERO + PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) +* .. +* .. Local Scalars .. + LOGICAL NOUNIT, ONENRM, UPPER + CHARACTER NORMIN + INTEGER IX, KASE, KASE1 + DOUBLE PRECISION AINVNM, ANORM, SCALE, SMLNUM, XNORM +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER IDAMAX + DOUBLE PRECISION DLAMCH, DLANTR + EXTERNAL LSAME, IDAMAX, DLAMCH, DLANTR +* .. +* .. External Subroutines .. + EXTERNAL DLACON, DLATRS, DRSCL, XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, DBLE, MAX +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + INFO = 0 + UPPER = LSAME( UPLO, 'U' ) + ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' ) + NOUNIT = LSAME( DIAG, 'N' ) +* + IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN + INFO = -1 + ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + INFO = -2 + ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN + INFO = -3 + ELSE IF( N.LT.0 ) THEN + INFO = -4 + ELSE IF( LDA.LT.MAX( 1, N ) ) THEN + INFO = -6 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'DTRCON', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( N.EQ.0 ) THEN + RCOND = ONE + RETURN + END IF +* + RCOND = ZERO + SMLNUM = DLAMCH( 'Safe minimum' )*DBLE( MAX( 1, N ) ) +* +* Compute the norm of the triangular matrix A. +* + ANORM = DLANTR( NORM, UPLO, DIAG, N, N, A, LDA, WORK ) +* +* Continue only if ANORM > 0. +* + IF( ANORM.GT.ZERO ) THEN +* +* Estimate the norm of the inverse of A. +* + AINVNM = ZERO + NORMIN = 'N' + IF( ONENRM ) THEN + KASE1 = 1 + ELSE + KASE1 = 2 + END IF + KASE = 0 + 10 CONTINUE + CALL DLACON( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE ) + IF( KASE.NE.0 ) THEN + IF( KASE.EQ.KASE1 ) THEN +* +* Multiply by inv(A). +* + CALL DLATRS( UPLO, 'No transpose', DIAG, NORMIN, N, A, + $ LDA, WORK, SCALE, WORK( 2*N+1 ), INFO ) + ELSE +* +* Multiply by inv(A'). +* + CALL DLATRS( UPLO, 'Transpose', DIAG, NORMIN, N, A, LDA, + $ WORK, SCALE, WORK( 2*N+1 ), INFO ) + END IF + NORMIN = 'Y' +* +* Multiply by 1/SCALE if doing so will not cause overflow. +* + IF( SCALE.NE.ONE ) THEN + IX = IDAMAX( N, WORK, 1 ) + XNORM = ABS( WORK( IX ) ) + IF( SCALE.LT.XNORM*SMLNUM .OR. SCALE.EQ.ZERO ) + $ GO TO 20 + CALL DRSCL( N, SCALE, WORK, 1 ) + END IF + GO TO 10 + END IF +* +* Compute the estimate of the reciprocal condition number. +* + IF( AINVNM.NE.ZERO ) + $ RCOND = ( ONE / ANORM ) / AINVNM + END IF +* + 20 CONTINUE + RETURN +* +* End of DTRCON +* + END
new file mode 100644 --- /dev/null +++ b/libcruft/lapack/dtrtrs.f @@ -0,0 +1,148 @@ + SUBROUTINE DTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, + $ INFO ) +* +* -- LAPACK routine (version 3.0) -- +* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +* Courant Institute, Argonne National Lab, and Rice University +* March 31, 1993 +* +* .. Scalar Arguments .. + CHARACTER DIAG, TRANS, UPLO + INTEGER INFO, LDA, LDB, N, NRHS +* .. +* .. Array Arguments .. + DOUBLE PRECISION A( LDA, * ), B( LDB, * ) +* .. +* +* Purpose +* ======= +* +* DTRTRS solves a triangular system of the form +* +* A * X = B or A**T * X = B, +* +* where A is a triangular matrix of order N, and B is an N-by-NRHS +* matrix. A check is made to verify that A is nonsingular. +* +* Arguments +* ========= +* +* UPLO (input) CHARACTER*1 +* = 'U': A is upper triangular; +* = 'L': A is lower triangular. +* +* TRANS (input) CHARACTER*1 +* Specifies the form of the system of equations: +* = 'N': A * X = B (No transpose) +* = 'T': A**T * X = B (Transpose) +* = 'C': A**H * X = B (Conjugate transpose = Transpose) +* +* DIAG (input) CHARACTER*1 +* = 'N': A is non-unit triangular; +* = 'U': A is unit triangular. +* +* N (input) INTEGER +* The order of the matrix A. N >= 0. +* +* NRHS (input) INTEGER +* The number of right hand sides, i.e., the number of columns +* of the matrix B. NRHS >= 0. +* +* A (input) DOUBLE PRECISION array, dimension (LDA,N) +* The triangular matrix A. If UPLO = 'U', the leading N-by-N +* upper triangular part of the array A contains the upper +* triangular matrix, and the strictly lower triangular part of +* A is not referenced. If UPLO = 'L', the leading N-by-N lower +* triangular part of the array A contains the lower triangular +* matrix, and the strictly upper triangular part of A is not +* referenced. If DIAG = 'U', the diagonal elements of A are +* also not referenced and are assumed to be 1. +* +* LDA (input) INTEGER +* The leading dimension of the array A. LDA >= max(1,N). +* +* B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) +* On entry, the right hand side matrix B. +* On exit, if INFO = 0, the solution matrix X. +* +* LDB (input) INTEGER +* The leading dimension of the array B. LDB >= max(1,N). +* +* INFO (output) INTEGER +* = 0: successful exit +* < 0: if INFO = -i, the i-th argument had an illegal value +* > 0: if INFO = i, the i-th diagonal element of A is zero, +* indicating that the matrix is singular and the solutions +* X have not been computed. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ZERO, ONE + PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) +* .. +* .. Local Scalars .. + LOGICAL NOUNIT +* .. +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL DTRSM, XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + INFO = 0 + NOUNIT = LSAME( DIAG, 'N' ) + IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + INFO = -1 + ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT. + $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN + INFO = -2 + ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN + INFO = -3 + ELSE IF( N.LT.0 ) THEN + INFO = -4 + ELSE IF( NRHS.LT.0 ) THEN + INFO = -5 + ELSE IF( LDA.LT.MAX( 1, N ) ) THEN + INFO = -7 + ELSE IF( LDB.LT.MAX( 1, N ) ) THEN + INFO = -9 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'DTRTRS', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( N.EQ.0 ) + $ RETURN +* +* Check for singularity. +* + IF( NOUNIT ) THEN + DO 10 INFO = 1, N + IF( A( INFO, INFO ).EQ.ZERO ) + $ RETURN + 10 CONTINUE + END IF + INFO = 0 +* +* Solve A * x = b or A' * x = b. +* + CALL DTRSM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, LDA, B, + $ LDB ) +* + RETURN +* +* End of DTRTRS +* + END
new file mode 100644 --- /dev/null +++ b/libcruft/lapack/zpocon.f @@ -0,0 +1,180 @@ + SUBROUTINE ZPOCON( UPLO, N, A, LDA, ANORM, RCOND, WORK, RWORK, + $ INFO ) +* +* -- LAPACK routine (version 3.0) -- +* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +* Courant Institute, Argonne National Lab, and Rice University +* March 31, 1993 +* +* .. Scalar Arguments .. + CHARACTER UPLO + INTEGER INFO, LDA, N + DOUBLE PRECISION ANORM, RCOND +* .. +* .. Array Arguments .. + DOUBLE PRECISION RWORK( * ) + COMPLEX*16 A( LDA, * ), WORK( * ) +* .. +* +* Purpose +* ======= +* +* ZPOCON estimates the reciprocal of the condition number (in the +* 1-norm) of a complex Hermitian positive definite matrix using the +* Cholesky factorization A = U**H*U or A = L*L**H computed by ZPOTRF. +* +* An estimate is obtained for norm(inv(A)), and the reciprocal of the +* condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). +* +* Arguments +* ========= +* +* UPLO (input) CHARACTER*1 +* = 'U': Upper triangle of A is stored; +* = 'L': Lower triangle of A is stored. +* +* N (input) INTEGER +* The order of the matrix A. N >= 0. +* +* A (input) COMPLEX*16 array, dimension (LDA,N) +* The triangular factor U or L from the Cholesky factorization +* A = U**H*U or A = L*L**H, as computed by ZPOTRF. +* +* LDA (input) INTEGER +* The leading dimension of the array A. LDA >= max(1,N). +* +* ANORM (input) DOUBLE PRECISION +* The 1-norm (or infinity-norm) of the Hermitian matrix A. +* +* RCOND (output) DOUBLE PRECISION +* The reciprocal of the condition number of the matrix A, +* computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an +* estimate of the 1-norm of inv(A) computed in this routine. +* +* WORK (workspace) COMPLEX*16 array, dimension (2*N) +* +* RWORK (workspace) DOUBLE PRECISION array, dimension (N) +* +* INFO (output) INTEGER +* = 0: successful exit +* < 0: if INFO = -i, the i-th argument had an illegal value +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ONE, ZERO + PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) +* .. +* .. Local Scalars .. + LOGICAL UPPER + CHARACTER NORMIN + INTEGER IX, KASE + DOUBLE PRECISION AINVNM, SCALE, SCALEL, SCALEU, SMLNUM + COMPLEX*16 ZDUM +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER IZAMAX + DOUBLE PRECISION DLAMCH + EXTERNAL LSAME, IZAMAX, DLAMCH +* .. +* .. External Subroutines .. + EXTERNAL XERBLA, ZDRSCL, ZLACON, ZLATRS +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, DBLE, DIMAG, MAX +* .. +* .. Statement Functions .. + DOUBLE PRECISION CABS1 +* .. +* .. Statement Function definitions .. + CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) ) +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + INFO = 0 + UPPER = LSAME( UPLO, 'U' ) + IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + INFO = -1 + ELSE IF( N.LT.0 ) THEN + INFO = -2 + ELSE IF( LDA.LT.MAX( 1, N ) ) THEN + INFO = -4 + ELSE IF( ANORM.LT.ZERO ) THEN + INFO = -5 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZPOCON', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + RCOND = ZERO + IF( N.EQ.0 ) THEN + RCOND = ONE + RETURN + ELSE IF( ANORM.EQ.ZERO ) THEN + RETURN + END IF +* + SMLNUM = DLAMCH( 'Safe minimum' ) +* +* Estimate the 1-norm of inv(A). +* + KASE = 0 + NORMIN = 'N' + 10 CONTINUE + CALL ZLACON( N, WORK( N+1 ), WORK, AINVNM, KASE ) + IF( KASE.NE.0 ) THEN + IF( UPPER ) THEN +* +* Multiply by inv(U'). +* + CALL ZLATRS( 'Upper', 'Conjugate transpose', 'Non-unit', + $ NORMIN, N, A, LDA, WORK, SCALEL, RWORK, INFO ) + NORMIN = 'Y' +* +* Multiply by inv(U). +* + CALL ZLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, + $ A, LDA, WORK, SCALEU, RWORK, INFO ) + ELSE +* +* Multiply by inv(L). +* + CALL ZLATRS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N, + $ A, LDA, WORK, SCALEL, RWORK, INFO ) + NORMIN = 'Y' +* +* Multiply by inv(L'). +* + CALL ZLATRS( 'Lower', 'Conjugate transpose', 'Non-unit', + $ NORMIN, N, A, LDA, WORK, SCALEU, RWORK, INFO ) + END IF +* +* Multiply by 1/SCALE if doing so will not cause overflow. +* + SCALE = SCALEL*SCALEU + IF( SCALE.NE.ONE ) THEN + IX = IZAMAX( N, WORK, 1 ) + IF( SCALE.LT.CABS1( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO ) + $ GO TO 20 + CALL ZDRSCL( N, SCALE, WORK, 1 ) + END IF + GO TO 10 + END IF +* +* Compute the estimate of the reciprocal condition number. +* + IF( AINVNM.NE.ZERO ) + $ RCOND = ( ONE / AINVNM ) / ANORM +* + 20 CONTINUE + RETURN +* +* End of ZPOCON +* + END
new file mode 100644 --- /dev/null +++ b/libcruft/lapack/zpotrs.f @@ -0,0 +1,133 @@ + SUBROUTINE ZPOTRS( UPLO, N, NRHS, A, LDA, B, LDB, INFO ) +* +* -- LAPACK routine (version 3.0) -- +* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +* Courant Institute, Argonne National Lab, and Rice University +* September 30, 1994 +* +* .. Scalar Arguments .. + CHARACTER UPLO + INTEGER INFO, LDA, LDB, N, NRHS +* .. +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), B( LDB, * ) +* .. +* +* Purpose +* ======= +* +* ZPOTRS solves a system of linear equations A*X = B with a Hermitian +* positive definite matrix A using the Cholesky factorization +* A = U**H*U or A = L*L**H computed by ZPOTRF. +* +* Arguments +* ========= +* +* UPLO (input) CHARACTER*1 +* = 'U': Upper triangle of A is stored; +* = 'L': Lower triangle of A is stored. +* +* N (input) INTEGER +* The order of the matrix A. N >= 0. +* +* NRHS (input) INTEGER +* The number of right hand sides, i.e., the number of columns +* of the matrix B. NRHS >= 0. +* +* A (input) COMPLEX*16 array, dimension (LDA,N) +* The triangular factor U or L from the Cholesky factorization +* A = U**H*U or A = L*L**H, as computed by ZPOTRF. +* +* LDA (input) INTEGER +* The leading dimension of the array A. LDA >= max(1,N). +* +* B (input/output) COMPLEX*16 array, dimension (LDB,NRHS) +* On entry, the right hand side matrix B. +* On exit, the solution matrix X. +* +* LDB (input) INTEGER +* The leading dimension of the array B. LDB >= max(1,N). +* +* INFO (output) INTEGER +* = 0: successful exit +* < 0: if INFO = -i, the i-th argument had an illegal value +* +* ===================================================================== +* +* .. Parameters .. + COMPLEX*16 ONE + PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) ) +* .. +* .. Local Scalars .. + LOGICAL UPPER +* .. +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA, ZTRSM +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + INFO = 0 + UPPER = LSAME( UPLO, 'U' ) + IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + INFO = -1 + ELSE IF( N.LT.0 ) THEN + INFO = -2 + ELSE IF( NRHS.LT.0 ) THEN + INFO = -3 + ELSE IF( LDA.LT.MAX( 1, N ) ) THEN + INFO = -5 + ELSE IF( LDB.LT.MAX( 1, N ) ) THEN + INFO = -7 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZPOTRS', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( N.EQ.0 .OR. NRHS.EQ.0 ) + $ RETURN +* + IF( UPPER ) THEN +* +* Solve A*X = B where A = U'*U. +* +* Solve U'*X = B, overwriting B with X. +* + CALL ZTRSM( 'Left', 'Upper', 'Conjugate transpose', 'Non-unit', + $ N, NRHS, ONE, A, LDA, B, LDB ) +* +* Solve U*X = B, overwriting B with X. +* + CALL ZTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N, + $ NRHS, ONE, A, LDA, B, LDB ) + ELSE +* +* Solve A*X = B where A = L*L'. +* +* Solve L*X = B, overwriting B with X. +* + CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', N, + $ NRHS, ONE, A, LDA, B, LDB ) +* +* Solve L'*X = B, overwriting B with X. +* + CALL ZTRSM( 'Left', 'Lower', 'Conjugate transpose', 'Non-unit', + $ N, NRHS, ONE, A, LDA, B, LDB ) + END IF +* + RETURN +* +* End of ZPOTRS +* + END
new file mode 100644 --- /dev/null +++ b/libcruft/lapack/ztrcon.f @@ -0,0 +1,200 @@ + SUBROUTINE ZTRCON( NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK, + $ RWORK, INFO ) +* +* -- LAPACK routine (version 3.0) -- +* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +* Courant Institute, Argonne National Lab, and Rice University +* March 31, 1993 +* +* .. Scalar Arguments .. + CHARACTER DIAG, NORM, UPLO + INTEGER INFO, LDA, N + DOUBLE PRECISION RCOND +* .. +* .. Array Arguments .. + DOUBLE PRECISION RWORK( * ) + COMPLEX*16 A( LDA, * ), WORK( * ) +* .. +* +* Purpose +* ======= +* +* ZTRCON estimates the reciprocal of the condition number of a +* triangular matrix A, in either the 1-norm or the infinity-norm. +* +* The norm of A is computed and an estimate is obtained for +* norm(inv(A)), then the reciprocal of the condition number is +* computed as +* RCOND = 1 / ( norm(A) * norm(inv(A)) ). +* +* Arguments +* ========= +* +* NORM (input) CHARACTER*1 +* Specifies whether the 1-norm condition number or the +* infinity-norm condition number is required: +* = '1' or 'O': 1-norm; +* = 'I': Infinity-norm. +* +* UPLO (input) CHARACTER*1 +* = 'U': A is upper triangular; +* = 'L': A is lower triangular. +* +* DIAG (input) CHARACTER*1 +* = 'N': A is non-unit triangular; +* = 'U': A is unit triangular. +* +* N (input) INTEGER +* The order of the matrix A. N >= 0. +* +* A (input) COMPLEX*16 array, dimension (LDA,N) +* The triangular matrix A. If UPLO = 'U', the leading N-by-N +* upper triangular part of the array A contains the upper +* triangular matrix, and the strictly lower triangular part of +* A is not referenced. If UPLO = 'L', the leading N-by-N lower +* triangular part of the array A contains the lower triangular +* matrix, and the strictly upper triangular part of A is not +* referenced. If DIAG = 'U', the diagonal elements of A are +* also not referenced and are assumed to be 1. +* +* LDA (input) INTEGER +* The leading dimension of the array A. LDA >= max(1,N). +* +* RCOND (output) DOUBLE PRECISION +* The reciprocal of the condition number of the matrix A, +* computed as RCOND = 1/(norm(A) * norm(inv(A))). +* +* WORK (workspace) COMPLEX*16 array, dimension (2*N) +* +* RWORK (workspace) DOUBLE PRECISION array, dimension (N) +* +* INFO (output) INTEGER +* = 0: successful exit +* < 0: if INFO = -i, the i-th argument had an illegal value +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ONE, ZERO + PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) +* .. +* .. Local Scalars .. + LOGICAL NOUNIT, ONENRM, UPPER + CHARACTER NORMIN + INTEGER IX, KASE, KASE1 + DOUBLE PRECISION AINVNM, ANORM, SCALE, SMLNUM, XNORM + COMPLEX*16 ZDUM +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER IZAMAX + DOUBLE PRECISION DLAMCH, ZLANTR + EXTERNAL LSAME, IZAMAX, DLAMCH, ZLANTR +* .. +* .. External Subroutines .. + EXTERNAL XERBLA, ZDRSCL, ZLACON, ZLATRS +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, DBLE, DIMAG, MAX +* .. +* .. Statement Functions .. + DOUBLE PRECISION CABS1 +* .. +* .. Statement Function definitions .. + CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) ) +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + INFO = 0 + UPPER = LSAME( UPLO, 'U' ) + ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' ) + NOUNIT = LSAME( DIAG, 'N' ) +* + IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN + INFO = -1 + ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + INFO = -2 + ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN + INFO = -3 + ELSE IF( N.LT.0 ) THEN + INFO = -4 + ELSE IF( LDA.LT.MAX( 1, N ) ) THEN + INFO = -6 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZTRCON', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( N.EQ.0 ) THEN + RCOND = ONE + RETURN + END IF +* + RCOND = ZERO + SMLNUM = DLAMCH( 'Safe minimum' )*DBLE( MAX( 1, N ) ) +* +* Compute the norm of the triangular matrix A. +* + ANORM = ZLANTR( NORM, UPLO, DIAG, N, N, A, LDA, RWORK ) +* +* Continue only if ANORM > 0. +* + IF( ANORM.GT.ZERO ) THEN +* +* Estimate the norm of the inverse of A. +* + AINVNM = ZERO + NORMIN = 'N' + IF( ONENRM ) THEN + KASE1 = 1 + ELSE + KASE1 = 2 + END IF + KASE = 0 + 10 CONTINUE + CALL ZLACON( N, WORK( N+1 ), WORK, AINVNM, KASE ) + IF( KASE.NE.0 ) THEN + IF( KASE.EQ.KASE1 ) THEN +* +* Multiply by inv(A). +* + CALL ZLATRS( UPLO, 'No transpose', DIAG, NORMIN, N, A, + $ LDA, WORK, SCALE, RWORK, INFO ) + ELSE +* +* Multiply by inv(A'). +* + CALL ZLATRS( UPLO, 'Conjugate transpose', DIAG, NORMIN, + $ N, A, LDA, WORK, SCALE, RWORK, INFO ) + END IF + NORMIN = 'Y' +* +* Multiply by 1/SCALE if doing so will not cause overflow. +* + IF( SCALE.NE.ONE ) THEN + IX = IZAMAX( N, WORK, 1 ) + XNORM = CABS1( WORK( IX ) ) + IF( SCALE.LT.XNORM*SMLNUM .OR. SCALE.EQ.ZERO ) + $ GO TO 20 + CALL ZDRSCL( N, SCALE, WORK, 1 ) + END IF + GO TO 10 + END IF +* +* Compute the estimate of the reciprocal condition number. +* + IF( AINVNM.NE.ZERO ) + $ RCOND = ( ONE / ANORM ) / AINVNM + END IF +* + 20 CONTINUE + RETURN +* +* End of ZTRCON +* + END
new file mode 100644 --- /dev/null +++ b/libcruft/lapack/ztrtrs.f @@ -0,0 +1,149 @@ + SUBROUTINE ZTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, + $ INFO ) +* +* -- LAPACK routine (version 3.0) -- +* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +* Courant Institute, Argonne National Lab, and Rice University +* September 30, 1994 +* +* .. Scalar Arguments .. + CHARACTER DIAG, TRANS, UPLO + INTEGER INFO, LDA, LDB, N, NRHS +* .. +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), B( LDB, * ) +* .. +* +* Purpose +* ======= +* +* ZTRTRS solves a triangular system of the form +* +* A * X = B, A**T * X = B, or A**H * X = B, +* +* where A is a triangular matrix of order N, and B is an N-by-NRHS +* matrix. A check is made to verify that A is nonsingular. +* +* Arguments +* ========= +* +* UPLO (input) CHARACTER*1 +* = 'U': A is upper triangular; +* = 'L': A is lower triangular. +* +* TRANS (input) CHARACTER*1 +* Specifies the form of the system of equations: +* = 'N': A * X = B (No transpose) +* = 'T': A**T * X = B (Transpose) +* = 'C': A**H * X = B (Conjugate transpose) +* +* DIAG (input) CHARACTER*1 +* = 'N': A is non-unit triangular; +* = 'U': A is unit triangular. +* +* N (input) INTEGER +* The order of the matrix A. N >= 0. +* +* NRHS (input) INTEGER +* The number of right hand sides, i.e., the number of columns +* of the matrix B. NRHS >= 0. +* +* A (input) COMPLEX*16 array, dimension (LDA,N) +* The triangular matrix A. If UPLO = 'U', the leading N-by-N +* upper triangular part of the array A contains the upper +* triangular matrix, and the strictly lower triangular part of +* A is not referenced. If UPLO = 'L', the leading N-by-N lower +* triangular part of the array A contains the lower triangular +* matrix, and the strictly upper triangular part of A is not +* referenced. If DIAG = 'U', the diagonal elements of A are +* also not referenced and are assumed to be 1. +* +* LDA (input) INTEGER +* The leading dimension of the array A. LDA >= max(1,N). +* +* B (input/output) COMPLEX*16 array, dimension (LDB,NRHS) +* On entry, the right hand side matrix B. +* On exit, if INFO = 0, the solution matrix X. +* +* LDB (input) INTEGER +* The leading dimension of the array B. LDB >= max(1,N). +* +* INFO (output) INTEGER +* = 0: successful exit +* < 0: if INFO = -i, the i-th argument had an illegal value +* > 0: if INFO = i, the i-th diagonal element of A is zero, +* indicating that the matrix is singular and the solutions +* X have not been computed. +* +* ===================================================================== +* +* .. Parameters .. + COMPLEX*16 ZERO, ONE + PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ), + $ ONE = ( 1.0D+0, 0.0D+0 ) ) +* .. +* .. Local Scalars .. + LOGICAL NOUNIT +* .. +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA, ZTRSM +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + INFO = 0 + NOUNIT = LSAME( DIAG, 'N' ) + IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + INFO = -1 + ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT. + $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN + INFO = -2 + ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN + INFO = -3 + ELSE IF( N.LT.0 ) THEN + INFO = -4 + ELSE IF( NRHS.LT.0 ) THEN + INFO = -5 + ELSE IF( LDA.LT.MAX( 1, N ) ) THEN + INFO = -7 + ELSE IF( LDB.LT.MAX( 1, N ) ) THEN + INFO = -9 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZTRTRS', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( N.EQ.0 ) + $ RETURN +* +* Check for singularity. +* + IF( NOUNIT ) THEN + DO 10 INFO = 1, N + IF( A( INFO, INFO ).EQ.ZERO ) + $ RETURN + 10 CONTINUE + END IF + INFO = 0 +* +* Solve A * x = b, A**T * x = b, or A**H * x = b. +* + CALL ZTRSM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, LDA, B, + $ LDB ) +* + RETURN +* +* End of ZTRTRS +* + END
--- a/liboctave/CMatrix.cc +++ b/liboctave/CMatrix.cc @@ -112,6 +112,43 @@ const octave_idx_type&, double*, double&, octave_idx_type&, Complex*, const octave_idx_type&, double*, octave_idx_type&); + F77_RET_T + F77_FUNC (zpotrf, ZPOTRF) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, + Complex*, const octave_idx_type&, + octave_idx_type& F77_CHAR_ARG_LEN_DECL); + + F77_RET_T + F77_FUNC (zpocon, ZPOCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, + Complex*, const octave_idx_type&, const double&, + double&, Complex*, double*, + octave_idx_type& F77_CHAR_ARG_LEN_DECL); + + F77_RET_T + F77_FUNC (zpotrs, ZPOTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, + const octave_idx_type&, const Complex*, + const octave_idx_type&, Complex*, + const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); + + F77_RET_T + F77_FUNC (ztrcon, ZTRCON) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, + const Complex*, const octave_idx_type&, double&, + Complex*, double*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); + + F77_RET_T + F77_FUNC (ztrtrs, ZTRTRS) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, + const octave_idx_type&, const Complex*, + const octave_idx_type&, Complex*, + const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); + // Note that the original complex fft routines were not written for // double complex arguments. They have been modified by adding an // implicit double precision (a-h,o-z) statement at the beginning of @@ -1491,6 +1528,583 @@ } ComplexMatrix +ComplexMatrix::utsolve (MatrixType &mattype, const ComplexMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const +{ + ComplexMatrix retval; + + octave_idx_type nr = rows (); + octave_idx_type nc = cols (); + + if (nr == 0 || nc == 0 || nr != b.rows ()) + (*current_liboctave_error_handler) + ("matrix dimension mismatch solution of linear equations"); + else + { + volatile int typ = mattype.type (); + + if (typ == MatrixType::Permuted_Upper || + typ == MatrixType::Upper) + { + octave_idx_type b_nc = b.cols (); + rcond = 1.; + info = 0; + + if (typ == MatrixType::Permuted_Upper) + { + (*current_liboctave_error_handler) + ("Permuted triangular matrix not implemented"); + } + else + { + const Complex *tmp_data = fortran_vec (); + + if (calc_cond) + { + char norm = '1'; + char uplo = 'U'; + char dia = 'N'; + + Array<Complex> z (2 * nc); + Complex *pz = z.fortran_vec (); + Array<double> rz (nc); + double *prz = rz.fortran_vec (); + + F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), + F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&dia, 1), + nr, tmp_data, nr, rcond, + pz, prz, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in ztrcon"); + + if (info != 0) + info = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + info = -2; + + if (sing_handler) + sing_handler (rcond); + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + + if (info == 0) + { + retval = b; + Complex *result = retval.fortran_vec (); + + char uplo = 'U'; + char trans = 'N'; + char dia = 'N'; + + F77_XFCN (ztrtrs, ZTRTRS, (F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&trans, 1), + F77_CONST_CHAR_ARG2 (&dia, 1), + nr, b_nc, tmp_data, nr, + result, nr, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in dtrtrs"); + } + } + } + else + (*current_liboctave_error_handler) ("incorrect matrix type"); + } + + return retval; +} + +ComplexMatrix +ComplexMatrix::ltsolve (MatrixType &mattype, const ComplexMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const +{ + ComplexMatrix retval; + + octave_idx_type nr = rows (); + octave_idx_type nc = cols (); + + if (nr == 0 || nc == 0 || nr != b.rows ()) + (*current_liboctave_error_handler) + ("matrix dimension mismatch solution of linear equations"); + else + { + volatile int typ = mattype.type (); + + if (typ == MatrixType::Permuted_Lower || + typ == MatrixType::Lower) + { + octave_idx_type b_nc = b.cols (); + rcond = 1.; + info = 0; + + if (typ == MatrixType::Permuted_Lower) + { + (*current_liboctave_error_handler) + ("Permuted triangular matrix not implemented"); + } + else + { + const Complex *tmp_data = fortran_vec (); + + if (calc_cond) + { + char norm = '1'; + char uplo = 'L'; + char dia = 'N'; + + Array<Complex> z (2 * nc); + Complex *pz = z.fortran_vec (); + Array<double> rz (nc); + double *prz = rz.fortran_vec (); + + F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), + F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&dia, 1), + nr, tmp_data, nr, rcond, + pz, prz, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in ztrcon"); + + if (info != 0) + info = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + info = -2; + + if (sing_handler) + sing_handler (rcond); + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + + if (info == 0) + { + retval = b; + Complex *result = retval.fortran_vec (); + + char uplo = 'L'; + char trans = 'N'; + char dia = 'N'; + + F77_XFCN (ztrtrs, ZTRTRS, (F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&trans, 1), + F77_CONST_CHAR_ARG2 (&dia, 1), + nr, b_nc, tmp_data, nr, + result, nr, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in dtrtrs"); + } + } + } + else + (*current_liboctave_error_handler) ("incorrect matrix type"); + } + + return retval; +} + +ComplexMatrix +ComplexMatrix::fsolve (MatrixType &mattype, const ComplexMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond) const +{ + ComplexMatrix retval; + + octave_idx_type nr = rows (); + octave_idx_type nc = cols (); + + if (nr == 0 || nc == 0 || nr != nc || nr != b.rows ()) + (*current_liboctave_error_handler) + ("matrix dimension mismatch in solution of linear equations"); + else + { + volatile int typ = mattype.type (); + + // Calculate the norm of the matrix, for later use. + double anorm = -1.; + + if (typ == MatrixType::Hermitian) + { + info = 0; + char job = 'L'; + ComplexMatrix atmp = *this; + Complex *tmp_data = atmp.fortran_vec (); + anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); + + F77_XFCN (zpotrf, ZPOTRF, (F77_CONST_CHAR_ARG2 (&job, 1), nr, + tmp_data, nr, info + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in zpotrf"); + else + { + // Throw-away extra info LAPACK gives so as to not change output. + rcond = 0.0; + if (info != 0) + { + info = -2; + + mattype.mark_as_unsymmetric (); + typ = MatrixType::Full; + } + else + { + if (calc_cond) + { + Array<Complex> z (2 * nc); + Complex *pz = z.fortran_vec (); + Array<double> rz (nc); + double *prz = rz.fortran_vec (); + + F77_XFCN (zpocon, ZPOCON, (F77_CONST_CHAR_ARG2 (&job, 1), + nr, tmp_data, nr, anorm, + rcond, pz, prz, info + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in zpocon"); + + if (info != 0) + info = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + info = -2; + + if (sing_handler) + sing_handler (rcond); + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + + if (info == 0) + { + retval = b; + Complex *result = retval.fortran_vec (); + + octave_idx_type b_nc = b.cols (); + + F77_XFCN (zpotrs, ZPOTRS, (F77_CONST_CHAR_ARG2 (&job, 1), + nr, b_nc, tmp_data, nr, + result, b.rows(), info + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in zpotrs"); + } + else + { + mattype.mark_as_unsymmetric (); + typ = MatrixType::Full; + } + } + } + } + + if (typ == MatrixType::Full) + { + info = 0; + + Array<octave_idx_type> ipvt (nr); + octave_idx_type *pipvt = ipvt.fortran_vec (); + + ComplexMatrix atmp = *this; + Complex *tmp_data = atmp.fortran_vec (); + + Array<Complex> z (2 * nc); + Complex *pz = z.fortran_vec (); + Array<double> rz (2 * nc); + double *prz = rz.fortran_vec (); + + // Calculate the norm of the matrix, for later use. + if (anorm < 0.) + anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); + + F77_XFCN (zgetrf, ZGETRF, (nr, nr, tmp_data, nr, pipvt, info)); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in zgetrf"); + else + { + // Throw-away extra info LAPACK gives so as to not change output. + rcond = 0.0; + if (info != 0) + { + info = -2; + + if (sing_handler) + sing_handler (rcond); + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision"); + + mattype.mark_as_rectangular (); + } + else + { + if (calc_cond) + { + // Now calculate the condition number for + // non-singular matrix. + char job = '1'; + F77_XFCN (zgecon, ZGECON, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, tmp_data, nr, anorm, + rcond, pz, prz, info + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in zgecon"); + + if (info != 0) + info = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + info = -2; + + if (sing_handler) + sing_handler (rcond); + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + + if (info == 0) + { + retval = b; + Complex *result = retval.fortran_vec (); + + octave_idx_type b_nc = b.cols (); + + char job = 'N'; + F77_XFCN (zgetrs, ZGETRS, (F77_CONST_CHAR_ARG2 (&job, 1), + nr, b_nc, tmp_data, nr, + pipvt, result, b.rows(), info + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in zgetrs"); + } + else + mattype.mark_as_rectangular (); + } + } + } + } + + return retval; +} + +ComplexMatrix +ComplexMatrix::solve (MatrixType &typ, const Matrix& b) const +{ + octave_idx_type info; + double rcond; + return solve (typ, b, info, rcond, 0); +} + +ComplexMatrix +ComplexMatrix::solve (MatrixType &typ, const Matrix& b, + octave_idx_type& info) const +{ + double rcond; + return solve (typ, b, info, rcond, 0); +} + +ComplexMatrix +ComplexMatrix::solve (MatrixType &typ, const Matrix& b, octave_idx_type& info, + double& rcond) const +{ + return solve (typ, b, info, rcond, 0); +} + +ComplexMatrix +ComplexMatrix::solve (MatrixType &typ, const Matrix& b, octave_idx_type& info, + double& rcond, solve_singularity_handler sing_handler, + bool singular_fallback) const +{ + ComplexMatrix tmp (b); + return solve (typ, tmp, info, rcond, sing_handler, singular_fallback); +} + +ComplexMatrix +ComplexMatrix::solve (MatrixType &typ, const ComplexMatrix& b) const +{ + octave_idx_type info; + double rcond; + return solve (typ, b, info, rcond, 0); +} + +ComplexMatrix +ComplexMatrix::solve (MatrixType &typ, const ComplexMatrix& b, + octave_idx_type& info) const +{ + double rcond; + return solve (typ, b, info, rcond, 0); +} + +ComplexMatrix +ComplexMatrix::solve (MatrixType &typ, const ComplexMatrix& b, + octave_idx_type& info, double& rcond) const +{ + return solve (typ, b, info, rcond, 0); +} + +ComplexMatrix +ComplexMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool singular_fallback) const +{ + ComplexMatrix retval; + int typ = mattype.type (); + + if (typ == MatrixType::Unknown) + typ = mattype.type (*this); + + // Only calculate the condition number for LU/Cholesky + if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) + retval = utsolve (mattype, b, info, rcond, sing_handler, false); + else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) + retval = ltsolve (mattype, b, info, rcond, sing_handler, false); + else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) + retval = fsolve (mattype, b, info, rcond, sing_handler, true); + else if (typ != MatrixType::Rectangular) + { + (*current_liboctave_error_handler) ("unknown matrix type"); + return ComplexMatrix (); + } + + // Rectangular or one of the above solvers flags a singular matrix + if (singular_fallback && mattype.type () == MatrixType::Rectangular) + { + octave_idx_type rank; + retval = lssolve (b, info, rank); + } + + return retval; +} + +ComplexColumnVector +ComplexMatrix::solve (MatrixType &typ, const ColumnVector& b) const +{ + octave_idx_type info; + double rcond; + return solve (typ, ComplexColumnVector (b), info, rcond, 0); +} + +ComplexColumnVector +ComplexMatrix::solve (MatrixType &typ, const ColumnVector& b, + octave_idx_type& info) const +{ + double rcond; + return solve (typ, ComplexColumnVector (b), info, rcond, 0); +} + +ComplexColumnVector +ComplexMatrix::solve (MatrixType &typ, const ColumnVector& b, + octave_idx_type& info, double& rcond) const +{ + return solve (typ, ComplexColumnVector (b), info, rcond, 0); +} + +ComplexColumnVector +ComplexMatrix::solve (MatrixType &typ, const ColumnVector& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler) const +{ + return solve (typ, ComplexColumnVector (b), info, rcond, sing_handler); +} + +ComplexColumnVector +ComplexMatrix::solve (MatrixType &typ, const ComplexColumnVector& b) const +{ + octave_idx_type info; + double rcond; + return solve (typ, b, info, rcond, 0); +} + +ComplexColumnVector +ComplexMatrix::solve (MatrixType &typ, const ComplexColumnVector& b, + octave_idx_type& info) const +{ + double rcond; + return solve (typ, b, info, rcond, 0); +} + +ComplexColumnVector +ComplexMatrix::solve (MatrixType &typ, const ComplexColumnVector& b, + octave_idx_type& info, double& rcond) const +{ + return solve (typ, b, info, rcond, 0); +} + +ComplexColumnVector +ComplexMatrix::solve (MatrixType &typ, const ComplexColumnVector& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler) const +{ + + ComplexMatrix tmp (b); + return solve (typ, tmp, info, rcond, sing_handler).column(static_cast<octave_idx_type> (0)); +} + +ComplexMatrix ComplexMatrix::solve (const Matrix& b) const { octave_idx_type info; @@ -1544,102 +2158,8 @@ ComplexMatrix::solve (const ComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler) const { - ComplexMatrix retval; - - octave_idx_type nr = rows (); - octave_idx_type nc = cols (); - - if (nr == 0 || nc == 0 || nr != nc || nr != b.rows ()) - (*current_liboctave_error_handler) - ("matrix dimension mismatch in solution of linear equations"); - else - { - info = 0; - - Array<octave_idx_type> ipvt (nr); - octave_idx_type *pipvt = ipvt.fortran_vec (); - - ComplexMatrix atmp = *this; - Complex *tmp_data = atmp.fortran_vec (); - - Array<Complex> z (2 * nc); - Complex *pz = z.fortran_vec (); - Array<double> rz (2 * nc); - double *prz = rz.fortran_vec (); - - // Calculate the norm of the matrix, for later use. - double anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); - - F77_XFCN (zgetrf, ZGETRF, (nr, nr, tmp_data, nr, pipvt, info)); - - if (f77_exception_encountered) - (*current_liboctave_error_handler) ("unrecoverable error in zgetrf"); - else - { - // Throw-away extra info LAPACK gives so as to not change output. - rcond = 0.0; - if (info != 0) - { - info = -2; - - if (sing_handler) - sing_handler (rcond); - else - (*current_liboctave_error_handler) - ("matrix singular to machine precision"); - - } - else - { - // Now calculate the condition number for non-singular matrix. - char job = '1'; - F77_XFCN (zgecon, ZGECON, (F77_CONST_CHAR_ARG2 (&job, 1), - nc, tmp_data, nr, anorm, - rcond, pz, prz, info - F77_CHAR_ARG_LEN (1))); - - if (f77_exception_encountered) - (*current_liboctave_error_handler) - ("unrecoverable error in zgecon"); - - if (info != 0) - info = -2; - - volatile double rcond_plus_one = rcond + 1.0; - - if (rcond_plus_one == 1.0 || xisnan (rcond)) - { - info = -2; - - if (sing_handler) - sing_handler (rcond); - else - (*current_liboctave_error_handler) - ("matrix singular to machine precision, rcond = %g", - rcond); - } - else - { - retval = b; - Complex *result = retval.fortran_vec (); - - octave_idx_type b_nc = b.cols (); - - job = 'N'; - F77_XFCN (zgetrs, ZGETRS, (F77_CONST_CHAR_ARG2 (&job, 1), - nr, b_nc, tmp_data, nr, - pipvt, result, b.rows(), info - F77_CHAR_ARG_LEN (1))); - - if (f77_exception_encountered) - (*current_liboctave_error_handler) - ("unrecoverable error in zgetrs"); - } - } - } - } - - return retval; + MatrixType mattype (*this); + return solve (b, info, rcond, sing_handler); } ComplexColumnVector @@ -1658,13 +2178,15 @@ } ComplexColumnVector -ComplexMatrix::solve (const ColumnVector& b, octave_idx_type& info, double& rcond) const +ComplexMatrix::solve (const ColumnVector& b, octave_idx_type& info, + double& rcond) const { return solve (ComplexColumnVector (b), info, rcond, 0); } ComplexColumnVector -ComplexMatrix::solve (const ColumnVector& b, octave_idx_type& info, double& rcond, +ComplexMatrix::solve (const ColumnVector& b, octave_idx_type& info, + double& rcond, solve_singularity_handler sing_handler) const { return solve (ComplexColumnVector (b), info, rcond, sing_handler); @@ -1697,100 +2219,8 @@ double& rcond, solve_singularity_handler sing_handler) const { - ComplexColumnVector retval; - - octave_idx_type nr = rows (); - octave_idx_type nc = cols (); - - if (nr == 0 || nc == 0 || nr != nc || nr != b.length ()) - (*current_liboctave_error_handler) - ("matrix dimension mismatch in solution of linear equations"); - else - { - info = 0; - - Array<octave_idx_type> ipvt (nr); - octave_idx_type *pipvt = ipvt.fortran_vec (); - - ComplexMatrix atmp = *this; - Complex *tmp_data = atmp.fortran_vec (); - - Array<Complex> z (2 * nc); - Complex *pz = z.fortran_vec (); - Array<double> rz (2 * nc); - double *prz = rz.fortran_vec (); - - // Calculate the norm of the matrix, for later use. - double anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); - - F77_XFCN (zgetrf, ZGETRF, (nr, nr, tmp_data, nr, pipvt, info)); - - if (f77_exception_encountered) - (*current_liboctave_error_handler) ("unrecoverable error in zgetrf"); - else - { - // Throw-away extra info LAPACK gives so as to not change output. - rcond = 0.0; - if (info != 0) - { - info = -2; - - if (sing_handler) - sing_handler (rcond); - else - (*current_liboctave_error_handler) - ("matrix singular to machine precision, rcond = %g", - rcond); - } - else - { - // Now calculate the condition number for non-singular matrix. - char job = '1'; - F77_XFCN (zgecon, ZGECON, (F77_CONST_CHAR_ARG2 (&job, 1), - nc, tmp_data, nr, anorm, - rcond, pz, prz, info - F77_CHAR_ARG_LEN (1))); - - if (f77_exception_encountered) - (*current_liboctave_error_handler) - ("unrecoverable error in zgecon"); - - if (info != 0) - info = -2; - - volatile double rcond_plus_one = rcond + 1.0; - - if (rcond_plus_one == 1.0 || xisnan (rcond)) - { - info = -2; - - if (sing_handler) - sing_handler (rcond); - else - (*current_liboctave_error_handler) - ("matrix singular to machine precision, rcond = %g", - rcond); - } - else - { - retval = b; - Complex *result = retval.fortran_vec (); - - job = 'N'; - F77_XFCN (zgetrs, ZGETRS, (F77_CONST_CHAR_ARG2 (&job, 1), - nr, 1, tmp_data, nr, pipvt, - result, b.length(), info - F77_CHAR_ARG_LEN (1))); - - if (f77_exception_encountered) - (*current_liboctave_error_handler) - ("unrecoverable error in zgetrs"); - - } - } - } - } - return retval; + MatrixType mattype (*this); + return solve (mattype, b, info, rcond, sing_handler); } ComplexMatrix
--- a/liboctave/CMatrix.h +++ b/liboctave/CMatrix.h @@ -26,6 +26,7 @@ #include "MArray2.h" #include "MDiagArray2.h" +#include "MatrixType.h" #include "mx-defs.h" #include "mx-op-defs.h" @@ -150,6 +151,66 @@ ComplexDET determinant (octave_idx_type& info) const; ComplexDET determinant (octave_idx_type& info, double& rcond, int calc_cond = 1) const; +private: + // Upper triangular matrix solvers + ComplexMatrix utsolve (MatrixType &typ, const ComplexMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; + + // Lower triangular matrix solvers + ComplexMatrix ltsolve (MatrixType &typ, const ComplexMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; + + // Full matrix solvers (umfpack/cholesky) + ComplexMatrix fsolve (MatrixType &typ, const ComplexMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool calc_cond = false) const; + +public: + // Generic interface to solver with no probing of type + ComplexMatrix solve (MatrixType &typ, const Matrix& b) const; + ComplexMatrix solve (MatrixType &typ, const Matrix& b, + octave_idx_type& info) const; + ComplexMatrix solve (MatrixType &typ, const Matrix& b, + octave_idx_type& info, double& rcond) const; + ComplexMatrix solve (MatrixType &typ, const Matrix& b, octave_idx_type& info, + double& rcond, solve_singularity_handler sing_handler, + bool singular_fallback = true) const; + + ComplexMatrix solve (MatrixType &typ, const ComplexMatrix& b) const; + ComplexMatrix solve (MatrixType &typ, const ComplexMatrix& b, + octave_idx_type& info) const; + ComplexMatrix solve (MatrixType &typ, const ComplexMatrix& b, + octave_idx_type& info, double& rcond) const; + ComplexMatrix solve (MatrixType &typ, const ComplexMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool singular_fallback = true) const; + + ComplexColumnVector solve (MatrixType &typ, const ColumnVector& b) const; + ComplexColumnVector solve (MatrixType &typ, const ColumnVector& b, + octave_idx_type& info) const; + ComplexColumnVector solve (MatrixType &typ, const ColumnVector& b, + octave_idx_type& info, double& rcond) const; + ComplexColumnVector solve (MatrixType &typ, const ColumnVector& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler) const; + + ComplexColumnVector solve (MatrixType &typ, + const ComplexColumnVector& b) const; + ComplexColumnVector solve (MatrixType &typ, const ComplexColumnVector& b, + octave_idx_type& info) const; + ComplexColumnVector solve (MatrixType &typ, const ComplexColumnVector& b, + octave_idx_type& info, double& rcond) const; + ComplexColumnVector solve (MatrixType &typ, const ComplexColumnVector& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler) const; + + // Generic interface to solver with probing of type ComplexMatrix solve (const Matrix& b) const; ComplexMatrix solve (const Matrix& b, octave_idx_type& info) const; ComplexMatrix solve (const Matrix& b, octave_idx_type& info, double& rcond) const;
--- a/liboctave/CSparse.cc +++ b/liboctave/CSparse.cc @@ -607,12 +607,12 @@ { octave_idx_type info; double rcond; - SparseType mattype (*this); + MatrixType mattype (*this); return inverse (mattype, info, rcond, 0, 0); } SparseComplexMatrix -SparseComplexMatrix::inverse (SparseType& mattype) const +SparseComplexMatrix::inverse (MatrixType& mattype) const { octave_idx_type info; double rcond; @@ -620,14 +620,14 @@ } SparseComplexMatrix -SparseComplexMatrix::inverse (SparseType& mattype, octave_idx_type& info) const +SparseComplexMatrix::inverse (MatrixType& mattype, octave_idx_type& info) const { double rcond; return inverse (mattype, info, rcond, 0, 0); } SparseComplexMatrix -SparseComplexMatrix::dinverse (SparseType &mattyp, octave_idx_type& info, +SparseComplexMatrix::dinverse (MatrixType &mattyp, octave_idx_type& info, double& rcond, const bool, const bool calccond) const { @@ -645,10 +645,10 @@ int typ = mattyp.type (); mattyp.info (); - if (typ == SparseType::Diagonal || - typ == SparseType::Permuted_Diagonal) + if (typ == MatrixType::Diagonal || + typ == MatrixType::Permuted_Diagonal) { - if (typ == SparseType::Permuted_Diagonal) + if (typ == MatrixType::Permuted_Diagonal) retval = transpose(); else retval = *this; @@ -681,7 +681,7 @@ } SparseComplexMatrix -SparseComplexMatrix::tinverse (SparseType &mattyp, octave_idx_type& info, +SparseComplexMatrix::tinverse (MatrixType &mattyp, octave_idx_type& info, double& rcond, const bool, const bool calccond) const { @@ -699,8 +699,8 @@ int typ = mattyp.type (); mattyp.info (); - if (typ == SparseType::Upper || typ == SparseType::Permuted_Upper || - typ == SparseType::Lower || typ == SparseType::Permuted_Lower) + if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper || + typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) { double anorm = 0.; double ainvnorm = 0.; @@ -718,7 +718,7 @@ } } - if (typ == SparseType::Upper || typ == SparseType::Lower) + if (typ == MatrixType::Upper || typ == MatrixType::Lower) { octave_idx_type nz = nnz (); octave_idx_type cx = 0; @@ -814,7 +814,7 @@ OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nr); octave_idx_type *perm = mattyp.triangular_perm(); - if (typ == SparseType::Permuted_Upper) + if (typ == MatrixType::Permuted_Upper) { for (octave_idx_type i = 0; i < nr; i++) rperm[perm[i]] = i; @@ -919,26 +919,26 @@ } SparseComplexMatrix -SparseComplexMatrix::inverse (SparseType& mattype, octave_idx_type& info, +SparseComplexMatrix::inverse (MatrixType& mattype, octave_idx_type& info, double& rcond, int, int calc_cond) const { int typ = mattype.type (false); SparseComplexMatrix ret; - if (typ == SparseType::Unknown) + if (typ == MatrixType::Unknown) typ = mattype.type (*this); - if (typ == SparseType::Diagonal || typ == SparseType::Permuted_Diagonal) + if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) ret = dinverse (mattype, info, rcond, true, calc_cond); - else if (typ == SparseType::Upper || typ == SparseType::Permuted_Upper) + else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) ret = tinverse (mattype, info, rcond, true, calc_cond).transpose(); - else if (typ == SparseType::Lower || typ == SparseType::Permuted_Lower) + else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) ret = transpose().tinverse (mattype, info, rcond, true, calc_cond); - else if (typ != SparseType::Rectangular) + else if (typ != MatrixType::Rectangular) { if (mattype.is_hermitian()) { - SparseType tmp_typ (SparseType::Upper); + MatrixType tmp_typ (MatrixType::Upper); SparseComplexCHOL fact (*this, info, false); rcond = fact.rcond(); if (info == 0) @@ -953,7 +953,7 @@ { // Matrix is either singular or not positive definite mattype.mark_as_unsymmetric (); - typ = SparseType::Full; + typ = MatrixType::Full; } } @@ -964,7 +964,7 @@ for (octave_idx_type i = 0; i < n; i++) Qinit(i) = i; - SparseType tmp_typ (SparseType::Upper); + MatrixType tmp_typ (MatrixType::Upper); SparseComplexLU fact (*this, Qinit, -1.0, false); rcond = fact.rcond(); double rcond2; @@ -1125,7 +1125,7 @@ } ComplexMatrix -SparseComplexMatrix::dsolve (SparseType &mattype, const Matrix& b, +SparseComplexMatrix::dsolve (MatrixType &mattype, const Matrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler, bool calc_cond) const { @@ -1145,11 +1145,11 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Diagonal || - typ == SparseType::Permuted_Diagonal) + if (typ == MatrixType::Diagonal || + typ == MatrixType::Permuted_Diagonal) { retval.resize (nc, b.cols(), Complex(0.,0.)); - if (typ == SparseType::Diagonal) + if (typ == MatrixType::Diagonal) for (octave_idx_type j = 0; j < b.cols(); j++) for (octave_idx_type i = 0; i < nm; i++) retval(i,j) = b(i,j) / data (i); @@ -1183,7 +1183,7 @@ } SparseComplexMatrix -SparseComplexMatrix::dsolve (SparseType &mattype, const SparseMatrix& b, +SparseComplexMatrix::dsolve (MatrixType &mattype, const SparseMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler, bool calc_cond) const @@ -1204,8 +1204,8 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Diagonal || - typ == SparseType::Permuted_Diagonal) + if (typ == MatrixType::Diagonal || + typ == MatrixType::Permuted_Diagonal) { octave_idx_type b_nc = b.cols (); octave_idx_type b_nz = b.nnz (); @@ -1213,7 +1213,7 @@ retval.xcidx(0) = 0; octave_idx_type ii = 0; - if (typ == SparseType::Diagonal) + if (typ == MatrixType::Diagonal) for (octave_idx_type j = 0; j < b.cols(); j++) { for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) @@ -1272,7 +1272,7 @@ } ComplexMatrix -SparseComplexMatrix::dsolve (SparseType &mattype, const ComplexMatrix& b, +SparseComplexMatrix::dsolve (MatrixType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler, bool calc_cond) const @@ -1293,11 +1293,11 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Diagonal || - typ == SparseType::Permuted_Diagonal) + if (typ == MatrixType::Diagonal || + typ == MatrixType::Permuted_Diagonal) { retval.resize (nc, b.cols(), Complex(0.,0.)); - if (typ == SparseType::Diagonal) + if (typ == MatrixType::Diagonal) for (octave_idx_type j = 0; j < b.cols(); j++) for (octave_idx_type i = 0; i < nm; i++) retval(i,j) = b(i,j) / data (i); @@ -1331,7 +1331,7 @@ } SparseComplexMatrix -SparseComplexMatrix::dsolve (SparseType &mattype, const SparseComplexMatrix& b, +SparseComplexMatrix::dsolve (MatrixType &mattype, const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler, bool calc_cond) const @@ -1352,8 +1352,8 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Diagonal || - typ == SparseType::Permuted_Diagonal) + if (typ == MatrixType::Diagonal || + typ == MatrixType::Permuted_Diagonal) { octave_idx_type b_nc = b.cols (); octave_idx_type b_nz = b.nnz (); @@ -1361,7 +1361,7 @@ retval.xcidx(0) = 0; octave_idx_type ii = 0; - if (typ == SparseType::Diagonal) + if (typ == MatrixType::Diagonal) for (octave_idx_type j = 0; j < b.cols(); j++) { for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) @@ -1420,7 +1420,7 @@ } ComplexMatrix -SparseComplexMatrix::utsolve (SparseType &mattype, const Matrix& b, +SparseComplexMatrix::utsolve (MatrixType &mattype, const Matrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -1441,8 +1441,8 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Permuted_Upper || - typ == SparseType::Upper) + if (typ == MatrixType::Permuted_Upper || + typ == MatrixType::Upper) { double anorm = 0.; double ainvnorm = 0.; @@ -1462,7 +1462,7 @@ } } - if (typ == SparseType::Permuted_Upper) + if (typ == MatrixType::Permuted_Upper) { retval.resize (nc, b_nc); octave_idx_type *perm = mattype.triangular_perm (); @@ -1654,7 +1654,7 @@ } SparseComplexMatrix -SparseComplexMatrix::utsolve (SparseType &mattype, const SparseMatrix& b, +SparseComplexMatrix::utsolve (MatrixType &mattype, const SparseMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -1675,8 +1675,8 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Permuted_Upper || - typ == SparseType::Upper) + if (typ == MatrixType::Permuted_Upper || + typ == MatrixType::Upper) { double anorm = 0.; double ainvnorm = 0.; @@ -1702,7 +1702,7 @@ octave_idx_type ii = 0; octave_idx_type x_nz = b_nz; - if (typ == SparseType::Permuted_Upper) + if (typ == MatrixType::Permuted_Upper) { octave_idx_type *perm = mattype.triangular_perm (); OCTAVE_LOCAL_BUFFER (Complex, work, nm); @@ -1939,7 +1939,7 @@ } ComplexMatrix -SparseComplexMatrix::utsolve (SparseType &mattype, const ComplexMatrix& b, +SparseComplexMatrix::utsolve (MatrixType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -1960,8 +1960,8 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Permuted_Upper || - typ == SparseType::Upper) + if (typ == MatrixType::Permuted_Upper || + typ == MatrixType::Upper) { double anorm = 0.; double ainvnorm = 0.; @@ -1981,7 +1981,7 @@ } } - if (typ == SparseType::Permuted_Upper) + if (typ == MatrixType::Permuted_Upper) { retval.resize (nc, b_nc); octave_idx_type *perm = mattype.triangular_perm (); @@ -2173,7 +2173,7 @@ } SparseComplexMatrix -SparseComplexMatrix::utsolve (SparseType &mattype, const SparseComplexMatrix& b, +SparseComplexMatrix::utsolve (MatrixType &mattype, const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -2194,8 +2194,8 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Permuted_Upper || - typ == SparseType::Upper) + if (typ == MatrixType::Permuted_Upper || + typ == MatrixType::Upper) { double anorm = 0.; double ainvnorm = 0.; @@ -2221,7 +2221,7 @@ octave_idx_type ii = 0; octave_idx_type x_nz = b_nz; - if (typ == SparseType::Permuted_Upper) + if (typ == MatrixType::Permuted_Upper) { octave_idx_type *perm = mattype.triangular_perm (); OCTAVE_LOCAL_BUFFER (Complex, work, nm); @@ -2459,7 +2459,7 @@ } ComplexMatrix -SparseComplexMatrix::ltsolve (SparseType &mattype, const Matrix& b, +SparseComplexMatrix::ltsolve (MatrixType &mattype, const Matrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -2480,8 +2480,8 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Permuted_Lower || - typ == SparseType::Lower) + if (typ == MatrixType::Permuted_Lower || + typ == MatrixType::Lower) { double anorm = 0.; double ainvnorm = 0.; @@ -2501,7 +2501,7 @@ } } - if (typ == SparseType::Permuted_Lower) + if (typ == MatrixType::Permuted_Lower) { retval.resize (nc, b_nc); OCTAVE_LOCAL_BUFFER (Complex, work, nm); @@ -2713,7 +2713,7 @@ } SparseComplexMatrix -SparseComplexMatrix::ltsolve (SparseType &mattype, const SparseMatrix& b, +SparseComplexMatrix::ltsolve (MatrixType &mattype, const SparseMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -2735,8 +2735,8 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Permuted_Lower || - typ == SparseType::Lower) + if (typ == MatrixType::Permuted_Lower || + typ == MatrixType::Lower) { double anorm = 0.; double ainvnorm = 0.; @@ -2762,7 +2762,7 @@ octave_idx_type ii = 0; octave_idx_type x_nz = b_nz; - if (typ == SparseType::Permuted_Lower) + if (typ == MatrixType::Permuted_Lower) { OCTAVE_LOCAL_BUFFER (Complex, work, nm); octave_idx_type *perm = mattype.triangular_perm (); @@ -3019,7 +3019,7 @@ } ComplexMatrix -SparseComplexMatrix::ltsolve (SparseType &mattype, const ComplexMatrix& b, +SparseComplexMatrix::ltsolve (MatrixType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -3040,8 +3040,8 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Permuted_Lower || - typ == SparseType::Lower) + if (typ == MatrixType::Permuted_Lower || + typ == MatrixType::Lower) { double anorm = 0.; double ainvnorm = 0.; @@ -3061,7 +3061,7 @@ } } - if (typ == SparseType::Permuted_Lower) + if (typ == MatrixType::Permuted_Lower) { retval.resize (nc, b_nc); OCTAVE_LOCAL_BUFFER (Complex, work, nm); @@ -3277,7 +3277,7 @@ } SparseComplexMatrix -SparseComplexMatrix::ltsolve (SparseType &mattype, const SparseComplexMatrix& b, +SparseComplexMatrix::ltsolve (MatrixType &mattype, const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -3298,8 +3298,8 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Permuted_Lower || - typ == SparseType::Lower) + if (typ == MatrixType::Permuted_Lower || + typ == MatrixType::Lower) { double anorm = 0.; double ainvnorm = 0.; @@ -3325,7 +3325,7 @@ octave_idx_type ii = 0; octave_idx_type x_nz = b_nz; - if (typ == SparseType::Permuted_Lower) + if (typ == MatrixType::Permuted_Lower) { OCTAVE_LOCAL_BUFFER (Complex, work, nm); octave_idx_type *perm = mattype.triangular_perm (); @@ -3582,7 +3582,7 @@ } ComplexMatrix -SparseComplexMatrix::trisolve (SparseType &mattype, const Matrix& b, +SparseComplexMatrix::trisolve (MatrixType &mattype, const Matrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -3605,7 +3605,7 @@ volatile int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Tridiagonal_Hermitian) + if (typ == MatrixType::Tridiagonal_Hermitian) { OCTAVE_LOCAL_BUFFER (double, D, nr); OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); @@ -3655,13 +3655,13 @@ { err = 0; mattype.mark_as_unsymmetric (); - typ = SparseType::Tridiagonal; + typ = MatrixType::Tridiagonal; } else rcond = 1.; } - if (typ == SparseType::Tridiagonal) + if (typ == MatrixType::Tridiagonal) { OCTAVE_LOCAL_BUFFER (Complex, DU, nr - 1); OCTAVE_LOCAL_BUFFER (Complex, D, nr); @@ -3729,7 +3729,7 @@ else rcond = 1.; } - else if (typ != SparseType::Tridiagonal_Hermitian) + else if (typ != MatrixType::Tridiagonal_Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -3737,7 +3737,7 @@ } SparseComplexMatrix -SparseComplexMatrix::trisolve (SparseType &mattype, const SparseMatrix& b, +SparseComplexMatrix::trisolve (MatrixType &mattype, const SparseMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -3761,8 +3761,8 @@ mattype.info (); // Note can't treat symmetric case as there is no dpttrf function - if (typ == SparseType::Tridiagonal || - typ == SparseType::Tridiagonal_Hermitian) + if (typ == MatrixType::Tridiagonal || + typ == MatrixType::Tridiagonal_Hermitian) { OCTAVE_LOCAL_BUFFER (Complex, DU2, nr - 2); OCTAVE_LOCAL_BUFFER (Complex, DU, nr - 1); @@ -3887,7 +3887,7 @@ } } } - else if (typ != SparseType::Tridiagonal_Hermitian) + else if (typ != MatrixType::Tridiagonal_Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -3895,7 +3895,7 @@ } ComplexMatrix -SparseComplexMatrix::trisolve (SparseType &mattype, const ComplexMatrix& b, +SparseComplexMatrix::trisolve (MatrixType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -3918,7 +3918,7 @@ volatile int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Tridiagonal_Hermitian) + if (typ == MatrixType::Tridiagonal_Hermitian) { OCTAVE_LOCAL_BUFFER (double, D, nr); OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); @@ -3974,11 +3974,11 @@ { err = 0; mattype.mark_as_unsymmetric (); - typ = SparseType::Tridiagonal; + typ = MatrixType::Tridiagonal; } } - if (typ == SparseType::Tridiagonal) + if (typ == MatrixType::Tridiagonal) { OCTAVE_LOCAL_BUFFER (Complex, DU, nr - 1); OCTAVE_LOCAL_BUFFER (Complex, D, nr); @@ -4049,7 +4049,7 @@ ("matrix singular to machine precision"); } } - else if (typ != SparseType::Tridiagonal_Hermitian) + else if (typ != MatrixType::Tridiagonal_Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -4057,7 +4057,7 @@ } SparseComplexMatrix -SparseComplexMatrix::trisolve (SparseType &mattype, +SparseComplexMatrix::trisolve (MatrixType &mattype, const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, @@ -4082,8 +4082,8 @@ mattype.info (); // Note can't treat symmetric case as there is no dpttrf function - if (typ == SparseType::Tridiagonal || - typ == SparseType::Tridiagonal_Hermitian) + if (typ == MatrixType::Tridiagonal || + typ == MatrixType::Tridiagonal_Hermitian) { OCTAVE_LOCAL_BUFFER (Complex, DU2, nr - 2); OCTAVE_LOCAL_BUFFER (Complex, DU, nr - 1); @@ -4219,7 +4219,7 @@ } } } - else if (typ != SparseType::Tridiagonal_Hermitian) + else if (typ != MatrixType::Tridiagonal_Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -4227,7 +4227,7 @@ } ComplexMatrix -SparseComplexMatrix::bsolve (SparseType &mattype, const Matrix& b, +SparseComplexMatrix::bsolve (MatrixType &mattype, const Matrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -4247,7 +4247,7 @@ volatile int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Banded_Hermitian) + if (typ == MatrixType::Banded_Hermitian) { octave_idx_type n_lower = mattype.nlower (); octave_idx_type ldm = n_lower + 1; @@ -4292,7 +4292,7 @@ // Matrix is not positive definite!! Fall through to // unsymmetric banded solver. mattype.mark_as_unsymmetric (); - typ = SparseType::Banded; + typ = MatrixType::Banded; err = 0; } else @@ -4365,7 +4365,7 @@ } } - if (typ == SparseType::Banded) + if (typ == MatrixType::Banded) { // Create the storage for the banded form of the sparse matrix octave_idx_type n_upper = mattype.nupper (); @@ -4493,7 +4493,7 @@ } } } - else if (typ != SparseType::Banded_Hermitian) + else if (typ != MatrixType::Banded_Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -4501,7 +4501,7 @@ } SparseComplexMatrix -SparseComplexMatrix::bsolve (SparseType &mattype, const SparseMatrix& b, +SparseComplexMatrix::bsolve (MatrixType &mattype, const SparseMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -4521,7 +4521,7 @@ volatile int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Banded_Hermitian) + if (typ == MatrixType::Banded_Hermitian) { octave_idx_type n_lower = mattype.nlower (); octave_idx_type ldm = n_lower + 1; @@ -4565,7 +4565,7 @@ { rcond = 0.0; mattype.mark_as_unsymmetric (); - typ = SparseType::Banded; + typ = MatrixType::Banded; err = 0; } else @@ -4677,7 +4677,7 @@ } } - if (typ == SparseType::Banded) + if (typ == MatrixType::Banded) { // Create the storage for the banded form of the sparse matrix octave_idx_type n_upper = mattype.nupper (); @@ -4844,7 +4844,7 @@ } } } - else if (typ != SparseType::Banded_Hermitian) + else if (typ != MatrixType::Banded_Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -4852,7 +4852,7 @@ } ComplexMatrix -SparseComplexMatrix::bsolve (SparseType &mattype, const ComplexMatrix& b, +SparseComplexMatrix::bsolve (MatrixType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -4872,7 +4872,7 @@ volatile int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Banded_Hermitian) + if (typ == MatrixType::Banded_Hermitian) { octave_idx_type n_lower = mattype.nlower (); octave_idx_type ldm = n_lower + 1; @@ -4918,7 +4918,7 @@ // unsymmetric banded solver. rcond = 0.0; mattype.mark_as_unsymmetric (); - typ = SparseType::Banded; + typ = MatrixType::Banded; err = 0; } else @@ -4994,7 +4994,7 @@ } } - if (typ == SparseType::Banded) + if (typ == MatrixType::Banded) { // Create the storage for the banded form of the sparse matrix octave_idx_type n_upper = mattype.nupper (); @@ -5121,7 +5121,7 @@ } } } - else if (typ != SparseType::Banded_Hermitian) + else if (typ != MatrixType::Banded_Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -5129,7 +5129,7 @@ } SparseComplexMatrix -SparseComplexMatrix::bsolve (SparseType &mattype, const SparseComplexMatrix& b, +SparseComplexMatrix::bsolve (MatrixType &mattype, const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -5149,7 +5149,7 @@ volatile int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Banded_Hermitian) + if (typ == MatrixType::Banded_Hermitian) { octave_idx_type n_lower = mattype.nlower (); octave_idx_type ldm = n_lower + 1; @@ -5194,7 +5194,7 @@ // Matrix is not positive definite!! Fall through to // unsymmetric banded solver. mattype.mark_as_unsymmetric (); - typ = SparseType::Banded; + typ = MatrixType::Banded; rcond = 0.0; err = 0; @@ -5313,7 +5313,7 @@ } } - if (typ == SparseType::Banded) + if (typ == MatrixType::Banded) { // Create the storage for the banded form of the sparse matrix octave_idx_type n_upper = mattype.nupper (); @@ -5481,7 +5481,7 @@ } } } - else if (typ != SparseType::Banded_Hermitian) + else if (typ != MatrixType::Banded_Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -5605,7 +5605,7 @@ } ComplexMatrix -SparseComplexMatrix::fsolve (SparseType &mattype, const Matrix& b, +SparseComplexMatrix::fsolve (MatrixType &mattype, const Matrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -5625,7 +5625,7 @@ volatile int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Hermitian) + if (typ == MatrixType::Hermitian) { #ifdef HAVE_CHOLMOD cholmod_common Common; @@ -5724,7 +5724,7 @@ { // Either its indefinite or singular. Try UMFPACK mattype.mark_as_unsymmetric (); - typ = SparseType::Full; + typ = MatrixType::Full; } else { @@ -5772,11 +5772,11 @@ ("CHOLMOD not installed"); mattype.mark_as_unsymmetric (); - typ = SparseType::Full; + typ = MatrixType::Full; #endif } - if (typ == SparseType::Full) + if (typ == MatrixType::Full) { #ifdef HAVE_UMFPACK Matrix Control, Info; @@ -5854,7 +5854,7 @@ (*current_liboctave_error_handler) ("UMFPACK not installed"); #endif } - else if (typ != SparseType::Hermitian) + else if (typ != MatrixType::Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -5862,7 +5862,7 @@ } SparseComplexMatrix -SparseComplexMatrix::fsolve (SparseType &mattype, const SparseMatrix& b, +SparseComplexMatrix::fsolve (MatrixType &mattype, const SparseMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -5882,7 +5882,7 @@ volatile int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Hermitian) + if (typ == MatrixType::Hermitian) { #ifdef HAVE_CHOLMOD cholmod_common Common; @@ -5994,7 +5994,7 @@ { // Either its indefinite or singular. Try UMFPACK mattype.mark_as_unsymmetric (); - typ = SparseType::Full; + typ = MatrixType::Full; } else { @@ -6048,11 +6048,11 @@ ("CHOLMOD not installed"); mattype.mark_as_unsymmetric (); - typ = SparseType::Full; + typ = MatrixType::Full; #endif } - if (typ == SparseType::Full) + if (typ == MatrixType::Full) { #ifdef HAVE_UMFPACK Matrix Control, Info; @@ -6162,7 +6162,7 @@ (*current_liboctave_error_handler) ("UMFPACK not installed"); #endif } - else if (typ != SparseType::Hermitian) + else if (typ != MatrixType::Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -6170,7 +6170,7 @@ } ComplexMatrix -SparseComplexMatrix::fsolve (SparseType &mattype, const ComplexMatrix& b, +SparseComplexMatrix::fsolve (MatrixType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -6190,7 +6190,7 @@ volatile int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Hermitian) + if (typ == MatrixType::Hermitian) { #ifdef HAVE_CHOLMOD cholmod_common Common; @@ -6292,7 +6292,7 @@ { // Either its indefinite or singular. Try UMFPACK mattype.mark_as_unsymmetric (); - typ = SparseType::Full; + typ = MatrixType::Full; } else { @@ -6340,11 +6340,11 @@ ("CHOLMOD not installed"); mattype.mark_as_unsymmetric (); - typ = SparseType::Full; + typ = MatrixType::Full; #endif } - if (typ == SparseType::Full) + if (typ == MatrixType::Full) { #ifdef HAVE_UMFPACK Matrix Control, Info; @@ -6401,7 +6401,7 @@ (*current_liboctave_error_handler) ("UMFPACK not installed"); #endif } - else if (typ != SparseType::Hermitian) + else if (typ != MatrixType::Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -6409,7 +6409,7 @@ } SparseComplexMatrix -SparseComplexMatrix::fsolve (SparseType &mattype, const SparseComplexMatrix& b, +SparseComplexMatrix::fsolve (MatrixType &mattype, const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -6429,7 +6429,7 @@ volatile int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Hermitian) + if (typ == MatrixType::Hermitian) { #ifdef HAVE_CHOLMOD cholmod_common Common; @@ -6541,7 +6541,7 @@ { // Either its indefinite or singular. Try UMFPACK mattype.mark_as_unsymmetric (); - typ = SparseType::Full; + typ = MatrixType::Full; } else { @@ -6595,11 +6595,11 @@ ("CHOLMOD not installed"); mattype.mark_as_unsymmetric (); - typ = SparseType::Full; + typ = MatrixType::Full; #endif } - if (typ == SparseType::Full) + if (typ == MatrixType::Full) { #ifdef HAVE_UMFPACK Matrix Control, Info; @@ -6704,7 +6704,7 @@ (*current_liboctave_error_handler) ("UMFPACK not installed"); #endif } - else if (typ != SparseType::Hermitian) + else if (typ != MatrixType::Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -6712,7 +6712,7 @@ } ComplexMatrix -SparseComplexMatrix::solve (SparseType &mattype, const Matrix& b) const +SparseComplexMatrix::solve (MatrixType &mattype, const Matrix& b) const { octave_idx_type info; double rcond; @@ -6720,7 +6720,7 @@ } ComplexMatrix -SparseComplexMatrix::solve (SparseType &mattype, const Matrix& b, +SparseComplexMatrix::solve (MatrixType &mattype, const Matrix& b, octave_idx_type& info) const { double rcond; @@ -6728,14 +6728,14 @@ } ComplexMatrix -SparseComplexMatrix::solve (SparseType &mattype, const Matrix& b, +SparseComplexMatrix::solve (MatrixType &mattype, const Matrix& b, octave_idx_type& info, double& rcond) const { return solve (mattype, b, info, rcond, 0); } ComplexMatrix -SparseComplexMatrix::solve (SparseType &mattype, const Matrix& b, +SparseComplexMatrix::solve (MatrixType &mattype, const Matrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool singular_fallback) const @@ -6743,29 +6743,29 @@ ComplexMatrix retval; int typ = mattype.type (false); - if (typ == SparseType::Unknown) + if (typ == MatrixType::Unknown) typ = mattype.type (*this); - if (typ == SparseType::Diagonal || typ == SparseType::Permuted_Diagonal) + if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) retval = dsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Upper || typ == SparseType::Permuted_Upper) + else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) retval = utsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Lower || typ == SparseType::Permuted_Lower) + else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) retval = ltsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Banded || typ == SparseType::Banded_Hermitian) + else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) retval = bsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Tridiagonal || - typ == SparseType::Tridiagonal_Hermitian) + else if (typ == MatrixType::Tridiagonal || + typ == MatrixType::Tridiagonal_Hermitian) retval = trisolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Full || typ == SparseType::Hermitian) + else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) retval = fsolve (mattype, b, err, rcond, sing_handler, true); - else if (typ != SparseType::Rectangular) + else if (typ != MatrixType::Rectangular) { (*current_liboctave_error_handler) ("unknown matrix type"); return ComplexMatrix (); } - if (singular_fallback && mattype.type(false) == SparseType::Rectangular) + if (singular_fallback && mattype.type(false) == MatrixType::Rectangular) { rcond = 1.; #ifdef USE_QRSOLVE @@ -6780,7 +6780,7 @@ } SparseComplexMatrix -SparseComplexMatrix::solve (SparseType &mattype, const SparseMatrix& b) const +SparseComplexMatrix::solve (MatrixType &mattype, const SparseMatrix& b) const { octave_idx_type info; double rcond; @@ -6788,7 +6788,7 @@ } SparseComplexMatrix -SparseComplexMatrix::solve (SparseType &mattype, const SparseMatrix& b, +SparseComplexMatrix::solve (MatrixType &mattype, const SparseMatrix& b, octave_idx_type& info) const { double rcond; @@ -6796,14 +6796,14 @@ } SparseComplexMatrix -SparseComplexMatrix::solve (SparseType &mattype, const SparseMatrix& b, +SparseComplexMatrix::solve (MatrixType &mattype, const SparseMatrix& b, octave_idx_type& info, double& rcond) const { return solve (mattype, b, info, rcond, 0); } SparseComplexMatrix -SparseComplexMatrix::solve (SparseType &mattype, const SparseMatrix& b, +SparseComplexMatrix::solve (MatrixType &mattype, const SparseMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool singular_fallback) const @@ -6811,29 +6811,29 @@ SparseComplexMatrix retval; int typ = mattype.type (false); - if (typ == SparseType::Unknown) + if (typ == MatrixType::Unknown) typ = mattype.type (*this); - if (typ == SparseType::Diagonal || typ == SparseType::Permuted_Diagonal) + if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) retval = dsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Upper || typ == SparseType::Permuted_Upper) + else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) retval = utsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Lower || typ == SparseType::Permuted_Lower) + else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) retval = ltsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Banded || typ == SparseType::Banded_Hermitian) + else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) retval = bsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Tridiagonal || - typ == SparseType::Tridiagonal_Hermitian) + else if (typ == MatrixType::Tridiagonal || + typ == MatrixType::Tridiagonal_Hermitian) retval = trisolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Full || typ == SparseType::Hermitian) + else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) retval = fsolve (mattype, b, err, rcond, sing_handler, true); - else if (typ != SparseType::Rectangular) + else if (typ != MatrixType::Rectangular) { (*current_liboctave_error_handler) ("unknown matrix type"); return SparseComplexMatrix (); } - if (singular_fallback && mattype.type(false) == SparseType::Rectangular) + if (singular_fallback && mattype.type(false) == MatrixType::Rectangular) { rcond = 1.; #ifdef USE_QRSOLVE @@ -6848,7 +6848,7 @@ } ComplexMatrix -SparseComplexMatrix::solve (SparseType &mattype, const ComplexMatrix& b) const +SparseComplexMatrix::solve (MatrixType &mattype, const ComplexMatrix& b) const { octave_idx_type info; double rcond; @@ -6856,7 +6856,7 @@ } ComplexMatrix -SparseComplexMatrix::solve (SparseType &mattype, const ComplexMatrix& b, +SparseComplexMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, octave_idx_type& info) const { double rcond; @@ -6864,14 +6864,14 @@ } ComplexMatrix -SparseComplexMatrix::solve (SparseType &mattype, const ComplexMatrix& b, +SparseComplexMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, octave_idx_type& info, double& rcond) const { return solve (mattype, b, info, rcond, 0); } ComplexMatrix -SparseComplexMatrix::solve (SparseType &mattype, const ComplexMatrix& b, +SparseComplexMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool singular_fallback) const @@ -6879,29 +6879,29 @@ ComplexMatrix retval; int typ = mattype.type (false); - if (typ == SparseType::Unknown) + if (typ == MatrixType::Unknown) typ = mattype.type (*this); - if (typ == SparseType::Diagonal || typ == SparseType::Permuted_Diagonal) + if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) retval = dsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Upper || typ == SparseType::Permuted_Upper) + else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) retval = utsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Lower || typ == SparseType::Permuted_Lower) + else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) retval = ltsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Banded || typ == SparseType::Banded_Hermitian) + else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) retval = bsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Tridiagonal || - typ == SparseType::Tridiagonal_Hermitian) + else if (typ == MatrixType::Tridiagonal || + typ == MatrixType::Tridiagonal_Hermitian) retval = trisolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Full || typ == SparseType::Hermitian) + else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) retval = fsolve (mattype, b, err, rcond, sing_handler, true); - else if (typ != SparseType::Rectangular) + else if (typ != MatrixType::Rectangular) { (*current_liboctave_error_handler) ("unknown matrix type"); return ComplexMatrix (); } - if (singular_fallback && mattype.type(false) == SparseType::Rectangular) + if (singular_fallback && mattype.type(false) == MatrixType::Rectangular) { rcond = 1.; #ifdef USE_QRSOLVE @@ -6916,7 +6916,7 @@ } SparseComplexMatrix -SparseComplexMatrix::solve (SparseType &mattype, +SparseComplexMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b) const { octave_idx_type info; @@ -6925,7 +6925,7 @@ } SparseComplexMatrix -SparseComplexMatrix::solve (SparseType &mattype, const SparseComplexMatrix& b, +SparseComplexMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b, octave_idx_type& info) const { double rcond; @@ -6933,14 +6933,14 @@ } SparseComplexMatrix -SparseComplexMatrix::solve (SparseType &mattype, const SparseComplexMatrix& b, +SparseComplexMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond) const { return solve (mattype, b, info, rcond, 0); } SparseComplexMatrix -SparseComplexMatrix::solve (SparseType &mattype, const SparseComplexMatrix& b, +SparseComplexMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool singular_fallback) const @@ -6948,29 +6948,29 @@ SparseComplexMatrix retval; int typ = mattype.type (false); - if (typ == SparseType::Unknown) + if (typ == MatrixType::Unknown) typ = mattype.type (*this); - if (typ == SparseType::Diagonal || typ == SparseType::Permuted_Diagonal) + if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) retval = dsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Upper || typ == SparseType::Permuted_Upper) + else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) retval = utsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Lower || typ == SparseType::Permuted_Lower) + else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) retval = ltsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Banded || typ == SparseType::Banded_Hermitian) + else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) retval = bsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Tridiagonal || - typ == SparseType::Tridiagonal_Hermitian) + else if (typ == MatrixType::Tridiagonal || + typ == MatrixType::Tridiagonal_Hermitian) retval = trisolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Full || typ == SparseType::Hermitian) + else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) retval = fsolve (mattype, b, err, rcond, sing_handler, true); - else if (typ != SparseType::Rectangular) + else if (typ != MatrixType::Rectangular) { (*current_liboctave_error_handler) ("unknown matrix type"); return SparseComplexMatrix (); } - if (singular_fallback && mattype.type(false) == SparseType::Rectangular) + if (singular_fallback && mattype.type(false) == MatrixType::Rectangular) { rcond = 1.; #ifdef USE_QRSOLVE @@ -6985,14 +6985,14 @@ } ComplexColumnVector -SparseComplexMatrix::solve (SparseType &mattype, const ColumnVector& b) const +SparseComplexMatrix::solve (MatrixType &mattype, const ColumnVector& b) const { octave_idx_type info; double rcond; return solve (mattype, b, info, rcond); } ComplexColumnVector -SparseComplexMatrix::solve (SparseType &mattype, const ColumnVector& b, +SparseComplexMatrix::solve (MatrixType &mattype, const ColumnVector& b, octave_idx_type& info) const { double rcond; @@ -7000,14 +7000,14 @@ } ComplexColumnVector -SparseComplexMatrix::solve (SparseType &mattype, const ColumnVector& b, +SparseComplexMatrix::solve (MatrixType &mattype, const ColumnVector& b, octave_idx_type& info, double& rcond) const { return solve (mattype, b, info, rcond, 0); } ComplexColumnVector -SparseComplexMatrix::solve (SparseType &mattype, const ColumnVector& b, +SparseComplexMatrix::solve (MatrixType &mattype, const ColumnVector& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler) const { @@ -7016,7 +7016,7 @@ } ComplexColumnVector -SparseComplexMatrix::solve (SparseType &mattype, +SparseComplexMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b) const { octave_idx_type info; @@ -7025,7 +7025,7 @@ } ComplexColumnVector -SparseComplexMatrix::solve (SparseType &mattype, const ComplexColumnVector& b, +SparseComplexMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, octave_idx_type& info) const { double rcond; @@ -7033,14 +7033,14 @@ } ComplexColumnVector -SparseComplexMatrix::solve (SparseType &mattype, const ComplexColumnVector& b, +SparseComplexMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, octave_idx_type& info, double& rcond) const { return solve (mattype, b, info, rcond, 0); } ComplexColumnVector -SparseComplexMatrix::solve (SparseType &mattype, const ComplexColumnVector& b, +SparseComplexMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler) const { @@ -7075,7 +7075,7 @@ double& rcond, solve_singularity_handler sing_handler) const { - SparseType mattype (*this); + MatrixType mattype (*this); return solve (mattype, b, err, rcond, sing_handler); } @@ -7107,7 +7107,7 @@ octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler) const { - SparseType mattype (*this); + MatrixType mattype (*this); return solve (mattype, b, err, rcond, sing_handler); } @@ -7131,7 +7131,7 @@ octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler) const { - SparseType mattype (*this); + MatrixType mattype (*this); return solve (mattype, b, err, rcond, sing_handler); } @@ -7163,7 +7163,7 @@ octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler) const { - SparseType mattype (*this); + MatrixType mattype (*this); return solve (mattype, b, err, rcond, sing_handler); }
--- a/liboctave/CSparse.h +++ b/liboctave/CSparse.h @@ -34,7 +34,7 @@ #include "MSparse.h" #include "MSparse-defs.h" #include "Sparse-op-defs.h" -#include "SparseType.h" +#include "MatrixType.h" class SparseMatrix; class SparseBoolMatrix; @@ -121,20 +121,20 @@ friend SparseComplexMatrix conj (const SparseComplexMatrix& a); private: - SparseComplexMatrix dinverse (SparseType &mattyp, octave_idx_type& info, + SparseComplexMatrix dinverse (MatrixType &mattyp, octave_idx_type& info, double& rcond, const bool force = false, const bool calccond = true) const; - SparseComplexMatrix tinverse (SparseType &mattyp, octave_idx_type& info, + SparseComplexMatrix tinverse (MatrixType &mattyp, octave_idx_type& info, double& rcond, const bool force = false, const bool calccond = true) const; public: SparseComplexMatrix inverse (void) const; - SparseComplexMatrix inverse (SparseType& mattype) const; - SparseComplexMatrix inverse (SparseType& mattype, + SparseComplexMatrix inverse (MatrixType& mattype) const; + SparseComplexMatrix inverse (MatrixType& mattype, octave_idx_type& info) const; - SparseComplexMatrix inverse (SparseType& mattype, octave_idx_type& info, + SparseComplexMatrix inverse (MatrixType& mattype, octave_idx_type& info, double& rcond, int force = 0, int calc_cond = 1) const; @@ -145,103 +145,103 @@ private: // Diagonal matrix solvers - ComplexMatrix dsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, + ComplexMatrix dsolve (MatrixType &typ, const Matrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - ComplexMatrix dsolve (SparseType &typ, const ComplexMatrix& b, + ComplexMatrix dsolve (MatrixType &typ, const ComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseComplexMatrix dsolve (SparseType &typ, const SparseMatrix& b, + SparseComplexMatrix dsolve (MatrixType &typ, const SparseMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseComplexMatrix dsolve (SparseType &typ, const SparseComplexMatrix& b, + SparseComplexMatrix dsolve (MatrixType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; // Upper triangular matrix solvers - ComplexMatrix utsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, + ComplexMatrix utsolve (MatrixType &typ, const Matrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - ComplexMatrix utsolve (SparseType &typ, const ComplexMatrix& b, + ComplexMatrix utsolve (MatrixType &typ, const ComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseComplexMatrix utsolve (SparseType &typ, const SparseMatrix& b, + SparseComplexMatrix utsolve (MatrixType &typ, const SparseMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseComplexMatrix utsolve (SparseType &typ, const SparseComplexMatrix& b, + SparseComplexMatrix utsolve (MatrixType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; // Lower triangular matrix solvers - ComplexMatrix ltsolve (SparseType &typ, const Matrix& b, + ComplexMatrix ltsolve (MatrixType &typ, const Matrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - ComplexMatrix ltsolve (SparseType &typ, const ComplexMatrix& b, + ComplexMatrix ltsolve (MatrixType &typ, const ComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseComplexMatrix ltsolve (SparseType &typ, const SparseMatrix& b, + SparseComplexMatrix ltsolve (MatrixType &typ, const SparseMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseComplexMatrix ltsolve (SparseType &typ, const SparseComplexMatrix& b, + SparseComplexMatrix ltsolve (MatrixType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; // Tridiagonal matrix solvers - ComplexMatrix trisolve (SparseType &typ, const Matrix& b, + ComplexMatrix trisolve (MatrixType &typ, const Matrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - ComplexMatrix trisolve (SparseType &typ, const ComplexMatrix& b, + ComplexMatrix trisolve (MatrixType &typ, const ComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseComplexMatrix trisolve (SparseType &typ, const SparseMatrix& b, + SparseComplexMatrix trisolve (MatrixType &typ, const SparseMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseComplexMatrix trisolve (SparseType &typ, const SparseComplexMatrix& b, + SparseComplexMatrix trisolve (MatrixType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; // Banded matrix solvers (umfpack/cholesky) - ComplexMatrix bsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, + ComplexMatrix bsolve (MatrixType &typ, const Matrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - ComplexMatrix bsolve (SparseType &typ, const ComplexMatrix& b, + ComplexMatrix bsolve (MatrixType &typ, const ComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseComplexMatrix bsolve (SparseType &typ, const SparseMatrix& b, + SparseComplexMatrix bsolve (MatrixType &typ, const SparseMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseComplexMatrix bsolve (SparseType &typ, const SparseComplexMatrix& b, + SparseComplexMatrix bsolve (MatrixType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; @@ -251,83 +251,83 @@ Matrix &Info, solve_singularity_handler sing_handler, bool calc_cond) const; - ComplexMatrix fsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, + ComplexMatrix fsolve (MatrixType &typ, const Matrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - ComplexMatrix fsolve (SparseType &typ, const ComplexMatrix& b, + ComplexMatrix fsolve (MatrixType &typ, const ComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseComplexMatrix fsolve (SparseType &typ, const SparseMatrix& b, + SparseComplexMatrix fsolve (MatrixType &typ, const SparseMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseComplexMatrix fsolve (SparseType &typ, const SparseComplexMatrix& b, + SparseComplexMatrix fsolve (MatrixType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; public: // Generic interface to solver with no probing of type - ComplexMatrix solve (SparseType &typ, const Matrix& b) const; - ComplexMatrix solve (SparseType &typ, const Matrix& b, + ComplexMatrix solve (MatrixType &typ, const Matrix& b) const; + ComplexMatrix solve (MatrixType &typ, const Matrix& b, octave_idx_type& info) const; - ComplexMatrix solve (SparseType &typ, const Matrix& b, octave_idx_type& info, + ComplexMatrix solve (MatrixType &typ, const Matrix& b, octave_idx_type& info, double& rcond) const; - ComplexMatrix solve (SparseType &typ, const Matrix& b, octave_idx_type& info, + ComplexMatrix solve (MatrixType &typ, const Matrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool singular_fallback = true) const; - ComplexMatrix solve (SparseType &typ, const ComplexMatrix& b) const; - ComplexMatrix solve (SparseType &typ, const ComplexMatrix& b, + ComplexMatrix solve (MatrixType &typ, const ComplexMatrix& b) const; + ComplexMatrix solve (MatrixType &typ, const ComplexMatrix& b, octave_idx_type& info) const; - ComplexMatrix solve (SparseType &typ, const ComplexMatrix& b, + ComplexMatrix solve (MatrixType &typ, const ComplexMatrix& b, octave_idx_type& info, double& rcond) const; - ComplexMatrix solve (SparseType &typ, const ComplexMatrix& b, + ComplexMatrix solve (MatrixType &typ, const ComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool singular_fallback = true) const; - SparseComplexMatrix solve (SparseType &typ, const SparseMatrix& b) const; - SparseComplexMatrix solve (SparseType &typ, const SparseMatrix& b, + SparseComplexMatrix solve (MatrixType &typ, const SparseMatrix& b) const; + SparseComplexMatrix solve (MatrixType &typ, const SparseMatrix& b, octave_idx_type& info) const; - SparseComplexMatrix solve (SparseType &typ, const SparseMatrix& b, + SparseComplexMatrix solve (MatrixType &typ, const SparseMatrix& b, octave_idx_type& info, double& rcond) const; - SparseComplexMatrix solve (SparseType &typ, const SparseMatrix& b, + SparseComplexMatrix solve (MatrixType &typ, const SparseMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool singular_fallback = true) const; - SparseComplexMatrix solve (SparseType &typ, + SparseComplexMatrix solve (MatrixType &typ, const SparseComplexMatrix& b) const; - SparseComplexMatrix solve (SparseType &typ, const SparseComplexMatrix& b, + SparseComplexMatrix solve (MatrixType &typ, const SparseComplexMatrix& b, octave_idx_type& info) const; - SparseComplexMatrix solve (SparseType &typ, const SparseComplexMatrix& b, + SparseComplexMatrix solve (MatrixType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond) const; - SparseComplexMatrix solve (SparseType &typ, const SparseComplexMatrix& b, + SparseComplexMatrix solve (MatrixType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool singular_fallback = true) const; - ComplexColumnVector solve (SparseType &typ, const ColumnVector& b) const; - ComplexColumnVector solve (SparseType &typ, const ColumnVector& b, + ComplexColumnVector solve (MatrixType &typ, const ColumnVector& b) const; + ComplexColumnVector solve (MatrixType &typ, const ColumnVector& b, octave_idx_type& info) const; - ComplexColumnVector solve (SparseType &typ, const ColumnVector& b, + ComplexColumnVector solve (MatrixType &typ, const ColumnVector& b, octave_idx_type& info, double& rcond) const; - ComplexColumnVector solve (SparseType &typ, const ColumnVector& b, + ComplexColumnVector solve (MatrixType &typ, const ColumnVector& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler) const; - ComplexColumnVector solve (SparseType &typ, + ComplexColumnVector solve (MatrixType &typ, const ComplexColumnVector& b) const; - ComplexColumnVector solve (SparseType &typ, const ComplexColumnVector& b, + ComplexColumnVector solve (MatrixType &typ, const ComplexColumnVector& b, octave_idx_type& info) const; - ComplexColumnVector solve (SparseType &typ, const ComplexColumnVector& b, + ComplexColumnVector solve (MatrixType &typ, const ComplexColumnVector& b, octave_idx_type& info, double& rcond) const; - ComplexColumnVector solve (SparseType &typ, const ComplexColumnVector& b, + ComplexColumnVector solve (MatrixType &typ, const ComplexColumnVector& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler) const;
--- a/liboctave/ChangeLog +++ b/liboctave/ChangeLog @@ -1,3 +1,41 @@ +2006-05-03 David Bateman <dbateman@free.fr> + + * CMatrix.cc (zpotrf, zpocon, zpotrs, ztrcon, ztrtrs): + External declaration of lapack triangular and Cholesky codes. + (ComplexMatrix::utsolve, ComplexMatrix::ltsolve, + ComplexMatrix::fsolve): New private solver codes for + upper, lower and LU/Cholesky solvers. + (ComplexMatrix::solve): New versions for cached matrix + type. Adapt old versions to call new versions + * CMatrix.h (utsolve, ltsolve, fsolve): Declaration of + new solvers. + (solve): New versions for cached matrix type. + * dMatrix.cc (dpotrf, dpocon, dpotrs, dtrcon, dtrtrs): + External declaration of lapack triangular and Cholesky codes. + (Matrix::utsolve, Matrix::ltsolve, + Matrix::fsolve): New private solver codes for + upper, lower and LU/Cholesky solvers. + (Matrix::solve): New versions for cached matrix + type. Adapt old versions to call new versions + * dMatrix.h (utsolve, ltsolve, fsolve): Declaration of + new solvers. + (solve): New versions for cached matrix type. + * CSparse.cc: Replace all uses of SparseType with MatrixType. + * CSparse.h: ditto. + * dSparse.cc: ditto. + * dSparse.h: ditto. + * SparseCmplxCHOL.cc: ditto. + * SparsedbleCHOL.cc: ditto. + * sparse-dmsolve.cc: ditto. + * SparseType.cc, SparseType.h: delete. + * MatrixType.cc: New file for class to cache matrix type, based on + old SparseType class but caching matrix and sparse types. + * MatrixType.h: ditto. + * Makefile.in (MATRIX_INC, MATRIX_SRC): Add MatrixType.h and + MatrixType.cc respectively. Delete SparseType.h and SparseType.cc + respectively. + * mx-base.h: Include MatrixTye.h as header file. + 2006-05-01 John W. Eaton <jwe@octave.org> * oct-shlib.h (octave_shlib::octave_shlib, octave_shlib::open):
--- a/liboctave/Makefile.in +++ b/liboctave/Makefile.in @@ -39,7 +39,7 @@ Sparse.h sparse-base-lu.h SparseCmplxLU.h SparsedbleLU.h \ sparse-base-chol.h sparse-dmsolve.cc SparseCmplxCHOL.h \ SparsedbleCHOL.h SparseCmplxQR.h SparseQR.h Sparse-op-defs.h \ - SparseType.h \ + MatrixType.h \ int8NDArray.h uint8NDArray.h int16NDArray.h uint16NDArray.h \ int32NDArray.h uint32NDArray.h int64NDArray.h uint64NDArray.h \ intNDArray.h @@ -101,7 +101,7 @@ dbleSCHUR.cc dbleSVD.cc boolSparse.cc CSparse.cc dSparse.cc \ MSparse.cc Sparse.cc SparseCmplxLU.cc SparsedbleLU.cc \ SparseCmplxCHOL.cc SparsedbleCHOL.cc \ - SparseCmplxQR.cc SparseQR.cc SparseType.cc \ + SparseCmplxQR.cc SparseQR.cc MatrixType.cc \ int8NDArray.cc uint8NDArray.cc int16NDArray.cc uint16NDArray.cc \ int32NDArray.cc uint32NDArray.cc int64NDArray.cc uint64NDArray.cc
new file mode 100644 --- /dev/null +++ b/liboctave/MatrixType.cc @@ -0,0 +1,1199 @@ +/* + +Copyright (C) 2006 David Bateman +Copyright (C) 2006 Andy Adler + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with this program; see the file COPYING. If not, write to the +Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. + +*/ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <vector> + +#include "MatrixType.h" +#include "dMatrix.h" +#include "CMatrix.h" +#include "dSparse.h" +#include "CSparse.h" +#include "oct-spparms.h" + +// FIXME There is a large code duplication here + +MatrixType::MatrixType (void) : typ (MatrixType::Unknown), full (false), + nperm (0) +{ + sp_bandden = Voctave_sparse_controls.get_key ("bandden"); +} + +MatrixType::MatrixType (const MatrixType &a) : typ (a.typ), + sp_bandden (a.sp_bandden), bandden (a.bandden), + upper_band (a.upper_band), lower_band (a.lower_band), + dense (a.dense), full (a.full), nperm (a.nperm) +{ + if (nperm != 0) + { + perm = new octave_idx_type [nperm]; + for (octave_idx_type i = 0; i < nperm; i++) + perm[i] = a.perm[i]; + } +} + +MatrixType::MatrixType (const Matrix &a) +{ + octave_idx_type nrows = a.rows (); + octave_idx_type ncols = a.cols (); + nperm = 0; + full = true; + + if (ncols == nrows) + { + bool upper = true; + bool lower = true; + bool hermitian = true; + + for (octave_idx_type j = 0; j < ncols; j++) + { + if (j < nrows) + { + if (a.elem (j,j) == 0.) + { + upper = false; + lower = false; + hermitian = false; + break; + } + if (a.elem (j,j) < 0.) + hermitian = false; + } + for (octave_idx_type i = 0; i < j; i++) + if (lower && a.elem (i,j) != 0.) + { + lower = false; + break; + } + for (octave_idx_type i = j+1; i < nrows; i++) + { + if (hermitian && a.elem (i, j) != a.elem (j, i)) + hermitian = false; + if (upper && a.elem (i,j) != 0) + upper = false; + } + if (!upper && !lower && !hermitian) + break; + } + + if (upper) + typ = MatrixType::Upper; + else if (lower) + typ = MatrixType::Lower; + else if (hermitian) + typ = MatrixType::Hermitian; + else if (ncols == nrows) + typ = MatrixType::Full; + } + else + typ = MatrixType::Rectangular; +} + +MatrixType::MatrixType (const ComplexMatrix &a) +{ + octave_idx_type nrows = a.rows (); + octave_idx_type ncols = a.cols (); + nperm = 0; + full = true; + + if (ncols == nrows) + { + bool upper = true; + bool lower = true; + bool hermitian = true; + + for (octave_idx_type j = 0; j < ncols; j++) + { + if (j < ncols) + { + if (imag(a.elem (j,j)) == 0. && + real(a.elem (j,j)) == 0.) + { + upper = false; + lower = false; + hermitian = false; + break; + } + + if (imag(a.elem (j,j)) != 0. || + real(a.elem (j,j)) < 0.) + hermitian = false; + } + for (octave_idx_type i = 0; i < j; i++) + if (lower && (real(a.elem (i,j)) != 0 || imag(a.elem (i,j)) != 0)) + { + lower = false; + break; + } + for (octave_idx_type i = j+1; i < nrows; i++) + { + if (hermitian && a.elem (i, j) != conj(a.elem (j, i))) + hermitian = false; + if (upper && (real(a.elem (i,j)) != 0 || + imag(a.elem (i,j)) != 0)) + upper = false; + } + if (!upper && !lower && !hermitian) + break; + } + + if (upper) + typ = MatrixType::Upper; + else if (lower) + typ = MatrixType::Lower; + else if (hermitian) + typ = MatrixType::Hermitian; + else if (ncols == nrows) + typ = MatrixType::Full; + } + else + typ = MatrixType::Rectangular; +} + +MatrixType::MatrixType (const SparseMatrix &a) +{ + octave_idx_type nrows = a.rows (); + octave_idx_type ncols = a.cols (); + octave_idx_type nm = (ncols < nrows ? ncols : nrows); + octave_idx_type nnz = a.nzmax (); + full = false; + + if (Voctave_sparse_controls.get_key ("spumoni") != 0.) + (*current_liboctave_warning_handler) + ("Calculating Sparse Matrix Type"); + + nperm = 0; + + sp_bandden = Voctave_sparse_controls.get_key ("bandden"); + bool maybe_hermitian = false; + typ = MatrixType::Full; + + if (nnz == nm) + { + matrix_type tmp_typ = MatrixType::Diagonal; + octave_idx_type i; + // Maybe the matrix is diagonal + for (i = 0; i < nm; i++) + { + if (a.cidx(i+1) != a.cidx(i) + 1) + { + tmp_typ = MatrixType::Full; + break; + } + if (a.ridx(i) != i) + { + tmp_typ = MatrixType::Permuted_Diagonal; + break; + } + } + + if (tmp_typ == MatrixType::Permuted_Diagonal) + { + std::vector<bool> found (nrows); + + for (octave_idx_type j = 0; j < i; j++) + found [j] = true; + for (octave_idx_type j = i; j < nrows; j++) + found [j] = false; + + for (octave_idx_type j = i; j < nm; j++) + { + if ((a.cidx(j+1) > a.cidx(j) + 1) || + ((a.cidx(j+1) == a.cidx(j) + 1) && found [a.ridx(j)])) + { + tmp_typ = MatrixType::Full; + break; + } + found [a.ridx(j)] = true; + } + } + typ = tmp_typ; + } + + if (typ == MatrixType::Full) + { + // Search for banded, upper and lower triangular matrices + bool singular = false; + upper_band = 0; + lower_band = 0; + for (octave_idx_type j = 0; j < ncols; j++) + { + bool zero_on_diagonal = false; + if (j < nrows) + { + zero_on_diagonal = true; + for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) + if (a.ridx(i) == j) + { + zero_on_diagonal = false; + break; + } + } + + if (zero_on_diagonal) + { + singular = true; + break; + } + + if (a.cidx(j+1) != a.cidx(j)) + { + octave_idx_type ru = a.ridx(a.cidx(j)); + octave_idx_type rl = a.ridx(a.cidx(j+1)-1); + + if (j - ru > upper_band) + upper_band = j - ru; + + if (rl - j > lower_band) + lower_band = rl - j; + } + } + + if (!singular) + { + bandden = double (nnz) / + (double (ncols) * (double (lower_band) + + double (upper_band)) - + 0.5 * double (upper_band + 1) * double (upper_band) - + 0.5 * double (lower_band + 1) * double (lower_band)); + + if (nrows == ncols && sp_bandden != 1. && bandden > sp_bandden) + { + if (upper_band == 1 && lower_band == 1) + typ = MatrixType::Tridiagonal; + else + typ = MatrixType::Banded; + + octave_idx_type nnz_in_band = + (upper_band + lower_band + 1) * nrows - + (1 + upper_band) * upper_band / 2 - + (1 + lower_band) * lower_band / 2; + if (nnz_in_band == nnz) + dense = true; + else + dense = false; + } + else if (upper_band == 0) + typ = MatrixType::Lower; + else if (lower_band == 0) + typ = MatrixType::Upper; + + if (upper_band == lower_band && nrows == ncols) + maybe_hermitian = true; + } + + if (typ == MatrixType::Full) + { + // Search for a permuted triangular matrix, and test if + // permutation is singular + + // FIXME + // Perhaps this should be based on a dmperm algorithm + bool found = false; + + nperm = ncols; + perm = new octave_idx_type [ncols]; + + for (octave_idx_type i = 0; i < ncols; i++) + perm [i] = -1; + + for (octave_idx_type i = 0; i < nm; i++) + { + found = false; + + for (octave_idx_type j = 0; j < ncols; j++) + { + if ((a.cidx(j+1) - a.cidx(j)) > 0 && + (a.ridx(a.cidx(j+1)-1) == i)) + { + perm [i] = j; + found = true; + break; + } + } + + if (!found) + break; + } + + if (found) + { + typ = MatrixType::Permuted_Upper; + if (ncols > nrows) + { + octave_idx_type k = nrows; + for (octave_idx_type i = 0; i < ncols; i++) + if (perm [i] == -1) + perm[i] = k++; + } + } + else if (a.cidx(nm) == a.cidx(ncols)) + { + nperm = nrows; + delete [] perm; + perm = new octave_idx_type [nrows]; + OCTAVE_LOCAL_BUFFER (octave_idx_type, tmp, nrows); + + for (octave_idx_type i = 0; i < nrows; i++) + { + perm [i] = -1; + tmp [i] = -1; + } + + for (octave_idx_type j = 0; j < ncols; j++) + for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) + perm [a.ridx(i)] = j; + + found = true; + for (octave_idx_type i = 0; i < nm; i++) + if (perm[i] == -1) + { + found = false; + break; + } + else + { + tmp[perm[i]] = 1; + } + + if (found) + { + octave_idx_type k = ncols; + for (octave_idx_type i = 0; i < nrows; i++) + { + if (tmp[i] == -1) + { + if (k < nrows) + { + perm[k++] = i; + } + else + { + found = false; + break; + } + } + } + } + + if (found) + typ = MatrixType::Permuted_Lower; + else + { + delete [] perm; + nperm = 0; + } + } + else + { + delete [] perm; + nperm = 0; + } + } + + // FIXME + // Disable lower under-determined and upper over-determined problems + // as being detected, and force to treat as singular. As this seems + // to cause issues + if (((typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) + && nrows > ncols) || + ((typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) + && nrows < ncols)) + { + typ = MatrixType::Rectangular; + if (typ == MatrixType::Permuted_Upper || + typ == MatrixType::Permuted_Lower) + delete [] perm; + nperm = 0; + } + + if (typ == MatrixType::Full && ncols != nrows) + typ = MatrixType::Rectangular; + + if (maybe_hermitian && (typ == MatrixType::Full || + typ == MatrixType::Tridiagonal || + typ == MatrixType::Banded)) + { + // Check for symmetry, with positive real diagonal, which + // has a very good chance of being symmetric positive + // definite.. + bool is_herm = true; + + for (octave_idx_type j = 0; j < ncols; j++) + { + bool diag_positive = false; + + for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) + { + octave_idx_type ri = a.ridx(i); + + if (ri == j) + { + if (a.data(i) == std::abs(a.data(i))) + diag_positive = true; + else + break; + } + else + { + bool found = false; + + for (octave_idx_type k = a.cidx(ri); k < a.cidx(ri+1); k++) + { + if (a.ridx(k) == j) + { + if (a.data(i) == a.data(k)) + found = true; + break; + } + } + + if (! found) + { + is_herm = false; + break; + } + } + } + + if (! diag_positive || ! is_herm) + { + is_herm = false; + break; + } + } + + if (is_herm) + { + if (typ == MatrixType::Full) + typ = MatrixType::Hermitian; + else if (typ == MatrixType::Banded) + typ = MatrixType::Banded_Hermitian; + else + typ = MatrixType::Tridiagonal_Hermitian; + } + } + } +} + +MatrixType::MatrixType (const SparseComplexMatrix &a) +{ + octave_idx_type nrows = a.rows (); + octave_idx_type ncols = a.cols (); + octave_idx_type nm = (ncols < nrows ? ncols : nrows); + octave_idx_type nnz = a.nzmax (); + full = false; + + if (Voctave_sparse_controls.get_key ("spumoni") != 0.) full = true; + + (*current_liboctave_warning_handler) + ("Calculating Sparse Matrix Type"); + + nperm = 0; + + sp_bandden = Voctave_sparse_controls.get_key ("bandden"); + bool maybe_hermitian = false; + typ = MatrixType::Full; + + if (nnz == nm) + { + matrix_type tmp_typ = MatrixType::Diagonal; + octave_idx_type i; + // Maybe the matrix is diagonal + for (i = 0; i < nm; i++) + { + if (a.cidx(i+1) != a.cidx(i) + 1) + { + tmp_typ = MatrixType::Full; + break; + } + if (a.ridx(i) != i) + { + tmp_typ = MatrixType::Permuted_Diagonal; + break; + } + } + + if (tmp_typ == MatrixType::Permuted_Diagonal) + { + std::vector<bool> found (nrows); + + for (octave_idx_type j = 0; j < i; j++) + found [j] = true; + for (octave_idx_type j = i; j < nrows; j++) + found [j] = false; + + for (octave_idx_type j = i; j < nm; j++) + { + if ((a.cidx(j+1) > a.cidx(j) + 1) || + ((a.cidx(j+1) == a.cidx(j) + 1) && found [a.ridx(j)])) + { + tmp_typ = MatrixType::Full; + break; + } + found [a.ridx(j)] = true; + } + } + typ = tmp_typ; + } + + if (typ == MatrixType::Full) + { + // Search for banded, upper and lower triangular matrices + bool singular = false; + upper_band = 0; + lower_band = 0; + for (octave_idx_type j = 0; j < ncols; j++) + { + bool zero_on_diagonal = false; + if (j < nrows) + { + zero_on_diagonal = true; + for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) + if (a.ridx(i) == j) + { + zero_on_diagonal = false; + break; + } + } + + if (zero_on_diagonal) + { + singular = true; + break; + } + + if (a.cidx(j+1) != a.cidx(j)) + { + octave_idx_type ru = a.ridx(a.cidx(j)); + octave_idx_type rl = a.ridx(a.cidx(j+1)-1); + + if (j - ru > upper_band) + upper_band = j - ru; + + if (rl - j > lower_band) + lower_band = rl - j; + } + } + + if (!singular) + { + bandden = double (nnz) / + (double (ncols) * (double (lower_band) + + double (upper_band)) - + 0.5 * double (upper_band + 1) * double (upper_band) - + 0.5 * double (lower_band + 1) * double (lower_band)); + + if (nrows == ncols && sp_bandden != 1. && bandden > sp_bandden) + { + if (upper_band == 1 && lower_band == 1) + typ = MatrixType::Tridiagonal; + else + typ = MatrixType::Banded; + + octave_idx_type nnz_in_band = + (upper_band + lower_band + 1) * nrows - + (1 + upper_band) * upper_band / 2 - + (1 + lower_band) * lower_band / 2; + if (nnz_in_band == nnz) + dense = true; + else + dense = false; + } + else if (upper_band == 0) + typ = MatrixType::Lower; + else if (lower_band == 0) + typ = MatrixType::Upper; + + if (upper_band == lower_band && nrows == ncols) + maybe_hermitian = true; + } + + if (typ == MatrixType::Full) + { + // Search for a permuted triangular matrix, and test if + // permutation is singular + + // FIXME + // Perhaps this should be based on a dmperm algorithm + bool found = false; + + nperm = ncols; + perm = new octave_idx_type [ncols]; + + for (octave_idx_type i = 0; i < ncols; i++) + perm [i] = -1; + + for (octave_idx_type i = 0; i < nm; i++) + { + found = false; + + for (octave_idx_type j = 0; j < ncols; j++) + { + if ((a.cidx(j+1) - a.cidx(j)) > 0 && + (a.ridx(a.cidx(j+1)-1) == i)) + { + perm [i] = j; + found = true; + break; + } + } + + if (!found) + break; + } + + if (found) + { + typ = MatrixType::Permuted_Upper; + if (ncols > nrows) + { + octave_idx_type k = nrows; + for (octave_idx_type i = 0; i < ncols; i++) + if (perm [i] == -1) + perm[i] = k++; + } + } + else if (a.cidx(nm) == a.cidx(ncols)) + { + nperm = nrows; + delete [] perm; + perm = new octave_idx_type [nrows]; + OCTAVE_LOCAL_BUFFER (octave_idx_type, tmp, nrows); + + for (octave_idx_type i = 0; i < nrows; i++) + { + perm [i] = -1; + tmp [i] = -1; + } + + for (octave_idx_type j = 0; j < ncols; j++) + for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) + perm [a.ridx(i)] = j; + + found = true; + for (octave_idx_type i = 0; i < nm; i++) + if (perm[i] == -1) + { + found = false; + break; + } + else + { + tmp[perm[i]] = 1; + } + + if (found) + { + octave_idx_type k = ncols; + for (octave_idx_type i = 0; i < nrows; i++) + { + if (tmp[i] == -1) + { + if (k < nrows) + { + perm[k++] = i; + } + else + { + found = false; + break; + } + } + } + } + + if (found) + typ = MatrixType::Permuted_Lower; + else + { + delete [] perm; + nperm = 0; + } + } + else + { + delete [] perm; + nperm = 0; + } + } + + // FIXME + // Disable lower under-determined and upper over-determined problems + // as being detected, and force to treat as singular. As this seems + // to cause issues + if (((typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) + && nrows > ncols) || + ((typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) + && nrows < ncols)) + { + typ = MatrixType::Rectangular; + if (typ == MatrixType::Permuted_Upper || + typ == MatrixType::Permuted_Lower) + delete [] perm; + nperm = 0; + } + + if (typ == MatrixType::Full && ncols != nrows) + typ = MatrixType::Rectangular; + + if (maybe_hermitian && (typ == MatrixType::Full || + typ == MatrixType::Tridiagonal || + typ == MatrixType::Banded)) + { + // Check for symmetry, with positive real diagonal, which + // has a very good chance of being symmetric positive + // definite.. + bool is_herm = true; + + for (octave_idx_type j = 0; j < ncols; j++) + { + bool diag_positive = false; + + for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) + { + octave_idx_type ri = a.ridx(i); + + if (ri == j) + { + if (a.data(i) == std::abs(a.data(i))) + diag_positive = true; + else + break; + } + else + { + bool found = false; + + for (octave_idx_type k = a.cidx(ri); k < a.cidx(ri+1); k++) + { + if (a.ridx(k) == j) + { + if (a.data(i) == conj(a.data(k))) + found = true; + break; + } + } + + if (! found) + { + is_herm = false; + break; + } + } + } + + if (! diag_positive || ! is_herm) + { + is_herm = false; + break; + } + } + + if (is_herm) + { + if (typ == MatrixType::Full) + typ = MatrixType::Hermitian; + else if (typ == MatrixType::Banded) + typ = MatrixType::Banded_Hermitian; + else + typ = MatrixType::Tridiagonal_Hermitian; + } + } + } +} +MatrixType::MatrixType (const matrix_type t, bool _full) : + typ (MatrixType::Unknown), nperm (0) +{ + sp_bandden = Voctave_sparse_controls.get_key ("bandden"); + full = _full; + + if (t == MatrixType::Full || t == MatrixType::Diagonal || + t == MatrixType::Permuted_Diagonal || t == MatrixType::Upper || + t == MatrixType::Lower || t == MatrixType::Tridiagonal || + t == MatrixType::Tridiagonal_Hermitian || t == MatrixType::Rectangular) + typ = t; + else + (*current_liboctave_warning_handler) ("Invalid matrix type"); +} + +MatrixType::MatrixType (const matrix_type t, const octave_idx_type np, + const octave_idx_type *p, bool _full) : + typ (MatrixType::Unknown), nperm (0) +{ + sp_bandden = Voctave_sparse_controls.get_key ("bandden"); + full = _full; + + if (t == MatrixType::Permuted_Upper || t == MatrixType::Permuted_Lower) + { + typ = t; + nperm = np; + perm = new octave_idx_type [nperm]; + for (octave_idx_type i = 0; i < nperm; i++) + perm[i] = p[i]; + } + else + (*current_liboctave_warning_handler) ("Invalid matrix type"); +} + +MatrixType::MatrixType (const matrix_type t, const octave_idx_type ku, + const octave_idx_type kl, bool _full) : + typ (MatrixType::Unknown), nperm (0) +{ + sp_bandden = Voctave_sparse_controls.get_key ("bandden"); + full = _full; + + if (t == MatrixType::Banded || t == MatrixType::Banded_Hermitian) + { + typ = t; + upper_band = ku; + lower_band = kl; + } + else + (*current_liboctave_warning_handler) ("Invalid sparse matrix type"); +} + +MatrixType::~MatrixType (void) +{ + if (nperm != 0) + { + delete [] perm; + } +} + +MatrixType& +MatrixType::operator = (const MatrixType& a) +{ + if (this != &a) + { + typ = a.typ; + sp_bandden = a.sp_bandden; + bandden = a.bandden; + upper_band = a.upper_band; + lower_band = a.lower_band; + dense = a.dense; + full = a.full; + nperm = a.nperm; + + if (nperm != 0) + { + perm = new octave_idx_type [nperm]; + for (octave_idx_type i = 0; i < nperm; i++) + perm[i] = a.perm[i]; + } + } + + return *this; +} + +int +MatrixType::type (bool quiet) +{ + if (typ != MatrixType::Unknown && (full || + sp_bandden == Voctave_sparse_controls.get_key ("bandden"))) + { + if (!quiet && + Voctave_sparse_controls.get_key ("spumoni") != 0.) + (*current_liboctave_warning_handler) + ("Using Cached Matrix Type"); + + return typ; + } + + if (typ != MatrixType::Unknown && + Voctave_sparse_controls.get_key ("spumoni") != 0.) + (*current_liboctave_warning_handler) + ("Invalidating Matrix Type"); + + typ = MatrixType::Unknown; + + return typ; +} + +int +MatrixType::type (const SparseMatrix &a) +{ + if (typ != MatrixType::Unknown && (full || + sp_bandden == Voctave_sparse_controls.get_key ("bandden"))) + { + if (Voctave_sparse_controls.get_key ("spumoni") != 0.) + (*current_liboctave_warning_handler) + ("Using Cached Matrix Type"); + + return typ; + } + + MatrixType tmp_typ (a); + typ = tmp_typ.typ; + sp_bandden = tmp_typ.sp_bandden; + bandden = tmp_typ.bandden; + upper_band = tmp_typ.upper_band; + lower_band = tmp_typ.lower_band; + dense = tmp_typ.dense; + full = tmp_typ.full; + nperm = tmp_typ.nperm; + + if (nperm != 0) + { + perm = new octave_idx_type [nperm]; + for (octave_idx_type i = 0; i < nperm; i++) + perm[i] = tmp_typ.perm[i]; + } + + return typ; +} + +int +MatrixType::type (const SparseComplexMatrix &a) +{ + if (typ != MatrixType::Unknown && (full || + sp_bandden == Voctave_sparse_controls.get_key ("bandden"))) + { + if (Voctave_sparse_controls.get_key ("spumoni") != 0.) + (*current_liboctave_warning_handler) + ("Using Cached Matrix Type"); + + return typ; + } + + MatrixType tmp_typ (a); + typ = tmp_typ.typ; + sp_bandden = tmp_typ.sp_bandden; + bandden = tmp_typ.bandden; + upper_band = tmp_typ.upper_band; + lower_band = tmp_typ.lower_band; + dense = tmp_typ.dense; + full = tmp_typ.full; + nperm = tmp_typ.nperm; + + if (nperm != 0) + { + perm = new octave_idx_type [nperm]; + for (octave_idx_type i = 0; i < nperm; i++) + perm[i] = tmp_typ.perm[i]; + } + + return typ; +} +int +MatrixType::type (const Matrix &a) +{ + if (typ != MatrixType::Unknown) + { + if (Voctave_sparse_controls.get_key ("spumoni") != 0.) + (*current_liboctave_warning_handler) + ("Using Cached Matrix Type"); + + return typ; + } + + MatrixType tmp_typ (a); + typ = tmp_typ.typ; + full = tmp_typ.full; + nperm = tmp_typ.nperm; + + if (nperm != 0) + { + perm = new octave_idx_type [nperm]; + for (octave_idx_type i = 0; i < nperm; i++) + perm[i] = tmp_typ.perm[i]; + } + + return typ; +} + +int +MatrixType::type (const ComplexMatrix &a) +{ + if (typ != MatrixType::Unknown) + { + if (Voctave_sparse_controls.get_key ("spumoni") != 0.) + (*current_liboctave_warning_handler) + ("Using Cached Matrix Type"); + + return typ; + } + + MatrixType tmp_typ (a); + typ = tmp_typ.typ; + full = tmp_typ.full; + nperm = tmp_typ.nperm; + + if (nperm != 0) + { + perm = new octave_idx_type [nperm]; + for (octave_idx_type i = 0; i < nperm; i++) + perm[i] = tmp_typ.perm[i]; + } + + return typ; +} + +void +MatrixType::info () const +{ + if (Voctave_sparse_controls.get_key ("spumoni") != 0.) + { + if (typ == MatrixType::Unknown) + (*current_liboctave_warning_handler) + ("Unknown Matrix Type"); + else if (typ == MatrixType::Diagonal) + (*current_liboctave_warning_handler) + ("Diagonal Sparse Matrix"); + else if (typ == MatrixType::Permuted_Diagonal) + (*current_liboctave_warning_handler) + ("Permuted Diagonal Sparse Matrix"); + else if (typ == MatrixType::Upper) + (*current_liboctave_warning_handler) + ("Upper Triangular Matrix"); + else if (typ == MatrixType::Lower) + (*current_liboctave_warning_handler) + ("Lower Triangular Matrix"); + else if (typ == MatrixType::Permuted_Upper) + (*current_liboctave_warning_handler) + ("Permuted Upper Triangular Matrix"); + else if (typ == MatrixType::Permuted_Lower) + (*current_liboctave_warning_handler) + ("Permuted Lower Triangular Matrix"); + else if (typ == MatrixType::Banded) + (*current_liboctave_warning_handler) + ("Banded Sparse Matrix %d-1-%d (Density %f)", lower_band, + upper_band, bandden); + else if (typ == MatrixType::Banded_Hermitian) + (*current_liboctave_warning_handler) + ("Banded Hermitian/Symmetric Sparse Matrix %d-1-%d (Density %f)", + lower_band, upper_band, bandden); + else if (typ == MatrixType::Hermitian) + (*current_liboctave_warning_handler) + ("Hermitian/Symmetric Matrix"); + else if (typ == MatrixType::Tridiagonal) + (*current_liboctave_warning_handler) + ("Tridiagonal Sparse Matrix"); + else if (typ == MatrixType::Tridiagonal_Hermitian) + (*current_liboctave_warning_handler) + ("Hermitian/Symmetric Tridiagonal Sparse Matrix"); + else if (typ == MatrixType::Rectangular) + (*current_liboctave_warning_handler) + ("Rectangular/Singular Matrix"); + else if (typ == MatrixType::Full) + (*current_liboctave_warning_handler) + ("Full Matrix"); + } +} + +void +MatrixType::mark_as_symmetric (void) +{ + if (typ == MatrixType::Tridiagonal || + typ == MatrixType::Tridiagonal_Hermitian) + typ = MatrixType::Tridiagonal_Hermitian; + else if (typ == MatrixType::Banded || + typ == MatrixType::Banded_Hermitian) + typ = MatrixType::Banded_Hermitian; + else if (typ == MatrixType::Full || typ == MatrixType::Hermitian || + typ == MatrixType::Unknown) + typ = MatrixType::Hermitian; + else + (*current_liboctave_error_handler) + ("Can not mark current matrix type as symmetric"); +} + +void +MatrixType::mark_as_unsymmetric (void) +{ + if (typ == MatrixType::Tridiagonal || + typ == MatrixType::Tridiagonal_Hermitian) + typ = MatrixType::Tridiagonal; + else if (typ == MatrixType::Banded || + typ == MatrixType::Banded_Hermitian) + typ = MatrixType::Banded; + else if (typ == MatrixType::Full || typ == MatrixType::Hermitian || + typ == MatrixType::Unknown) + typ = MatrixType::Full; +} + +void +MatrixType::mark_as_permuted (const octave_idx_type np, const octave_idx_type *p) +{ + nperm = np; + perm = new octave_idx_type [nperm]; + for (octave_idx_type i = 0; i < nperm; i++) + perm[i] = p[i]; + + if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) + typ = MatrixType::Permuted_Diagonal; + else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) + typ = MatrixType::Permuted_Upper; + else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) + typ = MatrixType::Permuted_Lower; + else + (*current_liboctave_error_handler) + ("Can not mark current matrix type as symmetric"); +} + +void +MatrixType::mark_as_unpermuted (void) +{ + if (nperm) + { + nperm = 0; + delete [] perm; + } + + if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) + typ = MatrixType::Diagonal; + else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) + typ = MatrixType::Upper; + else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) + typ = MatrixType::Lower; +} + +MatrixType +MatrixType::transpose (void) const +{ + MatrixType retval (*this); + if (typ == MatrixType::Upper) + retval.typ = MatrixType::Lower; + else if (typ == MatrixType::Permuted_Upper) + retval.typ = MatrixType::Permuted_Lower; + else if (typ == MatrixType::Lower) + retval.typ = MatrixType::Upper; + else if (typ == MatrixType::Permuted_Lower) + retval.typ = MatrixType::Permuted_Upper; + else if (typ == MatrixType::Banded) + { + retval.upper_band = lower_band; + retval.lower_band = upper_band; + } + + return retval; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/ +
new file mode 100644 --- /dev/null +++ b/liboctave/MatrixType.h @@ -0,0 +1,176 @@ +/* + +Copyright (C) 2006 David Bateman +Copyright (C) 2006 Andy Adler + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with this program; see the file COPYING. If not, write to the +Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. + +*/ + +#if !defined (octave_MatrixType_h) +#define octave_MatrixType_h + +class Matrix; +class ComplexMatrix; +class SparseMatrix; +class SparseComplexMatrix; + +class +MatrixType +{ +public: + enum matrix_type { + Unknown = 0, + Full, + Diagonal, + Permuted_Diagonal, + Upper, + Lower, + Permuted_Upper, + Permuted_Lower, + Banded, + Hermitian, + Banded_Hermitian, + Tridiagonal, + Tridiagonal_Hermitian, + Rectangular + }; + + MatrixType (void); + + MatrixType (const MatrixType &a); + + MatrixType (const Matrix &a); + + MatrixType (const ComplexMatrix &a); + + MatrixType (const SparseMatrix &a); + + MatrixType (const SparseComplexMatrix &a); + + MatrixType (const matrix_type t, bool _full = false); + + MatrixType (const matrix_type t, const octave_idx_type np, + const octave_idx_type *p, bool _full = false); + + MatrixType (const matrix_type t, const octave_idx_type ku, + const octave_idx_type kl, bool _full = false); + + ~MatrixType (void); + + MatrixType& operator = (const MatrixType& a); + + int type (bool quiet = true); + + int type (const Matrix &a); + + int type (const ComplexMatrix &a); + + int type (const SparseMatrix &a); + + int type (const SparseComplexMatrix &a); + + double band_density (void) const { return bandden; } + + int nupper (void) const { return upper_band; } + + int nlower (void) const { return lower_band; } + + bool is_dense (void) const { return dense; } + + bool is_diagonal (void) const + { return (typ == Diagonal || typ == Permuted_Diagonal); } + + bool is_upper_triangular (void) const + { return (typ == Upper || typ == Permuted_Upper); } + + bool is_lower_triangular (void) const + { return (typ == Lower || typ == Permuted_Lower); } + + bool is_banded (void) + { return (typ == Banded || typ == Banded_Hermitian); } + + bool is_tridiagonal (void) const + { return (typ == Tridiagonal || typ == Tridiagonal_Hermitian); } + + bool is_hermitian (void) const + { return (typ == Banded_Hermitian || typ == Tridiagonal_Hermitian || + typ == Hermitian); } + + bool is_rectangular (void) const { return (typ == Rectangular); } + + bool is_known (void) const { return (typ != Unknown); } + + bool is_unknown (void) const { return (typ == Unknown); } + + void info (void) const; + + octave_idx_type * triangular_perm (void) const { return perm; } + + void invalidate_type (void) { typ = Unknown; } + + void mark_as_diagonal (void) { typ = Diagonal; } + + void mark_as_permuted_diagonal (void) { typ = Permuted_Diagonal; } + + void mark_as_upper_triangular (void) { typ = Upper; } + + void mark_as_lower_triangular (void) { typ = Lower; } + + void mark_as_tridiagonal (void) {typ = Tridiagonal; } + + void mark_as_banded (const octave_idx_type ku, const octave_idx_type kl) + { typ = Banded; upper_band = ku; lower_band = kl; } + + void mark_as_full (void) { typ = Full; } + + void mark_as_rectangular (void) { typ = Rectangular; } + + void mark_as_dense (void) { dense = true; } + + void mark_as_not_dense (void) { dense = false; } + + void mark_as_symmetric (void); + + void mark_as_unsymmetric (void); + + void mark_as_permuted (const octave_idx_type np, const octave_idx_type *p); + + void mark_as_unpermuted (void); + + MatrixType transpose (void) const; + +private: + void type (int new_typ) { typ = static_cast<matrix_type>(new_typ); } + + matrix_type typ; + double sp_bandden; + double bandden; + octave_idx_type upper_band; + octave_idx_type lower_band; + bool dense; + bool full; + octave_idx_type nperm; + octave_idx_type *perm; +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
--- a/liboctave/SparseCmplxCHOL.cc +++ b/liboctave/SparseCmplxCHOL.cc @@ -42,18 +42,18 @@ if (r_nr == r_nc) { - SparseType mattype (r); + MatrixType mattype (r); int typ = mattype.type (false); double rcond; octave_idx_type info; SparseComplexMatrix rinv; - if (typ == SparseType::Upper) + if (typ == MatrixType::Upper) { rinv = r.inverse(mattype, info, rcond, true, false); retval = rinv.transpose() * rinv; } - else if (typ == SparseType::Lower) + else if (typ == MatrixType::Lower) { rinv = r.transpose().inverse(mattype, info, rcond, true, false); retval = rinv.transpose() * rinv;
deleted file mode 100644 --- a/liboctave/SparseType.cc +++ /dev/null @@ -1,1017 +0,0 @@ -/* - -Copyright (C) 2004 David Bateman -Copyright (C) 1998-2004 Andy Adler - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with this program; see the file COPYING. If not, write to the -Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -Boston, MA 02110-1301, USA. - -*/ - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include <vector> - -#include "SparseType.h" -#include "dSparse.h" -#include "CSparse.h" -#include "oct-spparms.h" - -// FIXME There is a large code duplication here - -SparseType::SparseType (void) : typ (SparseType::Unknown), nperm (0) -{ - sp_bandden = Voctave_sparse_controls.get_key ("bandden"); -} - -SparseType::SparseType (const SparseType &a) : typ (a.typ), - sp_bandden (a.sp_bandden), bandden (a.bandden), - upper_band (a.upper_band), lower_band (a.lower_band), - dense (a.dense), nperm (a.nperm) -{ - if (nperm != 0) - { - perm = new octave_idx_type [nperm]; - for (octave_idx_type i = 0; i < nperm; i++) - perm[i] = a.perm[i]; - } -} - -SparseType::SparseType (const SparseMatrix &a) -{ - octave_idx_type nrows = a.rows (); - octave_idx_type ncols = a.cols (); - octave_idx_type nm = (ncols < nrows ? ncols : nrows); - octave_idx_type nnz = a.nzmax (); - - if (Voctave_sparse_controls.get_key ("spumoni") != 0.) - (*current_liboctave_warning_handler) - ("Calculating Sparse Matrix Type"); - - nperm = 0; - - sp_bandden = Voctave_sparse_controls.get_key ("bandden"); - bool maybe_hermitian = false; - typ = SparseType::Full; - - if (nnz == nm) - { - matrix_type tmp_typ = SparseType::Diagonal; - octave_idx_type i; - // Maybe the matrix is diagonal - for (i = 0; i < nm; i++) - { - if (a.cidx(i+1) != a.cidx(i) + 1) - { - tmp_typ = SparseType::Full; - break; - } - if (a.ridx(i) != i) - { - tmp_typ = SparseType::Permuted_Diagonal; - break; - } - } - - if (tmp_typ == SparseType::Permuted_Diagonal) - { - std::vector<bool> found (nrows); - - for (octave_idx_type j = 0; j < i; j++) - found [j] = true; - for (octave_idx_type j = i; j < nrows; j++) - found [j] = false; - - for (octave_idx_type j = i; j < nm; j++) - { - if ((a.cidx(j+1) > a.cidx(j) + 1) || - ((a.cidx(j+1) == a.cidx(j) + 1) && found [a.ridx(j)])) - { - tmp_typ = SparseType::Full; - break; - } - found [a.ridx(j)] = true; - } - } - typ = tmp_typ; - } - - if (typ == SparseType::Full) - { - // Search for banded, upper and lower triangular matrices - bool singular = false; - upper_band = 0; - lower_band = 0; - for (octave_idx_type j = 0; j < ncols; j++) - { - bool zero_on_diagonal = false; - if (j < nrows) - { - zero_on_diagonal = true; - for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) - if (a.ridx(i) == j) - { - zero_on_diagonal = false; - break; - } - } - - if (zero_on_diagonal) - { - singular = true; - break; - } - - if (a.cidx(j+1) != a.cidx(j)) - { - octave_idx_type ru = a.ridx(a.cidx(j)); - octave_idx_type rl = a.ridx(a.cidx(j+1)-1); - - if (j - ru > upper_band) - upper_band = j - ru; - - if (rl - j > lower_band) - lower_band = rl - j; - } - } - - if (!singular) - { - bandden = double (nnz) / - (double (ncols) * (double (lower_band) + - double (upper_band)) - - 0.5 * double (upper_band + 1) * double (upper_band) - - 0.5 * double (lower_band + 1) * double (lower_band)); - - if (nrows == ncols && sp_bandden != 1. && bandden > sp_bandden) - { - if (upper_band == 1 && lower_band == 1) - typ = SparseType::Tridiagonal; - else - typ = SparseType::Banded; - - octave_idx_type nnz_in_band = - (upper_band + lower_band + 1) * nrows - - (1 + upper_band) * upper_band / 2 - - (1 + lower_band) * lower_band / 2; - if (nnz_in_band == nnz) - dense = true; - else - dense = false; - } - else if (upper_band == 0) - typ = SparseType::Lower; - else if (lower_band == 0) - typ = SparseType::Upper; - - if (upper_band == lower_band && nrows == ncols) - maybe_hermitian = true; - } - - if (typ == SparseType::Full) - { - // Search for a permuted triangular matrix, and test if - // permutation is singular - - // FIXME - // Perhaps this should be based on a dmperm algorithm - bool found = false; - - nperm = ncols; - perm = new octave_idx_type [ncols]; - - for (octave_idx_type i = 0; i < ncols; i++) - perm [i] = -1; - - for (octave_idx_type i = 0; i < nm; i++) - { - found = false; - - for (octave_idx_type j = 0; j < ncols; j++) - { - if ((a.cidx(j+1) - a.cidx(j)) > 0 && - (a.ridx(a.cidx(j+1)-1) == i)) - { - perm [i] = j; - found = true; - break; - } - } - - if (!found) - break; - } - - if (found) - { - typ = SparseType::Permuted_Upper; - if (ncols > nrows) - { - octave_idx_type k = nrows; - for (octave_idx_type i = 0; i < ncols; i++) - if (perm [i] == -1) - perm[i] = k++; - } - } - else if (a.cidx(nm) == a.cidx(ncols)) - { - nperm = nrows; - delete [] perm; - perm = new octave_idx_type [nrows]; - OCTAVE_LOCAL_BUFFER (octave_idx_type, tmp, nrows); - - for (octave_idx_type i = 0; i < nrows; i++) - { - perm [i] = -1; - tmp [i] = -1; - } - - for (octave_idx_type j = 0; j < ncols; j++) - for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) - perm [a.ridx(i)] = j; - - found = true; - for (octave_idx_type i = 0; i < nm; i++) - if (perm[i] == -1) - { - found = false; - break; - } - else - { - tmp[perm[i]] = 1; - } - - if (found) - { - octave_idx_type k = ncols; - for (octave_idx_type i = 0; i < nrows; i++) - { - if (tmp[i] == -1) - { - if (k < nrows) - { - perm[k++] = i; - } - else - { - found = false; - break; - } - } - } - } - - if (found) - typ = SparseType::Permuted_Lower; - else - { - delete [] perm; - nperm = 0; - } - } - else - { - delete [] perm; - nperm = 0; - } - } - - // FIXME - // Disable lower under-determined and upper over-determined problems - // as being detected, and force to treat as singular. As this seems - // to cause issues - if (((typ == SparseType::Lower || typ == SparseType::Permuted_Lower) - && nrows > ncols) || - ((typ == SparseType::Upper || typ == SparseType::Permuted_Upper) - && nrows < ncols)) - { - typ = SparseType::Rectangular; - if (typ == SparseType::Permuted_Upper || - typ == SparseType::Permuted_Lower) - delete [] perm; - nperm = 0; - } - - if (typ == SparseType::Full && ncols != nrows) - typ = SparseType::Rectangular; - - if (maybe_hermitian && (typ == SparseType::Full || - typ == SparseType::Tridiagonal || - typ == SparseType::Banded)) - { - // Check for symmetry, with positive real diagonal, which - // has a very good chance of being symmetric positive - // definite.. - bool is_herm = true; - - for (octave_idx_type j = 0; j < ncols; j++) - { - bool diag_positive = false; - - for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) - { - octave_idx_type ri = a.ridx(i); - - if (ri == j) - { - if (a.data(i) == std::abs(a.data(i))) - diag_positive = true; - else - break; - } - else - { - bool found = false; - - for (octave_idx_type k = a.cidx(ri); k < a.cidx(ri+1); k++) - { - if (a.ridx(k) == j) - { - if (a.data(i) == a.data(k)) - found = true; - break; - } - } - - if (! found) - { - is_herm = false; - break; - } - } - } - - if (! diag_positive || ! is_herm) - { - is_herm = false; - break; - } - } - - if (is_herm) - { - if (typ == SparseType::Full) - typ = SparseType::Hermitian; - else if (typ == SparseType::Banded) - typ = SparseType::Banded_Hermitian; - else - typ = SparseType::Tridiagonal_Hermitian; - } - } - } -} - -SparseType::SparseType (const SparseComplexMatrix &a) -{ - octave_idx_type nrows = a.rows (); - octave_idx_type ncols = a.cols (); - octave_idx_type nm = (ncols < nrows ? ncols : nrows); - octave_idx_type nnz = a.nzmax (); - - if (Voctave_sparse_controls.get_key ("spumoni") != 0.) - (*current_liboctave_warning_handler) - ("Calculating Sparse Matrix Type"); - - nperm = 0; - - sp_bandden = Voctave_sparse_controls.get_key ("bandden"); - bool maybe_hermitian = false; - typ = SparseType::Full; - - if (nnz == nm) - { - matrix_type tmp_typ = SparseType::Diagonal; - octave_idx_type i; - // Maybe the matrix is diagonal - for (i = 0; i < nm; i++) - { - if (a.cidx(i+1) != a.cidx(i) + 1) - { - tmp_typ = SparseType::Full; - break; - } - if (a.ridx(i) != i) - { - tmp_typ = SparseType::Permuted_Diagonal; - break; - } - } - - if (tmp_typ == SparseType::Permuted_Diagonal) - { - std::vector<bool> found (nrows); - - for (octave_idx_type j = 0; j < i; j++) - found [j] = true; - for (octave_idx_type j = i; j < nrows; j++) - found [j] = false; - - for (octave_idx_type j = i; j < nm; j++) - { - if ((a.cidx(j+1) > a.cidx(j) + 1) || - ((a.cidx(j+1) == a.cidx(j) + 1) && found [a.ridx(j)])) - { - tmp_typ = SparseType::Full; - break; - } - found [a.ridx(j)] = true; - } - } - typ = tmp_typ; - } - - if (typ == SparseType::Full) - { - // Search for banded, upper and lower triangular matrices - bool singular = false; - upper_band = 0; - lower_band = 0; - for (octave_idx_type j = 0; j < ncols; j++) - { - bool zero_on_diagonal = false; - if (j < nrows) - { - zero_on_diagonal = true; - for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) - if (a.ridx(i) == j) - { - zero_on_diagonal = false; - break; - } - } - - if (zero_on_diagonal) - { - singular = true; - break; - } - - if (a.cidx(j+1) != a.cidx(j)) - { - octave_idx_type ru = a.ridx(a.cidx(j)); - octave_idx_type rl = a.ridx(a.cidx(j+1)-1); - - if (j - ru > upper_band) - upper_band = j - ru; - - if (rl - j > lower_band) - lower_band = rl - j; - } - } - - if (!singular) - { - bandden = double (nnz) / - (double (ncols) * (double (lower_band) + - double (upper_band)) - - 0.5 * double (upper_band + 1) * double (upper_band) - - 0.5 * double (lower_band + 1) * double (lower_band)); - - if (nrows == ncols && sp_bandden != 1. && bandden > sp_bandden) - { - if (upper_band == 1 && lower_band == 1) - typ = SparseType::Tridiagonal; - else - typ = SparseType::Banded; - - octave_idx_type nnz_in_band = - (upper_band + lower_band + 1) * nrows - - (1 + upper_band) * upper_band / 2 - - (1 + lower_band) * lower_band / 2; - if (nnz_in_band == nnz) - dense = true; - else - dense = false; - } - else if (upper_band == 0) - typ = SparseType::Lower; - else if (lower_band == 0) - typ = SparseType::Upper; - - if (upper_band == lower_band && nrows == ncols) - maybe_hermitian = true; - } - - if (typ == SparseType::Full) - { - // Search for a permuted triangular matrix, and test if - // permutation is singular - - // FIXME - // Perhaps this should be based on a dmperm algorithm - bool found = false; - - nperm = ncols; - perm = new octave_idx_type [ncols]; - - for (octave_idx_type i = 0; i < ncols; i++) - perm [i] = -1; - - for (octave_idx_type i = 0; i < nm; i++) - { - found = false; - - for (octave_idx_type j = 0; j < ncols; j++) - { - if ((a.cidx(j+1) - a.cidx(j)) > 0 && - (a.ridx(a.cidx(j+1)-1) == i)) - { - perm [i] = j; - found = true; - break; - } - } - - if (!found) - break; - } - - if (found) - { - typ = SparseType::Permuted_Upper; - if (ncols > nrows) - { - octave_idx_type k = nrows; - for (octave_idx_type i = 0; i < ncols; i++) - if (perm [i] == -1) - perm[i] = k++; - } - } - else if (a.cidx(nm) == a.cidx(ncols)) - { - nperm = nrows; - delete [] perm; - perm = new octave_idx_type [nrows]; - OCTAVE_LOCAL_BUFFER (octave_idx_type, tmp, nrows); - - for (octave_idx_type i = 0; i < nrows; i++) - { - perm [i] = -1; - tmp [i] = -1; - } - - for (octave_idx_type j = 0; j < ncols; j++) - for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) - perm [a.ridx(i)] = j; - - found = true; - for (octave_idx_type i = 0; i < nm; i++) - if (perm[i] == -1) - { - found = false; - break; - } - else - { - tmp[perm[i]] = 1; - } - - if (found) - { - octave_idx_type k = ncols; - for (octave_idx_type i = 0; i < nrows; i++) - { - if (tmp[i] == -1) - { - if (k < nrows) - { - perm[k++] = i; - } - else - { - found = false; - break; - } - } - } - } - - if (found) - typ = SparseType::Permuted_Lower; - else - { - delete [] perm; - nperm = 0; - } - } - else - { - delete [] perm; - nperm = 0; - } - } - - // FIXME - // Disable lower under-determined and upper over-determined problems - // as being detected, and force to treat as singular. As this seems - // to cause issues - if (((typ == SparseType::Lower || typ == SparseType::Permuted_Lower) - && nrows > ncols) || - ((typ == SparseType::Upper || typ == SparseType::Permuted_Upper) - && nrows < ncols)) - { - typ = SparseType::Rectangular; - if (typ == SparseType::Permuted_Upper || - typ == SparseType::Permuted_Lower) - delete [] perm; - nperm = 0; - } - - if (typ == SparseType::Full && ncols != nrows) - typ = SparseType::Rectangular; - - if (maybe_hermitian && (typ == SparseType::Full || - typ == SparseType::Tridiagonal || - typ == SparseType::Banded)) - { - // Check for symmetry, with positive real diagonal, which - // has a very good chance of being symmetric positive - // definite.. - bool is_herm = true; - - for (octave_idx_type j = 0; j < ncols; j++) - { - bool diag_positive = false; - - for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) - { - octave_idx_type ri = a.ridx(i); - - if (ri == j) - { - if (a.data(i) == std::abs(a.data(i))) - diag_positive = true; - else - break; - } - else - { - bool found = false; - - for (octave_idx_type k = a.cidx(ri); k < a.cidx(ri+1); k++) - { - if (a.ridx(k) == j) - { - if (a.data(i) == conj(a.data(k))) - found = true; - break; - } - } - - if (! found) - { - is_herm = false; - break; - } - } - } - - if (! diag_positive || ! is_herm) - { - is_herm = false; - break; - } - } - - if (is_herm) - { - if (typ == SparseType::Full) - typ = SparseType::Hermitian; - else if (typ == SparseType::Banded) - typ = SparseType::Banded_Hermitian; - else - typ = SparseType::Tridiagonal_Hermitian; - } - } - } -} - -SparseType::SparseType (const matrix_type t) : typ (SparseType::Unknown), - nperm (0) -{ - sp_bandden = Voctave_sparse_controls.get_key ("bandden"); - - if (t == SparseType::Full || t == SparseType::Diagonal || - t == SparseType::Permuted_Diagonal || t == SparseType::Upper || - t == SparseType::Lower || t == SparseType::Tridiagonal || - t == SparseType::Tridiagonal_Hermitian || t == SparseType::Rectangular) - typ = t; - else - (*current_liboctave_warning_handler) ("Invalid sparse matrix type"); -} - -SparseType::SparseType (const matrix_type t, const octave_idx_type np, - const octave_idx_type *p) : typ (SparseType::Unknown), - nperm (0) -{ - sp_bandden = Voctave_sparse_controls.get_key ("bandden"); - - if (t == SparseType::Permuted_Upper || t == SparseType::Permuted_Lower) - { - typ = t; - nperm = np; - perm = new octave_idx_type [nperm]; - for (octave_idx_type i = 0; i < nperm; i++) - perm[i] = p[i]; - } - else - (*current_liboctave_warning_handler) ("Invalid sparse matrix type"); -} - -SparseType::SparseType (const matrix_type t, const octave_idx_type ku, - const octave_idx_type kl) : typ (SparseType::Unknown), - nperm (0) -{ - sp_bandden = Voctave_sparse_controls.get_key ("bandden"); - - if (t == SparseType::Banded || t == SparseType::Banded_Hermitian) - { - typ = t; - upper_band = ku; - lower_band = kl; - } - else - (*current_liboctave_warning_handler) ("Invalid sparse matrix type"); -} - -SparseType::~SparseType (void) -{ - if (nperm != 0) - { - delete [] perm; - } -} - -SparseType& -SparseType::operator = (const SparseType& a) -{ - if (this != &a) - { - typ = a.typ; - sp_bandden = a.sp_bandden; - bandden = a.bandden; - upper_band = a.upper_band; - lower_band = a.lower_band; - dense = a.dense; - nperm = a.nperm; - - if (nperm != 0) - { - perm = new octave_idx_type [nperm]; - for (octave_idx_type i = 0; i < nperm; i++) - perm[i] = a.perm[i]; - } - } - - return *this; -} - -int -SparseType::type (bool quiet) -{ - if (typ != SparseType::Unknown && - sp_bandden == Voctave_sparse_controls.get_key ("bandden")) - { - if (!quiet && - Voctave_sparse_controls.get_key ("spumoni") != 0.) - (*current_liboctave_warning_handler) - ("Using Cached Sparse Matrix Type"); - - return typ; - } - - if (typ != SparseType::Unknown && - Voctave_sparse_controls.get_key ("spumoni") != 0.) - (*current_liboctave_warning_handler) - ("Invalidating Sparse Matrix Type"); - - typ = SparseType::Unknown; - - return typ; -} - -int -SparseType::type (const SparseMatrix &a) -{ - if (typ != SparseType::Unknown && - sp_bandden == Voctave_sparse_controls.get_key ("bandden")) - { - if (Voctave_sparse_controls.get_key ("spumoni") != 0.) - (*current_liboctave_warning_handler) - ("Using Cached Sparse Matrix Type"); - - return typ; - } - - SparseType tmp_typ (a); - typ = tmp_typ.typ; - sp_bandden = tmp_typ.sp_bandden; - bandden = tmp_typ.bandden; - upper_band = tmp_typ.upper_band; - lower_band = tmp_typ.lower_band; - dense = tmp_typ.dense; - nperm = tmp_typ.nperm; - - if (nperm != 0) - { - perm = new octave_idx_type [nperm]; - for (octave_idx_type i = 0; i < nperm; i++) - perm[i] = tmp_typ.perm[i]; - } - - return typ; -} - -int -SparseType::type (const SparseComplexMatrix &a) -{ - if (typ != SparseType::Unknown && - sp_bandden == Voctave_sparse_controls.get_key ("bandden")) - { - if (Voctave_sparse_controls.get_key ("spumoni") != 0.) - (*current_liboctave_warning_handler) - ("Using Cached Sparse Matrix Type"); - - return typ; - } - - SparseType tmp_typ (a); - typ = tmp_typ.typ; - sp_bandden = tmp_typ.sp_bandden; - bandden = tmp_typ.bandden; - upper_band = tmp_typ.upper_band; - lower_band = tmp_typ.lower_band; - dense = tmp_typ.dense; - nperm = tmp_typ.nperm; - - if (nperm != 0) - { - perm = new octave_idx_type [nperm]; - for (octave_idx_type i = 0; i < nperm; i++) - perm[i] = tmp_typ.perm[i]; - } - - return typ; -} - -void -SparseType::info (void) const -{ - if (Voctave_sparse_controls.get_key ("spumoni") != 0.) - { - if (typ == SparseType::Unknown) - (*current_liboctave_warning_handler) - ("Unknown Sparse Matrix Type"); - else if (typ == SparseType::Diagonal) - (*current_liboctave_warning_handler) - ("Diagonal Sparse Matrix"); - else if (typ == SparseType::Permuted_Diagonal) - (*current_liboctave_warning_handler) - ("Permuted Diagonal Sparse Matrix"); - else if (typ == SparseType::Upper) - (*current_liboctave_warning_handler) - ("Upper Triangular Sparse Matrix"); - else if (typ == SparseType::Lower) - (*current_liboctave_warning_handler) - ("Lower Triangular Sparse Matrix"); - else if (typ == SparseType::Permuted_Upper) - (*current_liboctave_warning_handler) - ("Permuted Upper Triangular Sparse Matrix"); - else if (typ == SparseType::Permuted_Lower) - (*current_liboctave_warning_handler) - ("Permuted Lower Triangular Sparse Matrix"); - else if (typ == SparseType::Banded) - (*current_liboctave_warning_handler) - ("Banded Sparse Matrix %d-1-%d (Density %f)", lower_band, - upper_band, bandden); - else if (typ == SparseType::Banded_Hermitian) - (*current_liboctave_warning_handler) - ("Banded Hermitian/Symmetric Sparse Matrix %d-1-%d (Density %f)", - lower_band, upper_band, bandden); - else if (typ == SparseType::Hermitian) - (*current_liboctave_warning_handler) - ("Hermitian/Symmetric Sparse Matrix"); - else if (typ == SparseType::Tridiagonal) - (*current_liboctave_warning_handler) - ("Tridiagonal Sparse Matrix"); - else if (typ == SparseType::Tridiagonal_Hermitian) - (*current_liboctave_warning_handler) - ("Hermitian/Symmetric Tridiagonal Sparse Matrix"); - else if (typ == SparseType::Rectangular) - (*current_liboctave_warning_handler) - ("Rectangular/Singular Sparse Matrix"); - else if (typ == SparseType::Full) - (*current_liboctave_warning_handler) - ("Full Sparse Matrix"); - } -} - -void -SparseType::mark_as_symmetric (void) -{ - if (typ == SparseType::Tridiagonal || - typ == SparseType::Tridiagonal_Hermitian) - typ = SparseType::Tridiagonal_Hermitian; - else if (typ == SparseType::Banded || - typ == SparseType::Banded_Hermitian) - typ = SparseType::Banded_Hermitian; - else if (typ == SparseType::Full || typ == SparseType::Hermitian || - typ == SparseType::Unknown) - typ = SparseType::Hermitian; - else - (*current_liboctave_error_handler) - ("Can not mark current matrix type as symmetric"); -} - -void -SparseType::mark_as_unsymmetric (void) -{ - if (typ == SparseType::Tridiagonal || - typ == SparseType::Tridiagonal_Hermitian) - typ = SparseType::Tridiagonal; - else if (typ == SparseType::Banded || - typ == SparseType::Banded_Hermitian) - typ = SparseType::Banded; - else if (typ == SparseType::Full || typ == SparseType::Hermitian || - typ == SparseType::Unknown) - typ = SparseType::Full; -} - -void -SparseType::mark_as_permuted (const octave_idx_type np, const octave_idx_type *p) -{ - nperm = np; - perm = new octave_idx_type [nperm]; - for (octave_idx_type i = 0; i < nperm; i++) - perm[i] = p[i]; - - if (typ == SparseType::Diagonal || typ == SparseType::Permuted_Diagonal) - typ = SparseType::Permuted_Diagonal; - else if (typ == SparseType::Upper || typ == SparseType::Permuted_Upper) - typ = SparseType::Permuted_Upper; - else if (typ == SparseType::Lower || typ == SparseType::Permuted_Lower) - typ = SparseType::Permuted_Lower; - else - (*current_liboctave_error_handler) - ("Can not mark current matrix type as symmetric"); -} - -void -SparseType::mark_as_unpermuted (void) -{ - if (nperm) - { - nperm = 0; - delete [] perm; - } - - if (typ == SparseType::Diagonal || typ == SparseType::Permuted_Diagonal) - typ = SparseType::Diagonal; - else if (typ == SparseType::Upper || typ == SparseType::Permuted_Upper) - typ = SparseType::Upper; - else if (typ == SparseType::Lower || typ == SparseType::Permuted_Lower) - typ = SparseType::Lower; -} - -SparseType -SparseType::transpose (void) const -{ - SparseType retval (*this); - if (typ == SparseType::Upper) - retval.typ = SparseType::Lower; - else if (typ == SparseType::Permuted_Upper) - retval.typ = SparseType::Permuted_Lower; - else if (typ == SparseType::Lower) - retval.typ = SparseType::Upper; - else if (typ == SparseType::Permuted_Lower) - retval.typ = SparseType::Permuted_Upper; - else if (typ == SparseType::Banded) - { - retval.upper_band = lower_band; - retval.lower_band = upper_band; - } - - return retval; -} - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; End: *** -*/ -
deleted file mode 100644 --- a/liboctave/SparseType.h +++ /dev/null @@ -1,165 +0,0 @@ -/* - -Copyright (C) 2004 David Bateman -Copyright (C) 1998-2004 Andy Adler - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with this program; see the file COPYING. If not, write to the -Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -Boston, MA 02110-1301, USA. - -*/ - -#if !defined (octave_SparseType_h) -#define octave_SparseType_h - -class SparseMatrix; -class SparseComplexMatrix; - -class -SparseType -{ -public: - enum matrix_type { - Unknown = 0, - Full, - Diagonal, - Permuted_Diagonal, - Upper, - Lower, - Permuted_Upper, - Permuted_Lower, - Banded, - Hermitian, - Banded_Hermitian, - Tridiagonal, - Tridiagonal_Hermitian, - Rectangular - }; - - SparseType (void); - - SparseType (const SparseType &a); - - SparseType (const SparseMatrix &a); - - SparseType (const SparseComplexMatrix &a); - - SparseType (const matrix_type t); - - SparseType (const matrix_type t, const octave_idx_type np, - const octave_idx_type *p); - - SparseType (const matrix_type t, const octave_idx_type ku, - const octave_idx_type kl); - - ~SparseType (void); - - SparseType& operator = (const SparseType& a); - - int type (bool quiet = true); - - int type (const SparseMatrix &a); - - int type (const SparseComplexMatrix &a); - - double band_density (void) const { return bandden; } - - int nupper (void) const { return upper_band; } - - int nlower (void) const { return lower_band; } - - bool is_dense (void) const { return dense; } - - bool is_diagonal (void) const - { return (typ == Diagonal || typ == Permuted_Diagonal); } - - bool is_upper_triangular (void) const - { return (typ == Upper || typ == Permuted_Upper); } - - bool is_lower_triangular (void) const - { return (typ == Lower || typ == Permuted_Lower); } - - bool is_banded (void) - { return (typ == Banded || typ == Banded_Hermitian); } - - bool is_tridiagonal (void) const - { return (typ == Tridiagonal || typ == Tridiagonal_Hermitian); } - - bool is_hermitian (void) const - { return (typ == Banded_Hermitian || typ == Tridiagonal_Hermitian || - typ == Hermitian); } - - bool is_rectangular (void) const { return (typ == Rectangular); } - - bool is_known (void) const { return (typ != Unknown); } - - bool is_unknown (void) const { return (typ == Unknown); } - - void info (void) const; - - octave_idx_type * triangular_perm (void) const { return perm; } - - void invalidate_type (void) { typ = Unknown; } - - void mark_as_diagonal (void) { typ = Diagonal; } - - void mark_as_permuted_diagonal (void) { typ = Permuted_Diagonal; } - - void mark_as_upper_triangular (void) { typ = Upper; } - - void mark_as_lower_triangular (void) { typ = Lower; } - - void mark_as_tridiagonal (void) {typ = Tridiagonal; } - - void mark_as_banded (const octave_idx_type ku, const octave_idx_type kl) - { typ = Banded; upper_band = ku; lower_band = kl; } - - void mark_as_full (void) { typ = Full; } - - void mark_as_rectangular (void) { typ = Rectangular; } - - void mark_as_dense (void) { dense = true; } - - void mark_as_not_dense (void) { dense = false; } - - void mark_as_symmetric (void); - - void mark_as_unsymmetric (void); - - void mark_as_permuted (const octave_idx_type np, const octave_idx_type *p); - - void mark_as_unpermuted (void); - - SparseType transpose (void) const; - -private: - void type (int new_typ) { typ = static_cast<matrix_type>(new_typ); } - - matrix_type typ; - double sp_bandden; - double bandden; - octave_idx_type upper_band; - octave_idx_type lower_band; - bool dense; - octave_idx_type nperm; - octave_idx_type *perm; -}; - -#endif - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; End: *** -*/
--- a/liboctave/SparsedbleCHOL.cc +++ b/liboctave/SparsedbleCHOL.cc @@ -42,18 +42,18 @@ if (r_nr == r_nc) { - SparseType mattype (r); + MatrixType mattype (r); int typ = mattype.type (false); double rcond; octave_idx_type info; SparseMatrix rinv; - if (typ == SparseType::Upper) + if (typ == MatrixType::Upper) { rinv = r.inverse(mattype, info, rcond, true, false); retval = rinv.transpose() * rinv; } - else if (typ == SparseType::Lower) + else if (typ == MatrixType::Lower) { rinv = r.transpose().inverse(mattype, info, rcond, true, false); retval = rinv.transpose() * rinv;
--- a/liboctave/dMatrix.cc +++ b/liboctave/dMatrix.cc @@ -108,6 +108,41 @@ const octave_idx_type&, double*, double&, octave_idx_type&, double*, const octave_idx_type&, octave_idx_type&); + F77_RET_T + F77_FUNC (dpotrf, DPOTRF) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, + double *, const octave_idx_type&, + octave_idx_type& F77_CHAR_ARG_LEN_DECL); + + F77_RET_T + F77_FUNC (dpocon, DPOCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, + double*, const octave_idx_type&, const double&, + double&, double*, octave_idx_type*, + octave_idx_type& F77_CHAR_ARG_LEN_DECL); + F77_RET_T + F77_FUNC (dpotrs, DPOTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, + const octave_idx_type&, const double*, + const octave_idx_type&, double*, + const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL); + + F77_RET_T + F77_FUNC (dtrcon, DTRCON) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, + const double*, const octave_idx_type&, double&, + double*, octave_idx_type*, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); + F77_RET_T + F77_FUNC (dtrtrs, DTRTRS) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, + const octave_idx_type&, const double*, + const octave_idx_type&, double*, + const octave_idx_type&, octave_idx_type& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); + // Note that the original complex fft routines were not written for // double complex arguments. They have been modified by adding an // implicit double precision (a-h,o-z) statement at the beginning of @@ -1154,6 +1189,569 @@ } Matrix +Matrix::utsolve (MatrixType &mattype, const Matrix& b, octave_idx_type& info, + double& rcond, solve_singularity_handler sing_handler, + bool calc_cond) const +{ + Matrix retval; + + octave_idx_type nr = rows (); + octave_idx_type nc = cols (); + + if (nr == 0 || nc == 0 || nr != b.rows ()) + (*current_liboctave_error_handler) + ("matrix dimension mismatch solution of linear equations"); + else + { + volatile int typ = mattype.type (); + + if (typ == MatrixType::Permuted_Upper || + typ == MatrixType::Upper) + { + octave_idx_type b_nc = b.cols (); + rcond = 1.; + info = 0; + + if (typ == MatrixType::Permuted_Upper) + { + (*current_liboctave_error_handler) + ("Permuted triangular matrix not implemented"); + } + else + { + const double *tmp_data = fortran_vec (); + + if (calc_cond) + { + char norm = '1'; + char uplo = 'U'; + char dia = 'N'; + + Array<double> z (3 * nc); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nc); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (dtrcon, DTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), + F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&dia, 1), + nr, tmp_data, nr, rcond, + pz, piz, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in dtrcon"); + + if (info != 0) + info = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + info = -2; + + if (sing_handler) + sing_handler (rcond); + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + + if (info == 0) + { + retval = b; + double *result = retval.fortran_vec (); + + char uplo = 'U'; + char trans = 'N'; + char dia = 'N'; + + F77_XFCN (dtrtrs, DTRTRS, (F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&trans, 1), + F77_CONST_CHAR_ARG2 (&dia, 1), + nr, b_nc, tmp_data, nr, + result, nr, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in dtrtrs"); + } + } + } + else + (*current_liboctave_error_handler) ("incorrect matrix type"); + } + + return retval; +} + +Matrix +Matrix::ltsolve (MatrixType &mattype, const Matrix& b, octave_idx_type& info, + double& rcond, solve_singularity_handler sing_handler, + bool calc_cond) const +{ + Matrix retval; + + octave_idx_type nr = rows (); + octave_idx_type nc = cols (); + + if (nr == 0 || nc == 0 || nr != b.rows ()) + (*current_liboctave_error_handler) + ("matrix dimension mismatch solution of linear equations"); + else + { + volatile int typ = mattype.type (); + + if (typ == MatrixType::Permuted_Lower || + typ == MatrixType::Lower) + { + octave_idx_type b_nc = b.cols (); + rcond = 1.; + info = 0; + + if (typ == MatrixType::Permuted_Lower) + { + (*current_liboctave_error_handler) + ("Permuted triangular matrix not implemented"); + } + else + { + const double *tmp_data = fortran_vec (); + + if (calc_cond) + { + char norm = '1'; + char uplo = 'L'; + char dia = 'N'; + + Array<double> z (3 * nc); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nc); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (dtrcon, DTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), + F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&dia, 1), + nr, tmp_data, nr, rcond, + pz, piz, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in dtrcon"); + + if (info != 0) + info = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + info = -2; + + if (sing_handler) + sing_handler (rcond); + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + + if (info == 0) + { + retval = b; + double *result = retval.fortran_vec (); + + char uplo = 'L'; + char trans = 'N'; + char dia = 'N'; + + F77_XFCN (dtrtrs, DTRTRS, (F77_CONST_CHAR_ARG2 (&uplo, 1), + F77_CONST_CHAR_ARG2 (&trans, 1), + F77_CONST_CHAR_ARG2 (&dia, 1), + nr, b_nc, tmp_data, nr, + result, nr, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in dtrtrs"); + } + } + } + else + (*current_liboctave_error_handler) ("incorrect matrix type"); + } + + return retval; +} + +Matrix +Matrix::fsolve (MatrixType &mattype, const Matrix& b, octave_idx_type& info, + double& rcond, solve_singularity_handler sing_handler, + bool calc_cond) const +{ + Matrix retval; + + octave_idx_type nr = rows (); + octave_idx_type nc = cols (); + + if (nr == 0 || nc == 0 || nr != nc || nr != b.rows ()) + (*current_liboctave_error_handler) + ("matrix dimension mismatch solution of linear equations"); + else + { + volatile int typ = mattype.type (); + + // Calculate the norm of the matrix, for later use. + double anorm = -1.; + + if (typ == MatrixType::Hermitian) + { + info = 0; + char job = 'L'; + Matrix atmp = *this; + double *tmp_data = atmp.fortran_vec (); + anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); + + F77_XFCN (dpotrf, DPOTRF, (F77_CONST_CHAR_ARG2 (&job, 1), nr, + tmp_data, nr, info + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in dpotrf"); + else + { + // Throw-away extra info LAPACK gives so as to not change output. + rcond = 0.0; + if (info != 0) + { + info = -2; + + mattype.mark_as_unsymmetric (); + typ = MatrixType::Full; + } + else + { + if (calc_cond) + { + Array<double> z (3 * nc); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nc); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (dpocon, DPOCON, (F77_CONST_CHAR_ARG2 (&job, 1), + nr, tmp_data, nr, anorm, + rcond, pz, piz, info + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in dpocon"); + + if (info != 0) + info = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + info = -2; + + if (sing_handler) + sing_handler (rcond); + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + + if (info == 0) + { + retval = b; + double *result = retval.fortran_vec (); + + octave_idx_type b_nc = b.cols (); + + F77_XFCN (dpotrs, DPOTRS, (F77_CONST_CHAR_ARG2 (&job, 1), + nr, b_nc, tmp_data, nr, + result, b.rows(), info + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in dpotrs"); + } + else + { + mattype.mark_as_unsymmetric (); + typ = MatrixType::Full; + } + } + } + } + + if (typ == MatrixType::Full) + { + info = 0; + + Array<octave_idx_type> ipvt (nr); + octave_idx_type *pipvt = ipvt.fortran_vec (); + + Matrix atmp = *this; + double *tmp_data = atmp.fortran_vec (); + if(anorm < 0.) + anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); + + Array<double> z (4 * nc); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (nc); + octave_idx_type *piz = iz.fortran_vec (); + + F77_XFCN (dgetrf, DGETRF, (nr, nr, tmp_data, nr, pipvt, info)); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in dgetrf"); + else + { + // Throw-away extra info LAPACK gives so as to not change output. + rcond = 0.0; + if (info != 0) + { + info = -2; + + if (sing_handler) + sing_handler (rcond); + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision"); + + mattype.mark_as_rectangular (); + } + else + { + if (calc_cond) + { + // Now calculate the condition number for + // non-singular matrix. + char job = '1'; + F77_XFCN (dgecon, DGECON, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, tmp_data, nr, anorm, + rcond, pz, piz, info + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in dgecon"); + + if (info != 0) + info = -2; + + volatile double rcond_plus_one = rcond + 1.0; + + if (rcond_plus_one == 1.0 || xisnan (rcond)) + { + info = -2; + + if (sing_handler) + sing_handler (rcond); + else + (*current_liboctave_error_handler) + ("matrix singular to machine precision, rcond = %g", + rcond); + } + } + + if (info == 0) + { + retval = b; + double *result = retval.fortran_vec (); + + octave_idx_type b_nc = b.cols (); + + char job = 'N'; + F77_XFCN (dgetrs, DGETRS, (F77_CONST_CHAR_ARG2 (&job, 1), + nr, b_nc, tmp_data, nr, + pipvt, result, b.rows(), info + F77_CHAR_ARG_LEN (1))); + + if (f77_exception_encountered) + (*current_liboctave_error_handler) + ("unrecoverable error in dgetrs"); + } + else + mattype.mark_as_rectangular (); + } + } + } + else if (typ != MatrixType::Hermitian) + (*current_liboctave_error_handler) ("incorrect matrix type"); + } + + return retval; +} + +Matrix +Matrix::solve (MatrixType &typ, const Matrix& b) const +{ + octave_idx_type info; + double rcond; + return solve (typ, b, info, rcond, 0); +} + +Matrix +Matrix::solve (MatrixType &typ, const Matrix& b, octave_idx_type& info, + double& rcond) const +{ + return solve (typ, b, info, rcond, 0); +} + +Matrix +Matrix::solve (MatrixType &mattype, const Matrix& b, octave_idx_type& info, + double& rcond, solve_singularity_handler sing_handler, + bool singular_fallback) const +{ + Matrix retval; + int typ = mattype.type (); + + if (typ == MatrixType::Unknown) + typ = mattype.type (*this); + + // Only calculate the condition number for LU/Cholesky + if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) + retval = utsolve (mattype, b, info, rcond, sing_handler, false); + else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) + retval = ltsolve (mattype, b, info, rcond, sing_handler, false); + else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) + retval = fsolve (mattype, b, info, rcond, sing_handler, true); + else if (typ != MatrixType::Rectangular) + { + (*current_liboctave_error_handler) ("unknown matrix type"); + return Matrix (); + } + + // Rectangular or one of the above solvers flags a singular matrix + if (singular_fallback && mattype.type () == MatrixType::Rectangular) + { + octave_idx_type rank; + retval = lssolve (b, info, rank); + } + + return retval; +} + +ComplexMatrix +Matrix::solve (MatrixType &typ, const ComplexMatrix& b) const +{ + ComplexMatrix tmp (*this); + return tmp.solve (typ, b); +} + +ComplexMatrix +Matrix::solve (MatrixType &typ, const ComplexMatrix& b, + octave_idx_type& info) const +{ + ComplexMatrix tmp (*this); + return tmp.solve (typ, b, info); +} + +ComplexMatrix +Matrix::solve (MatrixType &typ, const ComplexMatrix& b, octave_idx_type& info, + double& rcond) const +{ + ComplexMatrix tmp (*this); + return tmp.solve (typ, b, info, rcond); +} + +ComplexMatrix +Matrix::solve (MatrixType &typ, const ComplexMatrix& b, octave_idx_type& info, + double& rcond, solve_singularity_handler sing_handler, + bool singular_fallback) const +{ + ComplexMatrix tmp (*this); + return tmp.solve (typ, b, info, rcond, sing_handler, singular_fallback); +} + +ColumnVector +Matrix::solve (MatrixType &typ, const ColumnVector& b) const +{ + octave_idx_type info; double rcond; + return solve (typ, b, info, rcond); +} + +ColumnVector +Matrix::solve (MatrixType &typ, const ColumnVector& b, + octave_idx_type& info) const +{ + double rcond; + return solve (typ, b, info, rcond); +} + +ColumnVector +Matrix::solve (MatrixType &typ, const ColumnVector& b, octave_idx_type& info, + double& rcond) const +{ + return solve (typ, b, info, rcond, 0); +} + +ColumnVector +Matrix::solve (MatrixType &typ, const ColumnVector& b, octave_idx_type& info, + double& rcond, solve_singularity_handler sing_handler) const +{ + Matrix tmp (b); + return solve (typ, tmp, info, rcond, sing_handler).column(static_cast<octave_idx_type> (0)); +} + +ComplexColumnVector +Matrix::solve (MatrixType &typ, const ComplexColumnVector& b) const +{ + ComplexMatrix tmp (*this); + return tmp.solve (typ, b); +} + +ComplexColumnVector +Matrix::solve (MatrixType &typ, const ComplexColumnVector& b, + octave_idx_type& info) const +{ + ComplexMatrix tmp (*this); + return tmp.solve (typ, b, info); +} + +ComplexColumnVector +Matrix::solve (MatrixType &typ, const ComplexColumnVector& b, + octave_idx_type& info, double& rcond) const +{ + ComplexMatrix tmp (*this); + return tmp.solve (typ, b, info, rcond); +} + +ComplexColumnVector +Matrix::solve (MatrixType &typ, const ComplexColumnVector& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler) const +{ + ComplexMatrix tmp (*this); + return tmp.solve(typ, b, info, rcond, sing_handler); +} + +Matrix Matrix::solve (const Matrix& b) const { octave_idx_type info; @@ -1175,105 +1773,11 @@ } Matrix -Matrix::solve (const Matrix& b, octave_idx_type& info, double& rcond, - solve_singularity_handler sing_handler) const +Matrix::solve (const Matrix& b, octave_idx_type& info, + double& rcond, solve_singularity_handler sing_handler) const { - Matrix retval; - - octave_idx_type nr = rows (); - octave_idx_type nc = cols (); - - if (nr == 0 || nc == 0 || nr != nc || nr != b.rows ()) - (*current_liboctave_error_handler) - ("matrix dimension mismatch solution of linear equations"); - else - { - info = 0; - - Array<octave_idx_type> ipvt (nr); - octave_idx_type *pipvt = ipvt.fortran_vec (); - - Matrix atmp = *this; - double *tmp_data = atmp.fortran_vec (); - - Array<double> z (4 * nc); - double *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nc); - octave_idx_type *piz = iz.fortran_vec (); - - // Calculate the norm of the matrix, for later use. - double anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); - - F77_XFCN (dgetrf, DGETRF, (nr, nr, tmp_data, nr, pipvt, info)); - - if (f77_exception_encountered) - (*current_liboctave_error_handler) ("unrecoverable error in dgetrf"); - else - { - // Throw-away extra info LAPACK gives so as to not change output. - rcond = 0.0; - if (info != 0) - { - info = -2; - - if (sing_handler) - sing_handler (rcond); - else - (*current_liboctave_error_handler) - ("matrix singular to machine precision"); - - } - else - { - // Now calculate the condition number for non-singular matrix. - char job = '1'; - F77_XFCN (dgecon, DGECON, (F77_CONST_CHAR_ARG2 (&job, 1), - nc, tmp_data, nr, anorm, - rcond, pz, piz, info - F77_CHAR_ARG_LEN (1))); - - if (f77_exception_encountered) - (*current_liboctave_error_handler) - ("unrecoverable error in dgecon"); - - if (info != 0) - info = -2; - - volatile double rcond_plus_one = rcond + 1.0; - - if (rcond_plus_one == 1.0 || xisnan (rcond)) - { - info = -2; - - if (sing_handler) - sing_handler (rcond); - else - (*current_liboctave_error_handler) - ("matrix singular to machine precision, rcond = %g", - rcond); - } - else - { - retval = b; - double *result = retval.fortran_vec (); - - octave_idx_type b_nc = b.cols (); - - job = 'N'; - F77_XFCN (dgetrs, DGETRS, (F77_CONST_CHAR_ARG2 (&job, 1), - nr, b_nc, tmp_data, nr, - pipvt, result, b.rows(), info - F77_CHAR_ARG_LEN (1))); - - if (f77_exception_encountered) - (*current_liboctave_error_handler) - ("unrecoverable error in dgetrs"); - } - } - } - } - - return retval; + MatrixType mattype (*this); + return solve (mattype, b, info, rcond, sing_handler); } ComplexMatrix @@ -1329,100 +1833,8 @@ Matrix::solve (const ColumnVector& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler) const { - ColumnVector retval; - - octave_idx_type nr = rows (); - octave_idx_type nc = cols (); - - if (nr == 0 || nc == 0 || nr != nc || nr != b.length ()) - (*current_liboctave_error_handler) - ("matrix dimension mismatch solution of linear equations"); - else - { - info = 0; - - Array<octave_idx_type> ipvt (nr); - octave_idx_type *pipvt = ipvt.fortran_vec (); - - Matrix atmp = *this; - double *tmp_data = atmp.fortran_vec (); - - Array<double> z (4 * nc); - double *pz = z.fortran_vec (); - Array<octave_idx_type> iz (nc); - octave_idx_type *piz = iz.fortran_vec (); - - // Calculate the norm of the matrix, for later use. - double anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); - - F77_XFCN (dgetrf, DGETRF, (nr, nr, tmp_data, nr, pipvt, info)); - - if (f77_exception_encountered) - (*current_liboctave_error_handler) ("unrecoverable error in dgetrf"); - else - { - // Throw-away extra info LAPACK gives so as to not change output. - rcond = 0.0; - if (info > 0) - { - info = -2; - - if (sing_handler) - sing_handler (rcond); - else - (*current_liboctave_error_handler) - ("matrix singular to machine precision"); - - } - else - { - // Now calculate the condition number for non-singular matrix. - char job = '1'; - F77_XFCN (dgecon, DGECON, (F77_CONST_CHAR_ARG2 (&job, 1), - nc, tmp_data, nr, anorm, - rcond, pz, piz, info - F77_CHAR_ARG_LEN (1))); - - if (f77_exception_encountered) - (*current_liboctave_error_handler) - ("unrecoverable error in dgecon"); - - if (info != 0) - info = -2; - - volatile double rcond_plus_one = rcond + 1.0; - - if (rcond_plus_one == 1.0 || xisnan (rcond)) - { - info = -2; - - if (sing_handler) - sing_handler (rcond); - else - (*current_liboctave_error_handler) - ("matrix singular to machine precision, rcond = %g", - rcond); - } - else - { - retval = b; - double *result = retval.fortran_vec (); - - job = 'N'; - F77_XFCN (dgetrs, DGETRS, (F77_CONST_CHAR_ARG2 (&job, 1), - nr, 1, tmp_data, nr, pipvt, - result, b.length(), info - F77_CHAR_ARG_LEN (1))); - - if (f77_exception_encountered) - (*current_liboctave_error_handler) - ("unrecoverable error in dgetrs"); - } - } - } - } - - return retval; + MatrixType mattype (*this); + return solve (mattype, b, info, rcond, sing_handler); } ComplexColumnVector
--- a/liboctave/dMatrix.h +++ b/liboctave/dMatrix.h @@ -26,6 +26,7 @@ #include "MArray2.h" #include "MDiagArray2.h" +#include "MatrixType.h" #include "mx-defs.h" #include "mx-op-defs.h" @@ -122,6 +123,62 @@ DET determinant (octave_idx_type& info) const; DET determinant (octave_idx_type& info, double& rcond, int calc_cond = 1) const; +private: + // Upper triangular matrix solvers + Matrix utsolve (MatrixType &typ, const Matrix& b, octave_idx_type& info, + double& rcond, solve_singularity_handler sing_handler, + bool calc_cond = false) const; + + // Lower triangular matrix solvers + Matrix ltsolve (MatrixType &typ, const Matrix& b, octave_idx_type& info, + double& rcond, solve_singularity_handler sing_handler, + bool calc_cond = false) const; + + // Full matrix solvers (lu/cholesky) + Matrix fsolve (MatrixType &typ, const Matrix& b, octave_idx_type& info, + double& rcond, solve_singularity_handler sing_handler, + bool calc_cond = false) const; + +public: + // Generic interface to solver with no probing of type + Matrix solve (MatrixType &typ, const Matrix& b) const; + Matrix solve (MatrixType &typ, const Matrix& b, octave_idx_type& info) const; + Matrix solve (MatrixType &typ, const Matrix& b, octave_idx_type& info, + double& rcond) const; + Matrix solve (MatrixType &typ, const Matrix& b, octave_idx_type& info, + double& rcond, solve_singularity_handler sing_handler, + bool singular_fallback = true) const; + + ComplexMatrix solve (MatrixType &typ, const ComplexMatrix& b) const; + ComplexMatrix solve (MatrixType &typ, const ComplexMatrix& b, + octave_idx_type& info) const; + ComplexMatrix solve (MatrixType &typ, const ComplexMatrix& b, + octave_idx_type& info, double& rcond) const; + ComplexMatrix solve (MatrixType &typ, const ComplexMatrix& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler, + bool singular_fallback = true) const; + + ColumnVector solve (MatrixType &typ, const ColumnVector& b) const; + ColumnVector solve (MatrixType &typ, const ColumnVector& b, + octave_idx_type& info) const; + ColumnVector solve (MatrixType &typ, const ColumnVector& b, + octave_idx_type& info, double& rcond) const; + ColumnVector solve (MatrixType &typ, const ColumnVector& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler) const; + + ComplexColumnVector solve (MatrixType &typ, + const ComplexColumnVector& b) const; + ComplexColumnVector solve (MatrixType &typ, const ComplexColumnVector& b, + octave_idx_type& info) const; + ComplexColumnVector solve (MatrixType &typ, const ComplexColumnVector& b, + octave_idx_type& info, double& rcond) const; + ComplexColumnVector solve (MatrixType &typ, const ComplexColumnVector& b, + octave_idx_type& info, double& rcond, + solve_singularity_handler sing_handler) const; + + // Generic interface to solver with probing of type Matrix solve (const Matrix& b) const; Matrix solve (const Matrix& b, octave_idx_type& info) const; Matrix solve (const Matrix& b, octave_idx_type& info, double& rcond) const; @@ -148,6 +205,7 @@ double& rcond, solve_singularity_handler sing_handler) const; + // Singular solvers Matrix lssolve (const Matrix& b) const; Matrix lssolve (const Matrix& b, octave_idx_type& info) const; Matrix lssolve (const Matrix& b, octave_idx_type& info, octave_idx_type& rank) const;
--- a/liboctave/dSparse.cc +++ b/liboctave/dSparse.cc @@ -40,7 +40,7 @@ #include "dSparse.h" #include "oct-spparms.h" #include "SparsedbleLU.h" -#include "SparseType.h" +#include "MatrixType.h" #include "oct-sparse.h" #include "sparse-util.h" #include "SparsedbleCHOL.h" @@ -684,12 +684,12 @@ { octave_idx_type info; double rcond; - SparseType mattype (*this); + MatrixType mattype (*this); return inverse (mattype, info, rcond, 0, 0); } SparseMatrix -SparseMatrix::inverse (SparseType& mattype) const +SparseMatrix::inverse (MatrixType& mattype) const { octave_idx_type info; double rcond; @@ -697,14 +697,14 @@ } SparseMatrix -SparseMatrix::inverse (SparseType& mattype, octave_idx_type& info) const +SparseMatrix::inverse (MatrixType& mattype, octave_idx_type& info) const { double rcond; return inverse (mattype, info, rcond, 0, 0); } SparseMatrix -SparseMatrix::dinverse (SparseType &mattyp, octave_idx_type& info, +SparseMatrix::dinverse (MatrixType &mattyp, octave_idx_type& info, double& rcond, const bool, const bool calccond) const { @@ -722,10 +722,10 @@ int typ = mattyp.type (); mattyp.info (); - if (typ == SparseType::Diagonal || - typ == SparseType::Permuted_Diagonal) + if (typ == MatrixType::Diagonal || + typ == MatrixType::Permuted_Diagonal) { - if (typ == SparseType::Permuted_Diagonal) + if (typ == MatrixType::Permuted_Diagonal) retval = transpose(); else retval = *this; @@ -758,7 +758,7 @@ } SparseMatrix -SparseMatrix::tinverse (SparseType &mattyp, octave_idx_type& info, +SparseMatrix::tinverse (MatrixType &mattyp, octave_idx_type& info, double& rcond, const bool, const bool calccond) const { @@ -776,8 +776,8 @@ int typ = mattyp.type (); mattyp.info (); - if (typ == SparseType::Upper || typ == SparseType::Permuted_Upper || - typ == SparseType::Lower || typ == SparseType::Permuted_Lower) + if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper || + typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) { double anorm = 0.; double ainvnorm = 0.; @@ -795,7 +795,7 @@ } } - if (typ == SparseType::Upper || typ == SparseType::Lower) + if (typ == MatrixType::Upper || typ == MatrixType::Lower) { octave_idx_type nz = nnz (); octave_idx_type cx = 0; @@ -891,7 +891,7 @@ OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nr); octave_idx_type *perm = mattyp.triangular_perm(); - if (typ == SparseType::Permuted_Upper) + if (typ == MatrixType::Permuted_Upper) { for (octave_idx_type i = 0; i < nr; i++) rperm[perm[i]] = i; @@ -996,26 +996,26 @@ } SparseMatrix -SparseMatrix::inverse (SparseType &mattype, octave_idx_type& info, +SparseMatrix::inverse (MatrixType &mattype, octave_idx_type& info, double& rcond, int, int calc_cond) const { int typ = mattype.type (false); SparseMatrix ret; - if (typ == SparseType::Unknown) + if (typ == MatrixType::Unknown) typ = mattype.type (*this); - if (typ == SparseType::Diagonal || typ == SparseType::Permuted_Diagonal) + if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) ret = dinverse (mattype, info, rcond, true, calc_cond); - else if (typ == SparseType::Upper || typ == SparseType::Permuted_Upper) + else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) ret = tinverse (mattype, info, rcond, true, calc_cond).transpose(); - else if (typ == SparseType::Lower || typ == SparseType::Permuted_Lower) + else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) ret = transpose().tinverse (mattype, info, rcond, true, calc_cond); - else if (typ != SparseType::Rectangular) + else if (typ != MatrixType::Rectangular) { if (mattype.is_hermitian()) { - SparseType tmp_typ (SparseType::Upper); + MatrixType tmp_typ (MatrixType::Upper); SparseCHOL fact (*this, info, false); rcond = fact.rcond(); if (info == 0) @@ -1030,7 +1030,7 @@ { // Matrix is either singular or not positive definite mattype.mark_as_unsymmetric (); - typ = SparseType::Full; + typ = MatrixType::Full; } } @@ -1041,7 +1041,7 @@ for (octave_idx_type i = 0; i < n; i++) Qinit(i) = i; - SparseType tmp_typ (SparseType::Upper); + MatrixType tmp_typ (MatrixType::Upper); SparseLU fact (*this, Qinit, -1.0, false); rcond = fact.rcond(); double rcond2; @@ -1194,7 +1194,7 @@ } Matrix -SparseMatrix::dsolve (SparseType &mattype, const Matrix& b, octave_idx_type& err, +SparseMatrix::dsolve (MatrixType &mattype, const Matrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler, bool calc_cond) const { @@ -1214,11 +1214,11 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Diagonal || - typ == SparseType::Permuted_Diagonal) + if (typ == MatrixType::Diagonal || + typ == MatrixType::Permuted_Diagonal) { retval.resize (nc, b.cols(), 0.); - if (typ == SparseType::Diagonal) + if (typ == MatrixType::Diagonal) for (octave_idx_type j = 0; j < b.cols(); j++) for (octave_idx_type i = 0; i < nm; i++) retval(i,j) = b(i,j) / data (i); @@ -1252,7 +1252,7 @@ } SparseMatrix -SparseMatrix::dsolve (SparseType &mattype, const SparseMatrix& b, +SparseMatrix::dsolve (MatrixType &mattype, const SparseMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler, bool calc_cond) const { @@ -1272,8 +1272,8 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Diagonal || - typ == SparseType::Permuted_Diagonal) + if (typ == MatrixType::Diagonal || + typ == MatrixType::Permuted_Diagonal) { octave_idx_type b_nc = b.cols (); octave_idx_type b_nz = b.nnz (); @@ -1281,7 +1281,7 @@ retval.xcidx(0) = 0; octave_idx_type ii = 0; - if (typ == SparseType::Diagonal) + if (typ == MatrixType::Diagonal) for (octave_idx_type j = 0; j < b_nc; j++) { for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) @@ -1340,7 +1340,7 @@ } ComplexMatrix -SparseMatrix::dsolve (SparseType &mattype, const ComplexMatrix& b, +SparseMatrix::dsolve (MatrixType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler, bool calc_cond) const { @@ -1360,11 +1360,11 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Diagonal || - typ == SparseType::Permuted_Diagonal) + if (typ == MatrixType::Diagonal || + typ == MatrixType::Permuted_Diagonal) { retval.resize (nc, b.cols(), 0); - if (typ == SparseType::Diagonal) + if (typ == MatrixType::Diagonal) for (octave_idx_type j = 0; j < b.cols(); j++) for (octave_idx_type i = 0; i < nm; i++) retval(i,j) = b(i,j) / data (i); @@ -1398,7 +1398,7 @@ } SparseComplexMatrix -SparseMatrix::dsolve (SparseType &mattype, const SparseComplexMatrix& b, +SparseMatrix::dsolve (MatrixType &mattype, const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler, bool calc_cond) const { @@ -1418,8 +1418,8 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Diagonal || - typ == SparseType::Permuted_Diagonal) + if (typ == MatrixType::Diagonal || + typ == MatrixType::Permuted_Diagonal) { octave_idx_type b_nc = b.cols (); octave_idx_type b_nz = b.nnz (); @@ -1427,7 +1427,7 @@ retval.xcidx(0) = 0; octave_idx_type ii = 0; - if (typ == SparseType::Diagonal) + if (typ == MatrixType::Diagonal) for (octave_idx_type j = 0; j < b.cols(); j++) { for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) @@ -1486,7 +1486,7 @@ } Matrix -SparseMatrix::utsolve (SparseType &mattype, const Matrix& b, +SparseMatrix::utsolve (MatrixType &mattype, const Matrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -1507,8 +1507,8 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Permuted_Upper || - typ == SparseType::Upper) + if (typ == MatrixType::Permuted_Upper || + typ == MatrixType::Upper) { double anorm = 0.; double ainvnorm = 0.; @@ -1528,7 +1528,7 @@ } } - if (typ == SparseType::Permuted_Upper) + if (typ == MatrixType::Permuted_Upper) { retval.resize (nc, b_nc); octave_idx_type *perm = mattype.triangular_perm (); @@ -1719,7 +1719,7 @@ } SparseMatrix -SparseMatrix::utsolve (SparseType &mattype, const SparseMatrix& b, +SparseMatrix::utsolve (MatrixType &mattype, const SparseMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -1740,8 +1740,8 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Permuted_Upper || - typ == SparseType::Upper) + if (typ == MatrixType::Permuted_Upper || + typ == MatrixType::Upper) { double anorm = 0.; double ainvnorm = 0.; @@ -1767,7 +1767,7 @@ octave_idx_type ii = 0; octave_idx_type x_nz = b_nz; - if (typ == SparseType::Permuted_Upper) + if (typ == MatrixType::Permuted_Upper) { octave_idx_type *perm = mattype.triangular_perm (); OCTAVE_LOCAL_BUFFER (double, work, nm); @@ -2004,7 +2004,7 @@ } ComplexMatrix -SparseMatrix::utsolve (SparseType &mattype, const ComplexMatrix& b, +SparseMatrix::utsolve (MatrixType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -2025,8 +2025,8 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Permuted_Upper || - typ == SparseType::Upper) + if (typ == MatrixType::Permuted_Upper || + typ == MatrixType::Upper) { double anorm = 0.; double ainvnorm = 0.; @@ -2046,7 +2046,7 @@ } } - if (typ == SparseType::Permuted_Upper) + if (typ == MatrixType::Permuted_Upper) { retval.resize (nc, b_nc); octave_idx_type *perm = mattype.triangular_perm (); @@ -2240,7 +2240,7 @@ } SparseComplexMatrix -SparseMatrix::utsolve (SparseType &mattype, const SparseComplexMatrix& b, +SparseMatrix::utsolve (MatrixType &mattype, const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -2261,8 +2261,8 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Permuted_Upper || - typ == SparseType::Upper) + if (typ == MatrixType::Permuted_Upper || + typ == MatrixType::Upper) { double anorm = 0.; double ainvnorm = 0.; @@ -2288,7 +2288,7 @@ octave_idx_type ii = 0; octave_idx_type x_nz = b_nz; - if (typ == SparseType::Permuted_Upper) + if (typ == MatrixType::Permuted_Upper) { octave_idx_type *perm = mattype.triangular_perm (); OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); @@ -2528,7 +2528,7 @@ } Matrix -SparseMatrix::ltsolve (SparseType &mattype, const Matrix& b, +SparseMatrix::ltsolve (MatrixType &mattype, const Matrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -2549,8 +2549,8 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Permuted_Lower || - typ == SparseType::Lower) + if (typ == MatrixType::Permuted_Lower || + typ == MatrixType::Lower) { double anorm = 0.; double ainvnorm = 0.; @@ -2570,7 +2570,7 @@ } } - if (typ == SparseType::Permuted_Lower) + if (typ == MatrixType::Permuted_Lower) { retval.resize (nc, b_nc); OCTAVE_LOCAL_BUFFER (double, work, nm); @@ -2786,7 +2786,7 @@ } SparseMatrix -SparseMatrix::ltsolve (SparseType &mattype, const SparseMatrix& b, +SparseMatrix::ltsolve (MatrixType &mattype, const SparseMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -2807,8 +2807,8 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Permuted_Lower || - typ == SparseType::Lower) + if (typ == MatrixType::Permuted_Lower || + typ == MatrixType::Lower) { double anorm = 0.; double ainvnorm = 0.; @@ -2834,7 +2834,7 @@ octave_idx_type ii = 0; octave_idx_type x_nz = b_nz; - if (typ == SparseType::Permuted_Lower) + if (typ == MatrixType::Permuted_Lower) { OCTAVE_LOCAL_BUFFER (double, work, nm); octave_idx_type *perm = mattype.triangular_perm (); @@ -3091,7 +3091,7 @@ } ComplexMatrix -SparseMatrix::ltsolve (SparseType &mattype, const ComplexMatrix& b, +SparseMatrix::ltsolve (MatrixType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -3112,8 +3112,8 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Permuted_Lower || - typ == SparseType::Lower) + if (typ == MatrixType::Permuted_Lower || + typ == MatrixType::Lower) { double anorm = 0.; double ainvnorm = 0.; @@ -3133,7 +3133,7 @@ } } - if (typ == SparseType::Permuted_Lower) + if (typ == MatrixType::Permuted_Lower) { retval.resize (nc, b_nc); OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); @@ -3350,7 +3350,7 @@ } SparseComplexMatrix -SparseMatrix::ltsolve (SparseType &mattype, const SparseComplexMatrix& b, +SparseMatrix::ltsolve (MatrixType &mattype, const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -3371,8 +3371,8 @@ int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Permuted_Lower || - typ == SparseType::Lower) + if (typ == MatrixType::Permuted_Lower || + typ == MatrixType::Lower) { double anorm = 0.; double ainvnorm = 0.; @@ -3398,7 +3398,7 @@ octave_idx_type ii = 0; octave_idx_type x_nz = b_nz; - if (typ == SparseType::Permuted_Lower) + if (typ == MatrixType::Permuted_Lower) { OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); octave_idx_type *perm = mattype.triangular_perm (); @@ -3657,7 +3657,7 @@ } Matrix -SparseMatrix::trisolve (SparseType &mattype, const Matrix& b, +SparseMatrix::trisolve (MatrixType &mattype, const Matrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -3680,7 +3680,7 @@ volatile int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Tridiagonal_Hermitian) + if (typ == MatrixType::Tridiagonal_Hermitian) { OCTAVE_LOCAL_BUFFER (double, D, nr); OCTAVE_LOCAL_BUFFER (double, DL, nr - 1); @@ -3730,13 +3730,13 @@ { err = 0; mattype.mark_as_unsymmetric (); - typ = SparseType::Tridiagonal; + typ = MatrixType::Tridiagonal; } else rcond = 1.; } - if (typ == SparseType::Tridiagonal) + if (typ == MatrixType::Tridiagonal) { OCTAVE_LOCAL_BUFFER (double, DU, nr - 1); OCTAVE_LOCAL_BUFFER (double, D, nr); @@ -3804,7 +3804,7 @@ else rcond = 1.; } - else if (typ != SparseType::Tridiagonal_Hermitian) + else if (typ != MatrixType::Tridiagonal_Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -3812,7 +3812,7 @@ } SparseMatrix -SparseMatrix::trisolve (SparseType &mattype, const SparseMatrix& b, +SparseMatrix::trisolve (MatrixType &mattype, const SparseMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -3836,8 +3836,8 @@ mattype.info (); // Note can't treat symmetric case as there is no dpttrf function - if (typ == SparseType::Tridiagonal || - typ == SparseType::Tridiagonal_Hermitian) + if (typ == MatrixType::Tridiagonal || + typ == MatrixType::Tridiagonal_Hermitian) { OCTAVE_LOCAL_BUFFER (double, DU2, nr - 2); OCTAVE_LOCAL_BUFFER (double, DU, nr - 1); @@ -3962,7 +3962,7 @@ } } } - else if (typ != SparseType::Tridiagonal_Hermitian) + else if (typ != MatrixType::Tridiagonal_Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -3970,7 +3970,7 @@ } ComplexMatrix -SparseMatrix::trisolve (SparseType &mattype, const ComplexMatrix& b, +SparseMatrix::trisolve (MatrixType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -3993,7 +3993,7 @@ volatile int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Tridiagonal_Hermitian) + if (typ == MatrixType::Tridiagonal_Hermitian) { OCTAVE_LOCAL_BUFFER (double, D, nr); OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); @@ -4049,11 +4049,11 @@ { err = 0; mattype.mark_as_unsymmetric (); - typ = SparseType::Tridiagonal; + typ = MatrixType::Tridiagonal; } } - if (typ == SparseType::Tridiagonal) + if (typ == MatrixType::Tridiagonal) { OCTAVE_LOCAL_BUFFER (Complex, DU, nr - 1); OCTAVE_LOCAL_BUFFER (Complex, D, nr); @@ -4124,7 +4124,7 @@ ("matrix singular to machine precision"); } } - else if (typ != SparseType::Tridiagonal_Hermitian) + else if (typ != MatrixType::Tridiagonal_Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -4132,7 +4132,7 @@ } SparseComplexMatrix -SparseMatrix::trisolve (SparseType &mattype, const SparseComplexMatrix& b, +SparseMatrix::trisolve (MatrixType &mattype, const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -4156,8 +4156,8 @@ mattype.info (); // Note can't treat symmetric case as there is no dpttrf function - if (typ == SparseType::Tridiagonal || - typ == SparseType::Tridiagonal_Hermitian) + if (typ == MatrixType::Tridiagonal || + typ == MatrixType::Tridiagonal_Hermitian) { OCTAVE_LOCAL_BUFFER (double, DU2, nr - 2); OCTAVE_LOCAL_BUFFER (double, DU, nr - 1); @@ -4321,7 +4321,7 @@ } } } - else if (typ != SparseType::Tridiagonal_Hermitian) + else if (typ != MatrixType::Tridiagonal_Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -4329,7 +4329,7 @@ } Matrix -SparseMatrix::bsolve (SparseType &mattype, const Matrix& b, +SparseMatrix::bsolve (MatrixType &mattype, const Matrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -4349,7 +4349,7 @@ volatile int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Banded_Hermitian) + if (typ == MatrixType::Banded_Hermitian) { octave_idx_type n_lower = mattype.nlower (); octave_idx_type ldm = n_lower + 1; @@ -4393,7 +4393,7 @@ // Matrix is not positive definite!! Fall through to // unsymmetric banded solver. mattype.mark_as_unsymmetric (); - typ = SparseType::Banded; + typ = MatrixType::Banded; rcond = 0.0; err = 0; } @@ -4467,7 +4467,7 @@ } } - if (typ == SparseType::Banded) + if (typ == MatrixType::Banded) { // Create the storage for the banded form of the sparse matrix int n_upper = mattype.nupper (); @@ -4596,7 +4596,7 @@ } } } - else if (typ != SparseType::Banded_Hermitian) + else if (typ != MatrixType::Banded_Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -4604,7 +4604,7 @@ } SparseMatrix -SparseMatrix::bsolve (SparseType &mattype, const SparseMatrix& b, +SparseMatrix::bsolve (MatrixType &mattype, const SparseMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -4624,7 +4624,7 @@ volatile int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Banded_Hermitian) + if (typ == MatrixType::Banded_Hermitian) { int n_lower = mattype.nlower (); int ldm = n_lower + 1; @@ -4667,7 +4667,7 @@ if (err != 0) { mattype.mark_as_unsymmetric (); - typ = SparseType::Banded; + typ = MatrixType::Banded; rcond = 0.0; err = 0; } @@ -4780,7 +4780,7 @@ } } - if (typ == SparseType::Banded) + if (typ == MatrixType::Banded) { // Create the storage for the banded form of the sparse matrix octave_idx_type n_upper = mattype.nupper (); @@ -4947,7 +4947,7 @@ } } } - else if (typ != SparseType::Banded_Hermitian) + else if (typ != MatrixType::Banded_Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -4955,7 +4955,7 @@ } ComplexMatrix -SparseMatrix::bsolve (SparseType &mattype, const ComplexMatrix& b, +SparseMatrix::bsolve (MatrixType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -4975,7 +4975,7 @@ volatile int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Banded_Hermitian) + if (typ == MatrixType::Banded_Hermitian) { octave_idx_type n_lower = mattype.nlower (); octave_idx_type ldm = n_lower + 1; @@ -5020,7 +5020,7 @@ // Matrix is not positive definite!! Fall through to // unsymmetric banded solver. mattype.mark_as_unsymmetric (); - typ = SparseType::Banded; + typ = MatrixType::Banded; rcond = 0.0; err = 0; } @@ -5137,7 +5137,7 @@ } } - if (typ == SparseType::Banded) + if (typ == MatrixType::Banded) { // Create the storage for the banded form of the sparse matrix int n_upper = mattype.nupper (); @@ -5294,7 +5294,7 @@ } } } - else if (typ != SparseType::Banded_Hermitian) + else if (typ != MatrixType::Banded_Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -5302,7 +5302,7 @@ } SparseComplexMatrix -SparseMatrix::bsolve (SparseType &mattype, const SparseComplexMatrix& b, +SparseMatrix::bsolve (MatrixType &mattype, const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -5322,7 +5322,7 @@ volatile int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Banded_Hermitian) + if (typ == MatrixType::Banded_Hermitian) { int n_lower = mattype.nlower (); int ldm = n_lower + 1; @@ -5367,7 +5367,7 @@ // Matrix is not positive definite!! Fall through to // unsymmetric banded solver. mattype.mark_as_unsymmetric (); - typ = SparseType::Banded; + typ = MatrixType::Banded; rcond = 0.0; err = 0; @@ -5515,7 +5515,7 @@ } } - if (typ == SparseType::Banded) + if (typ == MatrixType::Banded) { // Create the storage for the banded form of the sparse matrix int n_upper = mattype.nupper (); @@ -5704,7 +5704,7 @@ } } } - else if (typ != SparseType::Banded_Hermitian) + else if (typ != MatrixType::Banded_Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -5824,7 +5824,7 @@ } Matrix -SparseMatrix::fsolve (SparseType &mattype, const Matrix& b, +SparseMatrix::fsolve (MatrixType &mattype, const Matrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -5844,7 +5844,7 @@ volatile int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Hermitian) + if (typ == MatrixType::Hermitian) { #ifdef HAVE_CHOLMOD cholmod_common Common; @@ -5945,7 +5945,7 @@ { // Either its indefinite or singular. Try UMFPACK mattype.mark_as_unsymmetric (); - typ = SparseType::Full; + typ = MatrixType::Full; } else { @@ -5993,11 +5993,11 @@ ("CHOLMOD not installed"); mattype.mark_as_unsymmetric (); - typ = SparseType::Full; + typ = MatrixType::Full; #endif } - if (typ == SparseType::Full) + if (typ == MatrixType::Full) { #ifdef HAVE_UMFPACK Matrix Control, Info; @@ -6047,7 +6047,7 @@ (*current_liboctave_error_handler) ("UMFPACK not installed"); #endif } - else if (typ != SparseType::Hermitian) + else if (typ != MatrixType::Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -6055,7 +6055,7 @@ } SparseMatrix -SparseMatrix::fsolve (SparseType &mattype, const SparseMatrix& b, +SparseMatrix::fsolve (MatrixType &mattype, const SparseMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -6075,7 +6075,7 @@ volatile int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Hermitian) + if (typ == MatrixType::Hermitian) { #ifdef HAVE_CHOLMOD cholmod_common Common; @@ -6187,7 +6187,7 @@ { // Either its indefinite or singular. Try UMFPACK mattype.mark_as_unsymmetric (); - typ = SparseType::Full; + typ = MatrixType::Full; } else { @@ -6240,11 +6240,11 @@ ("CHOLMOD not installed"); mattype.mark_as_unsymmetric (); - typ = SparseType::Full; + typ = MatrixType::Full; #endif } - if (typ == SparseType::Full) + if (typ == MatrixType::Full) { #ifdef HAVE_UMFPACK Matrix Control, Info; @@ -6326,7 +6326,7 @@ (*current_liboctave_error_handler) ("UMFPACK not installed"); #endif } - else if (typ != SparseType::Hermitian) + else if (typ != MatrixType::Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -6334,7 +6334,7 @@ } ComplexMatrix -SparseMatrix::fsolve (SparseType &mattype, const ComplexMatrix& b, +SparseMatrix::fsolve (MatrixType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -6354,7 +6354,7 @@ volatile int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Hermitian) + if (typ == MatrixType::Hermitian) { #ifdef HAVE_CHOLMOD cholmod_common Common; @@ -6456,7 +6456,7 @@ { // Either its indefinite or singular. Try UMFPACK mattype.mark_as_unsymmetric (); - typ = SparseType::Full; + typ = MatrixType::Full; } else { @@ -6504,11 +6504,11 @@ ("CHOLMOD not installed"); mattype.mark_as_unsymmetric (); - typ = SparseType::Full; + typ = MatrixType::Full; #endif } - if (typ == SparseType::Full) + if (typ == MatrixType::Full) { #ifdef HAVE_UMFPACK Matrix Control, Info; @@ -6577,7 +6577,7 @@ (*current_liboctave_error_handler) ("UMFPACK not installed"); #endif } - else if (typ != SparseType::Hermitian) + else if (typ != MatrixType::Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -6585,7 +6585,7 @@ } SparseComplexMatrix -SparseMatrix::fsolve (SparseType &mattype, const SparseComplexMatrix& b, +SparseMatrix::fsolve (MatrixType &mattype, const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool calc_cond) const @@ -6605,7 +6605,7 @@ volatile int typ = mattype.type (); mattype.info (); - if (typ == SparseType::Hermitian) + if (typ == MatrixType::Hermitian) { #ifdef HAVE_CHOLMOD cholmod_common Common; @@ -6717,7 +6717,7 @@ { // Either its indefinite or singular. Try UMFPACK mattype.mark_as_unsymmetric (); - typ = SparseType::Full; + typ = MatrixType::Full; } else { @@ -6771,11 +6771,11 @@ ("CHOLMOD not installed"); mattype.mark_as_unsymmetric (); - typ = SparseType::Full; + typ = MatrixType::Full; #endif } - if (typ == SparseType::Full) + if (typ == MatrixType::Full) { #ifdef HAVE_UMFPACK Matrix Control, Info; @@ -6866,7 +6866,7 @@ (*current_liboctave_error_handler) ("UMFPACK not installed"); #endif } - else if (typ != SparseType::Hermitian) + else if (typ != MatrixType::Hermitian) (*current_liboctave_error_handler) ("incorrect matrix type"); } @@ -6874,7 +6874,7 @@ } Matrix -SparseMatrix::solve (SparseType &mattype, const Matrix& b) const +SparseMatrix::solve (MatrixType &mattype, const Matrix& b) const { octave_idx_type info; double rcond; @@ -6882,7 +6882,7 @@ } Matrix -SparseMatrix::solve (SparseType &mattype, const Matrix& b, +SparseMatrix::solve (MatrixType &mattype, const Matrix& b, octave_idx_type& info) const { double rcond; @@ -6890,45 +6890,45 @@ } Matrix -SparseMatrix::solve (SparseType &mattype, const Matrix& b, octave_idx_type& info, +SparseMatrix::solve (MatrixType &mattype, const Matrix& b, octave_idx_type& info, double& rcond) const { return solve (mattype, b, info, rcond, 0); } Matrix -SparseMatrix::solve (SparseType &mattype, const Matrix& b, octave_idx_type& err, +SparseMatrix::solve (MatrixType &mattype, const Matrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool singular_fallback) const { Matrix retval; int typ = mattype.type (false); - if (typ == SparseType::Unknown) + if (typ == MatrixType::Unknown) typ = mattype.type (*this); // Only calculate the condition number for CHOLMOD/UMFPACK - if (typ == SparseType::Diagonal || typ == SparseType::Permuted_Diagonal) + if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) retval = dsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Upper || typ == SparseType::Permuted_Upper) + else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) retval = utsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Lower || typ == SparseType::Permuted_Lower) + else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) retval = ltsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Banded || typ == SparseType::Banded_Hermitian) + else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) retval = bsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Tridiagonal || - typ == SparseType::Tridiagonal_Hermitian) + else if (typ == MatrixType::Tridiagonal || + typ == MatrixType::Tridiagonal_Hermitian) retval = trisolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Full || typ == SparseType::Hermitian) + else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) retval = fsolve (mattype, b, err, rcond, sing_handler, true); - else if (typ != SparseType::Rectangular) + else if (typ != MatrixType::Rectangular) { (*current_liboctave_error_handler) ("unknown matrix type"); return Matrix (); } // Rectangular or one of the above solvers flags a singular matrix - if (singular_fallback && mattype.type (false) == SparseType::Rectangular) + if (singular_fallback && mattype.type (false) == MatrixType::Rectangular) { rcond = 1.; #ifdef USE_QRSOLVE @@ -6942,7 +6942,7 @@ } SparseMatrix -SparseMatrix::solve (SparseType &mattype, const SparseMatrix& b) const +SparseMatrix::solve (MatrixType &mattype, const SparseMatrix& b) const { octave_idx_type info; double rcond; @@ -6950,7 +6950,7 @@ } SparseMatrix -SparseMatrix::solve (SparseType &mattype, const SparseMatrix& b, +SparseMatrix::solve (MatrixType &mattype, const SparseMatrix& b, octave_idx_type& info) const { double rcond; @@ -6958,14 +6958,14 @@ } SparseMatrix -SparseMatrix::solve (SparseType &mattype, const SparseMatrix& b, +SparseMatrix::solve (MatrixType &mattype, const SparseMatrix& b, octave_idx_type& info, double& rcond) const { return solve (mattype, b, info, rcond, 0); } SparseMatrix -SparseMatrix::solve (SparseType &mattype, const SparseMatrix& b, +SparseMatrix::solve (MatrixType &mattype, const SparseMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool singular_fallback) const @@ -6973,29 +6973,29 @@ SparseMatrix retval; int typ = mattype.type (false); - if (typ == SparseType::Unknown) + if (typ == MatrixType::Unknown) typ = mattype.type (*this); - if (typ == SparseType::Diagonal || typ == SparseType::Permuted_Diagonal) + if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) retval = dsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Upper || typ == SparseType::Permuted_Upper) + else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) retval = utsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Lower || typ == SparseType::Permuted_Lower) + else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) retval = ltsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Banded || typ == SparseType::Banded_Hermitian) + else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) retval = bsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Tridiagonal || - typ == SparseType::Tridiagonal_Hermitian) + else if (typ == MatrixType::Tridiagonal || + typ == MatrixType::Tridiagonal_Hermitian) retval = trisolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Full || typ == SparseType::Hermitian) + else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) retval = fsolve (mattype, b, err, rcond, sing_handler, true); - else if (typ != SparseType::Rectangular) + else if (typ != MatrixType::Rectangular) { (*current_liboctave_error_handler) ("unknown matrix type"); return SparseMatrix (); } - if (singular_fallback && mattype.type (false) == SparseType::Rectangular) + if (singular_fallback && mattype.type (false) == MatrixType::Rectangular) { rcond = 1.; #ifdef USE_QRSOLVE @@ -7010,7 +7010,7 @@ } ComplexMatrix -SparseMatrix::solve (SparseType &mattype, const ComplexMatrix& b) const +SparseMatrix::solve (MatrixType &mattype, const ComplexMatrix& b) const { octave_idx_type info; double rcond; @@ -7018,7 +7018,7 @@ } ComplexMatrix -SparseMatrix::solve (SparseType &mattype, const ComplexMatrix& b, +SparseMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, octave_idx_type& info) const { double rcond; @@ -7026,14 +7026,14 @@ } ComplexMatrix -SparseMatrix::solve (SparseType &mattype, const ComplexMatrix& b, +SparseMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, octave_idx_type& info, double& rcond) const { return solve (mattype, b, info, rcond, 0); } ComplexMatrix -SparseMatrix::solve (SparseType &mattype, const ComplexMatrix& b, +SparseMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool singular_fallback) const @@ -7041,29 +7041,29 @@ ComplexMatrix retval; int typ = mattype.type (false); - if (typ == SparseType::Unknown) + if (typ == MatrixType::Unknown) typ = mattype.type (*this); - if (typ == SparseType::Diagonal || typ == SparseType::Permuted_Diagonal) + if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) retval = dsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Upper || typ == SparseType::Permuted_Upper) + else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) retval = utsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Lower || typ == SparseType::Permuted_Lower) + else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) retval = ltsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Banded || typ == SparseType::Banded_Hermitian) + else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) retval = bsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Tridiagonal || - typ == SparseType::Tridiagonal_Hermitian) + else if (typ == MatrixType::Tridiagonal || + typ == MatrixType::Tridiagonal_Hermitian) retval = trisolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Full || typ == SparseType::Hermitian) + else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) retval = fsolve (mattype, b, err, rcond, sing_handler, true); - else if (typ != SparseType::Rectangular) + else if (typ != MatrixType::Rectangular) { (*current_liboctave_error_handler) ("unknown matrix type"); return ComplexMatrix (); } - if (singular_fallback && mattype.type(false) == SparseType::Rectangular) + if (singular_fallback && mattype.type(false) == MatrixType::Rectangular) { rcond = 1.; #ifdef USE_QRSOLVE @@ -7078,7 +7078,7 @@ } SparseComplexMatrix -SparseMatrix::solve (SparseType &mattype, const SparseComplexMatrix& b) const +SparseMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b) const { octave_idx_type info; double rcond; @@ -7086,7 +7086,7 @@ } SparseComplexMatrix -SparseMatrix::solve (SparseType &mattype, const SparseComplexMatrix& b, +SparseMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b, octave_idx_type& info) const { double rcond; @@ -7094,14 +7094,14 @@ } SparseComplexMatrix -SparseMatrix::solve (SparseType &mattype, const SparseComplexMatrix& b, +SparseMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond) const { return solve (mattype, b, info, rcond, 0); } SparseComplexMatrix -SparseMatrix::solve (SparseType &mattype, const SparseComplexMatrix& b, +SparseMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b, octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler, bool singular_fallback) const @@ -7109,29 +7109,29 @@ SparseComplexMatrix retval; int typ = mattype.type (false); - if (typ == SparseType::Unknown) + if (typ == MatrixType::Unknown) typ = mattype.type (*this); - if (typ == SparseType::Diagonal || typ == SparseType::Permuted_Diagonal) + if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) retval = dsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Upper || typ == SparseType::Permuted_Upper) + else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) retval = utsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Lower || typ == SparseType::Permuted_Lower) + else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) retval = ltsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Banded || typ == SparseType::Banded_Hermitian) + else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) retval = bsolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Tridiagonal || - typ == SparseType::Tridiagonal_Hermitian) + else if (typ == MatrixType::Tridiagonal || + typ == MatrixType::Tridiagonal_Hermitian) retval = trisolve (mattype, b, err, rcond, sing_handler, false); - else if (typ == SparseType::Full || typ == SparseType::Hermitian) + else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) retval = fsolve (mattype, b, err, rcond, sing_handler, true); - else if (typ != SparseType::Rectangular) + else if (typ != MatrixType::Rectangular) { (*current_liboctave_error_handler) ("unknown matrix type"); return SparseComplexMatrix (); } - if (singular_fallback && mattype.type(false) == SparseType::Rectangular) + if (singular_fallback && mattype.type(false) == MatrixType::Rectangular) { rcond = 1.; #ifdef USE_QRSOLVE @@ -7146,27 +7146,27 @@ } ColumnVector -SparseMatrix::solve (SparseType &mattype, const ColumnVector& b) const +SparseMatrix::solve (MatrixType &mattype, const ColumnVector& b) const { octave_idx_type info; double rcond; return solve (mattype, b, info, rcond); } ColumnVector -SparseMatrix::solve (SparseType &mattype, const ColumnVector& b, octave_idx_type& info) const +SparseMatrix::solve (MatrixType &mattype, const ColumnVector& b, octave_idx_type& info) const { double rcond; return solve (mattype, b, info, rcond); } ColumnVector -SparseMatrix::solve (SparseType &mattype, const ColumnVector& b, octave_idx_type& info, double& rcond) const +SparseMatrix::solve (MatrixType &mattype, const ColumnVector& b, octave_idx_type& info, double& rcond) const { return solve (mattype, b, info, rcond, 0); } ColumnVector -SparseMatrix::solve (SparseType &mattype, const ColumnVector& b, octave_idx_type& info, double& rcond, +SparseMatrix::solve (MatrixType &mattype, const ColumnVector& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler) const { Matrix tmp (b); @@ -7174,7 +7174,7 @@ } ComplexColumnVector -SparseMatrix::solve (SparseType &mattype, const ComplexColumnVector& b) const +SparseMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b) const { octave_idx_type info; double rcond; @@ -7182,21 +7182,21 @@ } ComplexColumnVector -SparseMatrix::solve (SparseType &mattype, const ComplexColumnVector& b, octave_idx_type& info) const +SparseMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, octave_idx_type& info) const { double rcond; return solve (mattype, b, info, rcond, 0); } ComplexColumnVector -SparseMatrix::solve (SparseType &mattype, const ComplexColumnVector& b, octave_idx_type& info, +SparseMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, octave_idx_type& info, double& rcond) const { return solve (mattype, b, info, rcond, 0); } ComplexColumnVector -SparseMatrix::solve (SparseType &mattype, const ComplexColumnVector& b, octave_idx_type& info, double& rcond, +SparseMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler) const { ComplexMatrix tmp (b); @@ -7230,7 +7230,7 @@ double& rcond, solve_singularity_handler sing_handler) const { - SparseType mattype (*this); + MatrixType mattype (*this); return solve (mattype, b, err, rcond, sing_handler); } @@ -7262,7 +7262,7 @@ octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler) const { - SparseType mattype (*this); + MatrixType mattype (*this); return solve (mattype, b, err, rcond, sing_handler); } @@ -7286,7 +7286,7 @@ octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler) const { - SparseType mattype (*this); + MatrixType mattype (*this); return solve (mattype, b, err, rcond, sing_handler); } @@ -7318,7 +7318,7 @@ octave_idx_type& err, double& rcond, solve_singularity_handler sing_handler) const { - SparseType mattype (*this); + MatrixType mattype (*this); return solve (mattype, b, err, rcond, sing_handler); }
--- a/liboctave/dSparse.h +++ b/liboctave/dSparse.h @@ -33,7 +33,7 @@ #include "MSparse.h" #include "MSparse-defs.h" #include "Sparse-op-defs.h" -#include "SparseType.h" +#include "MatrixType.h" class SparseComplexMatrix; class SparseBoolMatrix; @@ -115,19 +115,19 @@ SparseMatrix hermitian (void) const { return transpose (); } private: - SparseMatrix dinverse (SparseType &mattyp, octave_idx_type& info, + SparseMatrix dinverse (MatrixType &mattyp, octave_idx_type& info, double& rcond, const bool force = false, const bool calccond = true) const; - SparseMatrix tinverse (SparseType &mattyp, octave_idx_type& info, + SparseMatrix tinverse (MatrixType &mattyp, octave_idx_type& info, double& rcond, const bool force = false, const bool calccond = true) const; public: SparseMatrix inverse (void) const; - SparseMatrix inverse (SparseType& mattype) const; - SparseMatrix inverse (SparseType& mattype, octave_idx_type& info) const; - SparseMatrix inverse (SparseType& mattype, octave_idx_type& info, + SparseMatrix inverse (MatrixType& mattype) const; + SparseMatrix inverse (MatrixType& mattype, octave_idx_type& info) const; + SparseMatrix inverse (MatrixType& mattype, octave_idx_type& info, double& rcond, int force = 0, int calc_cond = 1) const; DET determinant (void) const; @@ -136,101 +136,101 @@ private: // Diagonal matrix solvers - Matrix dsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, + Matrix dsolve (MatrixType &typ, const Matrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - ComplexMatrix dsolve (SparseType &typ, const ComplexMatrix& b, + ComplexMatrix dsolve (MatrixType &typ, const ComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseMatrix dsolve (SparseType &typ, const SparseMatrix& b, + SparseMatrix dsolve (MatrixType &typ, const SparseMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseComplexMatrix dsolve (SparseType &typ, const SparseComplexMatrix& b, + SparseComplexMatrix dsolve (MatrixType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; // Upper triangular matrix solvers - Matrix utsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, + Matrix utsolve (MatrixType &typ, const Matrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - ComplexMatrix utsolve (SparseType &typ, const ComplexMatrix& b, + ComplexMatrix utsolve (MatrixType &typ, const ComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseMatrix utsolve (SparseType &typ, const SparseMatrix& b, + SparseMatrix utsolve (MatrixType &typ, const SparseMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseComplexMatrix utsolve (SparseType &typ, const SparseComplexMatrix& b, + SparseComplexMatrix utsolve (MatrixType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; // Lower triangular matrix solvers - Matrix ltsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, + Matrix ltsolve (MatrixType &typ, const Matrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - ComplexMatrix ltsolve (SparseType &typ, const ComplexMatrix& b, + ComplexMatrix ltsolve (MatrixType &typ, const ComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseMatrix ltsolve (SparseType &typ, const SparseMatrix& b, + SparseMatrix ltsolve (MatrixType &typ, const SparseMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseComplexMatrix ltsolve (SparseType &typ, const SparseComplexMatrix& b, + SparseComplexMatrix ltsolve (MatrixType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; // Tridiagonal matrix solvers - Matrix trisolve (SparseType &typ, const Matrix& b, octave_idx_type& info, + Matrix trisolve (MatrixType &typ, const Matrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - ComplexMatrix trisolve (SparseType &typ, const ComplexMatrix& b, + ComplexMatrix trisolve (MatrixType &typ, const ComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseMatrix trisolve (SparseType &typ, const SparseMatrix& b, + SparseMatrix trisolve (MatrixType &typ, const SparseMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseComplexMatrix trisolve (SparseType &typ, const SparseComplexMatrix& b, + SparseComplexMatrix trisolve (MatrixType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; // Banded matrix solvers (umfpack/cholesky) - Matrix bsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, + Matrix bsolve (MatrixType &typ, const Matrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - ComplexMatrix bsolve (SparseType &typ, const ComplexMatrix& b, + ComplexMatrix bsolve (MatrixType &typ, const ComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseMatrix bsolve (SparseType &typ, const SparseMatrix& b, + SparseMatrix bsolve (MatrixType &typ, const SparseMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseComplexMatrix bsolve (SparseType &typ, const SparseComplexMatrix& b, + SparseComplexMatrix bsolve (MatrixType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; @@ -240,82 +240,82 @@ Matrix &Info, solve_singularity_handler sing_handler, bool calc_cond = false) const; - Matrix fsolve (SparseType &typ, const Matrix& b, octave_idx_type& info, + Matrix fsolve (MatrixType &typ, const Matrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - ComplexMatrix fsolve (SparseType &typ, const ComplexMatrix& b, + ComplexMatrix fsolve (MatrixType &typ, const ComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseMatrix fsolve (SparseType &typ, const SparseMatrix& b, + SparseMatrix fsolve (MatrixType &typ, const SparseMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; - SparseComplexMatrix fsolve (SparseType &typ, const SparseComplexMatrix& b, + SparseComplexMatrix fsolve (MatrixType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool calc_cond = false) const; public: // Generic interface to solver with no probing of type - Matrix solve (SparseType &typ, const Matrix& b) const; - Matrix solve (SparseType &typ, const Matrix& b, octave_idx_type& info) const; - Matrix solve (SparseType &typ, const Matrix& b, octave_idx_type& info, + Matrix solve (MatrixType &typ, const Matrix& b) const; + Matrix solve (MatrixType &typ, const Matrix& b, octave_idx_type& info) const; + Matrix solve (MatrixType &typ, const Matrix& b, octave_idx_type& info, double& rcond) const; - Matrix solve (SparseType &typ, const Matrix& b, octave_idx_type& info, + Matrix solve (MatrixType &typ, const Matrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool singular_fallback = true) const; - ComplexMatrix solve (SparseType &typ, const ComplexMatrix& b) const; - ComplexMatrix solve (SparseType &typ, const ComplexMatrix& b, + ComplexMatrix solve (MatrixType &typ, const ComplexMatrix& b) const; + ComplexMatrix solve (MatrixType &typ, const ComplexMatrix& b, octave_idx_type& info) const; - ComplexMatrix solve (SparseType &typ, const ComplexMatrix& b, + ComplexMatrix solve (MatrixType &typ, const ComplexMatrix& b, octave_idx_type& info, double& rcond) const; - ComplexMatrix solve (SparseType &typ, const ComplexMatrix& b, + ComplexMatrix solve (MatrixType &typ, const ComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool singular_fallback = true) const; - SparseMatrix solve (SparseType &typ, const SparseMatrix& b) const; - SparseMatrix solve (SparseType &typ, const SparseMatrix& b, + SparseMatrix solve (MatrixType &typ, const SparseMatrix& b) const; + SparseMatrix solve (MatrixType &typ, const SparseMatrix& b, octave_idx_type& info) const; - SparseMatrix solve (SparseType &typ, const SparseMatrix& b, + SparseMatrix solve (MatrixType &typ, const SparseMatrix& b, octave_idx_type& info, double& rcond) const; - SparseMatrix solve (SparseType &typ, const SparseMatrix& b, + SparseMatrix solve (MatrixType &typ, const SparseMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool singular_fallback = true) const; - SparseComplexMatrix solve (SparseType &typ, + SparseComplexMatrix solve (MatrixType &typ, const SparseComplexMatrix& b) const; - SparseComplexMatrix solve (SparseType &typ, const SparseComplexMatrix& b, + SparseComplexMatrix solve (MatrixType &typ, const SparseComplexMatrix& b, octave_idx_type& info) const; - SparseComplexMatrix solve (SparseType &typ, const SparseComplexMatrix& b, + SparseComplexMatrix solve (MatrixType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond) const; - SparseComplexMatrix solve (SparseType &typ, const SparseComplexMatrix& b, + SparseComplexMatrix solve (MatrixType &typ, const SparseComplexMatrix& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler, bool singular_fallabck = true) const; - ColumnVector solve (SparseType &typ, const ColumnVector& b) const; - ColumnVector solve (SparseType &typ, const ColumnVector& b, + ColumnVector solve (MatrixType &typ, const ColumnVector& b) const; + ColumnVector solve (MatrixType &typ, const ColumnVector& b, octave_idx_type& info) const; - ColumnVector solve (SparseType &typ, const ColumnVector& b, + ColumnVector solve (MatrixType &typ, const ColumnVector& b, octave_idx_type& info, double& rcond) const; - ColumnVector solve (SparseType &typ, const ColumnVector& b, + ColumnVector solve (MatrixType &typ, const ColumnVector& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler) const; - ComplexColumnVector solve (SparseType &typ, + ComplexColumnVector solve (MatrixType &typ, const ComplexColumnVector& b) const; - ComplexColumnVector solve (SparseType &typ, const ComplexColumnVector& b, + ComplexColumnVector solve (MatrixType &typ, const ComplexColumnVector& b, octave_idx_type& info) const; - ComplexColumnVector solve (SparseType &typ, const ComplexColumnVector& b, + ComplexColumnVector solve (MatrixType &typ, const ComplexColumnVector& b, octave_idx_type& info, double& rcond) const; - ComplexColumnVector solve (SparseType &typ, const ComplexColumnVector& b, + ComplexColumnVector solve (MatrixType &typ, const ComplexColumnVector& b, octave_idx_type& info, double& rcond, solve_singularity_handler sing_handler) const;
--- a/liboctave/mx-base.h +++ b/liboctave/mx-base.h @@ -24,6 +24,10 @@ #if !defined (octave_mx_base_h) #define octave_mx_base_h 1 +// Matrix Type class + +#include "MatrixType.h" + // Matrix classes. #include "boolMatrix.h"
--- a/liboctave/sparse-base-chol.cc +++ b/liboctave/sparse-base-chol.cc @@ -30,7 +30,7 @@ #include "oct-sparse.h" #include "oct-spparms.h" #include "quit.h" -#include "SparseType.h" +#include "MatrixType.h" #ifdef HAVE_CHOLMOD // Can't use CHOLMOD_NAME(drop)(0.0, S, cm). It doesn't treat complex matrices @@ -283,7 +283,7 @@ chol_type ret; double rcond2; octave_idx_type info; - SparseType mattype (SparseType::Upper); + MatrixType mattype (MatrixType::Upper); chol_type linv = L().transpose().inverse(mattype, info, rcond2, 1, 0); if (perms.length() == n)
--- a/liboctave/sparse-dmsolve.cc +++ b/liboctave/sparse-dmsolve.cc @@ -31,7 +31,7 @@ #include "MSparse.h" #include "SparseQR.h" #include "SparseCmplxQR.h" -#include "SparseType.h" +#include "MatrixType.h" #include "oct-sort.h" template <class T> @@ -430,7 +430,7 @@ RT btmp2 = dmsolve_extract (btmp, NULL, NULL, dm->rr [1], dm->rr [2], 0, b_nc); double rcond = 0.0; - SparseType mtyp (SparseType::Full); + MatrixType mtyp (MatrixType::Full); RT mtmp = m.solve (mtyp, btmp2, info, rcond, solve_singularity_warning, false); if (info != 0)
--- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,7 +1,57 @@ 2006-05-03 David Bateman <dbateman@free.fr> + * ov-base-mat.h: Add caching of matrix type, and code to supply + and copy matrix type. + * ov-bool-mat.h: Add caching to constructor. + * ov-re-mat.h: ditto. + * ov-cx-mat.h: ditto. + * ov.cc: Add to the BoolMatrix, Matrix and the ComplexMatrix + octave_value constructors, the ability to specify the matrix type. + * ov.h: Adapt declaration of above constructors. + (MatrixType matrix_type(void) const, MatrixType matrix_type (const + MatrixType&)): New functions for probing and setting matrix type. + * ov-base.cc (virtual MatrixType matrix_type(void) const, virtual + MatrixType matrix_type (const MatrixType&)): New default functions + for probing and setting matrix type. + * ov-base.h (virtual MatrixType matrix_type(void) const, virtual + MatrixType matrix_type (const MatrixType&)): Declarations. + * ov-base-sparse.h: Replace all uses of SparseType with + MatrixType. Replace sparse_type function with matrix_type function. + * ov-bool-sparse.h: Replace all uses of SparseType with MatrixType. + * ov-cx-sparse.h: ditto. + * ov-re-sparse.h: ditto. + * sparse-xdiv.cc: ditto. + * sparse-xdiv.h: ditto. + * sparse-xpow.cc: ditto. + * DLD-FUNCTIONS/luinc.cc: ditto. + * DLD-FUNCTIONS/splu.cc: ditto. + * xdiv.cc (xdiv, xleftdiv): Pass the matrix type, simplfy since + the matrix solve function now calls lssolve if singular. + * xdiv.h (xdvi, xleftdiv): Update the declarations + * OPERATORS/op-cm-cm.cc, OPERATORS/op-cm-cs.cc, + OPERATORS/op-cm-m.cc, OPERATORS/op-cm-s.cc, + OPERATORS/op-cm-scm.cc, OPERATORS/op-cm-sm.cc, + OPERATORS/op-cs-cm.cc, OPERATORS/op-cs-m.cc, + OPERATORS/op-m-cm.cc, OPERATORS/op-m-cs.cc, + OPERATORS/op-m-m.cc, OPERATORS/op-m-s.cc, + OPERATORS/op-m-scm.cc, OPERATORS/op-m-sm.cc, + OPERATORS/op-s-cm.cc, OPERATORS/op-s-m.cc, + OPERATORS/op-scm-cm.cc, OPERATORS/op-scm-m.cc, + OPERATORS/op-sm-cm.cc, OPERATORS/op-sm-m.cc: Update use of + xdiv and xleftdiv functions to allow matrix type caching. + * DLD-FUNCTIONS/matrix_type.cc (Fmatrix_type): Update to allow typing + of Matrix, and ComplexMatrix types. Add new test code for this. + * DLD-FUNCTIONS/cellfun.cc (Fmat2cell): new function. + * DLD-FUNCTIONS/regexp.cc (class regexp_elem): New class to store + matched element in a std::list. + (octregexp_list): Take algorithm from octregexp and construct a + list of matches. + (octregexp): Rewrite to use linked list of matches. + (Fregexprep): New function, working directly in linked list of + matches. + 2006-05-02 John W. Eaton <jwe@octave.org> * lex.l ({CCHAR}): Exit rawcommand mode if returning '\n' token.
--- a/src/DLD-FUNCTIONS/luinc.cc +++ b/src/DLD-FUNCTIONS/luinc.cc @@ -30,7 +30,7 @@ #include "utils.h" #include "oct-map.h" -#include "SparseType.h" +#include "MatrixType.h" #include "SparseCmplxLU.h" #include "SparsedbleLU.h" #include "ov-re-sparse.h" @@ -171,9 +171,9 @@ SparseMatrix P = fact.Pr (); SparseMatrix L = P.transpose () * fact.L (); retval(1) = octave_value (fact.U (), - SparseType (SparseType::Upper)); - retval(0) = octave_value (L, SparseType - (SparseType::Permuted_Lower, + MatrixType (MatrixType::Upper)); + retval(0) = octave_value (L, MatrixType + (MatrixType::Permuted_Lower, sm_nr, fact.row_perm ())); } break; @@ -185,9 +185,9 @@ retval(2) = fact.Pr (); retval(1) = octave_value (fact.U (), - SparseType (SparseType::Upper)); + MatrixType (MatrixType::Upper)); retval(0) = octave_value (fact.L (), - SparseType (SparseType::Lower)); + MatrixType (MatrixType::Lower)); } break; @@ -200,9 +200,9 @@ retval(3) = fact.Pc (); retval(2) = fact.Pr (); retval(1) = octave_value (fact.U (), - SparseType (SparseType::Upper)); + MatrixType (MatrixType::Upper)); retval(0) = octave_value (fact.L (), - SparseType (SparseType::Lower)); + MatrixType (MatrixType::Lower)); } break; } @@ -233,9 +233,9 @@ SparseMatrix P = fact.Pr (); SparseComplexMatrix L = P.transpose () * fact.L (); retval(1) = octave_value (fact.U (), - SparseType (SparseType::Upper)); - retval(0) = octave_value (L, SparseType - (SparseType::Permuted_Lower, + MatrixType (MatrixType::Upper)); + retval(0) = octave_value (L, MatrixType + (MatrixType::Permuted_Lower, sm_nr, fact.row_perm ())); } break; @@ -247,9 +247,9 @@ retval(2) = fact.Pr (); retval(1) = octave_value (fact.U (), - SparseType (SparseType::Upper)); + MatrixType (MatrixType::Upper)); retval(0) = octave_value (fact.L (), - SparseType (SparseType::Lower)); + MatrixType (MatrixType::Lower)); } break; @@ -262,9 +262,9 @@ retval(3) = fact.Pc (); retval(2) = fact.Pr (); retval(1) = octave_value (fact.U (), - SparseType (SparseType::Upper)); + MatrixType (MatrixType::Upper)); retval(0) = octave_value (fact.L (), - SparseType (SparseType::Lower)); + MatrixType (MatrixType::Lower)); } break; }
--- a/src/DLD-FUNCTIONS/matrix_type.cc +++ b/src/DLD-FUNCTIONS/matrix_type.cc @@ -30,9 +30,11 @@ #include "ov.h" #include "defun-dld.h" #include "error.h" +#include "ov-re-mat.h" +#include "ov-cx-mat.h" #include "ov-re-sparse.h" #include "ov-cx-sparse.h" -#include "SparseType.h" +#include "MatrixType.h" DEFUN_DLD (matrix_type, args, , "-*- texinfo -*-\n\ @@ -111,14 +113,11 @@ { if (nargin == 1) { - SparseType mattyp; + MatrixType mattyp; if (args(0).type_name () == "sparse complex matrix" ) { - const octave_sparse_complex_matrix& rep - = dynamic_cast<const octave_sparse_complex_matrix&> (args(0).get_rep ()); - - mattyp = rep.sparse_type (); + mattyp = args(0).matrix_type (); if (mattyp.is_unknown ()) { @@ -126,61 +125,58 @@ args(0).sparse_complex_matrix_value (); if (!error_state) { - mattyp = SparseType (m); - rep.sparse_type (mattyp); + mattyp = MatrixType (m); + args(0).matrix_type (mattyp); } } } else { - const octave_sparse_matrix& rep - = dynamic_cast<const octave_sparse_matrix&> (args(0).get_rep ()); - - mattyp = rep.sparse_type (); + mattyp = args(0).matrix_type (); if (mattyp.is_unknown ()) { SparseMatrix m = args(0).sparse_matrix_value (); if (!error_state) { - mattyp = SparseType (m); - rep.sparse_type (mattyp); + mattyp = MatrixType (m); + args(0).matrix_type (mattyp); } } } int typ = mattyp.type (); - if (typ == SparseType::Diagonal) + if (typ == MatrixType::Diagonal) retval = octave_value ("Diagonal"); - else if (typ == SparseType::Permuted_Diagonal) + else if (typ == MatrixType::Permuted_Diagonal) retval = octave_value ("Permuted Diagonal"); - else if (typ == SparseType::Upper) + else if (typ == MatrixType::Upper) retval = octave_value ("Upper"); - else if (typ == SparseType::Permuted_Upper) + else if (typ == MatrixType::Permuted_Upper) retval = octave_value ("Permuted Upper"); - else if (typ == SparseType::Lower) + else if (typ == MatrixType::Lower) retval = octave_value ("Lower"); - else if (typ == SparseType::Permuted_Lower) + else if (typ == MatrixType::Permuted_Lower) retval = octave_value ("Permuted Lower"); - else if (typ == SparseType::Banded) + else if (typ == MatrixType::Banded) retval = octave_value ("Banded"); - else if (typ == SparseType::Banded_Hermitian) + else if (typ == MatrixType::Banded_Hermitian) retval = octave_value ("Banded Positive Definite"); - else if (typ == SparseType::Tridiagonal) + else if (typ == MatrixType::Tridiagonal) retval = octave_value ("Tridiagonal"); - else if (typ == SparseType::Tridiagonal_Hermitian) + else if (typ == MatrixType::Tridiagonal_Hermitian) retval = octave_value ("Tridiagonal Positive Definite"); - else if (typ == SparseType::Hermitian) + else if (typ == MatrixType::Hermitian) retval = octave_value ("Positive Definite"); - else if (typ == SparseType::Rectangular) + else if (typ == MatrixType::Rectangular) { if (args(0).rows() == args(0).columns()) retval = octave_value ("Singular"); else retval = octave_value ("Rectangular"); } - else if (typ == SparseType::Full) + else if (typ == MatrixType::Full) retval = octave_value ("Full"); else // This should never happen!!! @@ -192,7 +188,7 @@ std::string str_typ = args(1).string_value (); // FIXME -- why do I have to explicitly call the constructor? - SparseType mattyp = SparseType (); + MatrixType mattyp = MatrixType (); octave_idx_type nl = 0; octave_idx_type nu = 0; @@ -300,7 +296,148 @@ } } else - error ("matrix_type: Only sparse matrices treated at the moment"); + { + if (nargin == 1) + { + MatrixType mattyp; + + if (args(0).type_name () == "complex matrix" ) + { + mattyp = args(0).matrix_type (); + + if (mattyp.is_unknown ()) + { + ComplexMatrix m = args(0).complex_matrix_value (); + if (!error_state) + { + mattyp = MatrixType (m); + args(0).matrix_type (mattyp); + } + } + } + else + { + mattyp = args(0).matrix_type (); + + if (mattyp.is_unknown ()) + { + Matrix m = args(0).matrix_value (); + if (!error_state) + { + mattyp = MatrixType (m); + args(0).matrix_type (mattyp); + } + } + } + + int typ = mattyp.type (); + + if (typ == MatrixType::Upper) + retval = octave_value ("Upper"); + else if (typ == MatrixType::Permuted_Upper) + retval = octave_value ("Permuted Upper"); + else if (typ == MatrixType::Lower) + retval = octave_value ("Lower"); + else if (typ == MatrixType::Permuted_Lower) + retval = octave_value ("Permuted Lower"); + else if (typ == MatrixType::Hermitian) + retval = octave_value ("Positive Definite"); + else if (typ == MatrixType::Rectangular) + { + if (args(0).rows() == args(0).columns()) + retval = octave_value ("Singular"); + else + retval = octave_value ("Rectangular"); + } + else if (typ == MatrixType::Full) + retval = octave_value ("Full"); + else + // This should never happen!!! + retval = octave_value ("Unknown"); + } + else + { + // Ok, we're changing the matrix type + std::string str_typ = args(1).string_value (); + + // FIXME -- why do I have to explicitly call the constructor? + MatrixType mattyp = MatrixType (MatrixType::Unknown, true); + + if (error_state) + error ("Matrix type must be a string"); + else + { + // Use STL function to convert to lower case + std::transform (str_typ.begin (), str_typ.end (), + str_typ.begin (), tolower); + + if (str_typ == "upper") + mattyp.mark_as_upper_triangular (); + else if (str_typ == "lower") + mattyp.mark_as_lower_triangular (); + else if (str_typ == "positive definite") + { + mattyp.mark_as_full (); + mattyp.mark_as_symmetric (); + } + else if (str_typ == "singular") + mattyp.mark_as_rectangular (); + else if (str_typ == "full") + mattyp.mark_as_full (); + else if (str_typ == "unknown") + mattyp.invalidate_type (); + else + error ("matrix_type: Unknown matrix type %s", str_typ.c_str()); + + if (! error_state) + { + if (nargin == 3 && (str_typ == "upper" + || str_typ == "lower")) + { + const ColumnVector perm = + ColumnVector (args (2).vector_value ()); + + if (error_state) + error ("matrix_type: Invalid permutation vector"); + else + { + octave_idx_type len = perm.length (); + dim_vector dv = args(0).dims (); + + if (len != dv(0)) + error ("matrix_type: Invalid permutation vector"); + else + { + OCTAVE_LOCAL_BUFFER (octave_idx_type, p, len); + + for (octave_idx_type i = 0; i < len; i++) + p[i] = static_cast<octave_idx_type> (perm (i)) - 1; + + if (str_typ == "upper") + mattyp.mark_as_permuted (len, p); + else + mattyp.mark_as_permuted (len, p); + } + } + } + else if (nargin != 2) + error ("matrix_type: Invalid number of arguments"); + + if (! error_state) + { + // Set the matrix type + if (args(0).type_name () == "complex matrix" ) + retval = + octave_value (args(0).complex_matrix_value (), + mattyp); + else + retval = octave_value (args(0).matrix_value (), + mattyp); + } + } + } + } + } } return retval; @@ -310,7 +447,7 @@ ## FIXME ## Disable tests for lower under-determined and upper over-determined -## matrices and this detection is disabled in SparseType due to issues +## matrices and this detection is disabled in MatrixType due to issues ## of non minimum norm solution being found. %!assert(matrix_type(speye(10,10)),"Diagonal"); @@ -393,6 +530,26 @@ %! a = matrix_type(spdiags(randn(10,3),[-1,0,1],10,10),"Singular"); %! assert(matrix_type(a),"Singular"); +%!assert(matrix_type(triu(ones(10,10))),"Upper"); +%!assert(matrix_type(triu(ones(10,10),-1)),"Full"); +%!assert(matrix_type(tril(ones(10,10))),"Lower"); +%!assert(matrix_type(tril(ones(10,10),1)),"Full"); +%!assert(matrix_type(10*eye(10,10) + ones(10,10)), "Positive Definite"); +%!assert(matrix_type(ones(11,10)),"Rectangular") +%!test +%! a = matrix_type(ones(10,10),"Singular"); +%! assert(matrix_type(a),"Singular"); + +%!assert(matrix_type(triu(1i*ones(10,10))),"Upper"); +%!assert(matrix_type(triu(1i*ones(10,10),-1)),"Full"); +%!assert(matrix_type(tril(1i*ones(10,10))),"Lower"); +%!assert(matrix_type(tril(1i*ones(10,10),1)),"Full"); +%!assert(matrix_type(10*eye(10,10) + 1i*triu(ones(10,10),1) -1i*tril(ones(10,10),-1)), "Positive Definite"); +%!assert(matrix_type(ones(11,10)),"Rectangular") +%!test +%! a = matrix_type(ones(10,10),"Singular"); +%! assert(matrix_type(a),"Singular"); + */ /*
--- a/src/DLD-FUNCTIONS/regexp.cc +++ b/src/DLD-FUNCTIONS/regexp.cc @@ -20,9 +20,6 @@ */ -// FIXME -// regexprep should be written as an m-file based on regexp - #ifdef HAVE_CONFIG_H #include <config.h> #endif @@ -39,6 +36,8 @@ #include "Cell.h" #include "oct-map.h" #include "str-vec.h" +#include "quit.h" +#include "parse.h" #ifdef HAVE_PCRE #include <pcre.h> @@ -51,37 +50,67 @@ #endif #endif -static octave_value_list -octregexp (const octave_value_list &args, int nargout, const std::string &nm, - bool case_insensitive) +// The regexp is constructed as a linked list to avoid resizing the +// return values in arrays at each new match. + +// FIXME don't bother collecting and composing return values the user +// doesn't want. + +class regexp_elem { - octave_value_list retval; +public: + regexp_elem (const string_vector _named_token, const Cell _t, + const std::string _m, const Matrix _te, const double _s, + const double _e) : + named_token (_named_token), t (_t), m (_m), te (_te), s (_s), e (_e) { } + + regexp_elem (const regexp_elem &a) : named_token (a.named_token), t (a.t), + m (a.m), te (a.te), s (a.s), e (a.e) + { } + + string_vector named_token; + Cell t; + std::string m; + Matrix te; + double s; + double e; +}; + +typedef std::list<regexp_elem>::const_iterator const_iterator; + +static int +octregexp_list (const octave_value_list &args, const std::string &nm, + bool case_insensitive, std::list<regexp_elem> &lst, + string_vector &named, int &nopts) +{ + int sz = 0; #if defined (HAVE_REGEX) || defined (HAVE_PCRE) int nargin = args.length(); - int nopts = nargin - 2; bool once = false; bool lineanchors = false; bool dotexceptnewline = false; bool freespacing = false; + nopts = nargin - 2; + if (nargin < 2) { print_usage(nm); - return retval; + return 0; } std::string buffer = args(0).string_value (); if (error_state) { gripe_wrong_type_arg (nm.c_str(), args(0)); - return retval; + return 0; } std::string pattern = args(1).string_value (); if (error_state) { gripe_wrong_type_arg (nm.c_str(), args(1)); - return retval; + return 0; } for (int i = 2; i < nargin; i++) @@ -98,28 +127,6 @@ once = true; nopts--; } -#if HAVE_PCRE - // Only accept these options with pcre - else if (str.find("dotall", 0) == 0) - { - dotexceptnewline = false; - nopts--; - } - else if (str.find("dotexceptnewline", 0) == 0) - { - dotexceptnewline = true; - nopts--; - } - else if (str.find("stringanchors", 0) == 0) - { - lineanchors = false; - nopts--; - } - else if (str.find("lineanchors", 0) == 0) - { - lineanchors = true; - nopts--; - } else if (str.find("matchcase", 0) == 0) { case_insensitive = false; @@ -130,9 +137,14 @@ case_insensitive = true; nopts--; } - else if (str.find("freespacing", 0) == 0) + else if (str.find("dotall", 0) == 0) { - freespacing = true; + dotexceptnewline = false; + nopts--; + } + else if (str.find("stringanchors", 0) == 0) + { + lineanchors = false; nopts--; } else if (str.find("literalspacing", 0) == 0) @@ -140,6 +152,23 @@ freespacing = false; nopts--; } +#if HAVE_PCRE + // Only accept these options with pcre + else if (str.find("dotexceptnewline", 0) == 0) + { + dotexceptnewline = true; + nopts--; + } + else if (str.find("lineanchors", 0) == 0) + { + lineanchors = true; + nopts--; + } + else if (str.find("freespacing", 0) == 0) + { + freespacing = true; + nopts--; + } else if (str.find("start", 0) && str.find("end", 0) && str.find("tokenextents", 0) && str.find("match", 0) && str.find("tokens", 0) && str.find("names", 0)) @@ -149,7 +178,7 @@ str.find("dotexceptnewline", 0) == 0 || str.find("lineanchors", 0) == 0 || str.find("freespacing", 0) == 0) - error ("%s: named tokens not implemented in this version", nm.c_str()); + error ("%s: %s not implemented in this version", str.c_str(), nm.c_str()); else if (str.find("start", 0) && str.find("end", 0) && str.find("tokenextents", 0) && str.find("match", 0) && str.find("tokens", 0)) @@ -159,9 +188,9 @@ if (!error_state) { - Octave_map nmap; - Cell t, m, te; - NDArray s, e; + Cell t; + std::string m; + double s, e; // named tokens "(?<name>...)" are only treated with PCRE not regex. #if HAVE_PCRE @@ -174,13 +203,11 @@ size_t pos = 0; size_t new_pos; - string_vector named; int nnames = 0; int inames = 0; std::ostringstream buf; Array<int> named_idx; - // Add mode flags while ((new_pos = pattern.find ("(?<",pos)) != NPOS) { size_t tmp_pos = pattern.find_first_of ('>',new_pos); @@ -224,7 +251,7 @@ buf << pattern.substr(pos); if (error_state) - return retval; + return 0; // Compile expression pcre *re; @@ -241,7 +268,7 @@ if (re == NULL) { error("%s: %s at position %d of expression", nm.c_str(), err, erroffset); - return retval; + return 0; } int subpatterns; @@ -249,7 +276,6 @@ int nameentrysize; char *nametable; int idx = 0; - int sz = 0; pcre_fullinfo(re, NULL, PCRE_INFO_CAPTURECOUNT, &subpatterns); pcre_fullinfo(re, NULL, PCRE_INFO_NAMECOUNT, &namecount); @@ -267,10 +293,10 @@ static_cast<int>(nametable[i*nameentrysize+1]); } - Cell named_tokens(dim_vector(nnames,1)); - while(true) { + OCTAVE_QUIT; + int matches = pcre_exec(re, NULL, buffer.c_str(), buffer.length(), idx, (idx ? PCRE_NOTBOL : 0), @@ -280,7 +306,7 @@ { error ("%s: internal error calling pcre_exec", nm.c_str()); pcre_free(re); - return retval; + return 0; } else if (matches == PCRE_ERROR_NOMATCH) break; @@ -288,26 +314,19 @@ break; else { - // FIXME Should collect arguments in a linked structure and - // resize and assign the return value a single time to make - // this function O(n) rather than O(n^2) as it currently is. int pos_match = 0; - s.resize (dim_vector(1, sz+1)); - s(sz) = double (ovector[0]+1); - e.resize (dim_vector(1, sz+1)); - e(sz) = double (ovector[1]); - te.resize(dim_vector(1, sz+1)); - Matrix mat_te(matches-1,2); + Matrix te(matches-1,2); for (int i = 1; i < matches; i++) { if (ovector[2*i] >= 0 && ovector[2*i+1] > 0) { - mat_te(pos_match,0) = double (ovector[2*i]+1); - mat_te(pos_match++,1) = double (ovector[2*i+1]); + te(pos_match,0) = double (ovector[2*i]+1); + te(pos_match++,1) = double (ovector[2*i+1]); } } - mat_te.resize(pos_match,2); - te(sz) = mat_te; + te.resize(pos_match,2); + s = double (ovector[0]+1); + e = double (ovector[1]); const char **listptr; int status = pcre_get_substring_list(buffer.c_str(), ovector, @@ -317,53 +336,42 @@ error("%s: cannot allocate memory in pcre_get_substring_list", nm.c_str()); pcre_free(re); - return retval; + return 0; } - m.resize (dim_vector(1, sz+1)); - m(sz) = std::string(*listptr); - - t.resize (dim_vector(1, sz+1)); Cell cell_t (dim_vector(1,pos_match)); pos_match = 0; for (int i = 1; i < matches; i++) if (ovector[2*i] >= 0 && ovector[2*i+1] > 0) cell_t(pos_match++) = std::string(*(listptr+i)); - t(sz) = cell_t; + m = std::string(*listptr); + t = cell_t; + + string_vector named_tokens(nnames); if (namecount > 0) for (int i = 1; i < matches; i++) { if (ovector[2*i] >= 0 && ovector[2*i+1] > 0) { - if (sz == 0) - { - named_tokens(named_idx(i-1)) = - std::string(*(listptr+nidx[i-1])); - } - else - { - Cell tmp = named_tokens(named_idx(i-1)); - tmp.resize(dim_vector(1,sz+1)); - tmp(sz) = std::string(*(listptr+nidx[i-1])); - named_tokens(named_idx(i-1)) = tmp; - } + named_tokens(named_idx(i-1)) = + std::string(*(listptr+nidx[i-1])); } } pcre_free_substring_list(listptr); + regexp_elem new_elem (named_tokens, t, m, te, s, e); + lst.push_back (new_elem); + idx = ovector[1]; + sz++; + if (once) break; - idx = ovector[1]; - sz++; } } - for (int i = 0; i < nnames; i++) - nmap.assign (named(i), named_tokens(i)); - pcre_free(re); #else regex_t compiled; @@ -377,18 +385,19 @@ error("%s: %s in pattern (%s)", nm.c_str(), errmsg, pattern.c_str()); regfree(&compiled); - return retval; + return 0; } int subexpr = 1; int idx = 0; - int sz = 0; for (unsigned int i=0; i < pattern.length(); i++) subexpr += ( pattern[i] == '(' ? 1 : 0 ); OCTAVE_LOCAL_BUFFER (regmatch_t, match, subexpr ); while(true) { + OCTAVE_QUIT; + if (regexec(&compiled, buffer.c_str() + idx, subexpr, match, (idx ? REG_NOTBOL : 0)) == 0) { @@ -397,31 +406,28 @@ while (matches < subexpr && match[matches].rm_so >= 0) matches++; - s.resize (dim_vector(1, sz+1)); - s(sz) = double (match[0].rm_so+1+idx); - e.resize (dim_vector(1, sz+1)); - e(sz) = double (match[0].rm_eo+idx); - te.resize(dim_vector(1, sz+1)); - Matrix mat_te(matches-1,2); + s = double (match[0].rm_so+1+idx); + e = double (match[0].rm_eo+idx); + Matrix te(matches-1,2); for (int i = 1; i < matches; i++) { - mat_te(i-1,0) = double (match[i].rm_so+1+idx); - mat_te(i-1,1) = double (match[i].rm_eo+idx); + te(i-1,0) = double (match[i].rm_so+1+idx); + te(i-1,1) = double (match[i].rm_eo+idx); } - te(sz) = mat_te; - m.resize (dim_vector(1, sz+1)); - m(sz) = buffer.substr (match[0].rm_so+idx, + m = buffer.substr (match[0].rm_so+idx, match[0].rm_eo-match[0].rm_so); - t.resize (dim_vector(1, sz+1)); Cell cell_t (dim_vector(1,matches-1)); for (int i = 1; i < matches; i++) cell_t(i-1) = buffer.substr (match[i].rm_so+idx, match[i].rm_eo-match[i].rm_so); - t(sz) = cell_t; + t = cell_t; idx += match[0].rm_eo; + + regexp_elem new_elem (Octave_map(), t, m, te, s, e); + lst.push_back (new_elem); sz++; if (once) @@ -432,12 +438,82 @@ } regfree(&compiled); #endif + } +#else + error ("%s: not available in this version of Octave", nm.c_str()); +#endif + return sz; +} - retval(5) = nmap; +static octave_value_list +octregexp (const octave_value_list &args, int nargout, const std::string &nm, + bool case_insensitive) +{ + octave_value_list retval; + int nargin = args.length(); + std::list<regexp_elem> lst; + string_vector named; + int nopts; + int sz = octregexp_list (args, nm, case_insensitive, lst, named, nopts); + + if (! error_state) + { + // Converted the linked list in the correct form for the return values + + octave_idx_type i = 0; +#ifdef HAVE_PCRE + Octave_map nmap; + if (sz == 1) + { + for (int j = 0; j < named.length(); j++) + nmap.assign (named(j), lst.begin()->named_token(j)); + retval(5) = nmap; + } + else + { + for (int j = 0; j < named.length (); j++) + { + i = 0; + Cell tmp(dim_vector (1, sz)); + for (const_iterator p = lst.begin(); p != lst.end(); p++) + tmp(i++) = p->named_token(j); + nmap.assign (named(j), octave_value (tmp)); + } + retval(5) = nmap; + } +#else + retval(5) = Octave_map(); +#endif + + Cell t (dim_vector(1, sz)); + i = 0; + for (const_iterator p = lst.begin(); p != lst.end(); p++) + t(i++) = p->t; retval(4) = t; + + Cell m (dim_vector(1, sz)); + i = 0; + for (const_iterator p = lst.begin(); p != lst.end(); p++) + m(i++) = p->m; retval(3) = m; + + + Cell te (dim_vector(1, sz)); + i = 0; + for (const_iterator p = lst.begin(); p != lst.end(); p++) + te(i++) = p->te; retval(2) = te; + + NDArray e (dim_vector(1, sz)); + i = 0; + for (const_iterator p = lst.begin(); p != lst.end(); p++) + e(i++) = p->e; retval(1) = e; + + NDArray s (dim_vector(1, sz)); + i = 0; + for (const_iterator p = lst.begin(); p != lst.end(); p++) + s(i++) = p->s; retval(0) = s; // Alter the order of the output arguments @@ -448,16 +524,15 @@ new_retval.resize(nargout); OCTAVE_LOCAL_BUFFER (int, arg_used, 6); - for (int i = 0; i < 6; i++) - arg_used[i] = false; + for (int j = 0; j < 6; j++) + arg_used[j] = false; - for (int i = 2; i < nargin; i++) + for (int j = 2; j < nargin; j++) { int k = 0; - std::string str = args(i).string_value(); + std::string str = args(j).string_value(); std::transform (str.begin (), str.end (), str.begin (), tolower); if (str.find("once", 0) == 0 -#if HAVE_PCRE || str.find("stringanchors", 0) == 0 || str.find("lineanchors", 0) == 0 || str.find("matchcase", 0) == 0 @@ -466,7 +541,6 @@ || str.find("dotexceptnewline", 0) == 0 || str.find("literalspacing", 0) == 0 || str.find("freespacing", 0) == 0 -#endif ) continue; else if (str.find("start", 0) == 0) @@ -492,10 +566,10 @@ // Fill in the rest of the arguments if (n < nargout) { - for (int i = 0; i < 6; i++) + for (int j = 0; j < 6; j++) { - if (! arg_used[i]) - new_retval(n++) = retval(i); + if (! arg_used[j]) + new_retval(n++) = retval(j); } } @@ -503,9 +577,6 @@ } } -#else - error ("%s: not available in this version of Octave", nm.c_str()); -#endif return retval; } @@ -652,23 +723,23 @@ ## Check that anchoring of pattern works correctly %!assert(regexp('abcabc','^abc'),1); %!assert(regexp('abcabc','abc$'),4); -%!assert(regexp('abcabc','^abc$'),[]); +%!assert(regexp('abcabc','^abc$'),zeros(1,0)); %!test %! [s, e, te, m, t] = regexp(' No Match ', 'f(.*)uck'); -%! assert (s,[]) -%! assert (e,[]) -%! assert (te,{}) -%! assert (m, {}) -%! assert (t, {}) +%! assert (s,zeros(1,0)) +%! assert (e,zeros(1,0)) +%! assert (te,cell(1,0)) +%! assert (m, cell(1,0)) +%! assert (t, cell(1,0)) %!test %! [s, e, te, m, t] = regexp(' FiRetrUck ', 'f(.*)uck'); -%! assert (s,[]) -%! assert (e,[]) -%! assert (te,{}) -%! assert (m, {}) -%! assert (t, {}) +%! assert (s,zeros(1,0)) +%! assert (e,zeros(1,0)) +%! assert (te,cell(1,0)) +%! assert (m, cell(1,0)) +%! assert (t, cell(1,0)) %!test %! [s, e, te, m, t] = regexp(' firetruck ', 'f(.*)uck'); @@ -797,8 +868,8 @@ %!test %! if (!isempty(findstr(octave_config_info ("DEFS"),"HAVE_PCRE"))) %! assert (regexp("this word",'(?-x)s w','literalspacing'),4) -%! assert (regexp("this word",'s w','freespacing'),[]) -%! assert (regexp("this word",'(?x)s w'),[]) +%! assert (regexp("this word",'s w','freespacing'),zeros(1,0)) +%! assert (regexp("this word",'(?x)s w'),zeros(1,0)) %! endif %!error regexp('string', 'tri', 'BadArg'); @@ -827,15 +898,15 @@ ## Check that anchoring of pattern works correctly %!assert(regexpi('abcabc','^abc'),1); %!assert(regexpi('abcabc','abc$'),4); -%!assert(regexpi('abcabc','^abc$'),[]); +%!assert(regexpi('abcabc','^abc$'),zeros(1,0)); %!test %! [s, e, te, m, t] = regexpi(' No Match ', 'f(.*)uck'); -%! assert (s,[]) -%! assert (e,[]) -%! assert (te,{}) -%! assert (m, {}) -%! assert (t, {}) +%! assert (s,zeros(1,0)) +%! assert (e,zeros(1,0)) +%! assert (te,cell(1,0)) +%! assert (m, cell(1,0)) +%! assert (t, cell(1,0)) %!test %! [s, e, te, m, t] = regexpi(' FiRetrUck ', 'f(.*)uck'); @@ -956,8 +1027,8 @@ %!test %! if (!isempty(findstr(octave_config_info ("DEFS"),"HAVE_PCRE"))) %! assert (regexpi("this word",'(?-x)s w','literalspacing'),4) -%! assert (regexpi("this word",'s w','freespacing'),[]) -%! assert (regexpi("this word",'(?x)s w'),[]) +%! assert (regexpi("this word",'s w','freespacing'),zeros(1,0)) +%! assert (regexpi("this word",'(?x)s w'),zeros(1,0)) %! endif %!error regexpi('string', 'tri', 'BadArg'); @@ -965,6 +1036,293 @@ */ +DEFUN_DLD(regexprep, args, , + "-*- texinfo -*-\n\ +@deftypefn {Function File} @var{string} = regexprep(@var{string}, @var{pat}, @var{repstr}, @var{options})\n\ +Replace matches of @var{pat} in @var{string} with @var{repstr}.\n\ +\n\ +\n\ +The replacement can contain @code{$i}, which subsubstitutes\n\ +for the ith set of parentheses in the match string. E.g.,\n\ +@example\n\ +\n\ + regexprep(\"Bill Dunn\",'(\\w+) (\\w+)','$2, $1')\n\ +\n\ +@end example\n\ +returns \"Dunn, Bill\"\n\ +\n\ +@var{options} may be zero or more of\n\ +@table @samp\n\ +\n\ +@item once\n\ +Replace only the first occurance of @var{pat} in the result.\n\ +\n\ +@item warnings\n\ +This option is present for compatibility but is ignored.\n\ +\n\ +@item ignorecase or matchcase\n\ +Ignore case for the pattern matching (see @code{regexpi}).\n\ +Alternatively, use (?i) or (?-i) in the pattern.\n\ +\n\ +@item lineanchors and stringanchors\n\ +Whether characters ^ and $ match the beginning and ending of lines.\n\ +Alternatively, use (?m) or (?-m) in the pattern.\n\ +\n\ +@item dotexceptnewline and dotall\n\ +Whether . matches newlines in the string.\n\ +Alternatively, use (?s) or (?-s) in the pattern.\n\ +\n\ +@item freespacing or literalspacing\n\ +Whether whitespace and # comments can be used to make the regular expression more readable.\n\ +Alternatively, use (?x) or (?-x) in the pattern.\n\ +\n\ +@end table\n\ +@seealso{regexp,regexpi}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length(); + + if (nargin < 3) + { + print_usage("regexprep"); + return retval; + } + + // Make sure we have string,pattern,replacement + const std::string buffer = args(0).string_value (); + if (error_state) return retval; + const std::string pattern = args(1).string_value (); + if (error_state) return retval; + const std::string replacement = args(2).string_value (); + if (error_state) return retval; + + // Pack options excluding 'tokenize' and various output + // reordering strings into regexp arg list + octave_value_list regexpargs(nargin-1,octave_value()); + regexpargs(0) = args(0); + regexpargs(1) = args(1); + int len=2; + for (int i = 3; i < nargin; i++) + { + const std::string opt = args(i).string_value(); + if (opt != "tokenize" && opt != "start" && opt != "end" + && opt != "tokenextents" && opt != "match" && opt != "tokens" + && opt != "names" && opt != "warnings") + { + regexpargs(len++) = args(i); + } + } + regexpargs.resize(len); + + // Identify replacement tokens; build a vector of group numbers in + // the replacement string so that we can quickly calculate the size + // of the replacement. + int tokens = 0; + for (size_t i=1; i < replacement.size(); i++) + { + if (replacement[i-1]=='$' && isdigit(replacement[i])) + { + tokens++, i++; + } + } + std::vector<int> token(tokens); + int kk = 0; + for (size_t i = 1; i < replacement.size(); i++) + { + if (replacement[i-1]=='$' && isdigit(replacement[i])) + { + token[kk++] = replacement[i]-'0'; + i++; + } + } + + // Perform replacement + std::string rep; + if (tokens > 0) + { + std::list<regexp_elem> lst; + string_vector named; + int nopts; + int sz = octregexp_list (regexpargs, "regexprep", false, lst, named, + nopts); + + if (error_state) + return retval; + if (sz == 0) + { + retval(0) = args(0); + return retval; + } + + // Determine replacement length + const size_t replen = replacement.size() - 2*tokens; + int delta = 0; + const_iterator p = lst.begin(); + for (int i = 0; i < sz; i++) + { + OCTAVE_QUIT; + + const Matrix pairs(p->te); + size_t pairlen = 0; + for (int j = 0; j < tokens; j++) + { + if (token[j] == 0) + pairlen += static_cast<size_t>(p->e - p->s) + 1; + else if (token[j] <= pairs.rows()) + pairlen += static_cast<size_t>(pairs(token[j]-1,1) - + pairs(token[j]-1,0)) + 1; + } + delta += static_cast<int>(replen + pairlen) - + static_cast<int>(p->e - p->s + 1); + p++; + } + + // Build replacement string + rep.reserve(buffer.size()+delta); + size_t from = 0; + p = lst.begin(); + for (int i=0; i < sz; i++) + { + OCTAVE_QUIT; + + const Matrix pairs(p->te); + rep.append(&buffer[from], static_cast<size_t>(p->s - 1) - from); + from = static_cast<size_t>(p->e - 1) + 1; + for (size_t j = 1; j < replacement.size(); j++) + { + if (replacement[j-1]=='$' && isdigit(replacement[j])) + { + int k = replacement[j]-'0'; + if (k == 0) + { + // replace with entire match + rep.append(&buffer[static_cast<size_t>(p->e - 1)], + static_cast<size_t>(p->e - p->s) + 1); + } + else if (k <= pairs.rows()) + { + // replace with group capture + rep.append(&buffer[static_cast<size_t>(pairs(k-1,0)-1)], + static_cast<size_t>(pairs(k-1,1) - + pairs(k-1,0))+1); + } + else + { + // replace with nothing + } + j++; + } + else + { + rep.append(1,replacement[j-1]); + } + if (j+1 == replacement.size()) + { + rep.append(1,replacement[j]); + } + } + p++; + } + rep.append(&buffer[from],buffer.size()-from); + } + else + { + std::list<regexp_elem> lst; + string_vector named; + int nopts; + int sz = octregexp_list (regexpargs, "regexprep", false, lst, named, + nopts); + + if (error_state) + return retval; + if (sz == 0) + { + retval(0) = args(0); + return retval; + } + + // Determine replacement length + const size_t replen = replacement.size(); + int delta = 0; + const_iterator p = lst.begin(); + for (int i = 0; i < sz; i++) + { + OCTAVE_QUIT; + delta += static_cast<int>(replen) - + static_cast<int>(p->e - p->s + 1); + p++; + } + + // Build replacement string + rep.reserve(buffer.size()+delta); + size_t from = 0; + p = lst.begin(); + for (int i=0; i < sz; i++) + { + OCTAVE_QUIT; + rep.append(&buffer[from], static_cast<size_t>(p->s - 1) - from); + from = static_cast<size_t>(p->e - 1) + 1; + rep.append(replacement); + p++; + } + rep.append(&buffer[from],buffer.size()-from); + } + + retval(0) = rep; + return retval; +} + +/* +%!test # Replace with empty +%! xml = '<!-- This is some XML --> <tag v="hello">some stuff<!-- sample tag--></tag>'; +%! t = regexprep(xml,'<[!?][^>]*>',''); +%! assert(t,' <tag v="hello">some stuff</tag>') + +%!test # Replace with non-empty +%! xml = '<!-- This is some XML --> <tag v="hello">some stuff<!-- sample tag--></tag>'; +%! t = regexprep(xml,'<[!?][^>]*>','?'); +%! assert(t,'? <tag v="hello">some stuff?</tag>') + +%!test # Check that 'tokenize' is ignored +%! xml = '<!-- This is some XML --> <tag v="hello">some stuff<!-- sample tag--></tag>'; +%! t = regexprep(xml,'<[!?][^>]*>','','tokenize'); +%! assert(t,' <tag v="hello">some stuff</tag>') + +%!test # Capture replacement +%! if (!isempty(findstr(octave_config_info ("DEFS"),"HAVE_PCRE"))) +%! data = "Bob Smith\nDavid Hollerith\nSam Jenkins"; +%! result = "Smith, Bob\nHollerith, David\nJenkins, Sam"; +%! t = regexprep(data,'(?m)^(\w+)\s+(\w+)$','$2, $1'); +%! assert(t,result) +%! end + +# Return the original if no match +%!assert(regexprep('hello','world','earth'),'hello') + +## Test a general replacement +%!assert(regexprep("a[b]c{d}e-f=g", "[^A-Za-z0-9_]", "_"), "a_b_c_d_e_f_g"); + +## Make sure it works at the beginning and end +%!assert(regexprep("a[b]c{d}e-f=g", "a", "_"), "_[b]c{d}e-f=g"); +%!assert(regexprep("a[b]c{d}e-f=g", "g", "_"), "a[b]c{d}e-f=_"); + +## Options +%!assert(regexprep("a[b]c{d}e-f=g", "[^A-Za-z0-9_]", "_", "once"), "a_b]c{d}e-f=g"); +%!assert(regexprep("a[b]c{d}e-f=g", "[^A-Z0-9_]", "_", "ignorecase"), "a_b_c_d_e_f_g"); + +## Option combinations +%!assert(regexprep("a[b]c{d}e-f=g", "[^A-Z0-9_]", "_", "once", "ignorecase"), "a_b]c{d}e-f=g"); + +## End conditions on replacement +%!assert(regexprep("abc","(b)",".$1"),"a.bc"); +%!assert(regexprep("abc","(b)","$1"),"abc"); +%!assert(regexprep("abc","(b)","$1."),"ab.c"); +%!assert(regexprep("abc","(b)","$1.."),"ab..c"); + +*/ + /* ;;; Local Variables: *** ;;; mode: C++ ***
--- a/src/DLD-FUNCTIONS/splu.cc +++ b/src/DLD-FUNCTIONS/splu.cc @@ -240,13 +240,13 @@ SparseMatrix L = P.transpose () * fact.L (); if (have_Qinit) retval(1) = octave_value (fact.U () * fact.Pc ().transpose (), - SparseType (SparseType::Permuted_Upper, nc, fact.col_perm ())); + MatrixType (MatrixType::Permuted_Upper, nc, fact.col_perm ())); else retval(1) = octave_value (fact.U (), - SparseType (SparseType::Upper)); + MatrixType (MatrixType::Upper)); retval(0) = octave_value (L, - SparseType (SparseType::Permuted_Lower, nr, fact.row_perm ())); + MatrixType (MatrixType::Permuted_Lower, nr, fact.row_perm ())); } break; @@ -257,13 +257,13 @@ retval(2) = fact.Pr (); if (have_Qinit) retval(1) = octave_value (fact.U () * fact.Pc ().transpose (), - SparseType (SparseType::Permuted_Upper, nc, fact.col_perm ())); + MatrixType (MatrixType::Permuted_Upper, nc, fact.col_perm ())); else retval(1) = octave_value (fact.U (), - SparseType (SparseType::Upper)); + MatrixType (MatrixType::Upper)); retval(0) = octave_value (fact.L (), - SparseType (SparseType::Lower)); + MatrixType (MatrixType::Lower)); } break; @@ -277,9 +277,9 @@ retval(3) = fact.Pc (); retval(2) = fact.Pr (); retval(1) = octave_value (fact.U (), - SparseType (SparseType::Upper)); + MatrixType (MatrixType::Upper)); retval(0) = octave_value (fact.L (), - SparseType (SparseType::Lower)); + MatrixType (MatrixType::Lower)); } else { @@ -288,9 +288,9 @@ retval(3) = fact.Pc (); retval(2) = fact.Pr (); retval(1) = octave_value (fact.U (), - SparseType (SparseType::Upper)); + MatrixType (MatrixType::Upper)); retval(0) = octave_value (fact.L (), - SparseType (SparseType::Lower)); + MatrixType (MatrixType::Lower)); } } break; @@ -324,13 +324,13 @@ if (have_Qinit) retval(1) = octave_value (fact.U () * fact.Pc ().transpose (), - SparseType (SparseType::Permuted_Upper, nc, fact.col_perm ())); + MatrixType (MatrixType::Permuted_Upper, nc, fact.col_perm ())); else retval(1) = octave_value (fact.U (), - SparseType (SparseType::Upper)); + MatrixType (MatrixType::Upper)); retval(0) = octave_value (L, - SparseType (SparseType::Permuted_Lower, nr, fact.row_perm ())); + MatrixType (MatrixType::Permuted_Lower, nr, fact.row_perm ())); } break; @@ -341,13 +341,13 @@ retval(2) = fact.Pr (); if (have_Qinit) retval(1) = octave_value (fact.U () * fact.Pc ().transpose (), - SparseType (SparseType::Permuted_Upper, nc, fact.col_perm ())); + MatrixType (MatrixType::Permuted_Upper, nc, fact.col_perm ())); else retval(1) = octave_value (fact.U (), - SparseType (SparseType::Upper)); + MatrixType (MatrixType::Upper)); retval(0) = octave_value (fact.L (), - SparseType (SparseType::Lower)); + MatrixType (MatrixType::Lower)); } break; @@ -361,9 +361,9 @@ retval(3) = fact.Pc (); retval(2) = fact.Pr (); retval(1) = octave_value (fact.U (), - SparseType (SparseType::Upper)); + MatrixType (MatrixType::Upper)); retval(0) = octave_value (fact.L (), - SparseType (SparseType::Lower)); + MatrixType (MatrixType::Lower)); } else { @@ -372,9 +372,9 @@ retval(3) = fact.Pc (); retval(2) = fact.Pr (); retval(1) = octave_value (fact.U (), - SparseType (SparseType::Upper)); + MatrixType (MatrixType::Upper)); retval(0) = octave_value (fact.L (), - SparseType (SparseType::Lower)); + MatrixType (MatrixType::Lower)); } } break; @@ -445,16 +445,13 @@ if (! error_state) { - const octave_sparse_matrix& rep - = dynamic_cast<const octave_sparse_matrix&> (arg.get_rep ()); - - SparseType mattyp = rep.sparse_type (); + MatrixType mattyp = args(0).matrix_type (); octave_idx_type info; double rcond = 0.0; SparseMatrix result = m.inverse (mattyp, info, rcond, 1); - rep.sparse_type (mattyp); + args(0).matrix_type (mattyp); if (nargout > 1) retval(1) = rcond; @@ -474,16 +471,14 @@ if (! error_state) { - const octave_sparse_complex_matrix& rep - = dynamic_cast<const octave_sparse_complex_matrix&> (arg.get_rep ()); - SparseType mattyp = rep.sparse_type (); + MatrixType mattyp = args(0).matrix_type (); octave_idx_type info; double rcond = 0.0; SparseComplexMatrix result = m.inverse (mattyp, info, rcond, 1); - rep.sparse_type (mattyp); + args(0).matrix_type (mattyp); if (nargout > 1) retval(1) = rcond;
--- a/src/OPERATORS/op-cm-cm.cc +++ b/src/OPERATORS/op-cm-cm.cc @@ -75,7 +75,18 @@ DEFNDBINOP_OP (sub, complex_matrix, complex_matrix, complex_array, complex_array, -) DEFBINOP_OP (mul, complex_matrix, complex_matrix, *) -DEFBINOP_FN (div, complex_matrix, complex_matrix, xdiv) + +DEFBINOP (div, complex_matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + MatrixType typ = v2.matrix_type (); + + ComplexMatrix ret = xdiv (v1.complex_matrix_value (), + v2.complex_matrix_value (), typ); + + v2.matrix_type (typ); + return ret; +} DEFBINOPX (pow, complex_matrix, complex_matrix) { @@ -83,7 +94,17 @@ return octave_value (); } -DEFBINOP_FN (ldiv, complex_matrix, complex_matrix, xleftdiv) +DEFBINOP (ldiv, complex_matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + MatrixType typ = v1.matrix_type (); + + ComplexMatrix ret = xleftdiv (v1.complex_matrix_value (), + v2.complex_matrix_value (), typ); + + v1.matrix_type (typ); + return ret; +} DEFNDBINOP_FN (lt, complex_matrix, complex_matrix, complex_array, complex_array, mx_el_lt) DEFNDBINOP_FN (le, complex_matrix, complex_matrix, complex_array, complex_array, mx_el_le)
--- a/src/OPERATORS/op-cm-cs.cc +++ b/src/OPERATORS/op-cm-cs.cc @@ -61,8 +61,11 @@ ComplexMatrix m1 = v1.complex_matrix_value (); ComplexMatrix m2 = v2.complex_matrix_value (); + MatrixType typ = v1.matrix_type (); - return octave_value (xleftdiv (m1, m2)); + ComplexMatrix ret = xleftdiv (m1, m2, typ); + v1.matrix_type (typ); + return ret; } DEFNDBINOP_FN (lt, complex_matrix, complex, complex_array, complex, mx_el_lt)
--- a/src/OPERATORS/op-cm-m.cc +++ b/src/OPERATORS/op-cm-m.cc @@ -46,7 +46,19 @@ DEFNDBINOP_OP (sub, complex_matrix, matrix, complex_array, array, -) DEFBINOP_OP (mul, complex_matrix, matrix, *) -DEFBINOP_FN (div, complex_matrix, matrix, xdiv) + +DEFBINOP (div, complex_matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + MatrixType typ = v2.matrix_type (); + + ComplexMatrix ret = xdiv (v1.complex_matrix_value (), + v2.matrix_value (), typ); + + v2.matrix_type (typ); + return ret; +} + DEFBINOPX (pow, complex_matrix, matrix) { @@ -54,7 +66,17 @@ return octave_value (); } -DEFBINOP_FN (ldiv, complex_matrix, matrix, xleftdiv) +DEFBINOP (ldiv, complex_matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + MatrixType typ = v1.matrix_type (); + + ComplexMatrix ret = xleftdiv (v1.complex_matrix_value (), + v2.matrix_value (), typ); + + v1.matrix_type (typ); + return ret; +} DEFNDBINOP_FN (lt, complex_matrix, matrix, complex_array, array, mx_el_lt) DEFNDBINOP_FN (le, complex_matrix, matrix, complex_array, array, mx_el_le)
--- a/src/OPERATORS/op-cm-s.cc +++ b/src/OPERATORS/op-cm-s.cc @@ -65,8 +65,12 @@ ComplexMatrix m1 = v1.complex_matrix_value (); Matrix m2 = v2.matrix_value (); + MatrixType typ = v1.matrix_type (); - return octave_value (xleftdiv (m1, m2)); + ComplexMatrix ret = xleftdiv (m1, m2, typ); + + v1.matrix_type (typ); + return ret; } DEFNDBINOP_FN (lt, complex_matrix, scalar, complex_array, scalar, mx_el_lt)
--- a/src/OPERATORS/op-cm-scm.cc +++ b/src/OPERATORS/op-cm-scm.cc @@ -50,12 +50,12 @@ CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_sparse_complex_matrix&); - SparseType typ = v2.sparse_type (); + MatrixType typ = v2.matrix_type (); ComplexMatrix ret = xdiv (v1.complex_matrix_value (), v2.sparse_complex_matrix_value (), typ); - v2.sparse_type (typ); + v2.matrix_type (typ); return ret; } @@ -69,9 +69,13 @@ { CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_sparse_complex_matrix&); + MatrixType typ = v1.matrix_type (); - return xleftdiv (v1.complex_matrix_value (), - v2.complex_matrix_value ()); + ComplexMatrix ret = xleftdiv (v1.complex_matrix_value (), + v2.complex_matrix_value (), typ); + + v1.matrix_type (typ); + return ret; } DEFBINOP_FN (lt, complex_matrix, sparse_complex_matrix, mx_el_lt)
--- a/src/OPERATORS/op-cm-sm.cc +++ b/src/OPERATORS/op-cm-sm.cc @@ -49,12 +49,12 @@ { CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_sparse_matrix&); - SparseType typ = v2.sparse_type (); + MatrixType typ = v2.matrix_type (); ComplexMatrix ret = xdiv (v1.complex_matrix_value (), v2.sparse_matrix_value (), typ); - v2.sparse_type (typ); + v2.matrix_type (typ); return ret; } @@ -68,8 +68,13 @@ { CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_sparse_matrix&); + MatrixType typ = v1.matrix_type (); - return xleftdiv (v1.complex_matrix_value (), v2.matrix_value ()); + ComplexMatrix ret = xleftdiv (v1.complex_matrix_value (), + v2.matrix_value (), typ); + + v1.matrix_type (typ); + return ret; } DEFBINOP_FN (lt, complex_matrix, sparse_matrix, mx_el_lt)
--- a/src/OPERATORS/op-cs-cm.cc +++ b/src/OPERATORS/op-cs-cm.cc @@ -47,8 +47,12 @@ ComplexMatrix m1 = v1.complex_matrix_value (); ComplexMatrix m2 = v2.complex_matrix_value (); + MatrixType typ = v2.matrix_type (); - return octave_value (xdiv (m1, m2)); + ComplexMatrix ret = xdiv (m1, m2, typ); + + v2.matrix_type (typ); + return ret; } DEFBINOP_FN (pow, complex, complex_matrix, xpow)
--- a/src/OPERATORS/op-cs-m.cc +++ b/src/OPERATORS/op-cs-m.cc @@ -53,8 +53,12 @@ ComplexMatrix m1 = v1.complex_matrix_value (); Matrix m2 = v2.matrix_value (); + MatrixType typ = v2.matrix_type (); - return octave_value (xdiv (m1, m2)); + ComplexMatrix ret = xdiv (m1, m2, typ); + + v2.matrix_type (typ); + return ret; } DEFBINOP_FN (pow, complex, matrix, xpow)
--- a/src/OPERATORS/op-cs-scm.cc +++ b/src/OPERATORS/op-cs-scm.cc @@ -47,11 +47,11 @@ { CAST_BINOP_ARGS (const octave_complex&, const octave_sparse_complex_matrix&); - SparseType typ = v2.sparse_type (); + MatrixType typ = v2.matrix_type (); ComplexMatrix m1 = ComplexMatrix (1, 1, v1.complex_value ()); SparseComplexMatrix m2 = v2.sparse_complex_matrix_value (); ComplexMatrix ret = xdiv (m1, m2, typ); - v2.sparse_type (typ); + v2.matrix_type (typ); return ret; }
--- a/src/OPERATORS/op-cs-sm.cc +++ b/src/OPERATORS/op-cs-sm.cc @@ -49,11 +49,11 @@ { CAST_BINOP_ARGS (const octave_complex&, const octave_sparse_matrix&); - SparseType typ = v2.sparse_type (); + MatrixType typ = v2.matrix_type (); ComplexMatrix m1 = ComplexMatrix (1, 1, v1.complex_value ()); SparseMatrix m2 = v2.sparse_matrix_value (); ComplexMatrix ret = xdiv (m1, m2, typ); - v2.sparse_type (typ); + v2.matrix_type (typ); return ret; }
--- a/src/OPERATORS/op-m-cm.cc +++ b/src/OPERATORS/op-m-cm.cc @@ -46,7 +46,18 @@ DEFNDBINOP_OP (sub, matrix, complex_matrix, array, complex_array, -) DEFBINOP_OP (mul, matrix, complex_matrix, *) -DEFBINOP_FN (div, matrix, complex_matrix, xdiv) + +DEFBINOP (div, matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + MatrixType typ = v2.matrix_type (); + + ComplexMatrix ret = xdiv (v1.matrix_value (), + v2.complex_matrix_value (), typ); + + v2.matrix_type (typ); + return ret; +} DEFBINOPX (pow, matrix, complex_matrix) { @@ -54,7 +65,17 @@ return octave_value (); } -DEFBINOP_FN (ldiv, matrix, complex_matrix, xleftdiv) +DEFBINOP (ldiv, matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + MatrixType typ = v1.matrix_type (); + + ComplexMatrix ret = xleftdiv (v1.matrix_value (), + v2.complex_matrix_value (), typ); + + v1.matrix_type (typ); + return ret; +} DEFNDBINOP_FN (lt, matrix, complex_matrix, array, complex_array, mx_el_lt) DEFNDBINOP_FN (le, matrix, complex_matrix, array, complex_array, mx_el_le)
--- a/src/OPERATORS/op-m-cs.cc +++ b/src/OPERATORS/op-m-cs.cc @@ -67,8 +67,12 @@ Matrix m1 = v1.matrix_value (); ComplexMatrix m2 = v2.complex_matrix_value (); + MatrixType typ = v1.matrix_type (); - return octave_value (xleftdiv (m1, m2)); + ComplexMatrix ret = xleftdiv (m1, m2, typ); + + v1.matrix_type (typ); + return ret; } DEFNDBINOP_FN (lt, matrix, complex, array, complex, mx_el_lt)
--- a/src/OPERATORS/op-m-m.cc +++ b/src/OPERATORS/op-m-m.cc @@ -62,7 +62,17 @@ DEFNDBINOP_OP (sub, matrix, matrix, array, array, -) DEFBINOP_OP (mul, matrix, matrix, *) -DEFBINOP_FN (div, matrix, matrix, xdiv) + +DEFBINOP (div, matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + MatrixType typ = v2.matrix_type (); + + Matrix ret = xdiv (v1.matrix_value (), v2.matrix_value (), typ); + + v2.matrix_type (typ); + return ret; +} DEFBINOPX (pow, matrix, matrix) { @@ -70,7 +80,16 @@ return octave_value (); } -DEFBINOP_FN (ldiv, matrix, matrix, xleftdiv) +DEFBINOP (ldiv, matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + MatrixType typ = v1.matrix_type (); + + Matrix ret = xleftdiv (v1.matrix_value (), v2.matrix_value (), typ); + + v1.matrix_type (typ); + return ret; +} DEFNDBINOP_FN (lt, matrix, matrix, array, array, mx_el_lt) DEFNDBINOP_FN (le, matrix, matrix, array, array, mx_el_le)
--- a/src/OPERATORS/op-m-s.cc +++ b/src/OPERATORS/op-m-s.cc @@ -61,8 +61,12 @@ Matrix m1 = v1.matrix_value (); Matrix m2 = v2.matrix_value (); + MatrixType typ = v1.matrix_type (); - return octave_value (xleftdiv (m1, m2)); + Matrix ret = xleftdiv (m1, m2, typ); + + v1.matrix_type (typ); + return ret; } DEFNDBINOP_FN (lt, matrix, scalar, array, scalar, mx_el_lt)
--- a/src/OPERATORS/op-m-scm.cc +++ b/src/OPERATORS/op-m-scm.cc @@ -50,12 +50,12 @@ { CAST_BINOP_ARGS (const octave_matrix&, const octave_sparse_complex_matrix&); - SparseType typ = v2.sparse_type (); + MatrixType typ = v2.matrix_type (); ComplexMatrix ret = xdiv (v1.matrix_value (), v2.sparse_complex_matrix_value (), typ); - v2.sparse_type (typ); + v2.matrix_type (typ); return ret; } @@ -69,8 +69,13 @@ { CAST_BINOP_ARGS (const octave_matrix&, const octave_sparse_complex_matrix&); + MatrixType typ = v1.matrix_type (); - return xleftdiv (v1.matrix_value (), v2.complex_matrix_value ()); + ComplexMatrix ret = xleftdiv (v1.matrix_value (), + v2.complex_matrix_value (), typ); + + v1.matrix_type (typ); + return ret; } DEFBINOP_FN (lt, matrix, sparse_complex_matrix, mx_el_lt)
--- a/src/OPERATORS/op-m-sm.cc +++ b/src/OPERATORS/op-m-sm.cc @@ -48,11 +48,11 @@ DEFBINOP (div, matrix, sparse_matrix) { CAST_BINOP_ARGS (const octave_matrix&, const octave_sparse_matrix&); - SparseType typ = v2.sparse_type (); + MatrixType typ = v2.matrix_type (); Matrix ret = xdiv (v1.matrix_value (), v2.sparse_matrix_value (), typ); - v2.sparse_type (typ); + v2.matrix_type (typ); return ret; } @@ -65,8 +65,12 @@ DEFBINOP (ldiv, matrix, sparse_matrix) { CAST_BINOP_ARGS (const octave_matrix&, const octave_sparse_matrix&); + MatrixType typ = v1.matrix_type (); - return xleftdiv (v1.matrix_value (), v2.matrix_value ()); + Matrix ret = xleftdiv (v1.matrix_value (), v2.matrix_value (), typ); + + v1.matrix_type (typ); + return ret; } DEFBINOP_FN (lt, matrix, sparse_matrix, mx_el_lt)
--- a/src/OPERATORS/op-s-cm.cc +++ b/src/OPERATORS/op-s-cm.cc @@ -53,8 +53,12 @@ Matrix m1 = v1.matrix_value (); ComplexMatrix m2 = v2.complex_matrix_value (); + MatrixType typ = v2.matrix_type (); - return octave_value (xdiv (m1, m2)); + ComplexMatrix ret = xdiv (m1, m2, typ); + + v2.matrix_type (typ); + return ret; } DEFBINOP_FN (pow, scalar, complex_matrix, xpow)
--- a/src/OPERATORS/op-s-m.cc +++ b/src/OPERATORS/op-s-m.cc @@ -47,8 +47,12 @@ Matrix m1 = v1.matrix_value (); Matrix m2 = v2.matrix_value (); + MatrixType typ = v2.matrix_type (); - return octave_value (xdiv (m1, m2)); + Matrix ret = xdiv (m1, m2, typ); + + v2.matrix_type (typ); + return ret; } DEFBINOP_FN (pow, scalar, matrix, xpow)
--- a/src/OPERATORS/op-s-scm.cc +++ b/src/OPERATORS/op-s-scm.cc @@ -50,11 +50,11 @@ { CAST_BINOP_ARGS (const octave_scalar&, const octave_sparse_complex_matrix&); - SparseType typ = v2.sparse_type (); + MatrixType typ = v2.matrix_type (); Matrix m1 = Matrix (1, 1, v1.scalar_value ()); SparseComplexMatrix m2 = v2.sparse_complex_matrix_value (); ComplexMatrix ret = xdiv (m1, m2, typ); - v2.sparse_type (typ); + v2.matrix_type (typ); return ret; }
--- a/src/OPERATORS/op-s-sm.cc +++ b/src/OPERATORS/op-s-sm.cc @@ -46,11 +46,11 @@ { CAST_BINOP_ARGS (const octave_scalar&, const octave_sparse_matrix&); - SparseType typ = v2.sparse_type (); + MatrixType typ = v2.matrix_type (); Matrix m1 = Matrix (1, 1, v1.double_value ()); SparseMatrix m2 = v2.sparse_matrix_value (); Matrix ret = xdiv (m1, m2, typ); - v2.sparse_type (typ); + v2.matrix_type (typ); return ret; }
--- a/src/OPERATORS/op-scm-cm.cc +++ b/src/OPERATORS/op-scm-cm.cc @@ -49,8 +49,13 @@ { CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_complex_matrix&); + MatrixType typ = v2.matrix_type (); - return xdiv (v1.complex_matrix_value (), v2.complex_matrix_value ()); + ComplexMatrix ret = xdiv (v1.complex_matrix_value (), + v2.complex_matrix_value (), typ); + + v2.matrix_type (typ); + return ret; } DEFBINOPX (pow, sparse_complex_matrix, complex_matrix) @@ -62,12 +67,12 @@ DEFBINOP (ldiv, sparse_complex_matrix, complex_matrix) { CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_complex_matrix&); - SparseType typ = v1.sparse_type (); + MatrixType typ = v1.matrix_type (); ComplexMatrix ret = xleftdiv (v1.sparse_complex_matrix_value (), v2.complex_matrix_value (), typ); - v1.sparse_type (typ); + v1.matrix_type (typ); return ret; }
--- a/src/OPERATORS/op-scm-cs.cc +++ b/src/OPERATORS/op-scm-cs.cc @@ -74,11 +74,11 @@ { CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_complex&); - SparseType typ = v1.sparse_type (); + MatrixType typ = v1.matrix_type (); SparseComplexMatrix m1 = v1.sparse_complex_matrix_value (); ComplexMatrix m2 = ComplexMatrix (1, 1, v2.complex_value ()); ComplexMatrix ret = xleftdiv (m1, m2, typ); - v1.sparse_type (typ); + v1.matrix_type (typ); return ret; }
--- a/src/OPERATORS/op-scm-m.cc +++ b/src/OPERATORS/op-scm-m.cc @@ -50,8 +50,13 @@ { CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_matrix&); + MatrixType typ = v2.matrix_type (); - return xdiv (v1.complex_matrix_value (), v2.matrix_value ()); + ComplexMatrix ret = xdiv (v1.complex_matrix_value (), + v2.matrix_value (), typ); + + v2.matrix_type (typ); + return ret; } DEFBINOPX (pow, sparse_complex_matrix, matrix) @@ -64,12 +69,12 @@ { CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_matrix&); - SparseType typ = v1.sparse_type (); + MatrixType typ = v1.matrix_type (); ComplexMatrix ret = xleftdiv (v1.sparse_complex_matrix_value (), v2.matrix_value (), typ); - v1.sparse_type (typ); + v1.matrix_type (typ); return ret; }
--- a/src/OPERATORS/op-scm-s.cc +++ b/src/OPERATORS/op-scm-s.cc @@ -82,11 +82,11 @@ { CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_scalar&); - SparseType typ = v1.sparse_type (); + MatrixType typ = v1.matrix_type (); SparseComplexMatrix m1 = v1.sparse_complex_matrix_value (); Matrix m2 = Matrix (1, 1, v2.scalar_value ()); ComplexMatrix ret = xleftdiv (m1, m2, typ); - v1.sparse_type (typ); + v1.matrix_type (typ); return ret; }
--- a/src/OPERATORS/op-scm-scm.cc +++ b/src/OPERATORS/op-scm-scm.cc @@ -59,7 +59,7 @@ CAST_UNOP_ARG (const octave_sparse_complex_matrix&); return octave_value (v.sparse_complex_matrix_value().transpose (), - v.sparse_type ().transpose ()); + v.matrix_type ().transpose ()); } DEFUNOP (hermitian, sparse_complex_matrix) @@ -67,7 +67,7 @@ CAST_UNOP_ARG (const octave_sparse_complex_matrix&); return octave_value (v.sparse_complex_matrix_value().hermitian (), - v.sparse_type ().transpose ()); + v.matrix_type ().transpose ()); } #if 0 @@ -97,11 +97,11 @@ { CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_sparse_complex_matrix&); - SparseType typ = v2.sparse_type (); + MatrixType typ = v2.matrix_type (); SparseComplexMatrix ret = xdiv (v1.sparse_complex_matrix_value (), v2.sparse_complex_matrix_value (), typ); - v2.sparse_type (typ); + v2.matrix_type (typ); return ret; } @@ -115,12 +115,12 @@ { CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_sparse_complex_matrix&); - SparseType typ = v1.sparse_type (); + MatrixType typ = v1.matrix_type (); SparseComplexMatrix ret = xleftdiv (v1.sparse_complex_matrix_value (), v2.sparse_complex_matrix_value (), typ); - v1.sparse_type (typ); + v1.matrix_type (typ); return ret; }
--- a/src/OPERATORS/op-scm-sm.cc +++ b/src/OPERATORS/op-scm-sm.cc @@ -47,11 +47,11 @@ DEFBINOP (div, sparse_complex_matrix, sparse_matrix) { CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_sparse_matrix&); - SparseType typ = v2.sparse_type (); + MatrixType typ = v2.matrix_type (); SparseComplexMatrix ret = xdiv (v1.sparse_complex_matrix_value (), v2.sparse_matrix_value (), typ); - v2.sparse_type (typ); + v2.matrix_type (typ); return ret; } @@ -64,12 +64,12 @@ DEFBINOP (ldiv, sparse_complex_matrix, sparse_matrix) { CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_sparse_matrix&); - SparseType typ = v1.sparse_type (); + MatrixType typ = v1.matrix_type (); SparseComplexMatrix ret = xleftdiv (v1.sparse_complex_matrix_value (), v2.sparse_matrix_value (), typ); - v1.sparse_type (typ); + v1.matrix_type (typ); return ret; }
--- a/src/OPERATORS/op-sm-cm.cc +++ b/src/OPERATORS/op-sm-cm.cc @@ -49,8 +49,13 @@ { CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex_matrix&); + MatrixType typ = v2.matrix_type (); - return xdiv (v1.matrix_value (), v2.complex_matrix_value ()); + ComplexMatrix ret = xdiv (v1.matrix_value (), + v2.complex_matrix_value (), typ); + + v2.matrix_type (typ); + return ret; } DEFBINOPX (pow, sparse_matrix, complex_matrix) @@ -62,12 +67,12 @@ DEFBINOP (ldiv, sparse_matrix, complex_matrix) { CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex_matrix&); - SparseType typ = v1.sparse_type (); + MatrixType typ = v1.matrix_type (); ComplexMatrix ret = xleftdiv (v1.sparse_matrix_value (), v2.complex_matrix_value (), typ); - v1.sparse_type (typ); + v1.matrix_type (typ); return ret; }
--- a/src/OPERATORS/op-sm-cs.cc +++ b/src/OPERATORS/op-sm-cs.cc @@ -74,11 +74,11 @@ { CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex&); - SparseType typ = v1.sparse_type (); + MatrixType typ = v1.matrix_type (); SparseMatrix m1 = v1.sparse_matrix_value (); ComplexMatrix m2 = ComplexMatrix (1, 1, v2.complex_value ()); ComplexMatrix ret = xleftdiv (m1, m2, typ); - v1.sparse_type (typ); + v1.matrix_type (typ); return ret; }
--- a/src/OPERATORS/op-sm-m.cc +++ b/src/OPERATORS/op-sm-m.cc @@ -48,8 +48,12 @@ DEFBINOP (div, sparse_matrix, matrix) { CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_matrix&); + MatrixType typ = v2.matrix_type (); - return xdiv (v1.matrix_value (), v2.matrix_value ()); + Matrix ret = xdiv (v1.matrix_value (), v2.matrix_value (), typ); + + v2.matrix_type (typ); + return ret; } DEFBINOPX (pow, sparse_matrix, matrix) @@ -61,12 +65,12 @@ DEFBINOP (ldiv, sparse_matrix, matrix) { CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_matrix&); - SparseType typ = v1.sparse_type (); + MatrixType typ = v1.matrix_type (); Matrix ret = xleftdiv (v1.sparse_matrix_value (), v2.matrix_value (), typ); - v1.sparse_type (typ); + v1.matrix_type (typ); return ret; }
--- a/src/OPERATORS/op-sm-s.cc +++ b/src/OPERATORS/op-sm-s.cc @@ -76,11 +76,11 @@ { CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_scalar&); - SparseType typ = v1.sparse_type (); + MatrixType typ = v1.matrix_type (); SparseMatrix m1 = v1.sparse_matrix_value (); Matrix m2 = Matrix (1, 1, v2.scalar_value ()); Matrix ret = xleftdiv (m1, m2, typ); - v1.sparse_type (typ); + v1.matrix_type (typ); return ret; }
--- a/src/OPERATORS/op-sm-scm.cc +++ b/src/OPERATORS/op-sm-scm.cc @@ -47,11 +47,11 @@ DEFBINOP (div, sparse_matrix, sparse_complex_matrix) { CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_sparse_complex_matrix&); - SparseType typ = v2.sparse_type (); + MatrixType typ = v2.matrix_type (); SparseComplexMatrix ret = xdiv (v1.sparse_matrix_value (), v2.sparse_complex_matrix_value (), typ); - v2.sparse_type (typ); + v2.matrix_type (typ); return ret; } @@ -64,12 +64,12 @@ DEFBINOP (ldiv, sparse_matrix, sparse_complex_matrix) { CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_sparse_complex_matrix&); - SparseType typ = v1.sparse_type (); + MatrixType typ = v1.matrix_type (); SparseComplexMatrix ret = xleftdiv (v1.sparse_matrix_value (), v2.sparse_complex_matrix_value (), typ); - v1.sparse_type (typ); + v1.matrix_type (typ); return ret; }
--- a/src/OPERATORS/op-sm-sm.cc +++ b/src/OPERATORS/op-sm-sm.cc @@ -45,7 +45,7 @@ { CAST_UNOP_ARG (const octave_sparse_matrix&); return octave_value (v.sparse_matrix_value().transpose (), - v.sparse_type ().transpose ()); + v.matrix_type ().transpose ()); } // sparse matrix by sparse matrix ops. @@ -57,11 +57,11 @@ DEFBINOP (div, sparse_matrix, sparse_matrix) { CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_sparse_matrix&); - SparseType typ = v2.sparse_type (); + MatrixType typ = v2.matrix_type (); SparseMatrix ret = xdiv (v1.sparse_matrix_value (), v2.sparse_matrix_value (), typ); - v2.sparse_type (typ); + v2.matrix_type (typ); return ret; } @@ -74,12 +74,12 @@ DEFBINOP (ldiv, sparse_matrix, sparse_matrix) { CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_sparse_matrix&); - SparseType typ = v1.sparse_type (); + MatrixType typ = v1.matrix_type (); SparseMatrix ret = xleftdiv (v1.sparse_matrix_value (), v2.sparse_matrix_value (), typ); - v1.sparse_type (typ); + v1.matrix_type (typ); return ret; }
--- a/src/ov-base-mat.h +++ b/src/ov-base-mat.h @@ -37,6 +37,8 @@ #include "ov-base.h" #include "ov-typeinfo.h" +#include "MatrixType.h" + class Octave_map; class tree_walker; @@ -50,17 +52,24 @@ public: octave_base_matrix (void) - : octave_base_value () { } + : octave_base_value (), typ (MatrixType ()) { } octave_base_matrix (const MT& m) - : octave_base_value (), matrix (m) + : octave_base_value (), matrix (m), typ (MatrixType ()) + { + if (matrix.ndims () == 0) + matrix.resize (dim_vector (0, 0)); + } + + octave_base_matrix (const MT& m, const MatrixType& t) + : octave_base_value (), matrix (m), typ (t) { if (matrix.ndims () == 0) matrix.resize (dim_vector (0, 0)); } octave_base_matrix (const octave_base_matrix& m) - : octave_base_value (), matrix (m.matrix) { } + : octave_base_value (), matrix (m.matrix), typ (m.typ) { } ~octave_base_matrix (void) { } @@ -107,6 +116,10 @@ octave_value all (int dim = 0) const { return matrix.all (dim); } octave_value any (int dim = 0) const { return matrix.any (dim); } + MatrixType matrix_type (void) const { return typ; } + MatrixType matrix_type (const MatrixType& _typ) const + { MatrixType ret = typ; typ = _typ; return ret; } + bool is_matrix_type (void) const { return true; } bool is_numeric_type (void) const { return true; } @@ -126,6 +139,8 @@ protected: MT matrix; + + mutable MatrixType typ; }; #endif
--- a/src/ov-base-sparse.h +++ b/src/ov-base-sparse.h @@ -36,7 +36,7 @@ #include "ov-typeinfo.h" #include "boolSparse.h" -#include "SparseType.h" +#include "MatrixType.h" class Octave_map; @@ -50,16 +50,16 @@ { public: - octave_base_sparse (void) : octave_base_value (), typ (SparseType ()) { } + octave_base_sparse (void) : octave_base_value (), typ (MatrixType ()) { } octave_base_sparse (const T& a) : octave_base_value (), matrix (a), - typ (SparseType ()) + typ (MatrixType ()) { if (matrix.ndims () == 0) matrix.resize (dim_vector (0, 0)); } - octave_base_sparse (const T& a, const SparseType& t) : octave_base_value (), + octave_base_sparse (const T& a, const MatrixType& t) : octave_base_value (), matrix (a), typ (t) { if (matrix.ndims () == 0) @@ -117,9 +117,9 @@ octave_value all (int dim = 0) const { return matrix.all (dim); } octave_value any (int dim = 0) const { return matrix.any (dim); } - SparseType sparse_type (void) const { return typ; } - SparseType sparse_type (const SparseType& _typ) const - { SparseType ret = typ; typ = _typ; return ret; } + MatrixType matrix_type (void) const { return typ; } + MatrixType matrix_type (const MatrixType& _typ) const + { MatrixType ret = typ; typ = _typ; return ret; } bool is_matrix_type (void) const { return true; } @@ -152,7 +152,7 @@ T matrix; - mutable SparseType typ; + mutable MatrixType typ; }; #endif
--- a/src/ov-base.cc +++ b/src/ov-base.cc @@ -250,6 +250,20 @@ return octave_value (); } +MatrixType +octave_base_value::matrix_type (void) const +{ + gripe_wrong_type_arg ("octave_base_value::matrix_type ()", type_name ()); + return MatrixType (); +} + +MatrixType +octave_base_value::matrix_type (const MatrixType&) const +{ + gripe_wrong_type_arg ("octave_base_value::matrix_type ()", type_name ()); + return MatrixType (); +} + octave_value octave_base_value::all (int) const {
--- a/src/ov-base.h +++ b/src/ov-base.h @@ -183,6 +183,10 @@ virtual octave_value resize (const dim_vector&, bool fill = false) const; + virtual MatrixType matrix_type (void) const; + + virtual MatrixType matrix_type (const MatrixType& typ) const; + virtual bool is_defined (void) const { return false; } bool is_empty (void) const { return numel () == 0; }
--- a/src/ov-bool-mat.h +++ b/src/ov-bool-mat.h @@ -38,6 +38,8 @@ #include "ov-base-mat.h" #include "ov-typeinfo.h" +#include "MatrixType.h" + class Octave_map; class octave_value_list; @@ -59,6 +61,9 @@ octave_bool_matrix (const boolMatrix& bm) : octave_base_matrix<boolNDArray> (bm) { } + octave_bool_matrix (const boolMatrix& bm, const MatrixType& t) + : octave_base_matrix<boolNDArray> (bm, t) { } + octave_bool_matrix (const Array2<bool>& a) : octave_base_matrix<boolNDArray> (a) { }
--- a/src/ov-bool-sparse.h +++ b/src/ov-bool-sparse.h @@ -59,7 +59,7 @@ : octave_base_sparse<SparseBoolMatrix> (bnda) { } octave_sparse_bool_matrix (const SparseBoolMatrix& bnda, - const SparseType& t) + const MatrixType& t) : octave_base_sparse<SparseBoolMatrix> (bnda, t) { } octave_sparse_bool_matrix (const boolNDArray& m)
--- a/src/ov-cx-mat.h +++ b/src/ov-cx-mat.h @@ -39,6 +39,8 @@ #include "ov-base-mat.h" #include "ov-typeinfo.h" +#include "MatrixType.h" + class Octave_map; class octave_value_list; @@ -60,6 +62,9 @@ octave_complex_matrix (const ComplexMatrix& m) : octave_base_matrix<ComplexNDArray> (m) { } + octave_complex_matrix (const ComplexMatrix& m, const MatrixType& t) + : octave_base_matrix<ComplexNDArray> (m, t) { } + octave_complex_matrix (const ArrayN<Complex>& m) : octave_base_matrix<ComplexNDArray> (ComplexNDArray (m)) { }
--- a/src/ov-cx-sparse.h +++ b/src/ov-cx-sparse.h @@ -66,7 +66,7 @@ : octave_base_sparse<SparseComplexMatrix> (m) { } octave_sparse_complex_matrix (const SparseComplexMatrix& m, - const SparseType &t) + const MatrixType &t) : octave_base_sparse<SparseComplexMatrix> (m, t) { } octave_sparse_complex_matrix (const MSparse<Complex>& m)
--- a/src/ov-re-mat.h +++ b/src/ov-re-mat.h @@ -40,6 +40,8 @@ #include "ov-base-mat.h" #include "ov-typeinfo.h" +#include "MatrixType.h" + class Octave_map; class octave_value_list; @@ -58,6 +60,9 @@ octave_matrix (const Matrix& m) : octave_base_matrix<NDArray> (m) { } + octave_matrix (const Matrix& m, const MatrixType& t) + : octave_base_matrix<NDArray> (m, t) { } + octave_matrix (const NDArray& nda) : octave_base_matrix<NDArray> (nda) { }
--- a/src/ov-re-sparse.h +++ b/src/ov-re-sparse.h @@ -39,7 +39,7 @@ #include "ov-typeinfo.h" #include "dSparse.h" -#include "SparseType.h" +#include "MatrixType.h" #include "ov-base-sparse.h" #include "ov-bool-sparse.h" #include "ov-cx-sparse.h" @@ -66,7 +66,7 @@ octave_sparse_matrix (const SparseMatrix& m) : octave_base_sparse<SparseMatrix> (m) { } - octave_sparse_matrix (const SparseMatrix& m, const SparseType& t) + octave_sparse_matrix (const SparseMatrix& m, const MatrixType& t) : octave_base_sparse<SparseMatrix> (m, t) { } octave_sparse_matrix (const MSparse<double>& m)
--- a/src/ov.cc +++ b/src/ov.cc @@ -373,8 +373,8 @@ { } -octave_value::octave_value (const Matrix& m) - : rep (new octave_matrix (m)) +octave_value::octave_value (const Matrix& m, const MatrixType& t) + : rep (new octave_matrix (m, t)) { maybe_mutate (); } @@ -415,8 +415,8 @@ maybe_mutate (); } -octave_value::octave_value (const ComplexMatrix& m) - : rep (new octave_complex_matrix (m)) +octave_value::octave_value (const ComplexMatrix& m, const MatrixType& t) + : rep (new octave_complex_matrix (m, t)) { maybe_mutate (); } @@ -456,8 +456,8 @@ { } -octave_value::octave_value (const boolMatrix& bm) - : rep (new octave_bool_matrix (bm)) +octave_value::octave_value (const boolMatrix& bm, const MatrixType& t) + : rep (new octave_bool_matrix (bm, t)) { maybe_mutate (); } @@ -530,19 +530,19 @@ maybe_mutate (); } -octave_value::octave_value (const SparseMatrix& m, const SparseType &t) +octave_value::octave_value (const SparseMatrix& m, const MatrixType &t) : rep (new octave_sparse_matrix (m, t)) { maybe_mutate (); } -octave_value::octave_value (const SparseComplexMatrix& m, const SparseType &t) +octave_value::octave_value (const SparseComplexMatrix& m, const MatrixType &t) : rep (new octave_sparse_complex_matrix (m, t)) { maybe_mutate (); } -octave_value::octave_value (const SparseBoolMatrix& bm, const SparseType &t) +octave_value::octave_value (const SparseBoolMatrix& bm, const MatrixType &t) : rep (new octave_sparse_bool_matrix (bm, t)) { maybe_mutate ();
--- a/src/ov.h +++ b/src/ov.h @@ -40,7 +40,6 @@ #include "oct-alloc.h" #include "oct-time.h" #include "str-vec.h" -#include "SparseType.h" class Cell; class streamoff_array; @@ -163,21 +162,21 @@ octave_value (double d); octave_value (const ArrayN<octave_value>& a, bool is_cs_list = false); octave_value (const Cell& c, bool is_cs_list = false); - octave_value (const Matrix& m); + octave_value (const Matrix& m, const MatrixType& t = MatrixType()); octave_value (const NDArray& nda); octave_value (const ArrayN<double>& m); octave_value (const DiagMatrix& d); octave_value (const RowVector& v); octave_value (const ColumnVector& v); octave_value (const Complex& C); - octave_value (const ComplexMatrix& m); + octave_value (const ComplexMatrix& m, const MatrixType& t = MatrixType()); octave_value (const ComplexNDArray& cnda); octave_value (const ArrayN<Complex>& m); octave_value (const ComplexDiagMatrix& d); octave_value (const ComplexRowVector& v); octave_value (const ComplexColumnVector& v); octave_value (bool b); - octave_value (const boolMatrix& bm); + octave_value (const boolMatrix& bm, const MatrixType& t = MatrixType()); octave_value (const boolNDArray& bnda); octave_value (char c, char type = '"'); octave_value (const char *s, char type = '"'); @@ -189,11 +188,11 @@ char type = '"'); octave_value (const ArrayN<char>& chnda, bool is_string = false, char type = '"'); - octave_value (const SparseMatrix& m, const SparseType& t = SparseType ()); + octave_value (const SparseMatrix& m, const MatrixType& t = MatrixType ()); octave_value (const SparseComplexMatrix& m, - const SparseType& t = SparseType ()); + const MatrixType& t = MatrixType ()); octave_value (const SparseBoolMatrix& bm, - const SparseType& t = SparseType ()); + const MatrixType& t = MatrixType ()); octave_value (const octave_int8& i); octave_value (const octave_int16& i); octave_value (const octave_int32& i); @@ -364,6 +363,12 @@ octave_value resize (const dim_vector& dv, bool fill = false) const { return rep->resize (dv, fill);} + MatrixType matrix_type (void) const + { return rep->matrix_type (); } + + MatrixType matrix_type (const MatrixType& typ) const + { return rep->matrix_type (typ); } + // Does this constant have a type? Both of these are provided since // it is sometimes more natural to write is_undefined() instead of // ! is_defined().
--- a/src/sparse-xdiv.cc +++ b/src/sparse-xdiv.cc @@ -116,14 +116,14 @@ // -*- 1 -*- Matrix -xdiv (const Matrix& a, const SparseMatrix& b, SparseType &typ) +xdiv (const Matrix& a, const SparseMatrix& b, MatrixType &typ) { if (! mx_div_conform (a, b)) return Matrix (); Matrix atmp = a.transpose (); SparseMatrix btmp = b.transpose (); - SparseType btyp = typ.transpose (); + MatrixType btyp = typ.transpose (); octave_idx_type info; double rcond = 0.0; @@ -136,14 +136,14 @@ // -*- 2 -*- ComplexMatrix -xdiv (const Matrix& a, const SparseComplexMatrix& b, SparseType &typ) +xdiv (const Matrix& a, const SparseComplexMatrix& b, MatrixType &typ) { if (! mx_div_conform (a, b)) return ComplexMatrix (); Matrix atmp = a.transpose (); SparseComplexMatrix btmp = b.hermitian (); - SparseType btyp = typ.transpose (); + MatrixType btyp = typ.transpose (); octave_idx_type info; double rcond = 0.0; @@ -156,14 +156,14 @@ // -*- 3 -*- ComplexMatrix -xdiv (const ComplexMatrix& a, const SparseMatrix& b, SparseType &typ) +xdiv (const ComplexMatrix& a, const SparseMatrix& b, MatrixType &typ) { if (! mx_div_conform (a, b)) return ComplexMatrix (); ComplexMatrix atmp = a.hermitian (); SparseMatrix btmp = b.transpose (); - SparseType btyp = typ.transpose (); + MatrixType btyp = typ.transpose (); octave_idx_type info; double rcond = 0.0; @@ -176,14 +176,14 @@ // -*- 4 -*- ComplexMatrix -xdiv (const ComplexMatrix& a, const SparseComplexMatrix& b, SparseType &typ) +xdiv (const ComplexMatrix& a, const SparseComplexMatrix& b, MatrixType &typ) { if (! mx_div_conform (a, b)) return ComplexMatrix (); ComplexMatrix atmp = a.hermitian (); SparseComplexMatrix btmp = b.hermitian (); - SparseType btyp = typ.transpose (); + MatrixType btyp = typ.transpose (); octave_idx_type info; double rcond = 0.0; @@ -196,14 +196,14 @@ // -*- 5 -*- SparseMatrix -xdiv (const SparseMatrix& a, const SparseMatrix& b, SparseType &typ) +xdiv (const SparseMatrix& a, const SparseMatrix& b, MatrixType &typ) { if (! mx_div_conform (a, b)) return SparseMatrix (); SparseMatrix atmp = a.transpose (); SparseMatrix btmp = b.transpose (); - SparseType btyp = typ.transpose (); + MatrixType btyp = typ.transpose (); octave_idx_type info; double rcond = 0.0; @@ -216,14 +216,14 @@ // -*- 6 -*- SparseComplexMatrix -xdiv (const SparseMatrix& a, const SparseComplexMatrix& b, SparseType &typ) +xdiv (const SparseMatrix& a, const SparseComplexMatrix& b, MatrixType &typ) { if (! mx_div_conform (a, b)) return SparseComplexMatrix (); SparseMatrix atmp = a.transpose (); SparseComplexMatrix btmp = b.hermitian (); - SparseType btyp = typ.transpose (); + MatrixType btyp = typ.transpose (); octave_idx_type info; double rcond = 0.0; @@ -236,14 +236,14 @@ // -*- 7 -*- SparseComplexMatrix -xdiv (const SparseComplexMatrix& a, const SparseMatrix& b, SparseType &typ) +xdiv (const SparseComplexMatrix& a, const SparseMatrix& b, MatrixType &typ) { if (! mx_div_conform (a, b)) return SparseComplexMatrix (); SparseComplexMatrix atmp = a.hermitian (); SparseMatrix btmp = b.transpose (); - SparseType btyp = typ.transpose (); + MatrixType btyp = typ.transpose (); octave_idx_type info; double rcond = 0.0; @@ -256,14 +256,14 @@ // -*- 8 -*- SparseComplexMatrix -xdiv (const SparseComplexMatrix& a, const SparseComplexMatrix& b, SparseType &typ) +xdiv (const SparseComplexMatrix& a, const SparseComplexMatrix& b, MatrixType &typ) { if (! mx_div_conform (a, b)) return SparseComplexMatrix (); SparseComplexMatrix atmp = a.hermitian (); SparseComplexMatrix btmp = b.hermitian (); - SparseType btyp = typ.transpose (); + MatrixType btyp = typ.transpose (); octave_idx_type info; double rcond = 0.0; @@ -377,7 +377,7 @@ // -*- 1 -*- Matrix -xleftdiv (const SparseMatrix& a, const Matrix& b, SparseType &typ) +xleftdiv (const SparseMatrix& a, const Matrix& b, MatrixType &typ) { if (! mx_leftdiv_conform (a, b)) return Matrix (); @@ -389,7 +389,7 @@ // -*- 2 -*- ComplexMatrix -xleftdiv (const SparseMatrix& a, const ComplexMatrix& b, SparseType &typ) +xleftdiv (const SparseMatrix& a, const ComplexMatrix& b, MatrixType &typ) { if (! mx_leftdiv_conform (a, b)) return ComplexMatrix (); @@ -401,7 +401,7 @@ // -*- 3 -*- SparseMatrix -xleftdiv (const SparseMatrix& a, const SparseMatrix& b, SparseType &typ) +xleftdiv (const SparseMatrix& a, const SparseMatrix& b, MatrixType &typ) { if (! mx_leftdiv_conform (a, b)) return SparseMatrix (); @@ -413,7 +413,7 @@ // -*- 4 -*- SparseComplexMatrix -xleftdiv (const SparseMatrix& a, const SparseComplexMatrix& b, SparseType &typ) +xleftdiv (const SparseMatrix& a, const SparseComplexMatrix& b, MatrixType &typ) { if (! mx_leftdiv_conform (a, b)) return SparseComplexMatrix (); @@ -425,7 +425,7 @@ // -*- 5 -*- ComplexMatrix -xleftdiv (const SparseComplexMatrix& a, const Matrix& b, SparseType &typ) +xleftdiv (const SparseComplexMatrix& a, const Matrix& b, MatrixType &typ) { if (! mx_leftdiv_conform (a, b)) return ComplexMatrix (); @@ -437,7 +437,7 @@ // -*- 6 -*- ComplexMatrix -xleftdiv (const SparseComplexMatrix& a, const ComplexMatrix& b, SparseType &typ) +xleftdiv (const SparseComplexMatrix& a, const ComplexMatrix& b, MatrixType &typ) { if (! mx_leftdiv_conform (a, b)) return ComplexMatrix (); @@ -449,7 +449,7 @@ // -*- 7 -*- SparseComplexMatrix -xleftdiv (const SparseComplexMatrix& a, const SparseMatrix& b, SparseType &typ) +xleftdiv (const SparseComplexMatrix& a, const SparseMatrix& b, MatrixType &typ) { if (! mx_leftdiv_conform (a, b)) return SparseComplexMatrix (); @@ -462,7 +462,7 @@ // -*- 8 -*- SparseComplexMatrix xleftdiv (const SparseComplexMatrix& a, const SparseComplexMatrix& b, - SparseType &typ) + MatrixType &typ) { if (! mx_leftdiv_conform (a, b)) return SparseComplexMatrix ();
--- a/src/sparse-xdiv.h +++ b/src/sparse-xdiv.h @@ -24,27 +24,27 @@ #define octave_sparse_xdiv_h 1 #include "oct-cmplx.h" -#include "SparseType.h" +#include "MatrixType.h" class SparseMatrix; class SparseComplexMatrix; -extern Matrix xdiv (const Matrix& a, const SparseMatrix& b, SparseType &typ); +extern Matrix xdiv (const Matrix& a, const SparseMatrix& b, MatrixType &typ); extern ComplexMatrix xdiv (const Matrix& a, const SparseComplexMatrix& b, - SparseType &typ); + MatrixType &typ); extern ComplexMatrix xdiv (const ComplexMatrix& a, const SparseMatrix& b, - SparseType &typ); + MatrixType &typ); extern ComplexMatrix xdiv (const ComplexMatrix& a, - const SparseComplexMatrix& b, SparseType &typ); + const SparseComplexMatrix& b, MatrixType &typ); extern SparseMatrix xdiv (const SparseMatrix& a, const SparseMatrix& b, - SparseType &typ); + MatrixType &typ); extern SparseComplexMatrix xdiv (const SparseMatrix& a, - const SparseComplexMatrix& b, SparseType &typ); + const SparseComplexMatrix& b, MatrixType &typ); extern SparseComplexMatrix xdiv (const SparseComplexMatrix& a, - const SparseMatrix& b, SparseType &typ); + const SparseMatrix& b, MatrixType &typ); extern SparseComplexMatrix xdiv (const SparseComplexMatrix& a, - const SparseComplexMatrix& b, SparseType &typ); + const SparseComplexMatrix& b, MatrixType &typ); extern Matrix x_el_div (double a, const SparseMatrix& b); extern ComplexMatrix x_el_div (double a, const SparseComplexMatrix& b); @@ -53,22 +53,22 @@ const SparseComplexMatrix& b); extern Matrix xleftdiv (const SparseMatrix& a, const Matrix& b, - SparseType& typ); + MatrixType& typ); extern ComplexMatrix xleftdiv (const SparseMatrix& a, const ComplexMatrix& b, - SparseType &typ); + MatrixType &typ); extern ComplexMatrix xleftdiv (const SparseComplexMatrix& a, const Matrix& b, - SparseType &typ); + MatrixType &typ); extern ComplexMatrix xleftdiv (const SparseComplexMatrix& a, - const ComplexMatrix& b, SparseType &typ); + const ComplexMatrix& b, MatrixType &typ); extern SparseMatrix xleftdiv (const SparseMatrix& a, const SparseMatrix& b, - SparseType &typ); + MatrixType &typ); extern SparseComplexMatrix xleftdiv (const SparseMatrix& a, - const SparseComplexMatrix& b, SparseType &typ); + const SparseComplexMatrix& b, MatrixType &typ); extern SparseComplexMatrix xleftdiv (const SparseComplexMatrix& a, - const SparseMatrix& b, SparseType &typ); + const SparseMatrix& b, MatrixType &typ); extern SparseComplexMatrix xleftdiv (const SparseComplexMatrix& a, - const SparseComplexMatrix& b, SparseType &typ); + const SparseComplexMatrix& b, MatrixType &typ); #endif
--- a/src/sparse-xpow.cc +++ b/src/sparse-xpow.cc @@ -90,7 +90,7 @@ octave_idx_type info; double rcond = 0.0; - SparseType mattyp (a); + MatrixType mattyp (a); atmp = a.inverse (mattyp, info, rcond, 1); @@ -163,7 +163,7 @@ octave_idx_type info; double rcond = 0.0; - SparseType mattyp (a); + MatrixType mattyp (a); atmp = a.inverse (mattyp, info, rcond, 1);
--- a/src/xdiv.cc +++ b/src/xdiv.cc @@ -118,113 +118,85 @@ // -*- 1 -*- Matrix -xdiv (const Matrix& a, const Matrix& b) +xdiv (const Matrix& a, const Matrix& b, MatrixType &typ) { if (! mx_div_conform (a, b)) return Matrix (); Matrix atmp = a.transpose (); Matrix btmp = b.transpose (); + MatrixType btyp = typ.transpose (); octave_idx_type info; - if (btmp.rows () == btmp.columns ()) - { - double rcond = 0.0; - - Matrix result - = btmp.solve (atmp, info, rcond, solve_singularity_warning); + double rcond = 0.0; - if (result_ok (info)) - return Matrix (result.transpose ()); - } + Matrix result + = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); - octave_idx_type rank; - Matrix result = btmp.lssolve (atmp, info, rank); - + typ = btyp.transpose (); return result.transpose (); } // -*- 2 -*- ComplexMatrix -xdiv (const Matrix& a, const ComplexMatrix& b) +xdiv (const Matrix& a, const ComplexMatrix& b, MatrixType &typ) { if (! mx_div_conform (a, b)) return ComplexMatrix (); Matrix atmp = a.transpose (); ComplexMatrix btmp = b.hermitian (); + MatrixType btyp = typ.transpose (); octave_idx_type info; - if (btmp.rows () == btmp.columns ()) - { - double rcond = 0.0; - - ComplexMatrix result - = btmp.solve (atmp, info, rcond, solve_singularity_warning); + double rcond = 0.0; - if (result_ok (info)) - return result.hermitian (); - } + ComplexMatrix result + = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); - octave_idx_type rank; - ComplexMatrix result = btmp.lssolve (atmp, info, rank); - + typ = btyp.transpose (); return result.hermitian (); } // -*- 3 -*- ComplexMatrix -xdiv (const ComplexMatrix& a, const Matrix& b) +xdiv (const ComplexMatrix& a, const Matrix& b, MatrixType &typ) { if (! mx_div_conform (a, b)) return ComplexMatrix (); ComplexMatrix atmp = a.hermitian (); Matrix btmp = b.transpose (); + MatrixType btyp = typ.transpose (); octave_idx_type info; - if (btmp.rows () == btmp.columns ()) - { - double rcond = 0.0; - - ComplexMatrix result - = btmp.solve (atmp, info, rcond, solve_singularity_warning); + double rcond = 0.0; - if (result_ok (info)) - return result.hermitian (); - } + ComplexMatrix result + = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); - octave_idx_type rank; - ComplexMatrix result = btmp.lssolve (atmp, info, rank); - + typ = btyp.transpose (); return result.hermitian (); } // -*- 4 -*- ComplexMatrix -xdiv (const ComplexMatrix& a, const ComplexMatrix& b) +xdiv (const ComplexMatrix& a, const ComplexMatrix& b, MatrixType &typ) { if (! mx_div_conform (a, b)) return ComplexMatrix (); ComplexMatrix atmp = a.hermitian (); ComplexMatrix btmp = b.hermitian (); + MatrixType btyp = typ.transpose (); octave_idx_type info; - if (btmp.rows () == btmp.columns ()) - { - double rcond = 0.0; - - ComplexMatrix result - = btmp.solve (atmp, info, rcond, solve_singularity_warning); + double rcond = 0.0; - if (result_ok (info)) - return result.hermitian (); - } + ComplexMatrix result + = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); - octave_idx_type rank; - ComplexMatrix result = btmp.lssolve (atmp, info, rank); - + typ = btyp.transpose (); return result.hermitian (); } @@ -385,94 +357,51 @@ // -*- 1 -*- Matrix -xleftdiv (const Matrix& a, const Matrix& b) +xleftdiv (const Matrix& a, const Matrix& b, MatrixType &typ) { if (! mx_leftdiv_conform (a, b)) return Matrix (); octave_idx_type info; - if (a.rows () == a.columns ()) - { - double rcond = 0.0; - - Matrix result - = a.solve (b, info, rcond, solve_singularity_warning); - - if (result_ok (info)) - return result; - } - - octave_idx_type rank; - return a.lssolve (b, info, rank); + double rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning); } // -*- 2 -*- ComplexMatrix -xleftdiv (const Matrix& a, const ComplexMatrix& b) +xleftdiv (const Matrix& a, const ComplexMatrix& b, MatrixType &typ) { if (! mx_leftdiv_conform (a, b)) return ComplexMatrix (); octave_idx_type info; - if (a.rows () == a.columns ()) - { - double rcond = 0.0; - - ComplexMatrix result - = a.solve (b, info, rcond, solve_singularity_warning); + double rcond = 0.0; - if (result_ok (info)) - return result; - } - - octave_idx_type rank; - return a.lssolve (b, info, rank); + return a.solve (typ, b, info, rcond, solve_singularity_warning); } // -*- 3 -*- ComplexMatrix -xleftdiv (const ComplexMatrix& a, const Matrix& b) +xleftdiv (const ComplexMatrix& a, const Matrix& b, MatrixType &typ) { if (! mx_leftdiv_conform (a, b)) return ComplexMatrix (); octave_idx_type info; - if (a.rows () == a.columns ()) - { - double rcond = 0.0; - - ComplexMatrix result - = a.solve (b, info, rcond, solve_singularity_warning); - - if (result_ok (info)) - return result; - } - - octave_idx_type rank; - return a.lssolve (b, info, rank); + double rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning); } // -*- 4 -*- ComplexMatrix -xleftdiv (const ComplexMatrix& a, const ComplexMatrix& b) +xleftdiv (const ComplexMatrix& a, const ComplexMatrix& b, MatrixType &typ) { if (! mx_leftdiv_conform (a, b)) return ComplexMatrix (); octave_idx_type info; - if (a.rows () == a.columns ()) - { - double rcond = 0.0; - - ComplexMatrix result - = a.solve (b, info, rcond, solve_singularity_warning); - - if (result_ok (info)) - return result; - } - - octave_idx_type rank; - return a.lssolve (b, info, rank); + double rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning); } /*
--- a/src/xdiv.h +++ b/src/xdiv.h @@ -25,6 +25,7 @@ #define octave_xdiv_h 1 #include "oct-cmplx.h" +#include "MatrixType.h" class Matrix; class ComplexMatrix; @@ -32,10 +33,13 @@ class NDArray; class ComplexNDArray; -extern Matrix xdiv (const Matrix& a, const Matrix& b); -extern ComplexMatrix xdiv (const Matrix& a, const ComplexMatrix& b); -extern ComplexMatrix xdiv (const ComplexMatrix& a, const Matrix& b); -extern ComplexMatrix xdiv (const ComplexMatrix& a, const ComplexMatrix& b); +extern Matrix xdiv (const Matrix& a, const Matrix& b, MatrixType &typ); +extern ComplexMatrix xdiv (const Matrix& a, const ComplexMatrix& b, + MatrixType &typ); +extern ComplexMatrix xdiv (const ComplexMatrix& a, const Matrix& b, + MatrixType &typ); +extern ComplexMatrix xdiv (const ComplexMatrix& a, const ComplexMatrix& b, + MatrixType &typ); extern Matrix x_el_div (double a, const Matrix& b); extern ComplexMatrix x_el_div (double a, const ComplexMatrix& b); @@ -47,10 +51,13 @@ extern ComplexNDArray x_el_div (const Complex a, const NDArray& b); extern ComplexNDArray x_el_div (const Complex a, const ComplexNDArray& b); -extern Matrix xleftdiv (const Matrix& a, const Matrix& b); -extern ComplexMatrix xleftdiv (const Matrix& a, const ComplexMatrix& b); -extern ComplexMatrix xleftdiv (const ComplexMatrix& a, const Matrix& b); -extern ComplexMatrix xleftdiv (const ComplexMatrix& a, const ComplexMatrix& b); +extern Matrix xleftdiv (const Matrix& a, const Matrix& b, MatrixType &typ); +extern ComplexMatrix xleftdiv (const Matrix& a, const ComplexMatrix& b, + MatrixType &typ); +extern ComplexMatrix xleftdiv (const ComplexMatrix& a, const Matrix& b, + MatrixType &typ); +extern ComplexMatrix xleftdiv (const ComplexMatrix& a, const ComplexMatrix& b, + MatrixType &typ); #endif