Matrix/0000755000176200001440000000000014154217453011524 5ustar liggesusersMatrix/NAMESPACE0000644000176200001440000002112613775317466012762 0ustar liggesusersuseDynLib(Matrix, .registration=TRUE) ## Import functions we need explicitly, notably for which we define methods: importFrom("grDevices", colorRampPalette, grey) importFrom("graphics", par, image) importFrom("grid", grid.rect, gpar, grob)# others via 'grid::' importFrom("lattice", levelplot, panel.levelplot.raster) importFrom("utils", str, head, tail, assignInNamespace, capture.output) importFrom("stats" , "contrasts<-", cov2cor , diffinv, model.frame, rnorm, runif , symnum, terms , toeplitz, update#, vcov ) ## try to import all we need, but not more importFrom("methods" ## still needed {group generics needed to be explicitly imported} ? , Ops, Arith, Compare, Logic, Math, Math2, Summary, Complex ## generics for which we export new methods: , cbind2, rbind2, coerce, show , kronecker ## things we call,.. necessary when Matrix is loaded, but not attached, as in ## Rscript --vanilla -e 'require(methods);(M <- Matrix::Matrix(0:1,3,3));as(M,"sparseMatrix")' , as, is, extends, new , callGeneric, callNextMethod , .selectSuperClasses, .slotNames, canCoerce, packageSlot , getClass, getClassDef, validObject , setClass, setClassUnion, setMethod, setOldClass , setValidity, slot, "slot<-", slotNames, .hasSlot , signature, representation, prototype) ## Generics and functions defined in this package export("%&%", "Cholesky", .SuiteSparse_version, "Diagonal", .symDiagonal, .sparseDiagonal, .trDiagonal, "Hilbert", "KhatriRao", "Matrix", "MatrixClass", "spMatrix", "sparseMatrix", "rsparsematrix", "Schur", "abIseq", "abIseq1", "rep2abI", "band", "bandSparse", "bdiag", .bdiag, "c.sparseVector", # export to be used explicitly when 1st arg is not sparseVector ## no longer; implicit generics now ## "colMeans", "colSums", ## these needed a "..." added ## "rowMeans", "rowSums", "condest", "onenormest", "det",# << "identical" as base - but with correct determinant() ## "mkDet", # <- useful in other packages (Rmpfr, gmp) .. hmm --> 'stats' ? .asmatrix, ## FIXME: why exactly these and not e.g. dsp2dsy and many more? .dsy2mat, .dsy2dsp, .dxC2mat, .T2Cmat, ..2dge, .dense2sy, .C2nC, .nC2d, .nC2l, .m2dgC, .m2lgC, .m2ngC, .diag.dsC,# -> R/dsCMatrix.R --has FIXME .solve.dgC.chol, .solve.dgC.qr, .solve.dgC.lu, "diagN2U", "diagU2N", .diagU2N, .diag2tT, .diag2sT, .diag2mat, "drop0", "expand", "expm", "facmul", "fac2sparse", "fac2Sparse", "forceSymmetric", "T2graph", "graph2T", ## <- 'graph' package (and class) related "anyDuplicatedT", "uniqTsparse", "isTriangular", "isDiagonal", "isLDL", "is.null.DN", "invPerm", "lu", "mat2triplet", "nearPD", "nnzero", "formatSpMatrix", "formatSparseM", .formatSparseSimple, "printSpMatrix", "printSpMatrix2", "qrR", "rankMatrix", "qr2rankMatrix", "readHB", "readMM", "sparse.model.matrix", "sparseVector", "symmpart", "skewpart", "tril", "triu", "updown", "pack", "unpack" , .updateCHMfactor , .validateCsparse , "writeMM" ) ## substitute for using cbind() / rbind() ## .Deprecated() for R version >= 3.2.0 [2015-04]: ## .Defunct() since Matrix 1.3-3 (Jan/Feb 2021): export("cBind", "rBind") exportClasses( ## Class unions: "index", "replValue", # if we don't export it, things fail in dispatch "atomicVector", "number", "xsparseVector", # the class union of all 'x' slot sparseVector's ## not exported (but exporting does not help for method dispatch bug!) ## "numLike", ## "xMatrix", ## "mMatrix", ## all others: ## LOGIC "logic", "abIndex", "rleDiff", ## --- 'Matrix' mother and all its daughters : --------------- "Matrix", ## also intermediate `virtual' ones: "dMatrix", "lMatrix", "nMatrix", ## not yet used, but as sub-classes; ## must provide them for 'hierarchy-analysis': "iMatrix", "zMatrix", "denseMatrix", "sparseMatrix", "compMatrix", "diagonalMatrix", "generalMatrix", "symmetricMatrix", "triangularMatrix", "dsparseMatrix", "lsparseMatrix", "nsparseMatrix", "TsparseMatrix", "CsparseMatrix", "RsparseMatrix", "ddenseMatrix", "ldenseMatrix", "ndenseMatrix", "dgCMatrix", "dgRMatrix", "dgTMatrix", "dgeMatrix", "dpoMatrix", "dppMatrix", "dsCMatrix", "dsRMatrix", "dsTMatrix", "dspMatrix", "dsyMatrix", "dtCMatrix", "dtRMatrix", "dtTMatrix", "dtpMatrix", "dtrMatrix", "ddiMatrix", "lgeMatrix", "lspMatrix", "lsyMatrix", "ltpMatrix", "ltrMatrix", "ldiMatrix", "ngeMatrix", "nspMatrix", "nsyMatrix", "ntpMatrix", "ntrMatrix", "lgCMatrix", "lgRMatrix", "lgTMatrix", "lsCMatrix", "lsRMatrix", "lsTMatrix", "ltCMatrix", "ltRMatrix", "ltTMatrix", "ngCMatrix", "ngRMatrix", "ngTMatrix", "nsCMatrix", "nsRMatrix", "nsTMatrix", "ntCMatrix", "ntRMatrix", "ntTMatrix", "indMatrix", "pMatrix", "corMatrix", # unused ## --- inheriting "Matrix", but also factorizations: "BunchKaufman", "pBunchKaufman", "Cholesky", "pCholesky", ## "LDL", ## --- 'MatrixFactorization' mother and all its daughters : --- "MatrixFactorization", "CholeskyFactorization", "LU", "denseLU", "sparseLU", "CHMfactor", "CHMsuper", "CHMsimpl", "dCHMsuper", "dCHMsimpl", "nCHMsuper",# unused "nCHMsimpl",# unused "sparseQR", ## "SPQR", "Schur", "sparseVector", ## --- and daughters : --- "dsparseVector", "isparseVector", "lsparseVector", "nsparseVector", "zsparseVector" ) exportMethods(## for both own and "other" generics: ## Group Methods "Arith", "Compare", "Logic", "Math", "Math2", "Ops", "Summary", ## re-export S4 methods, for "stats"-S3-generics: "cov2cor", "toeplitz", "update", "!", "+",# for dgT(Matrix) only "%*%", "all", "any", "all.equal", "BunchKaufman", "Cholesky", "Schur", "as.array", "as.matrix", "as.vector", "as.numeric", "as.integer", "as.logical", "band", "chol", "chol2inv", "colMeans", "colSums", "coerce", "crossprod", "determinant", "diag", "diag<-", "diff", "dim", "dim<-", "dimnames", "dimnames<-", "drop", ## "eigen", "svd", # only if(.Matrix.avoiding.as.matrix) <--> ./R/Auxiliaries.R "expand", "expm", "format", "head", "image", "forceSymmetric", "isSymmetric", "is.na", "is.finite", "is.infinite", "kronecker", "length", "mean", "norm", "nnzero", "print",# print(x, ...) when show(x) is not sufficient "qr", "qr.R", "qr.Q", "qr.qy", "qr.qty", "qr.coef", "qr.resid", "qr.fitted", "rep", "rcond", "rowMeans", "rowSums", "show", "solve", ## "spqr", "summary", "symmpart", "skewpart", "t", "tail", "tcrossprod", "tril", "triu", "updown", "unname", "which", "zapsmall" ) if(getRversion() >= "3.1.0") exportMethods("anyNA") exportMethods("rbind2") exportMethods("cbind2") S3method(print, sparseSummary) S3method(print, diagSummary) S3method(c, abIndex)# < for now -- S4 method on c() seems "difficult" S3method(c, sparseVector)# (ditto) ## So that such dispatch also works inside base functions: S3method(as.array, Matrix) S3method(as.array, sparseVector) S3method(as.matrix, Matrix) S3method(as.matrix, sparseVector) S3method(as.vector, Matrix) S3method(as.vector, sparseVector) Matrix/ChangeLog0000644000176200001440000051232112520201600013260 0ustar liggesusers2015-04-01 Martin Maechler * inst/NEWS.Rd: Moving ChangeLog to new (markup) NEWS file 2015-03-16 Martin Maechler * R/Auxiliaries.R (anyDuplicatedT): renamed from is_duplicatedT(), and exported. uniqTsparse(): exported too. 2014-06-15 Martin Maechler * DESCRIPTION (Version): 1.1-4, released to CRAN on 2014-06-14 * src/dsyMatrix.c (dsyMatrix_matrix_mm): fix crossprod(, ) bug 2014-04-26 Martin Maechler * new rsparsematrix() 2014-03-30 Martin Maechler * DESCRIPTION (Version): 1.1-3, released to CRAN on 2014-03-30 2014-03-12 Martin Maechler * R/dgTMatrix.R (image): fix bug in default ylim computation. 2014-01-28 Martin Maechler * R/products.R: matrix products overhauled; should work with sparseVectors; speedup of crossprod(v, ), thanks to nudge by Niels Richard Hansen. * man/matrix-products.Rd: all matrix products documented in one file. * tests/matprod.R: more extensive testing 2014-01-20 Martin Maechler * DESCRIPTION (Version): 1.1-2, released to CRAN on 2014-01-28 * NAMESPACE: export fast power-user coercion utilities .dsy2mat(), .dxC2mat(), .T2Cmat(), ..2dge(). 2013-12-23 Martin Maechler * R/dgTMatrix.R (image): (xlim, ylim) get a slightly changed default, plus ylim := sort(ylim, "decreasing"). This is strictly not back-compatible but should never harm. 2013-09-26 Martin Maechler * R/spModels.R (fac2sparse, fac2Sparse): newly exported; plus 'giveCsparse' option. 2013-09-16 Martin Maechler * src/scripts/0get-SuiteSparse.sh: new download script, for * src/CHOLMOD/*, src/AMD/*, ...: getting SuiteSparse version 4.2.1 * R/zzz.R (.SuiteSparse_version): new function 2013-09-13 Martin Maechler * R/dsCMatrix.R (solve.dsC.*): finally fix the long-lasting undetected solve() bug (only in case Cholmod fails) [r2908]. * DESCRIPTION (Version): 1.0-15, CRAN-*non*-released 2013-09-26 2013-09-12 Martin Maechler * DESCRIPTION (Version): 1.0-14, CRAN-released 2013-09-12 * R/dgCMatrix.R: "stop gap fix" for R 3.0.2: partly revert solve(,*) changes in 1.0-13. 2013-08-27 Fabian Scheipl * man/indMatrix-class.Rd: new "indMatrix" class, a natural superclass of "pMatrix". Many methods moved from "pMatrix" to "indMatrix". 2013-05-09 Martin Maechler * DESCRIPTION (Version): 1.0-13, CRAN-released 2013-09-10 * R/KhatriRao.R: Efficient KhatriRao() by Michael Cysouw 2013-03-26 Martin Maechler * DESCRIPTION (Version): 1.0-12, CRAN-released 2013-03-26 2012-11-10 Martin Maechler * DESCRIPTION (Version): 1.0-11, CRAN-released 2013-02-02 * R/SparseM-conv.R: as(, "dgCMatrix") now works again * tests/other-pkgs.R: test that. * src/Mutils.c: do *not* use '#if R_VERSION < ..' so this also *runs* in older R when installed in R >= 2.15.2. 2012-10-15 Martin Maechler * src/Mutils.c (Mmatrix): new, to be used by .External() in order to replace .Internal(matrix(....)) 2012-10-05 Martin Maechler * R/diagMatrix.R (.sparseDiagonal): new 'unitri' argument; more flexibility; new: solve(, ) 2012-09-10 Martin Maechler * DESCRIPTION (Version): 1.0-10, CRAN-released: 2012-10-16, r2845 2012-09-01 Martin Maechler * R/sparseVector.R (sparseVector): new constructor * inst/test-tools-Matrix.R (rspMat): smarter; also useful for large dimensions. 2012-07-23 Martin Maechler * tests/group-methods.R: now do much more testing, notably of pairs of matrices ... however only when 'doExtras' is true, which it is not by default, e.g., on CRAN. 2012-07-21 Martin Maechler * R/Ops.R, R/diagMatrix.R: many fixes, notably for rare operations that were not triggered before. * R/Auxiliaries.R (allTrueMat): new utility. 2012-07-20 Martin Maechler * R/dsparseMatrix.R, R/sparseVector.R, ...: Newly defined is.finite() and is.infinite() methods for all our *Matrix and *sparseVector. 2012-07-14 Martin Maechler * R/d??Matrix.R (diag<-): many "diag<-" methods, which preserve symmetricity, triangularity (even uni-triangularity sometimes); Partly by also making A[cbind(i,i)] preserve such properties. * src/Mutils.c (SET_packed_setDiag) {and similar}: *_setDiag() C functions implementing "diag<-" R methods. 2012-06-30 Martin Maechler * R/Ops.R (Ops.x.x): now, dense symmetric and triangular matrices are preserved for many arithmetic and logic binary operators. * src/ldense.c (lsyMatrix_as_lspMatrix, ..): more coercions keep the dimnames(). * R/symmetricMatrix.R (pack, unpack): new pack() {"inverse" of unpack(), including pack()}; new unpack() methods. 2012-06-20 Douglas Bates * src/scripts/DEPS.mkf, ... * src/*.c: Update to version 4.0.0 of SuiteSparse 2012-06-19 Martin Maechler * DESCRIPTION (Version): 1.0-8, CRAN-released: 2012-06-20, r2789 * R/CHMfactor.R (update): *DO* allow non-symmetric parent. * man/CHMfactor-class.Rd: be more clear about the two ways. * tests/factorizing.R: more update() testing 2012-06-12 Martin Maechler * tests/matprod.R (chkDnProd): new testing function 2012-06-08 Martin Maechler * R/CHMfactor.R (update): now *warn* when parent is not formally symmetric and coerce it. 2012-06-05 Martin Maechler * R/Auxiliaries.R (chk.s): "check dots" - new utility -- possibly for base R ? 2012-04-16 Martin Maechler * R/sparseMatrix.R (sparseMatrix): now also works for 'symmetric=TRUE' and lower triangular indices. 2012-04-15 Martin Maechler * R/CHMfactor.R (updown): new generic and methods, * man/updown.Rd: provided by Nicholas Nagle. 2012-03-30 Martin Maechler * DESCRIPTION (Version): 1.0-7, CRAN-released: for a few days only. 2012-03-16 Martin Maechler * DESCRIPTION (Version): 1.0-6, CRAN-released: 2012-03-30, r2775 * DESCRIPTION (Depends): R >= 2.15.0 2012-03-15 Martin Maechler * R/spModels.R (sparseInt.r): recursion free (which does not help much). 2012-03-05 Martin Maechler * src/dtCMatrix.c (dtCMatrix_sparse_solve): no longer use Alloca() here. * tests/factorizing.R (checkSchur): check against segfault example. * R/Matrix.R (chol2inv()) new method. 2012-03-01 Martin Maechler * R/spModels.R (sparse.model.matrix, model.spmatrix): add 'verbose' argument in order to show to the user what's going on. * man/sparse.model.matrix.Rd: ditto 2012-02-27 Martin Maechler * R/Ops.R (A.M.n, A.n.M): o now correct, newly via sparseVector. 2012-02-25 Martin Maechler * DESCRIPTION (Version): 1.0-5, CRAN-released: 2012-03-15, r2773 * src/chm_common.c (chm_factor_to_SEXP): in case of failure, * src/dsCMatrix.c (internal_chm_factor): ensure memory cleanup; memory leak reported by Kasper Kristensen at dtu.dk. 2012-02-17 Martin Maechler * DESCRIPTION (Version): 1.0-4, CRAN-released: 2012-02-21, r2765 * R/Ops.R: Fix "-" method for diagonalMatrix types. 2012-01-12 Martin Maechler * DESCRIPTION (Suggests): MASS, as we use a data set in a vignette 2011-12-09 Martin Maechler * DESCRIPTION (Version): 1.0-3, CRAN-released: 2012-01-12, r2749 * R/diagMatrix.R (.bdiag): now works correctly when all blocks are "lMatrix" 2011-11-02 Martin Maechler * R/zzz.R (.onLoad): when R version >= 2.15.0, no longer need to assignInNamespace( ns = "base"), methods provides S4 generic. 2011-10-30 Martin Maechler * DESCRIPTION (Version): 1.0-2, CRAN-released: 2011-11-19, r2739 * tests/other-pkgs.R: print more, don't run SparseM on Solaris for now. * tests/Simple.R: encoding warning should not be promoted to error. 2011-10-22 Martin Maechler * R/rankMatrix.R (rankMatrix): 'method = "qrLINPACK"' now also works for sparse matrices, but using \code{sparseQR()}. * man/sparseQR-class.Rd: document options "Matrix.quiet" (old) and new "Matrix.quiet.qr.R" for suppressiong the permutation warning. * R/sparseQR.R: 2011-10-17 Douglas Bates * src/Csparse.c (Csparse_submatrix): plugging memory leak 2011-10-08 Martin Maechler * R/bind2.R (cbind2Sparse, rbind2Sparse): auxiliaries, used, also in new methods for . * tests/bind.R: testing some of these. * R/Matrix.R, man/Matrix.Rd: optional argument 'doDiag'. * DESCRIPTION (Version): 1.0-1, CRAN-released: 2011-10-18, r2732 2011-09-27 Martin Maechler * DESCRIPTION (Version): 1.0-0 -- to be released for R 2.14.0 2011-09-16 Martin Maechler * R/dsCMatrix.R (solve.dsC.mat): new utility which calls lu() if CHOLMOD'S Cholesky() errors (when matrix is not pos.def.). 2011-09-15 Martin Maechler * R/bandSparse.R (bandSparse): and * R/sparseMatrix.R (sparseMatrix): add 'giveCsparse = TRUE' argument and allow returning Tsparse*, useful e.g. when used in bdiag(). 2011-08-17 Martin Maechler * NAMESPACE: export diagN2U() & diagU2N(). They were "missing" for at least one user (GG). * man/diagU2N.Rd: docu + example. * DESCRIPTION (Version): 0.9996875-4 (*not* yet released) 2011-08-12 Martin Maechler * DESCRIPTION (Version): 0.9996875-3, for CRAN 2011-08-05 Martin Maechler * R/sparseVector.R (head): method; used in a few cases, eliminating two FIXMEs. * DESCRIPTION (Version): 0.9996875-1 * R/ngTMatrix.R: stop() instead of warning() when NA's are coerced. * R/Csparse.R, R/Tsparse.R * src/t_Csparse_subassign.c, src/Csparse.c: [..] <- val now works via .Call(*Csparse_subassign, ...) and no longer suffers from unnecessary memory-blowup. 2011-07-29 Martin Maechler * R/dgTMatrix.R (image): add 'useRaster = FALSE' argument, providing the possibility of using raster (instead of rectangle drawing vector) images. 2011-07-27 Martin Maechler * R/nearPD.R: allow 'ensureSymmetry' argument for speedup. 2011-06-10 Martin Maechler * R/diagMatrix.R (Cspdiagprod, diagCspprod): fixup for symmetric sparse, and non constant-diagonal. 2011-05-20 Martin Maechler * R/dsCMatrix.R (determinant(): fix for Matrix(0, 1) case. 2011-05-18 Martin Maechler * R/sparseMatrix.R (sparseMatrix): add 'symmetric' argument. 2011-04-04 Martin Maechler * src/Csparse.c (Csparse_subassign): unfinished prototype * src/....: Finally no longer hack "UFlong := int", but rather * src/UFconfig/UFconfig.h: use standard CHOLMOD headers * DESCRIPTION (Version): 0.9996875-0 2011-03-31 Martin Maechler * DESCRIPTION (Version): 0.999375-49 2011-03-30 Douglas Bates * Matrix/src/chm_common.c: [r2658] Install symbols first - {preventing seg.fault under -gct} 2011-03-17 Martin Maechler * DESCRIPTION (Version): 0.999375-48 *only* difference to CRAN released *-47, is the work around Sweave bug in inst/doc/sparseModels.Rnw. 2011-02-23 Martin Maechler * src/factorizations.c (LU_expand): now also works for non-square (m x n) * tests/factorizing.R: testing that 2011-02-22 Martin Maechler * R/Auxiliaries.R (t_geMatrix): drop 'factors', as they can be wrong. 2011-02-18 Martin Maechler * R/Tsparse.R (replTmat): fix bug for M[i,j] <- v, when j had duplicated entries. * tests/indexing.R (chkAssign): new function; testing the above. 2011-02-17 Martin Maechler * R/AllClass.R, R/sparseVector.R, man/sparseVector-class.Rd: now require explicitly that i-slot must be sorted for sparseVectors. 2011-02-16 Martin Maechler * R/sparseMatrix.R (formatSparseM): align="right" accidentally did not use zero.print at all. print/format sparse Matrix: fix align="right" and improve docu 2011-02-17 Douglas Bates * DESCRIPTION: Remove Encoding: directive. 2011-02-10 Martin Maechler * inst/doc/sparseModels.Rnw: use png for large graphics (suggestion from Brian) 2011-02-05 Martin Maechler * man/symmpart.Rd: update, thanks to Spencer Graves' prompting. 2011-01-07 Martin Maechler * R/CHMfactor.R (determinant()): no longer warn about incompatible change of 2009-09-01. 2011-01-04 Martin Maechler * R/nearPD.R (nearPD): better error message when all eigenvalues are (at least close to) negative. 2010-12-18 Martin Maechler * DESCRIPTION (Version): 0.999375-47, CRAN-released: 2011-02-23, r2653 * R/spModels.R, NAMESPACE: remove model.Matrix(); we had deprecated it for about four months now. 2010-12-12 Martin Maechler * R/eigen.R,...: use full argument names; * R/*.R: get rid of more from checkUsagePackage("Matrix", suppressPartialMatchArgs = FALSE) 2010-12-11 Martin Maechler * DESCRIPTION (Version): 0.999375-46, CRAN-released: 2010-12-14, r2633 * R/products.R: dimension fixing in some Matrix o vector [t]crossprod()s. * src/Csparse.c (nz2Csparse, nz_pattern_to_Csparse): new utilities, callable from C and R. (Csparse_dense_prod): check pattern matrix and coerce to "d..". * tests/Simple.R: testing %*% * R/ngCMatrix.R, R/nsCMatrix.R, .. : use the new fast coercions. 2010-10-08 Martin Maechler * DESCRIPTION (Version): 0.999375-45, CRAN-released: 2010-11-10, r2624 * R/sparseMatrix.R (graph.wgtMatrix): add 'graph::' in a few places; as 'graph' package is not imported and may well be loaded only. 2010-09-09 Martin Maechler * R/sparseMatrix.R (setAs): graph |-> Matrix: via CsparseMatrix 2010-08-21 Martin Maechler * R/spModels.R (sparse.model.matrix): argument 'drop.unused.levels = FALSE' NB: was *true* implicitly, before. Compatibility with model.matrix(). * R/sparseMatrix.R (formatSpMatrix, formatSparseM): factored out of printSpMatrix(); export as potentially useful for standard matrices, even. 2010-08-11 Martin Maechler * R/eigen.R (Schur): correct setMethod() such that Schur() works. 2010-08-10 Martin Maechler * R/diagMatrix.R, man/bdiag.Rd, NAMESPACE: export .bdiag() as well. 2010-08-09 Martin Maechler * DESCRIPTION (Version): 0.999375-44, CRAN-released: 2010-09-11, r2618 * R/diagMatrix.R (diagCspprod, Cspdiagprod): drop (possibly wrong) @factors * R/Ops.R (.Arith.CM.atom, .Arith.atom.CM, A.M.n, A.n.M): ditto * tests/factorizing.R: check some of the above. 2010-08-04 Douglas Bates * R/spModels.R (fac2sparse): Fix name resolution problem (R-SIG-Mixed-Models post by Florent Duyme). 2010-07-25 Martin Maechler * DESCRIPTION (Depends): require R >= 2.10.0 --> can clean up * R/spModels.R: prepare to move most parts to new package MatrixModels 2010-07-23 Martin Maechler * R/Auxiliaries.R (prMatrix): add " (unitriangular)" as we already have for sparse matrices. 2010-07-22 Martin Maechler * R/Auxiliaries.R (.diagU2N): implement for "dtpMatrix" = old 'FIXME'; (.dense.diagU2N): new utility, called from .diagU2N() 2010-07-19 Martin Maechler * src/dtrMatrix.c (dtrMatrix_dtrMatrix_mm): new for tri %*% tri * R/products.R (%*%): ditto * tests/matprod.R: test it 2010-07-16 Martin Maechler * R/spModels.R (do.defaults): add 'nonMatched.action' with default ensuring that typos are caught. 2010-07-16 Douglas Bates * R/spModels.R (do.defaults): utility function; TODO: move to R 2010-07-16 Martin Maechler * DESCRIPTION (Version): 0.999375-43, CRAN-released: 2010-08-05, r 2599 * R/AllClass.R (Model): as mother class (of "glpModel") * R/spModels.R (IRLS): more options() (updateModel): update() 2010-07-13 Martin Maechler * DESCRIPTION (Version): 0.999375-42, CRAN-released: 2010-07-15, r 2566 * R/spModels.R (glm4, IRLS): glm4 [was 'glm1']; tweaks. 2010-07-12 Martin Maechler * NAMESPACE: rename, export and * man/glpModel-class.Rd: document Doug's new "glpModel" class. 2010-07-08 Douglas Bates * R/AllClass.R: new "lpMod" class (-> later =: "glpModel"), and working function: * R/spModels.R (glm1): using linear pred.Model class, and Bates-Watts convergence criterion. 2010-07-06 Martin Maechler * R/lMatrix.R (whichDense): use arrayInd() * R/zzz.R (arrayInd): provide for older R versions 2010-07-05 Martin Maechler * src/chm_common.c (chm_triplet_to_SEXP): deal more carefully with NAs, needed e.g., on Solaris; thanks to Ruth and Brian Ripley. * R/Ops.R (Compare ): fix bug uncovered by "alongside" the above. 2010-07-02 Martin Maechler * R/sparseMatrix.R (x[] <- 0): fix shortcut code. * tests/indexing.R: and test * R/nearPD.R (nearPD): 'doDykstra = TRUE' and *do* use Dykstra's correction which was *not* used in Jens' code; thanks to Bernhard Spangl for a report 2010-06-26 Martin Maechler * R/Matrix.R: fix mean() method; add sparse one, remaining sparse at least for trim = 0. 2010-06-08 Martin Maechler * DESCRIPTION (Version): 0.999375-41, CRAN-released: 2010-07-03, r 2555 * R/sparseVector.R (spV2M): enable sparseVector -> (sparse)Matrix as(*,.) coercion. 2010-06-07 Martin Maechler * R/Tsparse.R (.TM.repl.i.mat): renamed from .TM.repl.i.2col(). * R/Matrix.R (.repl.i.lSMat): implement logical sparse sub-assignment: M[] <- v; ditto for dense & nsparse. * R/Csparse.R (.CM.repl.i.lSMat, ..): direct logical sparse sub-assignment for "Csparse". 2010-06-04 Martin Maechler * R/sparseMatrix.R (sparseMatrix): re-enable 'dimnames' argument. 2010-06-03 Martin Maechler * R/spModels.R (model.Matrix): tweak for NULL contrasts in dense case. 2010-06-02 Martin Maechler * tests/spModel.matrix.R (Sparse.model.matrix): adapt to the fact, that sparse.model.matrix() returns not just a dgCMatrix. 2010-05-29 Martin Maechler * DESCRIPTION (Version): 0.999375-40, CRAN-released: 2010-06-04, r 2546 * R/AllClass.R: new classes "ModelMatrix", "sparseModelMatrix", etc. * R/spModels.R (sparse.model.matrix): now return "dsparseModelMatrix" object, notably with 'assign' slot. * R/spModels.R (model.spmatrix): faster, using lower level cbind2/rbind2 directly. * R/spModels.R (model.Matrix): new function, returning "ddenseModelMatrix". * NAMESPACE: export new classes. 2010-05-18 Martin Maechler * src/Csparse.c (Csparse_horzcat, Csparse_vertcat): ensure that rBind()/cBind() i.e., rbind2()/cbind2() return logical sparse matrices when the components are. * tests/bind.R: test 2010-05-15 Martin Maechler * R/sparseMatrix.R: A[] <- v ; differentiate dense & sparse * R/pMatrix.R: disallow [] <- v more consequently * tests/indexing.R: test above 2010-05-08 Martin Maechler * R/spModels.R (model.spmatrix): deal with "AsIs" components * tests/spModel.matrix.R: test that 2010-05-01 Martin Maechler * R/condest.R (onenormest, condest): allow to estimate condition number for large sparse matrices. * condest.Rd: docu * R/pMatrix.R (.inv.perm): utility; add [t]crossprod() methods * man/sparseLU-class.Rd: A = P'LUQ; add examples, with "identities" * R/Auxiliaries.R (mmultCheck): new arg. 'kind' 2010-04-28 Martin Maechler * DESCRIPTION (Version): 0.999375-39, CRAN-released: 2010-05-19, r 2540 * R/spModels.R (fac2sparse): using names(formals(new))[[1]] to adapt to a future change in new()'s first argument *name*. 2010-03-31 Martin Maechler * R/spModels.R (lm.fit.sparse): update, allowing weights; also return residuals, notably for "cholesky" case. * man/lm.fit.sparse.Rd: examples; comparing with dense case. * src/dgCMatrix.c (dgCMatrix_cholsol): comments; also compute residuals. 2010-03-30 Martin Maechler * R/spModels.R (sparse.model.matrix, model.spmatrix): border case '~ 1' should also work. Add 'transpose = FALSE' argument. * tests/spModel.matrix.R: test that. 2010-03-27 Martin Maechler * R/sparseMatrix.R (printSpMatrix): ensure returning original argument 2010-03-26 Martin Maechler * R/sparseVector.R (coercion from TsparseMatrix): diagU2N() when needed. * inst/test-tools.R (checkMatrix): explicit which() test for "l" and "nMatrix". New sparseVector (coercion "and back") check. 2010-03-25 Martin Maechler * R/lMatrix.R (which): define methods for which(<[ln]Matrix>). * inst/test-tools.R (Q.eq.symmpart): new utility, now called in checkMatrix(). * R/nearPD.R: use symmpart() for non-symmetric x * man/nearPD.Rd: improve title 2010-03-24 Martin Maechler * R/colSums.R (.diag.Mean): define methods for "diagonalMatrix" * src/Mutils.c (m_encodeInd, do_ii_FILL): coerce ij to integer if necessary; check that ij are within "dim[]" values. Parametrize do_ii_FILL() to be used in m_encodeInd2() as well: * src/Mutils.c (m_encodeInd2): also check bounds (if desired). * tests/indexing.R: test the above. 2010-03-19 Martin Maechler * src/dgeMatrix.c (dgeMatrix_solve): compute the recip.cond.number and also bail out for *computational* singularity {as "base R" does}, from (code) suggestion by Daniel Sabanés Bové. * tests/dg_Matrix.R: "test" the above. 2010-03-01 Martin Maechler * man/rep2abI.Rd: rep2abI() utility is exported now. * R/Csparse.R (subCsp_cols, subCsp_rows, subCsp_ij): dimnames() <- fix for character subsetting. * tests/indexing.R: testing it. 2010-02-26 Martin Maechler * R/spModels.R (model.spmatrix): warn and coerce to sparseMatrix if result would end up dense (e.g., in case of *no* factors in formula). * tests/spModel.matrix.R: test the above. 2010-02-12 Martin Maechler * R/dtrMatrix.R: add solve(, ): e.g., for solve(, ) in lme4. 2010-02-09 Martin Maechler * DESCRIPTION (Version): 0.999375-38, CRAN-released: 2010-03-31, r 2529 * NAMESPACE, R/AllGeneric.R, R/zzz.R: change det() into a regularly exported function (masking base::det) instead of load-time hack. * man/Matrix-class.Rd: \alias, docu 2010-02-05 Martin Maechler * DESCRIPTION (Version): 0.999375-37, CRAN-released: 2010-02-05 * inst/test-tools.R (Qidentical.DN): new (Qidentical): all Qidentical.DN() * R/Csparse.R (subCsp_ij, subCsp_cols, subCsp_rows): use CHOLMOD's submatrix C code, instead of matrix multiplication; now *do* keep dimnames of result, wherever classical matrix subsetting does. 2010-02-04 Martin Maechler * DESCRIPTION (Version): 0.999375-36, CRAN-released: 2010-02-04 * R/Csparse.R (subCsp_ij): Fix [0,0] bug 2010-02-03 Martin Maechler * R/Tsparse.R (.TM.repl.i.2col): [ ] <- FALSE fix * tests/indexing.R, *.Rout.save: test that 2010-01-28 Martin Maechler * src/Csparse.c (Csparse_crossprod): PROTECT() Tsparse_diagU2N() result, from a suggestion by Andrew Runnalls. 2010-01-22 Martin Maechler * R/SparseM-conv.R (setAs(., "matrix.csc")): fix typo in method. 2010-01-20 Martin Maechler * R/AllGeneric.R: nnzero() is now generic, * R/nnzero.R: newly containing all nnzero() methods. * R/zzz.R (det): assign base::det such that it uses S4 generic kronecker. 2010-01-18 Martin Maechler * R/spModels.R (contr.poly): [the back-compatible-only version]: do not use a default for 'scores'; rather rely on stats::contr.poly. * tests/spModel.matrix.R: test that case 2009-12-28 Douglas Bates * DESCRIPTION (Version): 0.999375-35, CRAN-released: 2010-02-03 * src/init.c, inst/include/Matrix_stubs.c: cholmod_band_inplace() exported. 2009-12-23 Martin Maechler * tests/indexing.R: slightly adapt to the very slight [] changes. * inst/test-tools.R (Q.C.identical): + checkClass * R/Tsparse.R ([-methods): for now go via "Csparse" and drop all the sophisticated code dealing with the many cases. * R/Csparse.R (subCsp_cols, etc): faster [i,j] via matrix multiplication, thanks to suggestions by Greg Jorstad. * R/Auxiliaries.R (paste0): more use of paste0() 2009-12-22 Martin Maechler * R/diagMatrix.R (.sparseDiagonal): made more general, allowing to directly build the equivalent of Diagonal(n)[, j] * man/Diagonal.Rd: document .sparseDiagonal() as well. 2009-12-21 Martin Maechler * R/AllClass.R: abIndex@x and rleDiff@first are now "numLike", such that also logical can be converted to "abIndex". * R/abIndex.R (.diff): new utility, used in num2abI() 2009-12-19 Martin Maechler * src/abIndex.c: include new * src/t_Matrix_rle.c (Matrix_RLE_): is template for Matrix_rle_i() and Matrix_rle_d(); now obeys a 'force' argument. * R/abIndex.R: implement methods, at least with scalars. (all.equal.abI): add also all.equal() methods. * tests/abIndex-tsts.R: testing , using all.equal(). * R/AllClass.R: classUnion "numLike" := {"numeric", "logical"} 2009-12-18 Martin Maechler * src/abIndex.c (Matrix_int_rle): UNPROTECT() needed in trivial case. * R/abIndex.R (abIseq1, abIseq): new functions for building "abIndex" vectors. * tests/abIndex-tsts.R (tst.c.abI): test new c("") method. * DESCRIPTION (Version): 0.999375-34, CRAN-released: -never- * R/Ops.R: use prod(d) instead of d[1]*d[2], as the latter may integer overflow; fixes o * tests/Simple.R: test that. 2009-12-11 Martin Maechler * R/sparseVector.R (TsparseM* -> sparseV): symmetricMatrix needs to be expanded. This fixes a bug reported by Yu-Sung Su. * tests/indexing.R: testing the fix. * inst/test-tools.R (all.equalX): new util 2009-12-09 Martin Maechler * R/Ops.R (A.n.M, A.n.M): o : remain sparse also when *majority* (instead of all) of 0 o v is 0. * tests/group-methods.R: test one such case. 2009-12-06 Martin Maechler * DESCRIPTION (Version): 0.999375-33, CRAN-released: 2009-12-11 * R/Ops.R (Compare): fix case with NA x. * R/not.R: fix "typo" in ! * R/Ops.R (Ops.spV.spV): fix thinko 2009-12-05 Martin Maechler * R/sparseVector.R: setAs(nsparseV*, lsparseV*) etc * R/Ops.R (Ops.spM.spV, Ops.spV.spM): sparseVec. o sparseMat. 2009-11-20 Martin Maechler * R/Ops.R (Ops.spV.spV): enable sparseVector operations in more cases. * R/sparseVector.R (is.na): methods defined. * R/sparseVector.R (intIv): also accept "sparseVector"s * tests/Simple.R: check the above 2009-11-19 Martin Maechler * R/sparseVector.R (newSpV, newSpVec): new utility, dropping 0 "on the fly". * R/sparseVector.R (atomic -> sparse*): fix for NA case. * R/Ops.R (): using newSpVec() * R/not.R: fix thinko in ! 2009-11-17 Martin Maechler * tests/other-pkgs.R: detach(*, unload) Rgraphviz too 2009-11-14 Martin Maechler * R/AllClass.R: "abIndex" (and "rleDiff") class * R/abIndex.R: with some methods; commit these finally, even if it's mostly unfinished. * src/abIndex.[ch]: new: currently only for .Call(Matrix_int_rle,*) * tests/abIndex-tsts.R: basic consistency checks for "abIndex". * R/diagMatrix.R (diagOdiag): "exploding" Matrix.msg() only level 2; * tests/indexing.Rout.save: update 2009-11-11 Martin Maechler * DESCRIPTION (Version): 0.999375-32, CRAN-released: 2009-11-20 * src/Csparse.c (Csparse_Csparse_prod, Csparse_Csparse_crossprod): PROTECT(.) the dimnames; thanks to Kaspar Kristensen 2009-10-24 Martin Maechler * R/Ops.R (Logic.lCMat): to be used for lsC* and ltC* as well, effectively replacing previous suboptimal methods. * src/chm_common.c (chm2Ralloc): Fix unidiagonal ntC segfault: assign 'x' only when non-pattern. * src/chm_common.c (as_cholmod_triplet): reallocate now in a way that works; fix documentation about return value in diagU2N case; ditto for * src/chm_common.c (as_cholmod_sparse): * R/sparseMatrix.R (printSpMatrix): add 'cld' argument, typically passed from printSpMatrix2; and indicate "unit-diagonal" 2009-10-22 Martin Maechler * R/lsparseMatrix.R (C2l): fix for case with NA. * R/Csparse.R (replCmat): drop "stale" cached @factors factorizations after sub-assignments. * R/Tsparse.R (replTmat, .TM.repl.i.2col): ditto 2009-10-19 Martin Maechler * src/dgCMatrix.c (dgCMatrix_LU): new boolean argument 'error_on_sing' to allow no error in case of singularity; needed for determinant(), e.g. * R/Auxiliaries.R (detSparseLU): using lu(*, errSing=FALSE) * R/dgCMatrix.R, R/dsparseMatrix.R: lu() methods, using 'errSing' * R/sparseMatrix.R (printSpMatrix): fix bug introduced on *-09-10 * tests/Simple.R: test for that. 2009-10-18 Martin Maechler * src/dgeMatrix.c (dgeMatrix_crossprod): do not fail in 0-column case. * inst/test-tools.R (Q.eq): new utility (checkMatrix): minimally check %*%, crossprod() and tcrossprod() * R/products.R: more '%*%' methods for "[ln]?Matrix", "missing" 2009-10-06 Martin Maechler * DESCRIPTION (Version): 0.999375-31, CRAN-released: 2009-10-06 * inst/include/Matrix_stubs.c (M_R_cholmod_error): revert (2009-09-18), i.e., no longer restore cholmod_common. {{M_cholmod_defaults() still seems not usable from lme4's init.c}} 2009-10-05 Martin Maechler * src/dtrMatrix.c (dtrMatrix_chol2inv): use "dpoMatrix" instead of "dsy" * R/dtrMatrix.R: make use of implicit generic for chol2inv() in newer R versions. 2009-09-30 Martin Maechler * R/CHMfactor.R (solve): fix methods for "ddiMatrix" and "missing" RHS. * tests/factorizing.R: test these * R/Matrix.R (image): fix Matrix method to work for "ddiMatrix" * R/diagMatrix.R: coercion to "dsparse*" * tests/Simple.R: test image() 2009-09-29 Martin Maechler * R/AllGeneric.R: rcond is implicit generic in latest versions of R 2009-09-22 Martin Maechler * R/Ops.R (A.M.n,A.n.M): replace "Ops" methods by explicit "Arith", "Logic", etc, getting rid of ambiguity (notes), and of infinite recursions. * tests/group-methods.R: test these systematically. 2009-09-18 Martin Maechler * inst/include/Matrix_stubs.c (M_R_cholmod_start): print_function = NULL as in src/chm_common.c (2009-07-20) (M_R_cholmod_error): ditto, using new M_cholmod_default(), declared in * inst/include/cholmod.h * R/Tsparse.R (intI): do *not* allow logical subscript (row or column) to be too long, compatibly with traditional matrix indexing. * tests/indexing.R: and assert the error. 2009-09-17 Martin Maechler * R/pMatrix.R: as(sparseMatrix, pMatrix) * R/CHMfactor.R (solve): method for (CHMfactor, missing) * inst/test-tools.R (assertError): use tryCatch() * R/diagMatrix.R (.sparseDiagonal): fix shape "g" case. * R/Auxiliaries.R (isTriC): do not wrongly return TRUE for a *sCMatrix. * man/chol2inv-methods.Rd: document & example 2009-09-16 Douglas Bates * NAMESPACE, R/dtrMatrix.R, src/dtrMatrix.[ch]: add chol2inv() method for dtrMatrix. 2009-09-12 Martin Maechler * R/sparseVector.R ([): allow *indexing* with "lsparseVector" 2009-09-11 Martin Maechler * R/sparseVector.R (prSpVector): using ":" as in printSpMatrix() (Summary): add "Summary" group methods * man/sparseVector-class.Rd: and test a bit 2009-09-10 Martin Maechler * R/sparseMatrix.R (printSpMatrix): visually differentiate non-structural zeros in *logical* sparse matrices, using ":" * R/Auxiliaries.R (setparts): new utility, for * R/Ops.R (Ops.spV.spV): start implementing sparseVector arithmetic etc 2009-09-08 Martin Maechler * R/dgCMatrix.R (qr): for sparseMatrix must coerce to "dgCMatrix". * tests/factorizing.R: test qr() 2009-09-01 Martin Maechler * R/CHMfactor.R (determinant): divide previous log(det(.)) by 2; now returning det(L); and modify the "CHMfactor.warn" message. * man/CHMfactor-class.Rd: modify documentation accordingly. 2009-08-21 Martin Maechler * R/spModels.R (`contrasts<-`): a version that can also work with a "sparseMatrix" value. This is put into R 2.10.0 (devel) as well. * src/Mutils.h: rename any_NA to any_NA_in_x * src/Mutils.c (check_scalar_string): add doxygen doc 2009-08-15 Martin Maechler * R/spModels.R (fac2Sparse): make also work for 'contrasts.arg' = matrix; 2009-07-28 Martin Maechler * R/spModels.R (contr.sum): need also to define contr.*() as long as we document (./man/) them. 2009-07-27 Martin Maechler * DESCRIPTION (Version): 0.999375-30, CRAN-released: 2009-07-28 * R/Matrix.R (all.equal_Mat): add factorsCheck=FALSE argument * R/Auxiliaries.R (attr.all_Mat, attrSlots): ditto 2009-07-25 Martin Maechler * R/Auxiliaries.R (attr.all_Mat): fix checking of non-content slots. * R/Matrix.R (all.equal_Mat): thinko needed s/&&/&/ * R/sparseMatrix.R (all.equal(.) methods): ditto ===> Note: all.equal() is more stringent for "Matrix" arguments now! 2009-07-23 Martin Maechler * R/spModels.R (model.spmatrix, sparse2int): "complete" re-write * tests/spModel.matrix.R: many tests added 2009-07-20 Martin Maechler * src/chm_common.c (R_cholmod_l_start): set print_function to NULL, as we have long suggested ==> get rid of random strings seen in some cholmod warnings. (R_cholmod_error): call cholmod_l_defaults() before error(), so we restore the Cholmod global in case of errors. * R/ldenseMatrix.R (.rcond_via_d): fix thinko 2009-07-18 Martin Maechler * R/CHMfactor.R (isLDL): need a "!" as 'type' is "is_ll" * src/dsCMatrix.c (dsCMatrix_Cholesky): update, notably when caching. * tests/indexing.R: test col.names printing of sparseMatrix 2009-07-16 Martin Maechler * inst/test-tools.R (allCholesky): new testing function 2009-07-15 Martin Maechler * src/dsCMatrix.c (dsCMatrix_Cholesky): add possibility to set each of 'perm', 'LDL', and 'super' to NA (in addition to TRUE / FALSE). in these case, a CHOLMOD-heuristic choses the option "sensibly". * man/Cholesky.Rd: document the new possibility. 2009-07-14 Martin Maechler * R/rankMatrix.R (rankMatrix): diff(sval) <= 0 * R/spModels.R (model.spmatrix): fix case of missing main effect * tests/spModel.matrix.R: new file 2009-07-11 Martin Maechler * R/sparseMatrix.R (show, printSpMatrix2): both print() and show() now use printSpMatrix2(), and that now already prints " x sparse Matrix of class ...". * R/CHMfactor.R (isLDL): fix and * NAMESPACE: export isLDL() 2009-07-10 Martin Maechler * R/spModels.R (model.spmatrix): mf may be simple data.frame 2009-07-09 Martin Maechler * NAMESPACE: export sparse.model.matrix() and * man/sparse.model.matrix.Rd: document it 2009-07-08 Martin Maechler * R/Tsparse.R (intI): also work for integer dimnames (well ..) 2009-07-07 Martin Maechler * R/sparseMatrix.R: "factor out" sparse model things into * R/spModels.R (sparse.model.matrix): new model matrix functions 2009-06-20 Douglas Bates * src/CHMfactor.c: Ensure updated LL stays LL 2009-06-10 Martin Maechler * DESCRIPTION (Version): 0.999375-29, CRAN-released: 2009-06-11 2009-06-10 Douglas Bates * [r2404] src/Mutils.c: Change value of set_factor to be the cached factor * [r2403] src/dgCMatrix.c, src/dgCMatrix.h, src/init.c: Comment out unused dgCMatrix_lusol function * [r2402] R/dgCMatrix.R: R-level implementation of solve("dgCMatrix", "missing") * [r2401] src/dgCMatrix.c: Re-arrange LU factorization to always use the cached value. 2009-06-09 Douglas Bates * [r2399] src/dgCMatrix.c: PROTECT the result from dgCMatrix_LU in dgCMatrix_matrix_solve 2009-06-06 Martin Maechler * R/Tsparse.R: add numeric -> Tsparse* coercion 2009-06-05 Martin Maechler * src/Mutils.h, src/dgeMatrix.c: using dngettext(.) only on future versions of R. 2009-06-04 Martin Maechler * DESCRIPTION (Version): 0.999375-28, CRAN-released: 2009-06-08 * po/de.po, po/R-de.po: German translations from Chris Leick. * inst/po/de/: ditto, via po/update-me.sh 2009-05-28 Martin Maechler * src/chm_common.c, src/cs_utils.c, etc: internationalize more messages; fix some; thanks to feedback from Chris Leick. 2009-05-27 Martin Maechler * man/denseMatrix-class.Rd, etc: 'factors' is *not* a slot in this class; found by the upcoming R 2.10.0 codocClasses(). 2009-05-25 Martin Maechler * po/update-me.sh, Matrix.pot, etc: updated *.pot / *.po files * DESCRIPTION (Version, Date): 0.999375-27, CRAN-released today. * R/sparseVector.R: add as(, "dsparseVector") (spV2M): now works (again!?) for "isparseVector" (-> "dgTMatrix"). * tests/matprod.R: tcrossprod(), sparseVector multiplications, i.e., features of next paragraph. 2009-05-23 Martin Maechler * R/products.R: move almost all %*%, crossprod(), tcrossprod() methods to a new file. tcrossprod() compatibility with *fixed* base-R; enable operations with "sparseVector"s; some extra methods to avoid ambiguity messages. 2009-05-20 Martin Maechler * R/Auxiliaries.R (.M.v, .v.M): slight speedup, and *use* them in * R/Matrix.R (crossprod) 2009-05-18 Martin Maechler * R/sparseVector.R (dim<-): prod(as.integer(.)) may overflow! * R/Matrix.R (Matrix): Matrix(sv, ..) now works for a sparseVector * R/sparseVector.R (spV2M): allow zero nrow or ncol. 2009-05-16 Martin Maechler * R/sparseMatrix.R (dim<-): should also work for diagonalMatrix. * inst/test-tools.R (vec): add test for dim(x) <- c(n, 1) 2009-05-13 Martin Maechler * R/rankMatrix.R (rankMatrix): new function for matrix rank; "to be discussed". 2009-05-07 Doug Bates and Martin Maechler * src/Mutils.c (Matrix_check_class_etc): diverse smallish improvements, stuffing a small leak, adding PROTECT()ion, but, alas, not enough. 2009-05-06 Martin Maechler * R/HBMM.R (readMM): add checkIJ() to produce nicer error messages, on malformed input. * tests/write-read.R: and test that.. 2009-04-18 Martin Maechler * DESCRIPTION (Version, Date): 0.999375-26, CRAN-released on 2009-04-29 * src/Mutils.h (Matrix_check_class_etc): try to ensure it works also when Matrix is loaded but not attached. * src/init.c (R_init_Matrix): get Matrix namespace in C. * R/zzz.R (.onLoad): a *working* fix aka "hack" 2009-04-15 Martin Maechler * DESCRIPTION (Version): 0.999375-25 packaged --> CRAN 2009-04-09 Martin Maechler * R/Auxiliaries.R (Matrix.msg): new utility (.M.vectorSub): ditto, for vector-indexing; in * R/Matrix.R ([): M[i, drop=] should do *vector*-indexing. * R/Tsparse.R ([): ditto; * R/diagMatrix.R ([, subDiag): ditto. * R/Tsparse.R ([): more careful indexing of (triangular) TsparseMatrix. * tests/indexing.R: testing the above * R/Auxiliaries.R (gT2tT, check.gT2tT): consistency and efficiency improvement, using 'do.n' argument. 2009-04-08 Martin Maechler * R/Matrix.R: add as(., "vector") etc * man/Matrix-class.Rd: ditto * inst/test-tools.R (checkMatrix): and check them 2009-04-07 Martin Maechler * DESCRIPTION (Version, Date): 0.999375-24 ... released to CRAN * R/sparseVector.R: fix coercion from xsparse* * tests/Simple.R: and check it. * man/lu.Rd: document 'warnSing' argument * tests/dg_Matrix.R: and test it * src/dgeMatrix.c (dgeMatrix_LU): missing 'return' 2009-04-06 Martin Maechler * DESCRIPTION (Version, Date): 0.999375-24 only for 2.9.0 (and newer) 2009-03-30 Martin Maechler * src/Mutils.h (Matrix_check_class_etc): new version that *computes* the environment to be used. * src/Tsparse.c, src/cs_utils.c, src/chm_common.c, src/dgCMatrix.c: use the above in place of Matrix_check_class_and_super(). 2009-03-26 Martin Maechler * R/Auxiliaries.R (MatrixClass): use cld@package, not packageSlot(.) ! 2009-03-25 Martin Maechler * DESCRIPTION (Version, Date): 0.999375-23 * tests/Class+Meth.R (dotestMat): use getClassDef() for speed; adaptions to also work with "Matrix-extensions". * inst/test-tools.R (checkMatrix): similar adaptions. 2009-03-24 Martin Maechler * R/Auxiliaries.R (MatrixClass, l2d_meth, ...): make use of MatrixClass(): functionality for setClass("foo", contains="dgCMatrix") * src/Mutils.h (Matrix_check_class_and_super): new utility, to be used in lieu of Matrix_check_class() in most cases. * src/Tsparse.c, src/cs_utils.c, src/chm_common.c, src/dgCMatrix.c: use it, currently only with R_GlobalEnv {otherwise: API change} 2009-03-12 Martin Maechler * man/band.Rd: note and example about band() |-> dense * R/ddenseMatrix.R (.bandDense): fix typo in argument check. * R/Csparse.R: ditto * src/dense.c (dense_band): limit index range; thanks to Bill Dunlap. * tests/Simple.R (band): check it 2009-03-11 Martin Maechler * R/dMatrix.R (Summary): (dsparseMatrix): new logic, fixing prod(). * inst/test-tools.R (eqDeterminant): improve after suggestions from Doug * inst/test-tools.R (checkMatrix): message(), not warning(), for differing prod(). * src/dgeMatrix.h, src/init.c: dgeMatrix_LU(x, warn_singularity) * src/dgeMatrix.c (dgeMatrix_LU): allow to suppress singularity warning. (dgeMatrix_determinant, dgeMatrix_rcond): do *not* warn on exact singularity 2009-03-10 Martin Maechler * R/Matrix.R (Summary.l, Summary.np): no conversion to "dMatrix" for all()/any() * tests/Simple.R: do not use memory-expensive all(I.. == Diagonal(n)) for R >= 2.9.0, keep option 'warn = 2', i.e. warnings producing errors ==> * R/Ops.R: small fixes, getting rid of warnings in tests/Simple.R * TODO: think about providing something like allCompare(.,., "==") 2009-03-02 Martin Maechler * DESCRIPTION (Version): 0.999375-22, ready but not submitted 2009-03-01 Martin Maechler * inst/test-tools.R (eqDeterminant): fix for NAs 2009-02-28 Martin Maechler * R/diagMatrix.R (prod, all): fix methods (cut & paste remnant); for NA. * R/Auxiliaries.R (detSparseLU): determinant(<..NA..>) now gives NaN * R/sparseMatrix.R (printSpMatrix): workaround format.info() R bug * tests/Simple.R: test that 2009-02-27 Martin Maechler * R/Matrix.R (Matrix): Matrix(x,*) returns x unaltered when is(x, "diagonalMatrix"); OTOH, Matrix(x,1,1) should typically *not* return a diagonalMatrix. * R/diagMatrix.R (setAs(matrix, *)): fix for NAs. * tests/Simple.R: test things like Matrix(NA, 1,1) 2009-02-25 Martin Maechler * NAMESPACE: add bandSparse() "properly" * man/bandSparse.Rd: doc including examples 2009-02-20 Martin Maechler * R/bandSparse.R (bandSparse): constructor for band(diagonal) sparse matrices. 2009-02-13 Martin Maechler * DESCRIPTION (Version): 0.999375-21, released to CRAN * src/Mutils.h (Matrix_with_SPQR): #define (or #undef), in order to allow easy building "SPQR-free version" of Matrix. 2009-02-11 Martin Maechler * R/Csparse.R (replCmat): another check for 'has.x' * tests/indexing.R: very large (very sparse) sub-indexing. 2009-01-30 Martin Maechler * DESCRIPTION (Version): 0.999375-20 * man/spqr.Rd: disable example on Windows for now * inst/test-tools.R (checkMatrix): simpler for "logical" pMatrix. * R/ngTMatrix.R: fix ngT -> nge / lge coercion, and * tests/Simple.R: adapt test. * R/pMatrix.R: coercion to "matrix": more sensical to coerce to logical instead of 0/1 integer. This a mild back-compatibility breach. * man/pMatrix-class.Rd: adapt, including example * R/sparseMatrix.R (printSpMatrix): print as logical, too. 2009-01-29 Martin Maechler * R/Auxiliaries.R (geClass): define for "pMatrix" * R/pMatrix.R: pMatrix -> ngeMatrix coercion * man/pMatrix-class.Rd: * DESCRIPTION (Version): 0.999375-19 considering release. * R/ngTMatrix.R: coercing correctly to ngeMatrix via lge*. * man/dgTMatrix-class.Rd: remove no-more-existing coercion method; mention a bit less, and note. * R/diagMatrix.R: ensure that * is diagonal even with new method dispatch * R/Matrix.R (.M.sub.i.logical): change comments only, and extend error message which is never called currently. * R/Ops.R (Ops.x.x): fix for new "inherited method" dispatch 2009-01-28 Martin Maechler * R/spqr.R: put spqr() / class "SPQR" related code in one file for now. * NAMESPACE: export "SPQR" class * man/SPQR-class.Rd: document it 2009-01-27 Martin Maechler * R/Auxiliaries.R (is.na_nsp): should produce "nsCMatrix" only when dimnames are symmetric too. * R/sparseQR.R (solve): method for (, ) 2009-01-26 Douglas Bates * src/cs_utils.c (Matrix_as_cs): in diagU2N case: Force sorted columns after expanding unit diagonal. 2009-01-21 Martin Maechler * R/Tsparse.R (intI): for now give intelligible error on NA indices. * R/Matrix.R (subset.ij): should deal correctly with NA indices in the 2-column-matrix index case. * src/Mutils.c (m_encodeInd, m_encodeInd2): prepare to deal better with NA in indices. 2009-01-20 Martin Maechler * inst/doc/Intro2Matrix.Rnw: mention sparseMatrix * man/sparseMatrix.Rd: fix typos found by parse_Rd 2009-01-19 Martin Maechler * DESCRIPTION (Version,Date): release 0.999375-18 (as of yesterday) 2009-01-18 Douglas Bates * [r2319] src/Csparse.c, src/Csparse.h: Added an untested create_Csparse function 2009-01-17 Martin Maechler * R/sparseMatrix.R (sparseMatrix): recycle 'x' if necessary; use 'index1' rather than 'index0' {as proposed by Doug}. * R/dgeMatrix.R: drop two unnecessary (maybe very very slightly faster) methods for %*%. 2009-01-12 Douglas Bates * [r2313] R/sparseMatrix.R, man/sparseMatrix.rd: Use intermediate triplet rep in sparseMatrix. 2009-01-07 Martin Maechler * R/sparseMatrix.R (sparseMatrix): new function to be used in place of new(), notably for CsparseMatrix objects. * man/sparseMatrix.Rd: its doc; plus examples * man/CsparseMatrix-class.Rd: fix long-standing thinko; update the \note{} to reflect the fact that the validity method no longer modifies its argument. * R/Csparse.R (.validateCsparse): new utility accessing * src/Csparse.c (Csparse_validate_, Csparse_validate2): new utilities allowing the "sort-in-place" that used to be part of former Csparse_validate(). 2008-12-10 Douglas Bates * [r2309] DESCRIPTION: Release 0.99375-17 2008-12-05 Douglas Bates * [r2308] inst/include/Matrix_stubs.c, inst/include/cholmod.h: Adding const for picky compilers; Using CHM_FR typedef 2008-11-17 Martin Maechler * [r2307] ChangeLog, tests/validObj.R: update (as of Oct.26) 2008-10-31 Douglas Bates * [r2306] inst/include/Matrix_stubs.c: Consistency with cholmod.h re const qualifier 2008-10-26 Douglas Bates * src/Csparse.c (Csparse_validate): do not sort, but report error on unsorted row-indices within column. * tests/validObj.R: adapt the regression test. 2008-10-17 Douglas Bates * [r2300] inst/include/Matrix_stubs.c: Consistency with SparseSuite names * [r2299] src/AMD/Source/Makefile, src/CHMfactor.c, src/CHOLMOD/Lib/Makefile, src/COLAMD/Source/Makefile, src/Csparse.c, src/Tsparse.c, src/UFconfig/UFconfig.h, src/chm_common.c, src/chm_common.h, src/dense.c, src/dgCMatrix.c, src/dsCMatrix.c, src/init.c, src/t_gCMatrix_colSums.c: Compile only the UF_long version of SparseSuite but setting UF_long to be int 2008-10-17 Martin Maechler * src/Mutils.h: include also for AIX 2008-10-16 Martin Maechler * src/scripts/ : move *.sh, *.mkf and *.mk files from src/ to src/scripts/ * src/*/{Lib|Source}/Makefile: change to non-GNU-make style, and other improvements from Brian Ripley. 2008-10-15 Martin Maechler * src/Makevars, src/Makevars.win: replacing * src/Makefile, src/Makefile.win which are no longer needed 2008-10-14 Martin Maechler * src/Makefile, src/*/Makefile: changes from Brian Ripley enabling parallel make. 2008-10-13 Douglas Bates * [r2285] src/SPQR/Include/spqr.hpp: Include the C string declarations. 2008-10-06 Douglas Bates * [r2284] src/Makefile, src/SPQR/Lib/Makefile_SPQR, src/SPQR/Makefile, src/Win.mk: Modifications for compilation under Windows * [r2283] tests/validObj.R: remove reference to undefined object * [r2282] inst/doc/UFsparse/SPQR.txt: SPQR license information 2008-10-04 Douglas Bates * [r2281] src/Makefile, src/chm_common.c, src/chm_common.h, src/dgCMatrix.c, src/init.c: SparseSuiteQR interface 2008-10-03 Martin Maechler * src/Csparse.c (isValid_Csparse): new utility * src/chm_common.c (as_cholmod_sparse): add validity check early * tests/validObj.R: test the above 2008-10-02 Douglas Bates * [r2277] TODO: Think of a better way of structuring include files * [r2276] src/AMD/Source/Makefile, src/CHOLMOD/Lib/Makefile, src/COLAMD/Source/Makefile, src/Makefile, src/SPQR/Include/SuiteSparseQR_C.h, src/chm_common.h, src/dgCMatrix.c, src/dgCMatrix.h, src/init.c, src/sparseQR.h: Add dgCMatrix_SPQR and modify other code to allow its compilation and linkage 2008-10-02 Martin Maechler * R/sparseMatrix.R (printSpMatrix2): another validObject(.) call * src/Makefile: getting rid of SUBSTAMP etc, thanks to Simon U. 2008-10-01 Douglas Bates * src/Makefile, inst/doc/UFsparse/, inst/include/: Adjustments for SuiteSparse configuration. * src/CHOLMOD, src/UFconfig: update versions of SuiteSparse libraries. * src/SPQR/* add "SPQR", from Tim Davis' "SuiteSparse" collection, not yet with an R interface. 2008-09-25 Martin Maechler * Release 0.999375-15 to CRAN. 2008-09-23 Martin Maechler * src/dsyMatrix.c (dsyMatrix_as_dspMatrix): copy 'factors' slot * tests/dpo-test.R: test for it * R/Tsparse.R (intI): improve one error message. 2008-09-22 Martin Maechler * DESCRIPTION (Version): 0.999375-15 to be released * R/diagMatrix.R (diag o ): explicit setMethods, in order to keep result diagonal in many more cases. (coerce) to denseMatrix now *does* coerce. * man/diagonalMatrix-class.Rd: \alias{} for these. * R/Auxiliaries.R (.dense.prefixes): ".diMatrix" has not been dense anymore! * R/dMatrix.R: as(, ): enable Cholesky/BunchKaufman 2008-09-20 Martin Maechler * R/lsparseMatrix.R (C2l): as(, "lMatrix") should preserve NAs. * R/Ops.R (Arith, Compare): keep diag="U" in more cases when sensible 2008-09-19 Martin Maechler * R/Ops.R (Arith): better o which preserves symmetry / triangularity in "obvious" cases. * R/dpoMatrix.R: setAs(., "lMatrix") and setAs(., "nMatrix") * R/dppMatrix.R: ditto * man/dpoMatrix-class.Rd: * inst/test-tools.R (checkMatrix): add [dln]Matrix <-> [dln]Matrix coercion checks. * tests/indexing.Rout.save: more ambiguity warnings from the new checks. * R/dMatrix.R: dMatrix -> nMatrix: fix dense case. 2008-09-18 Martin Maechler * tests/factorizing.R: test expand() * src/dgCMatrix.c (dgCMatrix_LU): fill @Dim slot correctly. * R/Tsparse.R (replTmat): also optionally warn when sub-assignment loses symmetry of Matrix. 2008-09-17 Martin Maechler * R/Tsparse.R (.TM.repl.i.2col): fix sub-assignment of "dsCMatrix"; bug reported by Jacob van Etten. * tests/indexing.R, tests/indexing.Rout.save: testing it 2008-09-10 Douglas Bates * [r2260] src/Mutils.h, src/chm_common.c, src/cs_utils.c, src/dsCMatrix.c: Update doxygen comments 2008-09-10 Martin Maechler * man/ddiMatrix-class.Rd: docu update : sparse, not dense (see 2008-07-28). * man/ldiMatrix-class.Rd , man/diagonalMatrix-class.Rd: ditto. 2008-09-08 Martin Maechler * DESCRIPTION (Version): 0.999375-14 to be released to CRAN, in order to comply to to pending changes in R-devel (2.8.0). 2008-09-05 Martin Maechler * R/Matrix.R (solve,..): use (Matrix,ANY)... instead of (Matrix,Matrix) * R/Ops.R: ditto; most of these from John Chambers. * man/Matrix-class.Rd * R/Auxiliaries.R (.diagU2N): fix for Rsparse* * tests/Simple.R: test it 2008-09-02 Martin Maechler * man/drop0.Rd: * R/Auxiliaries.R (drop0): new argument 'tol = 0' (and 'is.Csparse'); entails updates in * R/Csparse.R, R/lMatrix.R, R/dMatrix.R 2008-08-30 Martin Maechler * DESCRIPTION (Version): 0.999375-13 released to CRAN 2008-08-29 Martin Maechler * R/Auxiliaries.R (attrSlotNames, attrSlots, attr.all_Mat): new utilities, for now to be used in all.equal() methods. * R/Matrix.R (all.equal_Mat): be more careful (less tolerant) in all.equal() methods. * R/sparseMatrix.R: ditto 2008-08-28 Martin Maechler * DESCRIPTION (Version): 0.999375-12 released to CRAN * R/Ops.R (Compare(,): fix for nsparseMatrix 2008-08-27 Douglas Bates * R/sparseMatrix.R: fac2sparse() for NA's 2008-08-26 Martin Maechler * R/sparseVector.R (all.equal.sparseV): make work for nsparseVector's 2008-08-25 Martin Maechler * src/dgCMatrix.c (dgCMatrix_LU): partially revert change r2175 (2008-04-23) and do give an error for a singular matrix. * man/lu.Rd, R/Auxiliaries.R (detSparseLU): adapt to that. * R/LU.R: expand( ) * NAMESPACE, man/all.equal-methods.Rd: * R/Matrix.R (all.equal): methods for Matrices, * R/sparseMatrix.R, R/sparseVector.R: sparseMatrices and -Vectors 2008-08-23 Douglas Bates * [r2243] R/CHMfactor.R, man/CHMfactor-class.Rd: Added expand method and documentation for CHMfactor class * [r2241] R/CHMfactor.R: Added trivial coercion method for CHMfactor -> pMatrix 2008-08-19 Martin Maechler * R/nsCMatrix.R (setAs(., dgTMatrix))): remove unused method 2008-08-18 Martin Maechler * R/Ops.R (.Ops2dge.via.x, and many others): eliminate never-used variable assignments {from "next version" codetools}. * R/Csparse.R, R/Tsparse.R: ditto 2008-08-17 Martin Maechler * R/sparseVector.R (sp2vec, coerce to sparseVector): make sure no integer overflows happen, and use double precision (n, index) where appropriate. * tests/Simple.R: test "large" sparse vectors. 2008-08-14 Martin Maechler * R/AllClass.R (sparseVector): 'length' and 'i' are "numeric", not just integer (allowing much longer length). 2008-07-28 Martin Maechler * R/AllClass.R (diagonalMatrix): extend "sparseMatrix" instead of "denseMatrix". This renders "scarceMatrix" dispensable and invalidates part of MM's presentations on "space of Matrix classes", but seems cleaner overall. * R/diagMatrix.R, etc: eliminate "scarceMatrix", replacing it by "sparseMatrix" in method signatures; further, instead of coercing to "sparseMatrix", coerce to "TsparseMatrix" now. 2008-07-26 Martin Maechler * src/dgCMatrix.c (dgCMatrix_qrsol): allow third argument 'order' in .Call(.) * R/sparseMatrix.R (lm.fit.sparse), src/dgCMatrix.h, src/init.c: ditto 2008-07-24 Martin Maechler * R/dgeMatrix.R: need solve(, ) against infinite recursion in new test in * tests/matprod.R: testing the above and another solve() case, below * R/sparseMatrix.R (lm.fit.sparse): slightly more efficient for e.g. triangular 'x'. * src/dgCMatrix.c (dgCMatrix_qrsol): use AS_CSP() hence allowing dtC* * src/dgCMatrix.c (dgCMatrix_cholsol): use AS_CHM_SP() to work correctly with unit-triangular x * src/dsCMatrix.c (dsCMatrix_Csparse_solve): use AS_CHM_SP() instead of not checking diagU. * R/diagMatrix.R, R/Auxiliaries.R: tweaks to allow later experiments where diagonalMatrix would extend sparse*. 2008-07-23 Martin Maechler * src/dgCMatrix.c (compressed_non_0_ij): for nnzero(), use "x@p[ncol(x)]" instead of length(x@i). * R/Auxiliaries.R (nnzero): ditto * src/chm_common.c (as_cholmod_sparse): Do not use LENGTH(islot) since that fails for over-allocated i. * tests/validObj.R: more testing of over-allocated (i,x) slots 2008-07-23 Martin Maechler * src/chm_common.c (as_cholmod_sparse): Add 4th argument 'sort_in_place' and set it to TRUE in call from * src/Csparse.c (Csparse_validate): sort in place, making sure that validObject() continues sort the columns if needed. * tests/validObj.R: now tests that more thoroughly, and * man/CsparseMatrix-class.Rd: documents it. 2008-07-22 Douglas Bates * [r2233] src/chm_common.c: sort columns more carefully in as_cholmod_sparse * [r2231] src/chm_common.c: check for sorted columns in as_cholmod_sparse instead of assuming it * [r2228] src/cs_utils.c: Use R_alloc for semi-permanent storage when expanding diagonal 2008-07-21 Martin Maechler * src/cs_utils.c (Matrix_as_cs): add check_Udiag switch * src/cs_utils.h (AS_CSP & AS_CSP__): two versions * src/dtCMatrix.c (dtCMatrix_sparse_solve): no longer needs diagU2N(). * R/diagMatrix.R (.sparseDiagonal): new utility, used in "old" .spDiagonal() and new .trDiagonal(). * R/dtCMatrix.R (solve): make use of .trDiagonal() 2008-07-19 Martin Maechler * R/Auxiliaries.R (dimNamesCheck): fix very long standing buglet, stumbled upon by Michael H. * tests/validObj.R: testing the bug-fix * src/chm_common.h (AS_CHM_SP__, AS_CHM_TR__): the non-diagU2N versions. * src/chm_common.c (as_cholmod_sparse, as_cholmod_triplet): new boolean argument 'check_Udiag' (formerly implicitly was FALSE). * src/Csparse.c (Csparse_Csparse_prod, ...): etc: use the new AS_CHM_SP() which includes diagU2N. * inst/include/Matrix_stubs.c (M_as_cholmod_sparse): similarly adapt to 3 arguments. 2008-07-17 Douglas Bates * [r2220] src/dtCMatrix.c: Correct number of columns for rhs in dtCMatrix_sparse_solve * [r2219] src/cs_utils.c: eye->nz should be -1 for compressed column storage * [r2217] R/dtCMatrix.R, src/dtCMatrix.c, src/dtCMatrix.h, src/init.c: Replace dtCMatrix_solve by more general dtCMatrix_sparse_solve and add new solve method * [r2216] src/cs_utils.c: Utility csp_eye in case we want to fold Csparse_diagU2N functionality into Matrix_as_cs 2008-07-17 Martin Maechler * inst/doc/factor2sparse.Rnw: revive a year-old unfinished vignette 2008-07-16 Douglas Bates * [r2212] R/sparseMatrix.R: fac2sparse gets a drop.unused.levels argument with default TRUE * [r2211] inst/include/Matrix.h, inst/include/Matrix_stubs.c: Export Csparse_diagU2N * [r2210] R/dtCMatrix.R, man/dtCMatrix-class.Rd, src/dtCMatrix.c, src/dtCMatrix.h, src/init.c: Remove vestigial methods based on the parent array; new solve method for signature(a = "dtCMatrix", b = "sparseMatrix") 2008-07-14 Martin Maechler * R/diagMatrix.R (.bdiag): also keep result triangular 2008-07-13 Douglas Bates * [r2208] src/dtCMatrix.c, src/dtTMatrix.c: Revise wording in error messages 2008-07-12 Martin Maechler * R/diagMatrix.R (.bdiag): make more sophisticated, keeping symmetric- or nsparse-Matrix, also fixing the bug introduced with the new version (.999375-10). * tests/Simple.R: regression test for the bugs. 2008-07-07 Martin Maechler * R/sparseVector.R (spV2M): fix for "isparseVector". Further, fix -> coercion (repSpV): add rep(, .) method * R/sparseMatrix.R ([<-): when the RHS is a "scarce"Matrix, do *not* use as.vector(.). * R/Tsparse.R ([<-): & [CR]sparse.R: methods for value = "sparseVector" * R/AllClass.R: new (hidden) class union "scarceMatrix" * R/AllClass.R: sparseVector: add prototype * src/dsCMatrix.c (chk_nm): fix "Cholesky" check, thanks to Kasper Kristensen 2008-06-28 Martin Maechler * tests/other-pkgs.R: add more interesting Matrix -> graph 2008-06-27 Martin Maechler * R/sparseMatrix.R (Tsp2grNEL): add 'need.uniq' argument for speed improvement in "[CR]sparseMatrix" -> "graphNEL" coercion. 2008-06-25 Martin Maechler * DESCRIPTION: release 0.999375-10 to CRAN * R/diagMatrix.R (.bdiag): use more efficient Bates-algorithm for .bdiag(). * man/bdiag.Rd: update, including test. 2008-06-24 Martin Maechler * tests/Simple.R: add minimal bdiag() checks * R/diagMatrix.R (bdiag): fix bdiag(diag(4:5)) case; factor out the Tsparse - internal computation into new .bdiag() 2008-06-14 Martin Maechler * R/nsparseMatrix.R: specific fast all() and any() methods. * src/dgTMatrix.c (MAKE_gTMatrix_to_geMatrix): better error message when trying to produce too large result. * inst/test-tools.R (checkMatrix): add 'do.matrix' with a check for very large matrices. * R/sparseMatrix.R (printSpMatrix2): new function, used by show(). * R/diagMatrix.R (show): print only diagonal entries when nrow(.) >= 50. 2008-06-13 Martin Maechler * src/Mutils.c (m_encodeInd, m_encodeInd2): * R/*.R: .Call(m_encodeInd2?, ..) instead of encodeInd2?(..). * R/Auxiliaries.R (encodeInd2?): care against integer overflow (for big matrices): -> 2nd argument 'di' instead of 'nr' ! 2008-06-09 Martin Maechler * R/dtCMatrix.R: faster dgC* -> dtC* method * tests/Simple.R: (hence removed "FIXME") * R/Auxiliaries.R (copyClass): add 'check = .copyClass.check' which can be be turned off for possible speed gains. 2008-06-02 Martin Maechler * R/dMatrix.R, R/Tsparse.R: get rid of some disambiguation warnings * R/not.R: fix ! implement two old "FIXME"s: ! & ! * R/diagMatrix.R (Ops): fix one-off thinko in o methods * inst/test-tools.R: checkMatrix(): drop0(m12) unconditionally 2008-05-30 Martin Maechler * R/diagMatrix.R (Ops): more o methods * tests/Simple.R: testing the above 2008-05-07 Martin Maechler * NAMESPACE: also import "Ops" {found via new tools:::get_S4_generics_with_methods()} 2008-05-03 Martin Maechler * R/Matrix.R (dimnames<-): dimnames(.) <- NULL works with a message; * NAMESPACE (unname): finally exported 2008-04-28 Martin Maechler * R/Auxiliaries.R (cholMat): possibly keep packed * inst/test-tools.R (checkMatrix): add fixed determinant.matrix() for R < 2.7.0. * R/Tsparse.R ([): for triangularMatrix, check if result may be triangular. * tests/indexing.R: regression test 2008-04-26 Martin Maechler * inst/test-tools.R (checkMatrix): test not only for dMatrix * R/Ops.R: more methods, for lMatrix/nMatrix 2008-04-24 Martin Maechler * R/expm.R: new file for all expm() methods; notably new ones for diagonal*, triangular*, symmetric* and also simple "matrix". 2008-04-23 Martin Maechler * R/dsyMatrix.R: setAs(.) rather than setIs(.) "to dpoMatrix" * inst/test-tools.R (assert.EQ.mat): better message when not equal * src/dgeMatrix.c (dgeMatrix_matrix_crossprod): allow integer RHS. * R/AllClass.R (ddiMatrix,ldiMatrix): extend [dl]Matrix instead of [dl]denseMatrix {identical slots; but more logical method dispatch} 2008-04-23 Martin Maechler * R/sparseMatrix.R (summary): use length() instead of nnzero() * R/diagMatrix.R (determinant): method 2008-04-22 Martin Maechler * src/dsCMatrix.c (dsCMatrix_Cholesky): suppress CHOLMOD printing too * R/Rsparse.R (.viaC.to.R): uplo fix for symmetric & triangular * R/dsCMatrix.R (determinant): switch to use Cholesky( 'LDL' ) and its diagonal 2008-04-21 Martin Maechler * R/dMatrix.R (Summary): short-cut for prod() * R/not.R: fix !<"U"-diag-ltrMatrix> ; drop {R < 2.6.0}-branch * R/Auxiliaries.R (tT2gT): fix for "U"-diag-ltTMatrix * R/AllClass.R: ltTMatrix validity: call (more stringent) tTMatrix_validate 2008-04-19 Martin Maechler * R/Ops.R (Ops.x.x): aux.function, not just for (dMatrix,dMatrix) * R/Ops.R (.do.Logic.lsparse): fix NA case * R/Tsparse.R (replTmat): fix r.sym case, using indTri() * R/Auxiliaries.R (nnzero): fix special cases, using * R/Auxiliaries.R (indDiag): new utility * R/Auxiliaries.R (indTri): new argument 'diag' * R/dMatrix.R: Summmary(): different branch for dsy* 2008-04-18 Martin Maechler * R/diagMatrix.R: "Summary" methods, and more "Arith" / "Ops" * src/Csparse.c (Csparse_drop): preserve (uplo,diag) for ".tCMatrix" triangular matrix. * R/Auxiliaries.R (drop0): use diagU2N(); according to helpfile, 'clx' can be class *or* class representation. (nnzSparse): new. (non0ind): new 'xtendSymm' argument; used in * R/Ops.R: * R/pMatrix.R: more efficient determinant() method 2008-04-17 Martin Maechler * [deactivated] R/Matrix.R (det): det() as base::det(), but with Matrix environment * [deactivated] NAMESPACE: export(det) * R/diagMatrix.R (mkDiag): new substitute for diag() * R/Auxiliaries.R (nnzero): fix for "diagU2N"-case (as0, as1): new utility. * R/Csparse.R (diag, band): need diagU2N() * src/dgeMatrix.c (get_norm): return NA when 'x' slot has NA/NaN. * R/lMatrix.R: coerce(nMatrix |-> lMatrix) fix * R/Ops.R (Compare): fix o case * R/nsparseMatrix.R, R/pMatrix.R: is.na() method 2008-04-16 Martin Maechler * R/Auxiliaries.R (signPerm): new utility for * R/Auxiliaries.R (detSparseLU): determinant() via sparseLU * src/dsCMatrix.c (dsCMatrix_LDL_D): suppress 'CHOLMOD warning'; since we have our own error handler (and can use tryCatch() from R). 2008-04-15 Martin Maechler * R/dgTMatrix.R (image): ha! set col=NA if lwd is small -- very nice! * R/dsCMatrix.R (determinant): use tryCatch() and switch to lu() when not positive definite. * R/Auxiliaries.R (asTri): new auxiliary (non0.i): make *much* faster for Tsparse with many non-zero entries; add 'uniqT = TRUE' argument to be used when sorting is undesired. * tests/Class+Meth.R (dotestMat): now build on checkMatrix() from test-tools.R , see below * R/dMatrix.R: fix "Summary" method: + diagU2N() * NAMESPACE, R/Matrix.R: add mean() method 2008-04-12 Martin Maechler * R/dgTMatrix.R (image): allow to *not* take abs(), and use cold-hot colors; try *changed* default useAbs = FALSE * man/image-methods.Rd: nice examples 2008-04-11 Martin Maechler * inst/test-tools.R (checkMatrix): new function for modularizing part of tstMatrixClass() in tests/Class+Meth.R * R/dsCMatrix.R: coercion from "matrix" * R/ltTMatrix.R, R/ntTMatrix.R: ditto (change it). * tests/Class+Meth.R (tstMatrixClass): some cleanup; add test for as(matrix(,0,0), ) 2008-04-09 Martin Maechler * src/dgeMatrix.c (dgeMatrix_determinant): for n == 0, work as determinant(matrix(,0,0)). * src/dgCMatrix.c (dgCMatrix_LU): return {L,U} as dtCMatrix * man/sparseLU-class.Rd: ditto * R/dgCMatrix.R (determinant): method building on lu() * R/sparseMatrix.R, Matrix.R, ...: ditto * R/Auxiliaries.R (mkDet): auxiliary for determinant() 2008-04-07 Martin Maechler * R/sparseMatrix.R (summary): no 'x' column for pattern matrices. 2008-04-02 Martin Maechler * src/dense.c (dense_to_Csparse): all declarations *before* R_CheckStack(); needed e.g. for ancient gcc 2.96. 2008-03-29 Martin Maechler * DESCRIPTION (Version): 0.999375-9 --- need to release for R-devel (and R 2.7.0 alpha soon). * R/AllClass.R: drop "double" from "atomicVector" class union * R/AllGeneric.R (rcond): check for base::rcond instead of R version * R/dgeMatrix.R: ditto * R/sparseMatrix.R (summary): count NAs * inst/doc/Intro2Matrix.Rnw: changes, aim for *one* introduction. 2008-03-28 Martin Maechler * R/AllGeneric.R: rcond(., norm) instead of rcond(., type), in order to become compatible to new R 2.7.0 base::rcond(). 2008-03-25 Martin Maechler * DESCRIPTION (Version,Date): 0.999375-8 --- released to CRAN * R/diagMatrix.R (Ops): fix newly introduce bug in <.di> o * inst/test-tools.R (isValid): new utility, used much in * tests/simple.R: * man/BunchKaufman-methods.Rd: added too 2008-03-24 Martin Maechler * R/dsyMatrix.R: add BunchKaufman() methods. * R/dspMatrix.R: * src/init.c: add dsyMatrix_trf 2008-03-23 Douglas Bates * DESCRIPTION (Version): release 0.999375-7 * src/CHMfactor.c (CHMfactor_update): fix 2008-03-22 Martin Maechler * src/dsCMatrix.c (dsCMatrix_LDL_D): cleanup, also using internal_chm_factor(). * R/AllGeneric.R: do *not* define a "chol" generic (but rather use the implicit one *without* making pivot part of the signature) * R/*.R: drop the 'pivot' from chol's signature and make 'pivot=FALSE' a default argument of method definitions. * .Rbuildignore: add 'wrld_1deg': I.e. do not put it into released version of Matrix 2008-03-18 Martin Maechler * R/Tsparse.R (.T.2.n): drop 0's before coercion to "nMatrix" * R/sparseMatrix.R (is.na): new simple method * R/denseMatrix.R (is.na): ditto. * R/diagMatrix.R (.symDiagonal): newly exported utility. * R/diagMatrix.R (Ops): * should not become dgeMatrix! * src/UFsparse_download.sh: --> * src/CHOLMOD/: update to CHOLMOD version 1.6 (Nov.2007) 2008-03-17 Martin Maechler * src/dsCMatrix.c (dsCMatrix_LDL_D): even faster utility with same functionality; barely tested in * tests/factorizing.R * src/Csparse.c (diag_tC): new functionality to enable faster determinant(, .) in * R/dsCMatrix.R 2008-03-17 18:53 Douglas Bates * R/CHMfactor.R, inst/include/Matrix.h, inst/include/Matrix_stubs.c, src/CHMfactor.c, src/CHMfactor.h, man/CHMfactor-class.Rd, src/init.c, tests/factorizing.R: Log-determinant of the parent matrix from a CHMfactor object as chm_factor_ldetL2; documentation and support 2008-03-15 Martin Maechler * R/dsCMatrix.R: enable determinant(, .) via chol(.) 2008-03-14 Martin Maechler * R/dsCMatrix.R: setAs(., "dsCMatrix") but with a deprecation warning. 2008-03-13 Martin Maechler * DESCRIPTION (Version, Date): bug-fix release 0.999375-6 * R/diagMatrix.R (diag2tT.u): utility to be smarter in o setAs(., "nMatrix") added. * R/diagMatrix.R (Diagonal): Diagonal(4, x=3) now works too * R/Auxiliaries.R (.diagU2N): more careful coercion in 2 steps new argument 'checkDense = FALSE'. 2008-03-07 Martin Maechler * src/dgeMatrix.c (dgeMatrix_exp): fix the octave-origin bug in the back-permutation of the matrix exponential. * tests/matr-exp.R: test the fix (for an example where expm() was wrong). * DESCRIPTION (Date,Version): ready to release 0.999375-5 * tests/simple.R: testing diagN2U 2008-03-06 Martin Maechler * R/Auxiliaries.R (diagN2U): interface to * src/Csparse.c (Csparse_diagN2U): .Call()able SEXP version of chm_diagN2U() * tests/matprod.R: test for triangularity preserving %*% 2008-03-05 Martin Maechler * src/chm_common.c (chm_diagN2U): new utility. * src/Csparse.c (Csparse_Csparse_crossprod, Csparse_Csparse_prod): make use of chm_diagN2U() and hence now preserve triangularity and unit-triangularity. * DESCRIPTION (LicenseDetails): new; such that 'License:' becomes "canonical" 2008-03-04 Martin Maechler * R/diagMatrix.R (subDiag): fix when x[..] became a vector * src/Tsparse.c (Tsparse_diagU2N): new utility, necessary for e.g. * src/Csparse.c (Csparse_crossprod): use [CT]sparse_diagU2N() !! * R/Auxiliaries.R (.diagU2N): make use of new Tsparse_diagU2N * R/Ops.R ("-" ()): use diagU2N() * src/chm_common.c (AS_CHM_FINISH): add note about problem for triangular (diag = "U"). 2008-02-21 Martin Maechler * R/Auxiliaries.R (as_Csparse2): drop this, replacing by * R/bind.R: .Call(dense_to_Csparse, *) 2008-02-20 Martin Maechler * R/Matrix.R (Matrix): no longer use coercions to specific classes (since we are discouraging them in user code). * tests/*.R: also replaces coercions to specific classes by coercions to super classes. * R/denseMatrix.R (.dense2C): simplified by using forceSymmetric() 2008-02-19 Martin Maechler * man/CAex.Rd: example: coerce to symmetric*, not dsC* * src/dense.c (dense_band): generalized from ddense_band * R/ddenseMatrix.R (.trilDense,.triuDense, .bandDense): now for "denseMatrix" (instead of just "ddense*"); much simplified setMethod()s for these. * src/dense.c (dense_to_symmetric): generalized from ddense_* 2008-02-18 Martin Maechler * R/AllGeneric.R: forceSymmetric() generic: fast no-checking version of as(*, "symmetricMatric"). * src/dense.c (ddense_to_symmetric): add 'symm_test' argument, and * R/symmetricMatrix.R: set it TRUE in coercion to "symmetricMatrix" 2008-02-16 Martin Maechler * R/Matrix.R (subset.ij): utility, as first step to faster M [ ] indexing. * R/Matrix.R (.M.sub.i.logical): M[ ] : try better. * src/dense.c (ddense_symmpart, ddense_skewpart): new functions for more efficient symmpart() and skewpart() methods. * src/Mutils.c (equal_string_vectors): utility * src/dense.c (ddense_to_symmetric): new function used in * R/symmetricMatrix.R: setAs(., "symmetricMatrix") * R/sparseMatrix.R, et_al (isSymmetric): add '...' to formals, in order to match the generic (and evade .local(..)). * R/dsCMatrix.R: dgC -> dsC: use C code! * NAMESPACE, R/AllGeneric.R (symmpart, skewpart): new functions as per TODO * R/Auxiliaries.R (setZero, all0Matrix): new utilities * R/symmetricMatrix.R: obvious symmpart(), skewpart() methods 2008-02-15 Martin Maechler * R/Ops.R (.Arith.Csparse): use diagU2N when needed in triangular * R/Auxiliaries.R (non0.i): take out of non0ind * R/ddenseMatrix.R (.trilDense, .triuDense, .bandDense): make tril(), triu(), band() work for "matrix" and all "dense*" * R/triangularMatrix.R (.tri[lu].tr): need .diagU2N(*) * tests/simple.R: test the fix above * R/sparseMatrix.R ([): simplification: no coerce to before we use as(., )[...] anyway * R/Rsparse.R (.viaC.to.R): mostly instead of .viaC.to.dgR() * R/triangularMatrix.R (isTriangular): methods for all subclasses instead of "triangularMatrix" -- just to disambiguate 2008-02-14 Martin Maechler * tests/Class+Meth.R (dotestMat): add m[FALSE, FALSE] { <-> TODO} * tests/indexing.R: example that fails above 2008-01-26 Martin Maechler * R/Matrix.R (.M.sub.i.2col): fix for logical matrix indexing * R/Tsparse.R (.TM.sub.i.2col, .TM.repl.i.2col): ditto; now, M[lower.tri(M)] and M[lower.tri(M)] <- v work better * src/Tsparse.c (Tsparse_to_tCsparse): new fast utility. * src/Tsparse.h, init.c: ditto * R/Auxiliaries.R (isTriT): new; faster than going via Csparse both isTriC() and isTriT() now return TRUE with "kind" or FALSE. * R/sparseMatrix.R (isTriangular): hence simplified 2008-01-24 Martin Maechler * R/Ops.R (.Arith.Csparse): new utility factored out of former o , extended for triangular and also used in o . 2008-01-23 Martin Maechler * tests/factorizing.R (checkSchur): and more tests for checking Schur() * inst/test-tools.R (isOrthogonal): new function; also file restructured 2008-01-22 Martin Maechler * R/ngTMatrix.R: allow as(, "ngTMatrix") and hence coercion to "nMatrix" and "pMatrix" * R/AllClass.R: "Schur" class; "number" class union * man/number-class.Rd: * man/Schur-class.Rd: * R/eigen.R (.dgeSchur): utility, and return "Schur" class (.simpleSchur): Schur() method for diagonal matrices (.triSchur): Schur() method for triangular matrices (Schur.sym): Schur() for symmetric matrices {building on eigen()}. 2008-01-21 Martin Maechler * src/dgCMatrix.c (dgCMatrix_QR): set @Dim slot (as per doc) 2008-01-15 Martin Maechler * R/CHMfactor.R (solve): method for b="numeric", but also b="ANY" in order to ensure 'system = *' is not lost; formals()$system instead of cut&paste. * tests/factorizing.R: test solve(, ) 2008-01-11 Martin Maechler * DESCRIPTION (Date): make ready for release --> 0.999375-4 * R/dgeMatrix.R: fix rcond() method for "dgeMatrix". 2007-12-08 Martin Maechler * R/pMatrix.R: as(*, "matrix") now returns 0/1 *integer* matrix, and hence does as.vector(.). * man/pMatrix-class.Rd: docs * R/sparseMatrix.R: fix for printing "integer sparse" * tests/Class+Meth.R (tstMatrixClass): test M[FALSE], M[2] etc * R/Matrix.R and others: use "exact" function argument list for both "[" : (x, i,j, ..., drop) and "[<-" : (x, i,j, ..., value) * R/denseMatrix.R: M[i] and M[i] <- v (i vector) now work * R/Tsparse.R (replTmat): ditto * R/diagMatrix.R (replDiag): ditto * R/Csparse.R (replCmat): ditto {was it worth the pain?} * tests/indexing.R: testing the above 2007-12-07 Martin Maechler * R/sparseMatrix.R (cov2cor): method for sparse matrices * R/diagMatrix.R ([<-): fix D[ cbind(i,j) ] <- v * R/bind2.R: fix for Rsparse* and rbind2(dense,dense) * tests/Class+Meth.R: test cbind2, rbind2 and diag<- 2007-12-06 Martin Maechler * R/Matrix.R: "generic" cov2cor() method * R/nearPD.R: new 'only.values', 'keepDiag' arguments; speed up Q %*% D %*% t(Q) * tests/dpoMatrix.R: test nearPD() 2007-12-05 Doug Bates and Martin Maechler * R/sparseMatrix.R: xtabs(*, sparse=.) function; an extention of stats::xtabs() allowing to create sparse matrices. 2007-10-08 Martin Maechler * DESCRIPTION (Version): *-4 (released *-3 two days ago) 2007-10-06 Martin Maechler * R/pMatrix.R: solve(, ) 2007-10-05 Martin Maechler * R/LU.R: solve() method for "denseLU" 2007-10-01 Martin Maechler * DESCRIPTION (Version): 0.999375-3 preparing for release * R/AllGeneric.R: simplify if(.) .. else .. for R <= 2.5.1 * R/Matrix.R (Matrix): .Internal(matrix(..)) different for R >= 2.7.0 2007-09-26 Martin Maechler * R/pMatrix.R (.m.mult.pMat): fix %*% , thanks to Kasper Kristensen. * tests/matprod.R: regression test for that. 2007-09-23 17:32 Douglas Bates * [r4778] R/AllGeneric.R: Check R version before defining generics for primitives 2007-09-13 Martin Maechler * R/denseMatrix.R (rcond): method * R/sparseQR.R (rcond): method, use x or t(x) 2007-09-12 Martin Maechler * R/dgeMatrix.R (rcond): method: work via qr.R() for non-square matrices. * R/sparseMatrix.R: Ditto for all other rcond() method definitions. * man/rcond.Rd: mention the more general definition, and add example for non-square matrices. * man/chol.Rd: new file, for the S4 chol() generic and all methods. 2007-09-11 Martin Maechler * R/sparseQR.R: add qr.R() method [to be used for rcond()] 2007-09-01 Martin Maechler * R/Matrix.R ([<-): add (Matrix,missing,ANY,Matrix) etc * tests/indexing.R: add new regression for the above cases. 2007-08-30 Martin Maechler * src/Mutils.h (__sun): clause for alloca.h on Solaris 2007-08-16 Martin Maechler * DESCRIPTION (Date, Version): 0.999375-2 2007-08-15 Martin Maechler * R/HBMM.R (readMM): make work for pattern matrices as well 2007-08-14 13:07 Douglas Bates * [r4730] src/Mutils.h: declare alloca * [r4734] NAMESPACE, R/AllGeneric.R, R/Csparse.R, R/HBMM.R, R/Tsparse.R, R/dgCMatrix.R, R/dgTMatrix.R, R/dsCMatrix.R, R/dsTMatrix.R, man/externalFormats.Rd, src/Csparse.c, src/Csparse.h, src/DEPS.mkf, src/HBMM.c, src/HBMM.h, src/Mutils.h, src/SOURCES_C.mkf, src/init.c, src/mmio.c, src/mmio.h: Remove deprecated function writeHB and its methods; switch writeMM to use CHOLMOD code; repair readMM 2007-08-14 Martin Maechler * R/nearPD.R, man/nearPD.Rd (nearPD): new function built on Jens Oehlschlaegel's ... result type still to be discussed! 2007-08-10 Martin Maechler * man/image-methods.Rd: new, combining all image() methods 2007-08-09 Martin Maechler * R/dgCMatrix.R: define qr() and lu() methods for "sparseMatrix" to work via dgC... * R/Matrix.R (Matrix): special treatment for "table" (S3) 2007-08-07 Martin Maechler * R/dgTMatrix.R (image): change defaults to aspect = "iso", colorkey = FALSE 2007-08-06 Martin Maechler * src/dsyMatrix.c (dsyMatrix_matrix_mm): 'b' might be matrix; must copy its *expanded* x slot before LAPACK call. * tests/matprod.R: test the last days' changes. 2007-08-06 16:43 Douglas Bates * [r4712] inst/include/Matrix_stubs.c: Change R_cholmod_printf in stubs as well as in sources * [r4713] src/dsyMatrix.c: Duplicate the contents of the RHS before Lapack call 2007-08-03 Martin Maechler * R/Matrix.R (%*%, crossprod, tcrossprod): add method for ("Matrix", "matrix") which is needed in some cases. Ditto for solve(). * R/colSums.R (.as.dge.Fun): need ddenseMatrix methods to avoid infinite recursion in dispatch for some cases. 2007-08-02 08:48 Martin Maechler * [r4693] src/chm_common.c: R_cholmod_printf() instead of Rprintf() just so pointers match 2007-08-02 Martin Maechler * DESCRIPTION (Date): set ready for release -- 0.999375-1 2007-08-01 15:44 Douglas Bates * [r4686] inst/include/Matrix.h, inst/include/Matrix_stubs.c, src/chm_common.c, src/chm_common.h: Change API for numeric_as_chm_dense and N_AS_CHM_DN 2007-08-01 Martin Maechler * src/dtrMatrix.c (dtrMatrix_matrix_mm): fix dimensionality check (!) * tests/matprod.R: regr.test for it 2007-07-20 Martin Maechler * R/dMatrix.R: fix from Brian for Math2(., digits = "missing") * tests/group-methods.R: and regression-test it 2007-07-19 19:45 Douglas Bates * [r4642] inst/include/Matrix.h, inst/include/Matrix_stubs.c, inst/include/cholmod.h, src/chm_common.c, src/init.c: Export triplet_to_sparse, documentation, use typedefs 2007-07-18 Martin Maechler * man/dpoMatrix-class.Rd: added 'corMatrix' example * src/dsyMatrix.[ch] (dsyMatrix_as_matrix): new 'keep_dimnames' arg * src/dtrMatrix.[ch] (dtrMatrix_as_matrix): ditto * src/init.c, R/dsyMatrix.R, R/dtrMatrix.R, R/lgTMatrix.R: ditto * R/lsparseMatrix.R: bug fix in "all" method * R/Ops.R (.do.Logic.lsparse): "|" bug in borderline case * R/dsyMatrix.R (coerce->dsTMatrix): (i,j) slots should *not* have names * R/ngTMatrix.R (coerce->ngTMatrix): ditto; + matrix |-> nMatrix coercion * R/pMatrix.R: + setAs() to dMatrix and from nMatrix * man/pMatrix-class.Rd: ditto * R/Matrix.R (Summary): method for non-dMatrix * tests/Class+Meth.R (extraValid): new check about "dirty" slots * tests/Class+Meth.R (tstMatrixClass): test norm(.); test all Summary methods. 2007-07-16 Martin Maechler * R/dgeMatrix.R (norm, rcond): methods for 'matrix' 2007-07-14 Martin Maechler * R/sparseMatrix.R (norm): simple methods for sparseMatrix * R/pMatrix.R (t?crossprod): methods for pMatrix 2007-07-10 Douglas Bates * src/dgeMatrix.c (dgeMatrix_colsums): Get the logic straight. 2007-07-09 20:45 Douglas Bates * [r4579] src/dgeMatrix.c: Untangle horrible code in dgeMatrix_colsums trying to fix a subtle bug - which has been somewhere else. 2007-07-09 19:43 Martin Maechler * [r4578] src/dgeMatrix.c: "cleaned" dgeMatrix_colsums() - but did not solve the bug 2007-07-08 Martin Maechler * src/dgCMatrix.c (compressed_to_TMatrix): 2007-07-07 Martin Maechler * src/Csparse.c (Rsparse_validate): new, to have some validity checking for RsparseMatrix * src/dgCMatrix.c (xRMatrix_validate): ditto * src/dtCMatrix.c (tRMatrix_validate): ditto 2007-07-07 Douglas Bates * [r4567] R/AllClass.R: Slots already in RsparseMatrix were redefined in lgRMatrix * [r4568] DESCRIPTION: Prepare for bug-fix release * [r4570] src/CHOLMOD/Check/cholmod_write.c: Include cholmod_matrixops.h for declaration of cholmod_symmetry 2007-07-06 Martin Maechler * DESCRIPTION (Version): 0.999375 merged into the trunk; ready for release. 2007-07-06 14:11 Douglas Bates * [r4559] src/iohb.c, src/iohb.h: Remove Harwell-Boeing input/output functions - no longer used * [r4560] src/HBMM.c, src/Mutils.c, src/dgTMatrix.c, src/dgeMatrix.c, src/dspMatrix.c, src/dsyMatrix.c, src/dtCMatrix.c, src/factorizations.c, src/sparseQR.c: Replace most calls to Calloc by Alloca 2007-07-06 13:14 Martin Maechler * [r4558] inst/doc/Comparisons.Rnw, src/CHMfactor.c, src/Csparse.c, src/Tsparse.c, src/chm_common.c, src/chm_common.h, src/dense.c, src/dgCMatrix.c, src/dsCMatrix.c, src/dtTMatrix.c, src/sparseQR.c, src/t_gCMatrix_colSums.c: more R_CheckStack()s 2007-07-05 18:12 Douglas Bates * [r4550] inst/include/Matrix.h: Add the macro N_AS_CHM_DN to "alloca" the required amount of memory then call M_numeric_as_chm_dense. * [r4556] src/Mutils.h, src/dgCMatrix.c: Define and use the Alloca macro (like Calloc but calling alloca) 2007-07-05 Martin Maechler * R/sparseMatrix.R (printSpMatrix): renamed from prSpMatrix() and extended with more sophisticated 'col.names' option. * NAMESPACE: export printSparseMatrix() * man/printSpMatrix.Rd: document, incl. examples 2007-07-04 16:21 Douglas Bates * [r4543] src/cs_utils.c, src/cs_utils.h, src/dgCMatrix.c, src/dtCMatrix.c, src/sparseQR.c: CSP typedef for *cs and macro AS_CSP. API change - pass the empty structure to Matrix_as_cs. 2007-07-04 Martin Maechler * DESCRIPTION (Version): 0.99875-4 * tests/Class+Meth.R (tstMatrixClass): add dimnames, and hence test some dimnames perservation. * R/dsTMatrix.R (t-method): keep dimnames * R/dtTMatrix.R: ditto * R/sparseMatrix.R (prSpMatrix): print colnames when non-trivial and ncol(.) < 10 * src/cs_utils.c: drop check_class() and use Matrix_check_class() from Mutils.h * src/lgCMatrix.c ([ln]csc_to_matrix): no longer lose dimnames, e.g. in as(, "matrix") 2007-07-01 13:27 Douglas Bates * [r4529] .: Create a branch for the API changes from the 0.99875 series to the 0.999375 series * [r4530] DESCRIPTION, inst/include/Matrix.h, inst/include/Matrix_stubs.c, src/CHMfactor.c, src/Csparse.c, src/Mutils.h, src/Tsparse.c, src/chm_common.c, src/chm_common.h, src/dense.c, src/dgCMatrix.c, src/dsCMatrix.c, src/dtTMatrix.c, src/t_gCMatrix_colSums.c: API change - pass the empty structure to the as_cholmod_x functions 2007-06-30 09:05 Martin Maechler * [r4527] trunk/Matrix/DESCRIPTION, trunk/Matrix/NAMESPACE, trunk/Matrix/inst/doc/Comparisons.Rnw: add session- and hardware-info to Comparisons >>>>>>> .merge-right.r4561 2007-06-29 Martin Maechler * DESCRIPTION (Version): 0.99875-3 ready to be released. * R/sparseMatrix.R (spMatrix): make spMatrix(3,4) working * R/AllGeneric.R: set "Math" (and "Math2") group generics in a way that should also work in a future version of R. 2007-06-21 Martin Maechler * NAMESPACE, R/AllClass.R: "xsparseVector" class union. * R/sparseVector.R: more *sparseVector coercions, notably for non - double ones. 2007-06-19 Martin Maechler * R/colSums.R: new file for all (col|row)(Sums|Means) methods, notably the new ones building on the new .Call(.)s: * src/dgCMatrix.c (DEF_gCMatrix_COLSUMS): use to define all 4 of [dlin]gCMatrix_colSums(). 2007-06-18 16:12 Douglas Bates * [r4472] src/Syms.h, src/init.c: Added Matrix_lengthSym * [r4473] src/dgCMatrix.c: Modified dgCMatrix_colSums for sparseVector result 2007-06-16 Martin Maechler * R/kronecker.R: fix typo (could lead to inf.recursion) * test/simple.R: testing that * R/sparseMatrix.R (prSpMatrix): change to be used as print() method as well (which can have arguments, show() can't). 2007-06-16 15:52 Douglas Bates * [r4466] R/dgCMatrix.R, src/dgCMatrix.c, src/dgCMatrix.h, src/init.c: added dgCMatrix_colSums for [col,row][Sums,Means] 2007-06-15 23:15 Douglas Bates * [r4460] R/sparseMatrix.R, man/dgCMatrix-class.Rd, src/dgCMatrix.c, src/dgCMatrix.h, src/init.c: added lm.fit.sparse (unexported), coercion of "factor" to "dgCMatrix" and dgCMatrix_cholsol * [r4461] R/AllClass.R, man/sparseMatrix-class.Rd: draft "indicators" class * [r4463] R/sparseMatrix.R, man/dgCMatrix-class.Rd, man/sparseMatrix-class.Rd: Don't need an "indicators" class - use the row names to store the levels - duh! Added an example. 2007-06-14 Martin Maechler * src/Csparse.c (Csparse_validate): check for *repeated* entries thanks to example from Christian Buchta; with a test here: * tests/simple.R: 2007-06-07 Martin Maechler * R/Auxiliaries.R (callGeneric): another fix, needed for some cases of colSums(*, sparseResult = TRUE) 2007-06-06 Martin Maechler * R/lsparseMatrix.R, R/ldenseMatrix.R (all, any): change default to 'na.rm = FALSE' as "everywhere" else in R. 2007-06-05 Douglas Bates * [r4421] src/CSparse_install.sh: Modify for new organization of CSparse package * [r4425] src/UFsparse_download.sh: Update to version 3.0.0 of SuiteSparse * [r4426] src/Makefile: add ./UFconfig to the include path for compilation * [r4427] src/cs.[ch]: update to CSparse version 2.2.0 * [r4428] inst/doc/UFsparse/* src/{AMD,CHOLMOD,COLAMD}/* src/UFconfig/UFconfig.h: Update to version 3.0.0 of SuiteSparse 2007-06-05 Martin Maechler * R/Auxiliaries.R (emptyColnames): + argument msg.if.not.empty, used in * R/sparseMatrix.R (prSpMatrix): now gives a message about suppressed column names. 2007-06-04 17:13 Douglas Bates * [r4418] src/Csparse.c, src/HBMM.c, src/Mutils.c, src/Mutils.h, src/Tsparse.c, src/chm_common.c, src/chm_common.h, src/dgCMatrix.c, src/dgeMatrix.c, src/dpoMatrix.c, src/dpoMatrix.h, src/dppMatrix.c, src/dppMatrix.h, src/dsCMatrix.c, src/dspMatrix.c, src/dspMatrix.h, src/dsyMatrix.c, src/dsyMatrix.h, src/dtpMatrix.c, src/dtrMatrix.c: Remove warnings after change to const char* CHAR 2007-06-04 17:11 Douglas Bates * [r4417] inst/include/Matrix_stubs.c, inst/include/cholmod.h: Corrected type of M_cholmod_ssmult 2007-06-03 14:42 Douglas Bates * [r4412] inst/include/Matrix_stubs.c, inst/include/cholmod.h, src/init.c: Yet another cholmod export - cholmod_ssmult 2007-05-23 Martin Maechler * NAMESPACE: exported drop0(), since * man/drop0.Rd: I have seen several cases, I really wanted to use it, so our users may want too. 2007-05-22 Martin Maechler * man/colSums.Rd: separately document colSums() etc, since these have the extra argument 'sparseResult'. 2007-05-21 Martin Maechler * R/sparseMatrix.R (spMatrix): utility (T)sparse Matrix constructor; * man/spMatrix.Rd: docu., including examples * R/Auxiliaries.R (sp.colMeans): etc, using a patched callGeneric(), in order to make colMeans() etc fast *and* correct. * R/sparseVector.R (replSPvec): "[<-" functionality for sparseVectors; tested in * tests/simple.R: 2007-05-19 Martin Maechler * R/sparseMatrix.R (print.sparseSummary): and summary() method for (very) sparse Matrices; output similar to Matlab's print(). 2007-05-17 Douglas Bates * src/HBMM.c (Matrix_writeMatrixMarket): Write 1-based, not 0-based, indices (Jose Quesada ). 2007-05-16 Douglas Bates * R/CHMfactor.R: Added solve methods for a CHMfactor object. 2007-05-16 Martin Maechler * R/Auxiliaries.R (sparsapply): new utility, much faster than tapply1() for large sparse matrices. 2007-05-15 Martin Maechler * R/Matrix.R (dim<-): reshape now via sparseVector. * R/sparseVector.R: methods and function for * R/AllClass.R: new "sparseVector" class and daughters. * NAMESPACE: export new classes 2007-05-14 Martin Maechler * DESCRIPTION (Version): 0.99875-1 * src/Makefile.win: also remove Lapack code from here (cf. 04-25). 2007-05-11 Martin Maechler * R/Tsparse.R ([, Tsparse): fix last case: *duplicated*, symmetric indexing * tests/indexing.R: test set for that. 2007-05-08 Martin Maechler * R/Tsparse.R (replTmat): fix the case of *duplicated* index entries. * tests/indexing.R(out): add regression test for it 2007-04-30 Martin Maechler * R/(l(dense|sparse))?Matrix.R (!): use 'x', not 'e1' as argument name for "!" method definitions. 2007-04-26 Martin Maechler * R/Tsparse.R (intI): new utility, used for "[" : Cleanup up there, and fixes for duplicated indices - more TODO! * tests/indexing.R(out): more tests 2007-04-25 Douglas Bates * DESCRIPTION,src/Makefile: require R>= 2.5.0 and remove Lapack code that is now part of the R Lapack library. * src/init.c,inst/include/{Matrix_stubs.c,cholmod.h}:export cholmod_factorize_p (used in lme4 for GLMMs and NLMMs). 2007-04-21 Martin Maechler * R/Matrix.R (image): method for all Matrices, not just sparse ones. 2007-04-17 Martin Maechler * R/Auxiliaries.R (tapply1): unname(.) -> colSums() etc don't end up with extraneous names '0'...'' 2007-04-12 Martin Maechler * R/dgTMatrix.R (mat2dgT): care about NAs 2007-04-11 Martin Maechler * R/kronecker.R: triangularity preserving methods 2007-03-27 Martin Maechler * R/kronecker.R: new file collecting kronecker() methods in one place. Goal: become much faster! 2007-03-23 Martin Maechler * src/dtCMatrix.c (dtCMatrix_solve): use the new code from Kasper Kristensen based cs_spsolve() instead of _lsolve & _usolve which can be much faster. * tests/matprod.R: add regression tests for these (upper & lower). 2007-03-19 Martin Maechler * R/Matrix.R (diff): method for our Matrices. * R/sparseMatrix.R (isDiagonal): check dim()! 2007-03-17 Martin Maechler * R/Matrix.R (dim<-): new method for "reshape()" built on a proposal from Tamas Papp. 2007-03-16 Martin Maechler * R/AllGeneric.R: remove all if(!isGeneric(.)) clauses * R/zzz.R (.onLoad, .onUnload): do *not* leave bind_activation(TRUE); rather define and export cBind() and rBind() only. --> useRs *must* change code that used to have cbind()/rbind() !! * R/bind.R: change tests from cbind() to cBind() and similarly to rBind() * R/bind.Rout.save: ditto 2007-02-16 Douglas Bates * DESCRIPTION (Date, Version): 0.9975-11 with new date * src/dgCMatrix.c (R_to_CMatrix, compressed_to_TMatrix): remove const modifier on declaration of the array 'valid' 2007-02-12 Douglas Bates * R/CHMfactor.R: Add image method (coercion to sparseMatrix). 2007-02-05 Martin Maechler * DESCRIPTION (Date, Version): 0.9975-10 with new date. * R/Ops.R (Arith): make sure Csparse o Csparse also works for e.g. ntCMatrix * tests/simple.R: test the above and some of these coercions: * R/nsparseMatrix.R: coercing "Csparse" to "lsparseMatrix"; be careful to avoid infinite recursion, using new coercions in * R/ngCMatrix.R and nsC... and ntC... * R/lsparseMatrix.R: ditto * R/SparseM-conv.R: more conversion, notably for triplet matrices. * src/dgCMatrix.c (R_to_C_Matrix): port Doug's fix and * R/Rsparse.R: reactivate .Call()s * tests/Class+Meth.R: a bit more on actual classes 2007-02-04 Douglas Bates * src/dgCMatrix.c (compressed_to_TMatrix): fix memory bug using strdup() 2007-02-03 Martin Maechler * DESCRIPTION (Version): 0.9975-10 to upload * tests/Class+Meth.R (tstMatrixClass): require coercions to specific classes less unconditionally. * R/Auxiliaries.R: get rid of as_Tsparse() and as_Rsparse() * R/Tsparse.R (triu): etc, use as(*, "TsparseMatrix") instead of as_Tsparse() * R/Rsparse.R (.R.2.T): R-level workaround using compressed_to_TMatrix. * R/Rsparse.R (.R.2.C): R-level workaround since C-level R_to_CMatrix segfaults on one platform. Eliminate most coercion method to *specific* classes, and replace with virtual classes coercions. 2007-02-01 Martin Maechler * src/init.c: export the CHM...._validate() placeholders, since they *are* called. * tests/Class+Meth.R (classCanCoerce): and starting to test all as(, ) 2007-01-30 Martin Maechler * R/Tsparse.R ([): more care when subsetting triangular Tsparse * tests/indexing.R: tested now * tests/indexing.Rout.save: updated * src/Csparse.c (Csparse_to_dense): use Rkind = -1 for PATTERN to * src/chm_common.c (chm_dense_to_SEXP): return "ngeMatrix" when appropriate. * NAMESPACE: export a trivial * R/Matrix.R: drop() Matrix-method * R/AllClass.R: moved all prototypes to virtual super classes. * R/Rsparse.R: many more coercions to have less exceptions in * tests/Class+Meth.R: * R/Ops.R (Compare): tweak for case with NA * tests/simpl.R: hence another 'FIXME' eliminated 2007-01-29 Martin Maechler * R/diagMatrix.R (solve): the obvious methods for diagonalMatrix objects. * tests/Class+Meth.R (tstMatrixClass): now testing diag(), nnzero(), and more of "!", "&", "|", all, any; coercions * R/Rsparse.R: many coercions (which enable quite a few other methods), thanks to enhancements in * src/dgCMatrix.c (R_to_CMatrix): new, and * src/dgCMatrix.c (compressed_to_TMatrix): now for (d,l,n) , symmetric & triangular and ..RMatrix objects. * src/TMatrix_as.c (Matrix_T_as_DENSE,Matrix_T_as_GENERAL): renamed file from src/dsTMatrix.c; now dealing with symmetric and triangular Tsparse coercions, both to dense and general. 2007-01-27 Martin Maechler * src/dsTMatrix.c: has now "l" and "n" methods besides the "d" ones. * R/Ops.R (Arith): o now remains sparse where sensible when the is of length > 1. 2007-01-26 Martin Maechler * R/Matrix.R ([<-): for M[] <- value: fix length 2007-01-25 Martin Maechler * R/Auxiliaries.R (n2l_Matrix): new, to be used in * R/ndenseMatrix.R: new coercions n* -> l* 2007-01-22 Martin Maechler * R/triangularMatrix.R: new file; simple triu() and tril() methods. * R/Ops.R ("Logic"): and other "Ops", many updates 2007-01-18 Martin Maechler * src/Mutils.h (SET_DimNames): new utility * R/Auxiliaries.R (nnzero): improved and now exported via * NAMESPACE: + nnzero(); length() == prod(dim(.)) method for all "Matrix" objects 2007-01-17 Martin Maechler * R/diagMatrix.R (!): fix typo. 2007-01-16 Martin Maechler * R/Auxiliaries.R (as_Csparse): and quite a few others: allow to pass class definition --> speedup * R/sparseMatrix.R: apply the above * R/Csparse.R: coercion Csparse* to dense* now preserves shape properties. * src/Mutils.h (mMatrix_as_geMatrix): new, based on * src/Mutils.c (dup_mMatrix_as_geMatrix): new; generalization of old dup_mMatrix_as_dgeMatrix), eliminating a long-standing "FIXME". * src/dense.c (dense_to_Csparse): use new mMatrix_as_geMatrix() * R/denseMatrix.R (.dense2C): based on dense_to_Csparse: name it, and use it for "sparse*" as well, since it's faster than the as_Csparse(.) way. 2007-01-15 Martin Maechler * R/Ops.R ("Logic"): more methods, notably an o one. 2007-01-12 Martin Maechler * R/Tsparse.R (.TM.repl.i.2col): new internal function to be used as method for M[ ij ] <- v * R/Csparse.R:: go via Tsparse for "M[ij] <- v" * R/Ops.R: "Compare" for (C|R)sparse: need pointer slot for all FALSE answer * R/Csparse.R (replCmat): fix the "all non-zero" case with reordering * tests/indexing.R: test it, and some of the above 2007-01-05 Martin Maechler * R/Auxiliaries.R (is_duplicatedT): new utility 2007-01-05 Douglas Bates * src/init.c (R_init_Matrix): export cholmod_scale 2006-12-30 Martin Maechler * R/zzz.R (tmp): for R >= 2.5.0, extend formals of our base::as.matrix to (x, ...) 2006-12-28 Martin Maechler * R/Ops.R ("Arith" etc): move almost all "Ops" methods to new R file; start using "Logic", hence * DESCRIPTION (Depends): R >= 2.4.1 (since we want "Logic") * NAMESPACE: import and export "Logic" 2006-12-27 Martin Maechler * src/zpotfr.f and dependencies: use LAPACK 3.1 version only needed previously to R version 2.5.0. 2006-12-26 Martin Maechler * DESCRIPTION (Date, Version): 0.9975-8, ready for release * R/Tsparse.R (replTmat): fix subassignment of triangular * R/Csparse.R (replCmat): ditto * tests/indexing.R: more tests, incl the above fix 2006-12-23 Martin Maechler * R/Auxiliaries.R (drop0): extend for non CSparse * R/Auxiliaries.R (diagU2N): should work for all sparseMatrix * src/Csparse.c (Csparse_to_Tsparse, Csparse_general_to_symmetric): use uplo correctly (!); other places: use uplo_P() macro * R/Csparse.R (replCmat): call diagU2N() when needed * R/Tsparse.R (replTmat): ditto * src/dtCMatrix.c (tCMatrix_validate): new * src/dtTMatrix.c (tTMatrix_validate): new, used in * R/AllClass.R: for validity of dtC, dsC, and dtT, dsT. * R/diagMatrix.R (replDiag): to use in [<- 2006-12-22 Martin Maechler * R/Auxiliaries.R (as_Csparse2, as_geSimpl): new functions; also more general diagU2N(). 2006-12-21 Martin Maechler * R/bind2.R: new file for all cbind2(), rbind() methods moved here from R/Matrix.R files. Better diagonal & improved sparse methods. 2006-12-20 Martin Maechler * tests/bind.R: a few more cases * R/Auxiliaries.R (.M.kind): also work for atomic vectors * R/denseMatrix.R (cbind2/rbind2): moved here (and generalized) from * R/ddenseMatrix.R (cbind2/rbind2) * R/Tsparse.R (replTmat): final(?!) fix for "[<-" .. * tests/indexing.R * tests/indexing.Rout.save: updated 2006-12-18 Martin Maechler * R/Tsparse.R (replTmat): fixed a remaining "[<-" bug in * tests/indexing.R 2006-12-15 Martin Maechler * R/sparseMatrix.R (prSpMatrix): "." alignment much improved: align with proper position of "0", i.e., right for integers. argument 'align' by default is "fancy". 2006-12-14 Martin Maechler * R/sparseMatrix.R: delegate "Compare" to "Csparse.." * R/Csparse.R: and fix "Compare" for more cases. * tests/Class+Meth.R: test some of these (m == m, m != m) 2006-12-13 Martin Maechler * R/lsparseMatrix.R: all() and any() methods * R/ldenseMatrix.R: ditto * NAMESPACE, R/Matrix.R: ditto * man/all-methods.Rd: document them minimally * tests/simple.R: add a few examples for these 2006-12-11 Martin Maechler * R/Tsparse.R ([): fix long standing typo in symmetric case * man/dsCMatrix-class.Rd: add example exhibiting the above case 2006-12-10 Douglas Bates * src/CHMfactor.c (CHMfactor_to_sparse): change LDL factorization to LL before converting to a sparse matrix. (The LDL form can be converted to a sparse matrix but it is implicitly a unit triangular matrix and a diagonal matrix overwritten on the diagonal.) 2006-12-09 Douglas Bates * src/chm_common.c (chm_factor_to_SEXP): allocate and fill the Dim slot. 2006-12-08 Douglas Bates * DESCRIPTION (Version): updated -> release 0.9975-7 * src/{init.c,chm_common.c}, inst/include/*: export cholmod_analyze_p 2006-11-30 Martin Maechler * R/diagMatrix.R (%*%): write a direct [diag o Csparse] method 2006-11-29 Douglas Bates * src/dgeMatrix.c (dgeMatrix_solve): Check error code from dgetri. * tests/dg_Matrix.R: Add Barry Rowlingson's test of a matrix that is exactly singular. 2006-11-07 Martin Maechler * DESCRIPTION (Date): updated -> release 0.9975-6 2006-11-06 Martin Maechler * R/Csparse.R (replCmat): symmetric indexing of symmetric matrix now returns symmetric. * R/zzz.R ("diag<-"): replace "diag<-" in base for R <= 2.4.x * R/Matrix.R (.M.sub.i.2col): new, for M[ cbind(i,j) ] indexing. * R/Matrix.R (.M.repl.i.2col): new, for M[ cbind(i,j) ] <- value * R/Auxiliaries.R (.type.kind): added 2006-11-04 Martin Maechler * src/cs.[ch]: updated to CSparse Version 2.0.3 by simply running src/CSparse_install.sh * R/denseMatrix.R: "[": keep symmetric on symmetric indexing. 2006-11-03 Martin Maechler * src/dsCMatrix.c (dsCMatrix_Csparse_solve): new * R/dsCMatrix.R (solve): "fully-sparse" using the above. * R/AllClass.R: "pMatrix" now also inherits from "generalMatrix" * tests/Class+Meth.R (tstMatrixClass): now assure the (important in method programming) property : ###>> Every "Matrix" is either ###>> "general*", "symmetric*", "triangular*" or "diagonal*" (where "*" stands for "Matrix") * R/Auxiliaries.R (diagU2N): now .Call()s Csparse_diagU2N for * R/dMatrix.R (Compare(,): update and * tests/validObj.R: checks for "comparison" * R/sparseMatrix.R ([): improved indexing for sparse; trying to keep [ n, n] symmmetric * tests/indexing.R: indexing for logical sparse now ok 2006-11-02 Martin Maechler * src/Tsparse.c: use xTsparse_validate() , and hence remove * src/{ltC,lsC,lgT}Matrix.[ch]: removed 2006-11-02 Martin Maechler * R/AllClass.R (Matrix-class): check length of dimnames in validity. * tests/simple.R: validObject() checking the above. * src/dgCMatrix.c (xCMatrix_validate): new, small and simple, replacing both dgCMatrix_validate and lgCM*. * src/Csparse.c (Csparse_dense_prod, etc): do not lose dimnames; fix dimnames setting in other places. * src/chm_common.c (chm_dense_to_SEXP): now can pass dimnames 2006-11-01 Martin Maechler * R/Csparse.R,src/Csparse.c, etc: tcrossprod(,) * R/sparseMatrix.R (isSymmetric): drop 'factors' slot for symmetry test, via * R/Auxiliaries.R (.as.dgC.0.factors): 2006-11-01 Douglas Bates * R/Csparse.R,src/Csparse.c,tests/matprod.R, man/CsparseMatrix-class.Rd: crossprod(, ) added 2006-10-30 Martin Maechler * tests/matprod.R: add a variation of Harri's example * R/dsparseMatrix.R: fix crossprod(, ) to *not* recursive infinitely. * R/dgCMatrix.R: + solve(, ) * tests/indexing.R: add test for the "<" bug fixed 10-27 in R/dMatrix.R 2006-10-28 Martin Maechler * tests/Class+Meth.R (tstMatrixClass): more: use non-trivial matrix if possible; test m+m == 2*m; now test dgRMatrix. * R/dgRMatrix.R (.to.dgR): a few more coercions, in order to satisfy the above test. 2006-10-27 Martin Maechler * R/Matrix.R (Ops): o method added * R/dgCMatrix.R: solve(a, b="missing") based on * src/dgCMatrix.c (dgCMatrix_matrix_solve): extend to work with RHS = NULL. * R/diagMatrix.R (diagdiagprod): extend %*% etc to ldiMatrix; add more (needed) [t]crossprod() methods. * man/ddiMatrix-class.Rd: more info, notably on 'diag' * R/Auxiliaries.R (as_CspClass): cleanup (drop0): internal utility for "Csparse_drop(*, 0)" (.bail.out.2): encourage active feedback 2006-10-26 Martin Maechler * R/dMatrix.R(Compare): new(), then slots [no validity check] * src/Csparse.c (Csparse_validate): fixed (and more efficient in non-valid or 'sorted' case). * R/dsparseMatrix.R: add "chol" method. * R/ddenseMatrix.R: ditto * R/diagMatrix.R (Ops): group methods for o * NAMESPACE (Ops) * R/diagMatrix.R (diag2T): simple utility used "higher level" coercion; deprecating direct lower level coercions. * R/*.R (seq): use seq_len() and seq_along() where possible. 2006-10-23 Martin Maechler * DESCRIPTION (Version): 0.9975-5 ready for release 2006-10-20 Douglas Bates * src/init.c (R_init_Matrix): export more cholmod CCallable functions. 2006-10-20 Martin Maechler * R/AllClass.R (corMatrix): add 'validity' check; comment out unused "LDL" class definition * NAMESPACE: mention, but do not export "LDL" class * R/corMatrix.R: new (simple), needed for R-devel with * tests/Class+Meth.R (tstMatrixClass): 1 exception for corMatrix coerce and t() exceptions for all 5 'Mat.MatFact' classes. 2006-10-19 Douglas Bates * src/chm_common.h: Add R_cholmod_start to initialize cholmod to use Rprintf and R's error handling. 2006-10-17 Martin Maechler * R/diagMatrix.R (%*%): rep(*, each = .) in Matrix %*% diagonal. * tests/matprod.R: add tests for the bug fixed. 2006-10-11 Douglas Bates * src/HBMM.[ch]: remove HarwellBoeing format for writing. * src/SOURCES_C.mkf (SOURCES_C): no longer compile iohb.c 2006-10-06 Douglas Bates * R/d[gs]CMatrix.R: deprecate the writeHB function. Use writeMM instead. 2006-10-06 Martin Maechler * DESCRIPTION (Version): 0.9975-3 * R/diagMatrix.R (bdiag): new function constructing block diagonal (sparse) matrices. * man/bdiag.Rd: docu + examples * R/Csparse.R (replCmat): calling new Csparse_drop() now. * src/Csparse.c (Csparse_general_to_symmetric, Csparse_drop): new functions * R/lsCMatrix.R: three more coercions to lsC (thanks to the above) * R/diagMatrix.R (Diagonal): '[<-' method for diag.matrices such that result is sparse or diagonal (and not dense). * man/Subassign-methods.Rd: fix examples * R/Matrix.R (Matrix): Matrix(0, *) or Matrix(*, sparse=TRUE) should always return a sparse (and not sometimes a diagonal) matrix. 2006-10-05 Martin Maechler * R/Matrix.R ([<-): also for value "Matrix" or "matrix" 2006-10-04 Douglas Bates * DESCRIPTION (Version): 0.9975-2 * inst/include/Matrix_stubs.c (M_cholmod_sparse_to_triplet): export more symbols 2006-10-02 Douglas Bates * tests/dg_Matrix.R: Simplify test taking into account new code. 2006-09-29 Martin Maechler * R/Csparse.R (replCmat): improve for missing i / j in non-simple cases * R/lsTMatrix.R: new files w/ missing methods * R/nsTMatrix.R: " 'for completeness' * tests/Class+Meth.R: a bit less 'not.ok.classes' * R/Tsparse.R (t): generalized "t" method from "dgT*" to "Tsparse*" 2006-09-28 Douglas Bates * src/dppMatrix.h: Ensure definition of dspMatrix_validate is included. * src/init.c, inst/include/{Matrix.h,Matrix_stubs.h,cholmod.h}: Export C-callable functions used in Zt_create in lme4. 2006-09-28 Martin Maechler * DESCRIPTION (Version): 0.9975-1 * tests/simple.R: less checks fail; using NA, found that our kronecker() is not base-compatible with NA's. * R/dMatrix.R: "Compare" method now implemented for all cases * R/Auxiliaries.R (indTri): == which([lower/upper].tri( * )) new utility * man/dtpMatrix-class.Rd: mention length of 'x' slot * src/dtpMatrix.c (dtpMatrix_validate): fix check * src/dspMatrix.c (dspMatrix_validate): ditto * R/dtTMatrix.R (gt2tT): fix ("l" -> "n") including coercion to [nl]tTMatrix. * R/diagMatrix.R (show): print a header line as for other classes. 2006-09-27 Martin Maechler * src/Makefile.win (SUBDIRS): fix typo 2006-09-19 Martin Maechler * DESCRIPTION (Date): ready to release 0.9975-0 to CRAN 2006-09-18 Douglas Bates * R/[CT]sparse.R (crossprod and tcrossprod): Handle the cases for x symmetric and y missing in R code using %*% (cholmod_aat doesn't accept a symmetric matrix). * tests/group-methods.R: Uncomment test of crossprod applied to lsCMatrix objects. 2006-09-18 Martin Maechler * R/AllClass.R (symmetricMatrix): add validity method (available in C for a long time). Many "n..Matrix": drop (wrong) validity arg. * src/lgCMatrix.c (lgCMatrix_validate): check 'x' slot (!) * tests/indexing.Rout.save: * tests/indexing.R: additions, mainly for 'lsparse' * R/diagMatrix.R (Diagonal) & coercion to lgTMatrix: fixes for NA case. * R/Auxiliaries.R (nz.NA): new utility now used in nnzero() 2006-09-16 Martin Maechler * R/sparseMatrix.R (prSpMatrix): print logical NAs "visibly" as 'N' (1-letter - Ok?) * tests/group-methods.R: add test for logical + NAs * R/dMatrix.R ("Compare"): fix to work with NA's * R/AllClass.R: "Cholesky" etc now inherit from MatrixFactorization. * src/lgCMatrix.c (ncsc_to_matrix): renamed from lcsc_to_matrix() which is implemented. 2006-09-15 Martin Maechler * src/chm_common.c: coerce logical <-> double instead of typecasting; needed for "l" matrix handling in cholmod. * tests/other-pkgs.R (graph): small extension in "graph" checks. * R/sparseMatrix.R (graphNEL -> Tsparse): method for weight case. (Tsp2grNEL): other fixes needed 2006-09-11 Martin Maechler * R/AllClass.R ("nMatrix"): and subclasses for "nonzero pattern" Matrices, since "lMatrix", also "lsparseM" can have NA * R/ndenseMatrix.R, etc: new source files * man/nsparseMatrix-classes.Rd, etc: new help files * tests/: adaptions * src/chm_common.c (chm_dense_to_SEXP): and others: new 'Rkind' argument: "l*" and "d*" both use CHOLMOD_REAL * src/Csparse.c, etc: ditto 2006-09-11 Douglas Bates * src/Mutils.[ch],init.c inst/include/*.h: Move the alloc_d**Matrix functions to the lme4 package. 2006-09-09 Douglas Bates * src/dsCMatrix.c (dsCMatrix_Cholesky): igoring LDL = FALSE now fixed 2006-09-09 Martin Maechler * R/lMatrix.R: new * R/sparseMatrix.R (Tsp2grNEL): do not yet use graph::foo() * R/dgeMatrix.R: do not define tcrossprod() methods for "matrix" * man/tcrossprod.Rd: ditto 2006-09-08 Douglas Bates * inst/include/Matrix_stubs.c,Matrix.h: Add declarations and stubs for exported functions * src/Makefile, src/CHOLMOD/Lib/Makefile, src/Metis,CAMD,CCOLAMD: Remove partitioning algorithms for sparse matrix reordering. The copyright on the Metis code was problematic and the methods were rarely used. * src/triplet_to_col.[ch],MMHB.[ch]: Remove triplet_to_col. Such operations are now done entirely in CHOLMOD code. 2006-09-06 Douglas Bates * src/Mutils.h: Remove functions that are no longer used. 2006-09-04 Douglas Bates * src/dtCMatrix.c (dtCMatrix_validate): rename functions. * src/DEPS.mkf: update 2006-09-02 Martin Maechler * created branches/Matrix-for-R-2.3.x; on trunk: do * DESCRIPTION (Version): 0.9975-0 (Depends): R (>= 2.4.0) 2006-09-01 Douglas Bates * R/sparseMatrix.R: Added direct method to CsparseMatrix from graphNEL 2006-09-01 Martin Maechler * R/sparseMatrix.R: add coercion from "ANY" to "sparseMatrix" * R/denseMatrix.R: add coercion from "ANY" to "denseMatrix" * R/Matrix.R ([): use nargs() to disambiguate M[i] and M[i,] 2006-08-31 Martin Maechler * R/sparseMatrix.R (Arith): moved Arith group method one-level up from "dsparse" to "sparse" and now go via "Csparse" instead of "dgC" * R/dsparseMatrix.R: ditto * R/Csparse.R: ditto 2006-08-31 Martin Maechler * R/dMatrix.R (Compare): improve availability of "<", etc * R/Auxiliaries.R (asTuniq): new; also make use of R 2.4.x print(*,max) 2006-08-30 Martin Maechler * R/dgCMatrix.R: aargh: "Arith(, numeric)" was wrong because of a 0-index which was used as 1-index (..hmm) * R/sparseMatrix.R (prSpMatrix): fix printing an all-0 sparse Matrix * R/Auxiliaries.R (all0, is0): for 0-testing in presence of NA's * R/Auxiliaries.R (isTriMat): use all0() for 0-testing. (.is.diagonal): ditto * R/lgTMatrix.R: as("matrix", "lgTMatrix"): warn about NA's * R/Matrix.R (Matrix): also work for NA data 2006-08-28 Martin Maechler * R/Matrix.R (Matrix): + 'forceCheck' argument; dimnames setting in all cases. 2006-08-27 Douglas Bates * src/dense.[ch],init.c, R/ddenseMatrix.R, man/band.Rd (ddense_band): Added triu, tril and band for ddenseMatrix objects. 2006-08-25 Martin Maechler * src/Mutils.c (dup_mMatrix_as_dgeMatrix): added all subclasses of subclasses of "ddenseMatrix" * src/init.c et al: outcomment dtrM*_as_dge* and dsyM*_as_dge*_ * R/ddenseMatrix.R et al: setAs("ddenseMatrix", "dgeMatrix", ..) instead of half dozen specialized ones. 2006-08-25 Douglas Bates * R/lmer.R (qqmath method): Bug fix provided by Emmanuel Tillard - ordering standard errors to match effects. 2006-08-24 Douglas Bates * src/lsCMatrix.c (lsCMatrix_trans): Remove lsCMatrix_chol based on R_ldl. * R/lCholCMatrix.R, src/[dl]CholCMatrix.[ch],R_ldl.[ch],Metis_utils.[ch]: removed * src/dsCMatrix.c (dsCMatrix_to_dgTMatrix): use CHOLMOD * many files in ./R and ./src: Use more general version of dup_mMatrix_as_dgeMatrix to simplify method definitions. * src/Mutils.c (dup_mMatrix_as_dgeMatrix): Add ddiMatrix, dtpMatrix, dspMatrix and dppMatrix conversions. 2006-08-23 Douglas Bates * R/AllClass.R,lCholCMatrix.R,src/SOURCES_C.mkf,init.c,NAMESPACE: Remove classes lCholCMatrix and dCholCMatrix based on R_ldl code. * src/dgeMatrix.c: Ensure 'factors' slot exists in result of dgeMatrix_crossprod (may need to do this in other places). * R/AllGeneric.R,dsCMatrix.R, src/dscMatrix.[ch]: Add Cholesky generic and method for dsCMatrix. Use CHOLMOD for chol(). 2006-08-22 Douglas Bates * src/Mutils.c (dup_mMatrix_as_dgeMatrix): updated for general types of classed Matrices, matrices or numeric or logical vectors. * src/init.c: register dup_mMatrix_as_dgeMatrix for coercions. * src/chm_common.c,Mutils.h (as_cholmod_factor): Move check_class to Mutils.h (as an inline) and change name to Matrix_check_class; fixes in as_cholmod_factor and chm_factor_to_SEXP. * src/dsCMatrix.[ch]: Use CHOLMOD for dsCMatrix_chol and dsCMatrix_matrix_solve. Comment out vestigial functions. * src/Csparse.c: use diag_P and uplo_P macros. 2006-08-21 Douglas Bates * src/lmer.c (internal_mer_RZXinv): Fix memory leak caught by valgrind. * tests/matprod.R: Add tests to verify that 'solve' and '%*%' are inverses. * src/sparseQR.c (sparseQR_validate): add new validation test, fix -Wall warnings. * src/dppMatrix.c,dtrMatrix.c,dgCMatrix.c,dgeMatrix.c,dspMatrix.c: Use dup_mMatrix_as_dgeMatrix. 2006-08-20 Douglas Bates * src/sparseQR.c: Fix thinko in sparseQR_resid_fitted. * tests/sparseQR.R: Added * man/sparseQR-class.Rd: Document methods for qr.* generics * R/sparseQR.R: Return correct # of coefs; fix cut-and-paste errors 2006-08-19 Douglas Bates * NAMESPACE, R/sparseQR.R, src/init.c,sparseQR.[ch],SOURCES_C.mkf: Added methods for sparseQR for qr.qy, qr.qty, qr.coef, qr.resid and qr.fitted. * src/Mutils.[ch]: Added dup_mMatrix_as_dgeMatrix utility * src/dgCMatrix.c: Check for ordering before storing q in dgCMatrix_QR 2006-08-18 Martin Maechler * R/AllGeneric.R: add "qr" and "chol" generics; via 'trick' since the base version has no "..." argument. * R/sparseMatrix.R (prSpMatrix): fix the triangular unit diagonal case. * R/Matrix.R: define and * NAMESPACE: export as.numeric() and as.logical() methods. Let's hope these do not badly slow down something... Finally export the zapsmall() method. 2006-08-17 Douglas Bates * src/dgCMatrix.[ch] (dgCMatrix_matrix_solve), src/init.c, R/dgCMatrix.R: solve methods for dgCMatrix and dense RHS. * src/dtCMatrix.c :Remove code that is no longer used * R/dtCMatrix.R: Use C code for diagU2N in CsparseMatrix classes 2006-08-14 Douglas Bates * src/Csparse.[ch],init.c (Csparse_to_logical): Added utilities Csparse_to_logical and Csparse_symmetric_to_general. * R/dgCMatrix.R,dsCMatrix.R,Csparse.R : Consolidate general coercion methods between CsparseMatrix and TsparseMatrix. 2006-08-14 Douglas Bates * R/dtCMatrix.R,dgCMatrix.R,Csparse.R src/init.c,dgCMatrix.[ch], Csparse.[ch],chm_common.c,dense.c : Use CHOLMOD code and methods for CsparseMatrix, TsparseMatrix, denseMatrix or matrix when possible. 2006-08-12 Douglas Bates * src/chm_common.[ch],Csparse.[ch],Tsparse.[ch],CHMfactor.c,dtTMatrix.c, dgTMatrix.c,dgCMatrix.c,dsCMatrix.c,dtTMatrix.c, R/dsTMatrix.R, Tsparse.R,Csparse.R,dgTMatrix.R,dsCMatrix.R,lsCMatrix.R: generalize conversions between TsparseMatrix, CsparseMatrix, denseMatrix and matrix. Preserve triangularity property and propagate Dimnames in the easy cases. 2006-08-10 Douglas Bates * src/lmer.c: adjust checks in glmer_init for S4SXP * tests/validObj.R: check of all(eq) should be all(eq@x) - worked before S4SXP but for the wrong reasons. 2006-08-08 Douglas Bates * src/Csparse.c (Csparse_crossprod): tcrossprod result has stype = -1. Later modified to return the upper triangle only. * R/dgTMatrix.R: Remove vestigial crossprod and tcrossprod methods. 2006-08-07 Douglas Bates * src/Csparse.c (Csparse_crossprod): Set stype on result to avoid R-level conversion to a sparse symmetric class. * R/Tsparse.R,R/Csparse.R (crossprod and tcrossprod methods): Remove conversion to sparse symmetric classes (now done in C code). 2006-08-07 Martin Maechler * R/dgCMatrix.R: disable old crossprod and tcrossprod methods * man/band.Rd: adapt the \dontshow{} unit test. 2006-08-07 Martin Maechler * DESCRIPTION (Version): 0.995-14 for CRAN * tests/other-pkgs.R: oops: library(Matrix) outside *if* ! * R/sparseMatrix.R (Tsp2grNEL): fixed Tsparse -> graph coercion * tests/other-pkgs.R: more checks, sparseMatrix -> graph * R/Auxiliaries.R (as_Tsparse, as_Rsparse): new * R/Tsparse.R (tril, triu, band): methods * R/dgRMatrix.R (tril, ...): ditto * man/band.Rd: ditto 2006-08-04 Martin Maechler * R/Matrix.R (head, tail): directly use utils:::head.matrix to be up-to-date automatically. 2006-08-03 Martin Maechler * DESCRIPTION (Version): 0.995-13 to be released to CRAN * DESCRIPTION (Lazydata): no, instead of 'yes' because it fails for: * data/CAex.R, inst/external/CAex_slots.rda: replacing data/CAex.rda * data/KNex.R, inst/external/KNex_slots.rda: replacing data/KNex.rda such that the S4 objects are always created by the current version of R and 'Matrix' class definitions. 2006-08-01 Douglas Bates * R/lmer.R (LMEoptimize method), tests/lmer.R, inst/external/test3comp.rda: Added warnings for convergence on boundary and test cases. * src/lmer.c (mer_postVar): Modified to return the variances that are marginal to the fixed effects, not conditional on them (which is what the bVar slot contents represent). 2006-07-31 Douglas Bates * NAMESPACE, src/lmer.c, R/lmer.R (hatTrace): Add the hatTrace function which calls the C function mer_hat_trace2. * man/ranef.Rd: Include description of "postVar" argument and producing a caterpillar plot. 2006-07-31 Martin Maechler * NAMESPACE: change "correlation" to "corMatrix" * R/AllClass.R: to avoid clash with S3 class in 'nlme'. * R/dpoMatrix.R: ditto * R/lmer.R: ditto 2006-07-28 Douglas Bates * src/lmer.c (internal_mer_RZXinv): Split the calculation of the RZXinv slot's contents into a separate internal function that can be used in mer_hat_trace. 2006-07-22 Martin Maechler * R/Matrix.R: Coercions "Matrix" -> (sparse|dense)Matrix via new smart * R/Auxiliaries.R (as_Csparse, as_dense, .M.shapse): new utility functions. 2006-07-21 Martin Maechler * R/Csparse.R (tril, triu, band): do return *triangular* classed matrices when appropriate; band() even symmetric ones. (replCmat): extend to potentially all "CsparseMatrix" * R/Tsparse.R (replTmat): extend to all "TsparseMatrix"; hence allow subassignment for special sparse matrices. * R/Auxiliaries.R (as_geClass): factor out the .M.kind() functionality * src/lmer.c (mer_MCMCsamp, glmer_MCMCsamp): new 'verbose' argument; in glmer_*(): print only if(verbose). speed-optimize a few places by moving REAL(.) out of loops. * src/lmer.h, src/init.h, R/lmer.R: related to above. 2006-07-20 Martin Maechler * R/Matrix.R("["): disable ("Matrix", i = "logical", j = "missing"), since that wrongly triggers also for M[ logi , ] * R/denseMatrix.R: "[" methods now also work e.g. when indexing a symmetric matrix that results in a non-symmetric one. * R/Auxiliaries.R (as_geClass): new function used in "[" above. * R/dMatrix.R: make round(M) work as round(M, 0) * R/dgTMatrix.R (image): coordinate system and axis now use 1-based indices, not 0-based ones. * R/Tsparse.R (.ind.prep for "["): get rid of max() warning. * tests/indexing.R: test it. * NAMESPACE: export isSymmetric(); has been a generic in "base" for a while; * man/isSymmetric-methods.Rd: and document it. * R/SparseM-conv.R: added coercion methods for some 'SparseM' matrices. * man/SparseM-conv.Rd: docu them * tests/other-pkgs.R: renamed from tests/graph.R and add example for 'SparseM' conversions 2006-07-17 Douglas Bates * R/Matrix.R (head): added head() and tail() methods. 2006-07-17 Martin Maechler * DESCRIPTION (Version): 0.995-12 released to CRAN 2006-07-15 Martin Maechler * tests/simple.R: add check for correct dsT -> dgT coercion; add check for correct printing of symmetric sparse matrices. * R/Auxiliaries.R (non0ind): return *all* non-0 entry indices also for sparse symmetric matrices. * src/dsTMatrix.c (dsTMatrix_as_dgTMatrix): do not copy the diagonal twice. 2006-07-11 Douglas Bates * src/dsTMatrix.c (dsTMatrix_as_dgTMatrix): Fix a case of INTEGER being applied to the x slot (detected by Brian Ripley). 2006-07-10 Martin Maechler * src/dgCMatrix.c (dgCMatrix_validate): 'p' slot must have correct length. * R/Auxiliaries.R (isTriC): fix buglet (we were 1-based!) 2006-07-08 Martin Maechler * src/lgCMatrix.c (lgCMatrix_diag): new function * R/lgCMatrix.R (diag): for new method * R/AllClass.R (TsparseMatrix): do use Tsparse_validate ==> construction of illegal "*gTMatrix" via new() should now be much less easy: * tests/Class+Meth.R: assertError() for some illegal "dgT*" * R/Matrix.R (Matrix): Matrix(0, nrow,ncol) now "goes sparse" directly. * man/Matrix.Rd: documents it. 2006-07-06 Douglas Bates * src/pedigree.c (pedigree_inbreeding): Correction in initialization. This function is not currently being used and is not fully tested. * NAMESPACE, R/{AllClass.R,lmer.R}, src/{init.c,lmer.c}: Introduced the glmer class. Added code for mcmcmsamp on glmer objects. Modified validity check on pedigree objects to account for nonparallel patterns of missingness of parents. * man/{lmer-class.Rd,mcmcsamp.Rd}: Update documentation for glmer class. 2006-07-01 Martin Maechler * R/pMatrix.R: coercion pMatrix -> Tsparse 2006-06-12 Douglas Bates * DESCRIPTION (Version): 0.995-11 released to CRAN * R/lmer.R (mcmcsamp method): Corrected arrangments of names on the output from mcmcsamp. 2006-06-10 Douglas Bates * R/lmer.R (simulestimate): added C code for calculating the trace of the hat matrix. 2006-06-09 Martin Maechler * R/diagMatrix.R (setAs): define coercion methods to sparse matrix classes. * R/sparseMatrix.R etc: multiplication of diagonal and sparse 2006-06-08 Martin Maechler * R/dgTMatrix.R (colSums): etc. All four of colSums(), rowSums(), colMeans(), rowMeans() now should work for all "Matrices". 2006-06-01 Douglas Bates * R/lmer.R (panel.ci): Add a reference line at zero and a background grid to the qqmath plot of ranef.lmer. 2006-05-30 Douglas Bates * R/lmer.R (expandSlash): Functions (non-exported) to allow nested grouping factors to be specified in the formula as (1|foo/bar). 2006-05-27 Douglas Bates * R/lmer.R (findbars and others): Change check of is.numeric to !is.language to resolve the bug reported by Jacob Wegelin. * src/pedigree.c (pedigree_inbreeding): Initial implementation of code to evaluate inbreeding coefficients without calculating T, based on code in Sargolzaei and Iwaisaki's paper. 2006-05-27 Douglas Bates * R/{lmer.R,AllGeneric.R}, src/{init.c,lmer.[ch]}: Added local generic and mer methods for isNested and denomDF. This denomDF was an attempt to emulate that in lme but I don't think that makes sense. Use the trace of the hat matrix instead. 2006-05-17 Martin Maechler * R/sparseMatrix.R: Matrix <-> graph methods: can no longer use the C code depending on a slot structure that's no longer valid. * src/dgTMatrix.c: ditto (also: src/init.c src/dgTMatrix.h) 2006-05-17 Douglas Bates * R/{AllGeneric.R,Csparse.R},man/band.Rd,NAMESPACE: changed name of lowerTriMatrix generic and methods to tril (also upper to triu) and added a general band extractor. 2006-05-16 Douglas Bates * R/pedigree.R (pedigree): Replace sire and dam values outside the allowable range with NAs. Added a corresponding check in the validity check for the pedigree class. * R/[CT]sparse.R ([t]crossprod): The result of single-argument crossprod methods now inherits from symmetricMatrix. 2006-05-15 Douglas Bates * R/AllGeneric.R (lowerTriMatrix): Added (but did not export) generics lowerTriMatrix and upperTriMatrix along with methods for the Csparse virtual class. Also added a C function Csparse_band that implements these methods by calling cholmod_band. 2006-05-15 Martin Maechler * R/Tsparse.R ("["): column or row subsetting; @Dimnames[k] got erased when it was NULL. This led to invalid subselections! 2006-04-25 Douglas Bates * R/dtCMatrix.R: avoid coercion of dtCMatrix object to dgCMatrix in method for "t" so as not to lose the unit diagonal property. 2006-04-19 Douglas Bates * R/lmer.R, R/AllGeneric.R, NAMESPACE: Remove the postVar generic and methods. This is now an option to the ranef method for the mer class. * src/cs_utils.c: Ensure that the nz component is -1 for a compressed column-oriented matrix. Minor formatting cleanup. * man/lmer-class.Rd: Document the qqmath method for ranef.lmer objects. 2006-04-19 Martin Maechler * R/Auxiliaries.R (diagU2N): new for the solve() methods in * R/dtCMatrix.R: where dgC -> dgT coercion now preserves diag = "U". 2006-04-15 Douglas Bates * src/cs.[ch],src/cs_utils.[ch] : Added Tim Davis' CSparse library in cs.[ch] and utilities to interface to that code in cs_utils.[ch]. * R/dtCMatrix.R, src/dtCMatrix.[ch] : CSparse-based solve methods for the dtCMatrix class. 2006-04-12 Douglas Bates * R/pedigree.R, R/AllClass.R, NAMESPACE: added a pedigree class and methods for it. 2006-04-12 Martin Maechler * R/dgCMatrix.R: add storage.mode(.) <- "double" for "matrix" arguments, such that M %*% 1:6 now works * Tests/matprod.R: test the above 2006-04-03 Douglas Bates * R/lmer.R (qqmath,ranef.lmer-method): added a qqmath method for the ranef.lmer class. * R/AllClass.R, NAMESPACE, R/lmer.R: Added a postVar generic and methods to extract the posterior variances from the bVar slot. 2006-03-30 Martin Maechler * R/dtCMatrix.R: allow coercion from dgC* to triangular (dtC*) * R/dsCMatrix.R: and symmetric (dsC*) 'Csparse' matrices. * R/Tsparse.R: Tsparse* -> Csparse* coercion now works and is tested in * tests/simple: (extended) * R/sparseMatrix.R (isTriangular): now using much improved * R/Auxiliaries.R (isTriC): new triangularity check for *CMatrix 2006-03-23 Douglas Bates * src/dsyMatrix.c (dsyMatrix_as_dspMatrix): Propagate DimNames (problem report from Franklin Parlamis). This should be done generally. 2006-03-21 Douglas Bates * R/AllClass.R,lmer.R: Change the name of the lmer.ranef class to ranef.lmer (like summary.lmer). Add the coef.lmer class and update the plot methods. 2006-03-20 Douglas Bates * R/lmer.R (resid and ranef methods): Added methods for the "residuals" and "resid" generic but only for linear mixed model fits. Changed the ranef method to return a list of data frames so that the plot methods now work. 2006-03-16 Douglas Bates * src/dpoMatrix.c (dpoMatrix_chol): Require n > 0 in call to dpotrf - otherwise the BLAS on Mac OS X complains and quits. * DESCRIPTION (Date): New release 2006-03-15 Martin Maechler * DESCRIPTION (Version): 0.995-6 -- to be released to CRAN * data/KNex.rda: replacing 'mm' and 'y' by KNex <- list(mm=mm, y=y) * man/KNex.Rd: and other help files * tests/*.R: several ones needed adaption * inst/doc/Comparisons.Rnw: ditto 2006-03-11 Martin Maechler * R/dgCMatrix.R (replCmat): "[<-" methods for dgCMatrix * tests/indexing.R: tests for new [<- methods for sparse matrices. 2006-03-10 Martin Maechler * R/dgTMatrix.R (replTmat): "[<-" methods for dgTMatrix * R/Tsparse.R (.ind.prep): fix out-of-range indexing 2006-03-08 Martin Maechler * R/dMatrix.R: enable things like M [ M < 10 ] * R/dgeMatrix.R: implement it 2006-03-06 Martin Maechler * R/AllClass.R: define "summary.mer" and "*.lmer" * R/lmer.R (summary): summary() computes & returns the above; * R/lmer.R (show): now works with summary() 2006-03-04 Martin Maechler * R/dgCMatrix.R: finally direct "Arith" dgC o dgC * R/Auxiliaries.R (WhichintersectInd): and other utilities to support the above 2006-02-07 Douglas Bates * R/lmer.R (lmer): fix initial values of offset and weights for glm.fit. Use glmFit$prior.weights for weights in a glmm. Allow an option usePQL = FALSE to skip the PQL steps for the Laplace method (and, in time, the AGQ method). * src/lmer.c (mer_factor): Move downdating and factoring of XtX into a separate function internal_mer_Xfactor to be able to call it from internal_bhat. 2006-01-23 Martin Maechler * tests/Class+Meth.R (tstMatrixClass): function for much better testing; now again of all actual classes. * src/Mutils.c (MAKE_TRIANGULAR_BODY, MAKE_SYMMETRIC_BODY): use macros and define make_d_matrix_* and make_i_matrix_* where _i_ is for the ldense routines: * src/ldense.c (ltrMatrix_as_lgeMatrix): provide functions * src/ldense.c (lsyMatrix_as_lgeMatrix): * R/ldenseMatrix.R: use the above in setAs(*,"lgeMatrix") 2006-01-16 Martin Maechler * R/Matrix.R (Matrix): has become much "smarter" now auto-producing many different kinds of matrices. * R/*.R: quite a few new methods were needed for R CMD check with new Matrix(). Very good for users playing around. 2006-01-15 Martin Maechler * src/dgeMatrix.c (dMatrix_validate): new * src/Mutils.c (dense_nonpacked_validate): new * src/dtrMatrix.c (dtrMatrix_validate): improved/fixed 2006-01-14 Douglas Bates * R/AllClass.R (compMatrix), (generalMatrix): new virtual classes 2006-01-07 Douglas Bates * DESCRIPTION (Version): 0.99-6 released to CRAN * src/dgBCMatrix.c (cscb_trcbsm): Fix due to Peter Dalgaard for segfault in cases with multiple non-nested grouping factors. 2006-01-03 Martin Maechler * DESCRIPTION (Version): 0.99-4 to be released to CRAN (Depends): also on 'utils' * R/AllClass.R (diagonalMatrix): new class with "ddi*" and "ldi*" * R/diagMatrix.R (Diagonal): constructor and methods for diagonal matrices * R/ltTMatrix.R: new "minimal methods" 2005-12-12 Martin Maechler * R/AllGeneric.R (tcrossprod): 2-argument version; here, and for all methods (and help files). 2005-12-09 Martin Maechler * R/Auxiliaries.R (dimNamesCheck): fixed thinko -> bug for case (dimn. op no_dimn.) 2005-11-14 Douglas Bates * DESCRIPTION (Version): 0.99-2 released to CRAN 2005-10-21 Douglas Bates * R/lmer.R (simulate method): Fixed a drop=FALSE problem reported by Julian Faraway. 2005-10-06 Martin Maechler * R/Auxiliaries.R (try_as): new utility * R/sparseMatrix.R: use try_as() in coercion to original class 2005-09-30 Martin Maechler * src/dgCMatrix.c (double_to_csc): and dgeMatrix_to_csc() 2005-09-29 Martin Maechler * R/Auxiliaries.R (dimNamesCheck): added * R/Matrix.R (as.array), (as.vector): new 2005-09-28 Martin Maechler * R/Matrix.R (Matrix): get logical argument 'sparse' with a smart default. * R/AllClass.R: move 'factors' slot toplevel "Matrix"; "pMatrix" now contains "sparseMatrix" 2005-09-26 Martin Maechler * tests/Class+Meth.R: new tests; t(t(m)) == m * src/dtCMatrix.c (tsc_transpose): add forgotten "diag" slot * src/dsTMatrix.c (dsTMatrix_as_dsCMatrix): bad typo (segfault!) * src/dtTMatrix.c (dtTMatrix_as_dtCMatrix): new * R/dspMatrix.R: typo in "t" method 2005-09-18 Douglas Bates * R/AllClass.R (TsparseMatrix), CsparseM* and RsparseM* * R/Tsparse.R: instead of R/gTMatrix.R * R/Csparse.R: new * src/Tsparse.c (Tsparse_to_Csparse): new; -> cholmod_() * src/Tsparse.c: new; many trivial methods calling cholmod_() * src/Csparse.c (Csparse_to_Tsparse), transpose, (mat|cross)prod: via cholmod 2005-09-16 Martin Maechler * R/Auxiliaries.R (non0ind): new function using new C code * src/dgCMatrix.c (compressed_non_0_ij): new utility 2005-09-15 Douglas Bates * src/chm_common.h: header file required by all C sources that call CHOLMOD functions. It defines a cholmod_common structure called 'c' whose address is passed as the last argument to (virtually) every CHOLMOD function. * src/Pattern.c: Simple example of the use of CHOLMOD. * src/init.c: initialize and finalize the cholmod_common structure. * src/Makefile: Added source packages CHOLMOD UMFPACK AMD COLAMD LDL and CCOLAMD from the U. of Florida sparse matrix library. 2005-09-08 Martin Maechler * inst/test-tools.R: new file collecting the utility functions used in ./tests/*.R * R/ddenseMatrix.R (cbind2): new methods for "numeric" and "matrix" * R/Matrix.R (cbind2): methods for NULL and missing 2005-08-31 Martin Maechler * R/AllClass.R: new "index" class for "[" and "[<-": First cut at "symmetricMatrix" and "triangularMatrix" * R/gTMatrix.R (.ind.prep): new function; Logical and character indexing now work too. * R/Matrix.R: cheap "[<-" methods for denseMatrix now work * tests/indexing.R: new, including *.Rout.save * tests/dgTMatrix.R: new 2005-08-29 Douglas Bates * src/dgTMatrix.c (graphNEL_as_dgTMatrix): Corrected the position indicator pos not being updated. Also enforced upper triangular for symmetric case. Need to coerce edges component of elements of edge list - grr! (Why don't they define their classes cleanly?) 2005-08-26 Martin Maechler * R/Matrix.R: added first "[<-" methods; not yet functional * R/denseMatrix.R: ditto * man/Subassign-methods.Rd: new help file for these 2005-08-25 Martin Maechler * DESCRIPTION (Version): 0.98-6 * R/denseMatrix.R: new file for "[" fallback methods for all dense matrices. 2005-08-19 Martin Maechler * src/lgCMatrix.c (lcsc_to_matrix): new; need for as( , "matrix") * R/pMatrix.R: coercion to "lgTMatrix" * R/gTMatrix.R: new virtual class to define "[" methods for. * man/gTMatrix-class.Rd: * General slight re-organization of where "[" methods are defined. more to come. 2005-08-18 Douglas Bates * DESCRIPTION (Version): 0.98-5 released to CRAN * src/dgTMatrix.c (graphNEL_as_dgTMatrix): add first graphNEL methods * ..... 2005-08-18 Douglas Bates * R/lmer.R: Corrected naming scheme in mcmcsamp to work with lmer or glmer objects. 2005-08-17 Martin Maechler * DESCRIPTION (Version): 0.98-4 : upload to CRAN 2005-08-16 Douglas Bates * R/HBMM.R: finish re-writing R-only code. 2005-08-15 Douglas Bates * man/externalFormats.Rd: move documentation for writeHB and writeMM here. * src/mmio.c: replace inclusion of by (suggested by Paul Roecker). * tests/validObj.R (assertError): Comment out test that is failing after recent changes in r-devel. 2005-08-11 Martin Maechler * R/AllClass.R: intermediate virtual class "denseMatrix" * man/denseMatrix-class.Rd * NAMESPACE: export it, and also export * man/unused-classes.Rd: "iMatrix", "zMatrix" and "ldenseMatrix" 2005-08-10 Douglas Bates * DESCRIPTION (Version): 0.98-3 to CRAN * src/dtrMatrix.c (dtrMatrix_validate): fixed up validation and matrix_solve code (which was really, really wrong). 2005-08-07 Douglas Bates * DESCRIPTION (Version): 0.98-2 * R/HBMM.R (readHB), (readMM): read Matrix Market formats * R/lmer.R (abbrvNms): new * R/lmer.R (mcmcsamp): allow transformed parameters * src/HBMM.c (Matrix_writeMatrixMarket): Added read/write routines for the Harwell-Boeing and the MatrixMarket formats. 2005-08-04 Martin Maechler * man/dtrMatrix-class.Rd: add examples * man/dtpMatrix-class.Rd: ditto; plus note about PROBLEM * TODO: note the dtpMatrix (docu) bug * R/zzz.R (.onLoad): assignInNamespace("as.matrix", *, "base") in order to ensure that new as.matrix() is used by old functions, e.g., svd(), qr(), eigen(), dist(),..; apply(), also matplot() or pairs(). 2005-08-03 Martin Maechler * R/lmer.R: add 'fixme' comments and move the linear vs glm check; add comments about 'control' / lmerControl() arguments 2005-07-27 Douglas Bates * man/sleepstudy.Rd: Added the sleep data set. * DESCRIPTION (Version): 0.98-1 released to CRAN 2005-07-12 Douglas Bates * man/sleepstudy.Rd: Added the sleep data set. * R/lmer.R (glmmMCMC): Added PACKAGE = "Matrix" in a couple of .Call calls that were producing spurious output. 2005-07-05 Douglas Bates * R/lmer.R (lmer): stored updated variance component estimates in mer object for the generalized model. (Bug reported by Renaud Lancelot). 2005-07-03 Douglas Bates * src/lmer.c (glmer_devAGQ): Added AGQ for single grouping factor, unidimensional case. 2005-06-08 Douglas Bates * DESCRIPTION (Version): 0.96-1 * moved lmer-class' R and C code moved from lme4 to here 2005-06-04 Douglas Bates * R/dgCMatrix.R: Call to csc_matrix_mm used undefined arguments (reported by Guissepe Ragusa ) 2005-06-02 Douglas Bates * src/Makefile.win: Forgot to update this when Makefile changed. 2005-05-11 Douglas Bates * src/dgCMatrix.c (csc_transpose): Simplified function fixing a bug reported by Kurt Hornik and Michael Hahsler. 2005-05-10 Douglas Bates * src/lgCMatrix.c (Matrix_lgClgCmm): Implementation of methods for logical sparse matrices. These will also be used in the symbolic analysis for lmer objects. * src/dsCMatrix.c (dsCMatrix_matrix_solve): Copied the dimensions of b to the result. Fixes bug reported by Jean.Coursol@math.u-psud.fr 2005-05-06 Douglas Bates * src/dgeMatrix.c (dgeMatrix_colsums): Added an implementation of colMeans, colSums, rowMeans and rowSums. 2005-04-18 Douglas Bates * src/lgCMatrix.[ch]: code for _validate method and stub for multiplication operation. * src/dgeMatrix.c (dgeMatrix_matrix_solve): Passing wrong argument to dgetrs. * src/init.c: Fix cut-and-paste error in definition of dgeMatrix_matrix_solve * src/{many files}: Tighten code by using ALLOC_SLOT. 2005-04-15 Douglas Bates * R/AllClass.R: Add lgTMatrix and lgCMatrix classes * DESCRIPTION: Eliminate import of stats. 2005-04-06 Douglas Bates * R/AllClass.R : add logical sparse matrix classes 2005-04-01 Martin Maechler * R/dgTMatrix.R: add "[" method for triplet matrices * R/sparseMatrix.R: and other sparse ones; --> add show() for sparse 2005-03-31 Douglas Bates * DESCRIPTION (Version): release 0.95-5 to CRAN * R/dMatrix.R: add %*%, crossprod and solve "fallback" methods * R/sparseMatrix.R: %*%, crossprod() * R/dgeMatrix.R: more "fallback" methods for numeric/dense matrices * man/*.Rd: move method definitions to 'Matrix' and 'dMatrix' * src/lmer.c (lmer_fitted): fix thinko 2005-03-26 Martin Maechler * R/AllClass.R: add two virtual sparse classes ``on top'' 2005-03-24 Martin Maechler * R/AllClass.R (setClass): use "VIRTUAL" for the virtual classes; correspondingly fix examples and tests/ since new() doesn't work for virtual classes. 2005-03-17 Martin Maechler * R/Matrix.R (as.matrix): method and one for unname() * tests/dpoMatrix.R: tests should now be less platform dependent; also run for R 2.1.0; using as.matrix() 2005-03-15 Douglas Bates * R/pMatrix.R: "pMatrix" class added * .... 2005-03-14 Douglas Bates * R/dtpMatrix.R: Add unpack method and an example. * src/dsyMatrix.c (dsyMatrix_trf): Add BunchKaufman factorization of general symmetric matrices and associated S4 methods. 2005-03-10 Martin Maechler + 2005-03-05 Martin Maechler * R/dgeMatrix.R (setAs): and many other files: more coercion, crossprod() and "%*%" methods added; tests, too. * tests/matprod.R: new, for testing these 2005-03-03 Douglas Bates * src/lmer.c (lmer_fitted): Added. 2005-03-02 Douglas Bates * R/dsTMatrix.R: Conversion from dsTMatrix to dsCMatrix 2005-02-28 Douglas Bates * src/*.c,po/,inst/po: Internationalization and localization of the package. * src/ldl.[ch]: Removed these as their contents are referenced in the R_ldl.c file. * src/flame.[ch]: Removed these source files. * src/dtrMatrix.c (make_array_triangular): Move to Mutils * src/LU.[ch],src/init.c: absorb in factorizations * src/Mutils.h: prepare for internationalization * src/cblas.h: move the enum definitions to Mutils.h and remove this file 2005-02-26 Martin Maechler * R/dgeMatrix.R: provide "dimnames" and "dimnames<-" methods * R/dtrMatrix.R: fix t() method * R/dgeMatrix.R: define group methods "Arith", "Math", "Math2" * NAMESPACE: export them (and import generics from "methods") * tests/group-methods.R : and test them. * src/dtrMatrix.c (dtrMatrix_as_dgeMatrix): prevent seg.fault in border case 2005-02-24 Douglas Bates * DESCRIPTION (Version): 0.95-2 released to CRAN * src/dgBCMatrix.c: * src/lmer.c: many changes * ... 2005-02-04 Martin Maechler * R/Matrix.R: add more sophisticated show() method. 2005-02-02 Douglas Bates * */* : almost complete reorganization of classes. 2005-01-26 Douglas Bates * R/AllGeneric.R: Added matrix exponential generic expm and a method for the geMatrix class. 2005-01-24 Douglas Bates * src/Makefile (clean): Remove *.a and *.so * man/cscBlocked-class.Rd: Remove reference to the lmer-class. 2005-01-23 Douglas Bates * src/lmer.c (Lind): Definition of Lind was backwards. This only had an effect in cases with more than 2 grouping factors. 2005-01-03 Douglas Bates * src/lmeRep.c (lmer_variances): change from lmeRep to lmer 2004-12-23 Douglas Bates * src/init.c (R_init_Matrix): Reorder calls to R_registerRoutines and R_useDynamicSymbols (suggested by B.D.Ripley). 2004-12-14 Douglas Bates * R/sscMatrix.R: Add determinant methods * src/triplet.[ch],src/init.c (triplet_to_matrix): Add a coercion for tripletMatrix to matrix. 2004-12-13 Douglas Bates * R/AllClass.R (.onLoad): Eliminate the bbCrosstab class, which is no longer used. * src/R_ldl.c: Created an R-specific version of the ldl.[ch] files with dynamic allocation of scratch arrays. * src/ssclme.c (ssclme_copy_ctab): Fixed bug in creation of ZtZ for multivariate random effects with multiple grouping factors. Fixes part but not all of #15. 2004-12-03 Douglas Bates * src/lmeRep.c (lmeRep_factor): order of operations for multiple scalar grouping factors corrected. 2004-11-29 Douglas Bates * src/bCrosstab.c: remove diag_update which is no longer used 2004-11-16 Douglas Bates * src/Metis_utils.c: Move metis.h include to C sources so that the .h file can be included. 2004-11-12 Douglas Bates * src/LU.c,geMatrix.c,trMatrix.c, etc.: Complete allocation of slots in NEW_OBJECT. * src/Mutils.h: Moved list of symbols to an include file 2004-11-11 Douglas Bates * src/geMutils.c (Matrix_init): remove unused function 2004-11-10 Douglas Bates * src/cscMatrix.c (csc_to_imagemat): removed unused function 2004-11-05 Douglas Bates * src/Makefile.win (SOURCES_C): Keep consistent with Makefile 2004-10-27 Douglas Bates * R/pdmatrix.R: remove PACKAGE="Matrix" in .Call calls 2004-10-04 Douglas Bates * src/init.c: Created R_init_Matrix and added registration of C routines. 2004-10-02 Douglas Bates * R/tripletMatrix.R: Force a require(lattice) for the image methods. 2004-06-15 Douglas Bates * man/trMatrix-class.Rd: Escape the % chars in .Rd files. 2004-04-20 Douglas Bates * src/Makefile.win ($(SHLIB)): Modifications per Uwe Ligges. 2004-04-19 Douglas Bates * src/ssclme.c (ssclme_update_mm): fix logic error in ssclme_update_mm 2004-04-18 Douglas Bates * src/ssclme.c (ssclme_coef, ssclme_coefGets): Create consistency in the order of unconstrained and constrained parameters. (ssclme_gradient): Added the gradients (not yet correct for multidimensional, unconstrained case). 2004-04-14 Douglas Bates * src/ssclme.c (ssclme_EMsteps): Fix logic in REML update * src/Makefile.win: Remove unneeded ranlib call 2004-04-12 Douglas Bates * DESCRIPTION (Version): New release * src/Makefile.win: Update Makefile.win to umfpack removal. 2004-04-05 Douglas Bates * src/triplet_to_col.c: Create triplet_to_col as a native function, not the version from umfpack. There were problems with the configuration of UMFPACK for 64-bit processors and there was only one umfpack routine being used so I moved it here. 2004-04-04 Douglas Bates * src/ssclme.c (ssclme_variances): New function. 2004-03-28 Douglas Bates * src/ssclme.c (ssclme_fitted): Added function. 2004-03-27 Douglas Bates * src/ssclme.c (ssclme_transfer_dimnames): Add new function to store the dimnames in the XtX and bVar slots (ssclme_update_mm): Change the dimensions of the bVar slot components and the returned value from ssclme_ranef. 2004-03-18 Douglas Bates * R/{pdMat.R,pdIdent.R,pdLogChol.R,pdMatrixLog.R,pdNatural.R}, src/{pdMat.c,pdIdent.c,pdLogChol.c,pdNatural.c}, tests/{pdCompSymm.R,pdDiag.R,pdIdent.R,pdLogChol.R,pdNatural.R}, man/{pdMat-class.Rd,pdmatrix-class.Rd,corrmatrix-class.Rd, pdDiag-class.Rd,pdIdent-class.Rd,pdNatural-class.Rd, pdLogChol-class.Rd,coefGets.Rd,pdCompSymm-class.Rd, pdfactor-class.Rd,pdFactor.Rd,pdMatrix.Rd, pdBlocked-class.Rd},AllClass.R,AllGeneric.R: Moved the pdMat classes from the lme4 package. 2004-03-02 Douglas Bates * man/ssclme-class.Rd: Update definition and documentation of the ssclme class to include the DIsqrt slot. * src/ssclme.c (ssclme_deviance): Modify order of computation (much faster using dsyrk, a level 3 BLAS routine). * src/Makefile (SUBLIBS): Change definition (K. Hornik) 2004-02-28 Douglas Bates * tests/ssclme.R: Modify the test to account for the permutation of the levels of the grouping factors. 2004-02-23 Douglas Bates * R/ssclme.R,src/ssclme.c (ssclme): Move slots of sscCrosstab slot directly into the ssclme class definition. 2004-02-22 Douglas Bates * DESCRIPTION (Date): New release * man/ssclme-class.Rd: new file. * src/ssclme.c (ssclme_loglik): major revisions in design. It works and it's fast! 2004-02-17 Douglas Bates * src/taucs/Makefile.win (lib): Change "ar" to "$(AR)" (B.Ripley) 2004-02-16 Douglas Bates * DESCRIPTION (Date): New release * NAMESPACE: Don't export ssclme. * data/ScotsSec.rda, man/ScotsSec.Rd: Add Scottish secondary school data. 2004-02-11 Douglas Bates * src/sscCrosstab.c (sscCrosstab): Added a row to the incidence to keep track of the fixed-effects and the response. Counts also gets an extra element, which is always one. * src/ldl.c: Include these routines from Tim Davis' LDL package. 2004-02-10 Douglas Bates * src/cscMatrix.c (csc_transpose): new function * src/Mutils.c (csc_sort_columns): perm/iperm confusion corrected (csc_components_transpose): new function 2004-02-06 Douglas Bates * src/triplet.c (triplet_validate): Fix Dim slot on generated triplets 2004-01-30 Douglas Bates * R/sscCrosstab.R (sscCrosstab): Added sscCrosstab generator function. * src/LU.h (MATRIX_LU_H): Add #ifndef #define ... #endif to this and all other .h files in src. * src/Makefile.win: This and other Makefile.win files contributed by Brian Ripley. 2004-01-27 Douglas Bates * R/syMatrix.R: Added methods for "%*%". * R/Hilbert.R (Hilbert): Changed Hilbert function to return a poMatrix object. 2004-01-26 Douglas Bates * man/sscChol-class.Rd,man/mm.Rd,man/y.Rd: Added man pages. 2004-01-25 Douglas Bates * inst/doc/Introduction.Rnw,Comparisons.Rnw: Added vignettes. * R/csc.R: Convert all cscMatrix classes to use Dim slot instead of nrow. 2003-12-31 Douglas Bates * src/taucs/taucs.h: Moved taucs.h, amd.h, and umfpack.h into subdirectories. 2003-12-08 Douglas Bates * src/taucs.h: Accidently referred to global header files instead of local files. 2003-12-04 Douglas Bates * R/AllClass.R: Lots of changes. Removed all the lapack++ code and methods and replaced all classes with S4 classes. 2003-04-19 Douglas Bates * R/det.R,man/det.Rd: Change name of det generic to determinant * src/R_LapackPP.cc: Change method of calculating determinants 2003-02-03 Douglas Bates * DESCRIPTION (Version): removed empty data directory as requested by CRAN maintainers. Changed version number and date. 2002-10-23 Douglas Bates * src/laindex.h: Applied patches from Brian Ripley for compilation under Windows. * Added configure.win and src/Makevars.win as requested by Brian Ripley. 2002-05-03 Douglas Bates * src/lamatrix.h: Removing pre-1.2.0 compatibility code per Kurt Hornik. 2002-04-24 Douglas Bates * configure.ac: Replaced configure.in with configure.ac contributed by Kurt Hornik. * aclocal.m4 (ac_clean_files): Replaced this with Kurt Hornik's version for R-1.5.0 2001-12-10 Douglas Bates * man/eigen.Rd: Removed the .Alias in the example Matrix/.Rinstignore0000644000176200001440000000003012545576764014040 0ustar liggesusersdoc/.*\.sty doc/.*\.tex Matrix/LICENCE0000644000176200001440000010714112702273622012512 0ustar liggesusersCopyrights ========== The Matrix package, an R package, available from CRAN or R-forge, consists of basically two parts. 1. Matrix' own C code in src/*.[ch] (apart from cs.h and cs.c), R code in R/*.R, including more in ./inst/ and ./tests/ and other directories including vignettes, documentation etc. All these have been created by Douglas Bates and Martin Maechler and hence are Copyright (C) 1999-2016 Douglas Bates and Martin Maechler 2. The Matrix package includes libraries AMD, CHOLMOD, COLAMD, CSparse and SPQR from the SuiteSparse collection of Tim Davis. All sections of that code are covered by the GPL or LGPL licenses. See the directory (inst/) doc/SuiteSparse/ for details. Douglas M. Bates, University of Wisconsin, Madison, bates@stat.wisc.edu Martin Maechler ETH Zurich, maechler@stat.math.ethz.ch | maechler@r-project.org Licences ======== 1. The Matrix package itself is licenced under "GPL-3", the GNU GENERAL PUBLIC LICENCE Version 3, see "GPL-3" below. 2. The licences of the libraries from the SuiteSparse collection mentioned are included in the respective source directories. ------------------ GPL-3 : the following is == http://www.gnu.org/licenses/gpl-3.0.txt --------------------------------------- GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The GNU General Public License is a free, copyleft license for software and other kinds of works. The licenses for most software and other practical works are designed to take away your freedom to share and change the works. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change all versions of a program--to make sure it remains free software for all its users. We, the Free Software Foundation, use the GNU General Public License for most of our software; it applies also to any other work released this way by its authors. You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for them if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs, and that you know you can do these things. To protect your rights, we need to prevent others from denying you these rights or asking you to surrender the rights. Therefore, you have certain responsibilities if you distribute copies of the software, or if you modify it: responsibilities to respect the freedom of others. For example, if you distribute copies of such a program, whether gratis or for a fee, you must pass on to the recipients the same freedoms that you received. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. Developers that use the GNU GPL protect your rights with two steps: (1) assert copyright on the software, and (2) offer you this License giving you legal permission to copy, distribute and/or modify it. For the developers' and authors' protection, the GPL clearly explains that there is no warranty for this free software. For both users' and authors' sake, the GPL requires that modified versions be marked as changed, so that their problems will not be attributed erroneously to authors of previous versions. Some devices are designed to deny users access to install or run modified versions of the software inside them, although the manufacturer can do so. This is fundamentally incompatible with the aim of protecting users' freedom to change the software. The systematic pattern of such abuse occurs in the area of products for individuals to use, which is precisely where it is most unacceptable. Therefore, we have designed this version of the GPL to prohibit the practice for those products. If such problems arise substantially in other domains, we stand ready to extend this provision to those domains in future versions of the GPL, as needed to protect the freedom of users. Finally, every program is threatened constantly by software patents. States should not allow patents to restrict development and use of software on general-purpose computers, but in those that do, we wish to avoid the special danger that patents applied to a free program could make it effectively proprietary. To prevent this, the GPL assures that patents cannot be used to render the program non-free. The precise terms and conditions for copying, distribution and modification follow. TERMS AND CONDITIONS 0. Definitions. "This License" refers to version 3 of the GNU General Public License. "Copyright" also means copyright-like laws that apply to other kinds of works, such as semiconductor masks. "The Program" refers to any copyrightable work licensed under this License. Each licensee is addressed as "you". "Licensees" and "recipients" may be individuals or organizations. To "modify" a work means to copy from or adapt all or part of the work in a fashion requiring copyright permission, other than the making of an exact copy. The resulting work is called a "modified version" of the earlier work or a work "based on" the earlier work. A "covered work" means either the unmodified Program or a work based on the Program. To "propagate" a work means to do anything with it that, without permission, would make you directly or secondarily liable for infringement under applicable copyright law, except executing it on a computer or modifying a private copy. Propagation includes copying, distribution (with or without modification), making available to the public, and in some countries other activities as well. To "convey" a work means any kind of propagation that enables other parties to make or receive copies. Mere interaction with a user through a computer network, with no transfer of a copy, is not conveying. An interactive user interface displays "Appropriate Legal Notices" to the extent that it includes a convenient and prominently visible feature that (1) displays an appropriate copyright notice, and (2) tells the user that there is no warranty for the work (except to the extent that warranties are provided), that licensees may convey the work under this License, and how to view a copy of this License. If the interface presents a list of user commands or options, such as a menu, a prominent item in the list meets this criterion. 1. Source Code. The "source code" for a work means the preferred form of the work for making modifications to it. "Object code" means any non-source form of a work. A "Standard Interface" means an interface that either is an official standard defined by a recognized standards body, or, in the case of interfaces specified for a particular programming language, one that is widely used among developers working in that language. The "System Libraries" of an executable work include anything, other than the work as a whole, that (a) is included in the normal form of packaging a Major Component, but which is not part of that Major Component, and (b) serves only to enable use of the work with that Major Component, or to implement a Standard Interface for which an implementation is available to the public in source code form. A "Major Component", in this context, means a major essential component (kernel, window system, and so on) of the specific operating system (if any) on which the executable work runs, or a compiler used to produce the work, or an object code interpreter used to run it. The "Corresponding Source" for a work in object code form means all the source code needed to generate, install, and (for an executable work) run the object code and to modify the work, including scripts to control those activities. However, it does not include the work's System Libraries, or general-purpose tools or generally available free programs which are used unmodified in performing those activities but which are not part of the work. For example, Corresponding Source includes interface definition files associated with source files for the work, and the source code for shared libraries and dynamically linked subprograms that the work is specifically designed to require, such as by intimate data communication or control flow between those subprograms and other parts of the work. The Corresponding Source need not include anything that users can regenerate automatically from other parts of the Corresponding Source. The Corresponding Source for a work in source code form is that same work. 2. Basic Permissions. All rights granted under this License are granted for the term of copyright on the Program, and are irrevocable provided the stated conditions are met. This License explicitly affirms your unlimited permission to run the unmodified Program. The output from running a covered work is covered by this License only if the output, given its content, constitutes a covered work. This License acknowledges your rights of fair use or other equivalent, as provided by copyright law. You may make, run and propagate covered works that you do not convey, without conditions so long as your license otherwise remains in force. You may convey covered works to others for the sole purpose of having them make modifications exclusively for you, or provide you with facilities for running those works, provided that you comply with the terms of this License in conveying all material for which you do not control copyright. Those thus making or running the covered works for you must do so exclusively on your behalf, under your direction and control, on terms that prohibit them from making any copies of your copyrighted material outside their relationship with you. Conveying under any other circumstances is permitted solely under the conditions stated below. Sublicensing is not allowed; section 10 makes it unnecessary. 3. Protecting Users' Legal Rights From Anti-Circumvention Law. No covered work shall be deemed part of an effective technological measure under any applicable law fulfilling obligations under article 11 of the WIPO copyright treaty adopted on 20 December 1996, or similar laws prohibiting or restricting circumvention of such measures. When you convey a covered work, you waive any legal power to forbid circumvention of technological measures to the extent such circumvention is effected by exercising rights under this License with respect to the covered work, and you disclaim any intention to limit operation or modification of the work as a means of enforcing, against the work's users, your or third parties' legal rights to forbid circumvention of technological measures. 4. Conveying Verbatim Copies. You may convey verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice; keep intact all notices stating that this License and any non-permissive terms added in accord with section 7 apply to the code; keep intact all notices of the absence of any warranty; and give all recipients a copy of this License along with the Program. You may charge any price or no price for each copy that you convey, and you may offer support or warranty protection for a fee. 5. Conveying Modified Source Versions. You may convey a work based on the Program, or the modifications to produce it from the Program, in the form of source code under the terms of section 4, provided that you also meet all of these conditions: a) The work must carry prominent notices stating that you modified it, and giving a relevant date. b) The work must carry prominent notices stating that it is released under this License and any conditions added under section 7. This requirement modifies the requirement in section 4 to "keep intact all notices". c) You must license the entire work, as a whole, under this License to anyone who comes into possession of a copy. This License will therefore apply, along with any applicable section 7 additional terms, to the whole of the work, and all its parts, regardless of how they are packaged. This License gives no permission to license the work in any other way, but it does not invalidate such permission if you have separately received it. d) If the work has interactive user interfaces, each must display Appropriate Legal Notices; however, if the Program has interactive interfaces that do not display Appropriate Legal Notices, your work need not make them do so. A compilation of a covered work with other separate and independent works, which are not by their nature extensions of the covered work, and which are not combined with it such as to form a larger program, in or on a volume of a storage or distribution medium, is called an "aggregate" if the compilation and its resulting copyright are not used to limit the access or legal rights of the compilation's users beyond what the individual works permit. Inclusion of a covered work in an aggregate does not cause this License to apply to the other parts of the aggregate. 6. Conveying Non-Source Forms. You may convey a covered work in object code form under the terms of sections 4 and 5, provided that you also convey the machine-readable Corresponding Source under the terms of this License, in one of these ways: a) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by the Corresponding Source fixed on a durable physical medium customarily used for software interchange. b) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by a written offer, valid for at least three years and valid for as long as you offer spare parts or customer support for that product model, to give anyone who possesses the object code either (1) a copy of the Corresponding Source for all the software in the product that is covered by this License, on a durable physical medium customarily used for software interchange, for a price no more than your reasonable cost of physically performing this conveying of source, or (2) access to copy the Corresponding Source from a network server at no charge. c) Convey individual copies of the object code with a copy of the written offer to provide the Corresponding Source. This alternative is allowed only occasionally and noncommercially, and only if you received the object code with such an offer, in accord with subsection 6b. d) Convey the object code by offering access from a designated place (gratis or for a charge), and offer equivalent access to the Corresponding Source in the same way through the same place at no further charge. You need not require recipients to copy the Corresponding Source along with the object code. If the place to copy the object code is a network server, the Corresponding Source may be on a different server (operated by you or a third party) that supports equivalent copying facilities, provided you maintain clear directions next to the object code saying where to find the Corresponding Source. Regardless of what server hosts the Corresponding Source, you remain obligated to ensure that it is available for as long as needed to satisfy these requirements. e) Convey the object code using peer-to-peer transmission, provided you inform other peers where the object code and Corresponding Source of the work are being offered to the general public at no charge under subsection 6d. A separable portion of the object code, whose source code is excluded from the Corresponding Source as a System Library, need not be included in conveying the object code work. A "User Product" is either (1) a "consumer product", which means any tangible personal property which is normally used for personal, family, or household purposes, or (2) anything designed or sold for incorporation into a dwelling. In determining whether a product is a consumer product, doubtful cases shall be resolved in favor of coverage. For a particular product received by a particular user, "normally used" refers to a typical or common use of that class of product, regardless of the status of the particular user or of the way in which the particular user actually uses, or expects or is expected to use, the product. A product is a consumer product regardless of whether the product has substantial commercial, industrial or non-consumer uses, unless such uses represent the only significant mode of use of the product. "Installation Information" for a User Product means any methods, procedures, authorization keys, or other information required to install and execute modified versions of a covered work in that User Product from a modified version of its Corresponding Source. The information must suffice to ensure that the continued functioning of the modified object code is in no case prevented or interfered with solely because modification has been made. If you convey an object code work under this section in, or with, or specifically for use in, a User Product, and the conveying occurs as part of a transaction in which the right of possession and use of the User Product is transferred to the recipient in perpetuity or for a fixed term (regardless of how the transaction is characterized), the Corresponding Source conveyed under this section must be accompanied by the Installation Information. But this requirement does not apply if neither you nor any third party retains the ability to install modified object code on the User Product (for example, the work has been installed in ROM). The requirement to provide Installation Information does not include a requirement to continue to provide support service, warranty, or updates for a work that has been modified or installed by the recipient, or for the User Product in which it has been modified or installed. Access to a network may be denied when the modification itself materially and adversely affects the operation of the network or violates the rules and protocols for communication across the network. Corresponding Source conveyed, and Installation Information provided, in accord with this section must be in a format that is publicly documented (and with an implementation available to the public in source code form), and must require no special password or key for unpacking, reading or copying. 7. Additional Terms. "Additional permissions" are terms that supplement the terms of this License by making exceptions from one or more of its conditions. Additional permissions that are applicable to the entire Program shall be treated as though they were included in this License, to the extent that they are valid under applicable law. If additional permissions apply only to part of the Program, that part may be used separately under those permissions, but the entire Program remains governed by this License without regard to the additional permissions. When you convey a copy of a covered work, you may at your option remove any additional permissions from that copy, or from any part of it. (Additional permissions may be written to require their own removal in certain cases when you modify the work.) You may place additional permissions on material, added by you to a covered work, for which you have or can give appropriate copyright permission. Notwithstanding any other provision of this License, for material you add to a covered work, you may (if authorized by the copyright holders of that material) supplement the terms of this License with terms: a) Disclaiming warranty or limiting liability differently from the terms of sections 15 and 16 of this License; or b) Requiring preservation of specified reasonable legal notices or author attributions in that material or in the Appropriate Legal Notices displayed by works containing it; or c) Prohibiting misrepresentation of the origin of that material, or requiring that modified versions of such material be marked in reasonable ways as different from the original version; or d) Limiting the use for publicity purposes of names of licensors or authors of the material; or e) Declining to grant rights under trademark law for use of some trade names, trademarks, or service marks; or f) Requiring indemnification of licensors and authors of that material by anyone who conveys the material (or modified versions of it) with contractual assumptions of liability to the recipient, for any liability that these contractual assumptions directly impose on those licensors and authors. All other non-permissive additional terms are considered "further restrictions" within the meaning of section 10. If the Program as you received it, or any part of it, contains a notice stating that it is governed by this License along with a term that is a further restriction, you may remove that term. If a license document contains a further restriction but permits relicensing or conveying under this License, you may add to a covered work material governed by the terms of that license document, provided that the further restriction does not survive such relicensing or conveying. If you add terms to a covered work in accord with this section, you must place, in the relevant source files, a statement of the additional terms that apply to those files, or a notice indicating where to find the applicable terms. Additional terms, permissive or non-permissive, may be stated in the form of a separately written license, or stated as exceptions; the above requirements apply either way. 8. Termination. You may not propagate or modify a covered work except as expressly provided under this License. Any attempt otherwise to propagate or modify it is void, and will automatically terminate your rights under this License (including any patent licenses granted under the third paragraph of section 11). However, if you cease all violation of this License, then your license from a particular copyright holder is reinstated (a) provisionally, unless and until the copyright holder explicitly and finally terminates your license, and (b) permanently, if the copyright holder fails to notify you of the violation by some reasonable means prior to 60 days after the cessation. Moreover, your license from a particular copyright holder is reinstated permanently if the copyright holder notifies you of the violation by some reasonable means, this is the first time you have received notice of violation of this License (for any work) from that copyright holder, and you cure the violation prior to 30 days after your receipt of the notice. Termination of your rights under this section does not terminate the licenses of parties who have received copies or rights from you under this License. If your rights have been terminated and not permanently reinstated, you do not qualify to receive new licenses for the same material under section 10. 9. Acceptance Not Required for Having Copies. You are not required to accept this License in order to receive or run a copy of the Program. Ancillary propagation of a covered work occurring solely as a consequence of using peer-to-peer transmission to receive a copy likewise does not require acceptance. However, nothing other than this License grants you permission to propagate or modify any covered work. These actions infringe copyright if you do not accept this License. Therefore, by modifying or propagating a covered work, you indicate your acceptance of this License to do so. 10. Automatic Licensing of Downstream Recipients. Each time you convey a covered work, the recipient automatically receives a license from the original licensors, to run, modify and propagate that work, subject to this License. You are not responsible for enforcing compliance by third parties with this License. An "entity transaction" is a transaction transferring control of an organization, or substantially all assets of one, or subdividing an organization, or merging organizations. If propagation of a covered work results from an entity transaction, each party to that transaction who receives a copy of the work also receives whatever licenses to the work the party's predecessor in interest had or could give under the previous paragraph, plus a right to possession of the Corresponding Source of the work from the predecessor in interest, if the predecessor has it or can get it with reasonable efforts. You may not impose any further restrictions on the exercise of the rights granted or affirmed under this License. For example, you may not impose a license fee, royalty, or other charge for exercise of rights granted under this License, and you may not initiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging that any patent claim is infringed by making, using, selling, offering for sale, or importing the Program or any portion of it. 11. Patents. A "contributor" is a copyright holder who authorizes use under this License of the Program or a work on which the Program is based. The work thus licensed is called the contributor's "contributor version". A contributor's "essential patent claims" are all patent claims owned or controlled by the contributor, whether already acquired or hereafter acquired, that would be infringed by some manner, permitted by this License, of making, using, or selling its contributor version, but do not include claims that would be infringed only as a consequence of further modification of the contributor version. For purposes of this definition, "control" includes the right to grant patent sublicenses in a manner consistent with the requirements of this License. Each contributor grants you a non-exclusive, worldwide, royalty-free patent license under the contributor's essential patent claims, to make, use, sell, offer for sale, import and otherwise run, modify and propagate the contents of its contributor version. In the following three paragraphs, a "patent license" is any express agreement or commitment, however denominated, not to enforce a patent (such as an express permission to practice a patent or covenant not to sue for patent infringement). To "grant" such a patent license to a party means to make such an agreement or commitment not to enforce a patent against the party. If you convey a covered work, knowingly relying on a patent license, and the Corresponding Source of the work is not available for anyone to copy, free of charge and under the terms of this License, through a publicly available network server or other readily accessible means, then you must either (1) cause the Corresponding Source to be so available, or (2) arrange to deprive yourself of the benefit of the patent license for this particular work, or (3) arrange, in a manner consistent with the requirements of this License, to extend the patent license to downstream recipients. "Knowingly relying" means you have actual knowledge that, but for the patent license, your conveying the covered work in a country, or your recipient's use of the covered work in a country, would infringe one or more identifiable patents in that country that you have reason to believe are valid. If, pursuant to or in connection with a single transaction or arrangement, you convey, or propagate by procuring conveyance of, a covered work, and grant a patent license to some of the parties receiving the covered work authorizing them to use, propagate, modify or convey a specific copy of the covered work, then the patent license you grant is automatically extended to all recipients of the covered work and works based on it. A patent license is "discriminatory" if it does not include within the scope of its coverage, prohibits the exercise of, or is conditioned on the non-exercise of one or more of the rights that are specifically granted under this License. You may not convey a covered work if you are a party to an arrangement with a third party that is in the business of distributing software, under which you make payment to the third party based on the extent of your activity of conveying the work, and under which the third party grants, to any of the parties who would receive the covered work from you, a discriminatory patent license (a) in connection with copies of the covered work conveyed by you (or copies made from those copies), or (b) primarily for and in connection with specific products or compilations that contain the covered work, unless you entered into that arrangement, or that patent license was granted, prior to 28 March 2007. Nothing in this License shall be construed as excluding or limiting any implied license or other defenses to infringement that may otherwise be available to you under applicable patent law. 12. No Surrender of Others' Freedom. If conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot convey a covered work so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not convey it at all. For example, if you agree to terms that obligate you to collect a royalty for further conveying from those to whom you convey the Program, the only way you could satisfy both those terms and this License would be to refrain entirely from conveying the Program. 13. Use with the GNU Affero General Public License. Notwithstanding any other provision of this License, you have permission to link or combine any covered work with a work licensed under version 3 of the GNU Affero General Public License into a single combined work, and to convey the resulting work. The terms of this License will continue to apply to the part which is the covered work, but the special requirements of the GNU Affero General Public License, section 13, concerning interaction through a network will apply to the combination as such. 14. Revised Versions of this License. The Free Software Foundation may publish revised and/or new versions of the GNU General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies that a certain numbered version of the GNU General Public License "or any later version" applies to it, you have the option of following the terms and conditions either of that numbered version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the GNU General Public License, you may choose any version ever published by the Free Software Foundation. If the Program specifies that a proxy can decide which future versions of the GNU General Public License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Program. Later license versions may give you additional or different permissions. However, no additional obligations are imposed on any author or copyright holder as a result of your choosing to follow a later version. 15. Disclaimer of Warranty. THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. Limitation of Liability. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 17. Interpretation of Sections 15 and 16. If the disclaimer of warranty and limitation of liability provided above cannot be given local legal effect according to their terms, reviewing courts shall apply local law that most closely approximates an absolute waiver of all civil liability in connection with the Program, unless a warranty or assumption of liability accompanies a copy of the Program in return for a fee. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively state the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program 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 3 of the License, or (at your option) any later version. This program 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. If not, see . Also add information on how to contact you by electronic and paper mail. If the program does terminal interaction, make it output a short notice like this when it starts in an interactive mode: Copyright (C) This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, your program's commands might be different; for a GUI interface, you would use an "about box". You should also get your employer (if you work as a programmer) or school, if any, to sign a "copyright disclaimer" for the program, if necessary. For more information on this, and how to apply and follow the GNU GPL, see . The GNU General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. But first, please read . Matrix/data/0000755000176200001440000000000014154165362012436 5ustar liggesusersMatrix/data/USCounties.R0000644000176200001440000000073513612521507014622 0ustar liggesusersstopifnot(requireNamespace("Matrix" , quietly = TRUE)) # includes 'methods' USCounties <- local({ load(system.file(file.path("external", "USCounties_slots.rda"), package = "Matrix")) ## -> 'L' r <- methods::new("dsCMatrix") `slot<-` <- methods::`slot<-` for (n in c("Dim", "i","p","x")) slot(r, n) <- L[[n]] r }) ## The reverse: if(FALSE) { L <- list() for (n in c("Dim", "i","p","x")) L[[n]] <- slot(USCounties, n) } Matrix/data/datalist0000644000176200001440000000003713517134750014165 0ustar liggesusersCAex KNex USCounties wrld_1deg Matrix/data/KNex.R0000644000176200001440000000057513612521507013430 0ustar liggesusersstopifnot(requireNamespace("Matrix" , quietly = TRUE)) # includes 'methods' KNex <- local({ load(system.file(file.path("external", "KNex_slots.rda"), package = "Matrix")) ## -> 'L' r <- list(mm = methods::new("dgCMatrix"), y = L[["y"]]) `slot<-` <- methods::`slot<-` for (n in c("Dim", "i","p","x")) ## needs methods::slot<- slot(r$mm, n) <- L[[n]] r }) Matrix/data/CAex.R0000644000176200001440000000102013612521507013365 0ustar liggesusersstopifnot(requireNamespace("Matrix" , quietly = TRUE)) # includes 'methods' CAex <- local({ load(system.file(file.path("external", "CAex_slots.rda"), package = "Matrix")) ## -> 'L' r <- methods::new("dgCMatrix") for (n in c("Dim", "i","p","x")) methods::slot(r, n) <- L[[n]] r }) ## The reverse { CAex |--> L } is if(FALSE) { sNms <- c("Dim", "i", "p", "x") L <- lapply(sNms, function(N) slot(CAex, N)); names(L) <- sNms save(L, file = "/u/maechler/R/Pkgs/Matrix/inst/external/CAex_slots.rda") } Matrix/data/wrld_1deg.R0000644000176200001440000000067313612521507014432 0ustar liggesusersstopifnot(requireNamespace("Matrix" , quietly = TRUE)) # includes 'methods' wrld_1deg <- local({ load(system.file(file.path("external", "wrld_1deg_slots.rda"), package = "Matrix")) ## -> 'L' r <- methods::new("dsCMatrix") for (n in c("Dim", "i","p","x")) methods::slot(r, n) <- L[[n]] r }) if(FALSE) {## The reverse: L <- list() for (n in c("Dim", "i","p","x")) L[[n]] <- slot(wrld_1deg, n) } Matrix/man/0000755000176200001440000000000014154165362012300 5ustar liggesusersMatrix/man/printSpMatrix.Rd0000644000176200001440000001502513647652324015423 0ustar liggesusers\name{printSpMatrix} \alias{formatSpMatrix} \alias{printSpMatrix} \alias{printSpMatrix2} \title{Format and Print Sparse Matrices Flexibly} \description{ Format and print sparse matrices flexibly. These are the \dQuote{workhorses} used by the \code{\link{format}}, \code{\link{show}} and \code{\link{print}} methods for sparse matrices. If \code{x} is large, \code{printSpMatrix2(x)} calls \code{printSpMatrix()} twice, namely, for the first and the last few rows, suppressing those in between, and also suppresses columns when \code{x} is too wide. \code{printSpMatrix()} basically prints the result of \code{formatSpMatrix()}. } \usage{ formatSpMatrix(x, digits = NULL, maxp = 1e9, cld = getClassDef(class(x)), zero.print = ".", col.names, note.dropping.colnames = TRUE, uniDiag = TRUE, align = c("fancy", "right")) printSpMatrix(x, digits = NULL, maxp = max(100L, getOption("max.print")), cld = getClassDef(class(x)), zero.print = ".", col.names, note.dropping.colnames = TRUE, uniDiag = TRUE, col.trailer = "", align = c("fancy", "right")) printSpMatrix2(x, digits = NULL, maxp = max(100L, getOption("max.print")), zero.print = ".", col.names, note.dropping.colnames = TRUE, uniDiag = TRUE, suppRows = NULL, suppCols = NULL, col.trailer = if(suppCols) "......" else "", align = c("fancy", "right"), width = getOption("width"), fitWidth = TRUE) } \arguments{ \item{x}{an \R object inheriting from class \code{\linkS4class{sparseMatrix}}.} \item{digits}{significant digits to use for printing, see \code{\link{print.default}}, the default, \code{\link{NULL}}, corresponds to using \code{\link{getOption}("digits")}.} \item{maxp}{integer, default from \code{\link{options}(max.print)}, influences how many entries of large matrices are printed at all. Typically should not be smaller than around 1000; values smaller than 100 are silently \dQuote{rounded up} to 100.}% for now \item{cld}{the class definition of \code{x}; must be equivalent to \code{\link{getClassDef}(class(x))} and exists mainly for possible speedup.} \item{zero.print}{character which should be printed for \emph{structural} zeroes. The default \code{"."} may occasionally be replaced by \code{" "} (blank); using \code{"0"} would look almost like \code{print()}ing of non-sparse matrices.} \item{col.names}{logical or string specifying if and how column names of \code{x} should be printed, possibly abbreviated. The default is taken from \code{\link{options}("sparse.colnames")} if that is set, otherwise \code{FALSE} unless there are less than ten columns. When \code{TRUE} the full column names are printed.\cr When \code{col.names} is a string beginning with \code{"abb"} or \code{"sub"} and ending with an integer \code{n} (i.e., of the form \code{"abb... "}), the column names are \code{\link{abbreviate}()}d or \code{\link{substring}()}ed to (target) length \code{n}, see the examples. } \item{note.dropping.colnames}{logical specifying, when \code{col.names} is \code{FALSE} if the dropping of the column names should be noted, \code{TRUE} by default.} \item{uniDiag}{logical indicating if the diagonal entries of a sparse unit triangular or unit-diagonal matrix should be formatted as \code{"I"} instead of \code{"1"} (to emphasize that the 1's are \dQuote{structural}).} \item{col.trailer}{a string to be appended to the right of each column; this is typically made use of by \code{\link{show}()} only, when suppressing columns.} \item{suppRows, suppCols}{logicals or \code{NULL}, for \code{printSpMatrix2()} specifying if rows or columns should be suppressed in printing. If \code{NULL}, sensible defaults are determined from \code{\link{dim}(x)} and \code{\link{options}(c("width", "max.print"))}. Setting both to \code{FALSE} may be a very bad idea.} \item{align}{a string specifying how the \code{zero.print} codes should be aligned, i.e., padded as strings. The default, \code{"fancy"}, takes some effort to align the typical \code{zero.print = "."} with the position of \code{0}, i.e., the first decimal (one left of decimal point) of the numbers printed, whereas \code{align = "right"} just makes use of \code{\link{print}(*, right = TRUE)}.} \item{width}{number, a positive integer, indicating the approximately desired (line) width of the output, see also \code{fitWidth}.} \item{fitWidth}{logical indicating if some effort should be made to match the desired \code{width} or temporarily enlarge that if deemed necessary.} } \details{ \describe{ \item{formatSpMatrix:}{ If \code{x} is large, only the first rows making up the approximately first \code{maxp} entries is used, otherwise all of \code{x}. \code{\link{.formatSparseSimple}()} is applied to (a dense version of) the matrix. Then, \code{\link{formatSparseM}} is used, unless in trivial cases or for sparse matrices without \code{x} slot.} } } \value{ \item{formatSpMatrix()}{returns a character matrix with possibly empty column names, depending on \code{col.names} etc, see above.} \item{printSpMatrix*()}{return \code{x} \emph{invisibly}, see \code{\link{invisible}}.} } \author{Martin Maechler} \seealso{the virtual class \code{\linkS4class{sparseMatrix}} and the classes extending it; maybe \code{\link{sparseMatrix}} or \code{\link{spMatrix}} as simple constructors of such matrices. The underlying utilities \code{\link{formatSparseM}} and \code{.formatSparseSimple()} (on the same page). } \examples{ f1 <- gl(5, 3, labels = LETTERS[1:5]) X <- as(f1, "sparseMatrix") X ## <==> show(X) <==> print(X) t(X) ## shows column names, since only 5 columns X2 <- as(gl(12, 3, labels = paste(LETTERS[1:12],"c",sep=".")), "sparseMatrix") X2 ## less nice, but possible: print(X2, col.names = TRUE) # use [,1] [,2] .. => does not fit ## Possibilities with column names printing: t(X2) # suppressing column names print(t(X2), col.names=TRUE) print(t(X2), zero.print = "", col.names="abbr. 1") print(t(X2), zero.print = "-", col.names="substring 2") \dontshow{% show() was slow in 0.9975-8 because of slow adjust="fancy" op <- options(max.print = 25000, width = 80) sink(print(tempfile())) M <- Matrix(0, 10000, 100) M[1,1] <- M[2,3] <- 3.14 st <- system.time(show(M)) sink() st stopifnot(st[1] < 1.0) # only 0.09 on cmath-3 options(op) } } \keyword{print} Matrix/man/externalFormats.Rd0000644000176200001440000000730214154165051015742 0ustar liggesusers\name{externalFormats} \alias{readHB} \alias{readMM} % \alias{writeHB} \alias{writeMM} \alias{writeMM,CsparseMatrix-method} \alias{writeMM,sparseMatrix-method} \title{Read and write external matrix formats} \description{ Read matrices stored in the Harwell-Boeing or MatrixMarket formats or write \code{\linkS4class{sparseMatrix}} objects to one of these formats. } \usage{ readHB(file) readMM(file) writeMM(obj, file, \dots) } \arguments{ \item{obj}{a real sparse matrix} \item{file}{for \code{writeMM} - the name of the file to be written. For \code{readHB} and \code{readMM} the name of the file to read, as a character scalar. The names of files storing matrices in the Harwell-Boeing format usually end in \code{".rua"} or \code{".rsa"}. Those storing matrices in the MatrixMarket format usually end in \code{".mtx"}. Alternatively, \code{readHB} and \code{readMM} accept connection objects.} \item{\dots}{optional additional arguments. Currently none are used in any methods.} } \value{ The \code{readHB} and \code{readMM} functions return an object that inherits from the \code{"\linkS4class{Matrix}"} class. Methods for the \code{writeMM} generic functions usually return \code{\link{NULL}} and, as a side effect, the matrix \code{obj} is written to \code{file} in the MatrixMarket format (writeMM). } \note{ The Harwell-Boeing format is older and less flexible than the MatrixMarket format. The function \code{writeHB} was deprecated and has now been removed. Please use \code{writeMM} instead. Note that these formats do \emph{not} know anything about \code{\link{dimnames}}, hence these are dropped by \code{writeMM()}. A very simple way to export small sparse matrices \code{S}, is to use \code{summary(S)} which returns a \code{\link{data.frame}} with columns \code{i}, \code{j}, and possibly \code{x}, see \code{summary} in \code{\link{sparseMatrix-class}}, and an example below. } \references{ \url{https://math.nist.gov/MatrixMarket/} \url{https://sparse.tamu.edu/}% was https://www.cise.ufl.edu/research/sparse/matrices/ } \examples{ str(pores <- readMM(system.file("external/pores_1.mtx", package = "Matrix"))) str(utm <- readHB(system.file("external/utm300.rua", package = "Matrix"))) str(lundA <- readMM(system.file("external/lund_a.mtx", package = "Matrix"))) str(lundA <- readHB(system.file("external/lund_a.rsa", package = "Matrix"))) str(jgl009 <- ## https://math.nist.gov/MatrixMarket/data/Harwell-Boeing/counterx/counterx.html readMM(system.file("external/jgl009.mtx", package = "Matrix"))) \dontrun{ ## NOTE: The following examples take quite some time ## ---- even on a fast internet connection: if(FALSE) # the URL has been corrected, but we need an un-tar step! str(sm <- readHB(gzcon(url("https://www.cise.ufl.edu/research/sparse/RB/Boeing/msc00726.tar.gz")))) } data(KNex) ## Store as MatrixMarket (".mtx") file, here inside temporary dir./folder: (MMfile <- file.path(tempdir(), "mmMM.mtx")) writeMM(KNex$mm, file=MMfile) file.info(MMfile)[,c("size", "ctime")] # (some confirmation of the file's) ## very simple export - in triplet format - to text file: data(CAex) s.CA <- summary(CAex) s.CA # shows (i, j, x) [columns of a data frame] message("writing to ", outf <- tempfile()) write.table(s.CA, file = outf, row.names=FALSE) ## and read it back -- showing off sparseMatrix(): str(dd <- read.table(outf, header=TRUE)) ## has columns (i, j, x) -> we can use via do.call() as arguments to sparseMatrix(): mm <- do.call(sparseMatrix, dd) stopifnot(all.equal(mm, CAex, tolerance=1e-15)) } \keyword{IO} \keyword{array} \keyword{algebra} Matrix/man/compMatrix-class.Rd0000644000176200001440000000306612526660171016021 0ustar liggesusers\name{compMatrix-class} \docType{class} \title{Class "compMatrix" of Composite (Factorizable) Matrices} \alias{compMatrix-class} \alias{dimnames<-,compMatrix,list-method} \alias{dimnames<-,compMatrix,NULL-method} \description{ Virtual class of \emph{composite} matrices; i.e., matrices that can be \emph{factorized}, typically as a product of simpler matrices. } \section{Objects from the Class}{A virtual Class: No objects may be created from it.} \section{Slots}{ \describe{ \item{\code{factors}:}{Object of class \code{"list"} - a list of factorizations of the matrix. Note that this is typically empty, i.e., \code{list()}, initially and is \emph{updated \bold{automagically}} whenever a matrix factorization is computed.} \item{\code{Dim}, \code{Dimnames}:}{inherited from the \code{\linkS4class{Matrix}} class, see there.} } } \section{Extends}{ Class \code{"Matrix"}, directly. } \section{Methods}{ \describe{ \item{dimnames<-}{\code{signature(x = "compMatrix", value = "list")}: set the \code{dimnames} to a \code{\link{list}} of length 2, see \code{\link{dimnames<-}}. The \code{factors} slot is currently reset to empty, as the factorization \code{dimnames} would have to be adapted, too.} } } \seealso{ The matrix factorization classes \code{"\linkS4class{MatrixFactorization}"} and their generators, \code{\link{lu}()}, \code{\link{qr}()}, \code{\link{chol}()} and \code{\link{Cholesky}()}, \code{\link{BunchKaufman}()}, \code{\link{Schur}()}. } %% FIXME: add: % \examples{ % % } \keyword{classes} Matrix/man/band.Rd0000644000176200001440000001261114127645633013500 0ustar liggesusers\name{band} \docType{methods} \alias{band-methods} \alias{tril-methods} \alias{triu-methods} \alias{band,CsparseMatrix-method} \alias{tril,CsparseMatrix-method} \alias{triu,CsparseMatrix-method} \alias{band,RsparseMatrix-method} \alias{tril,RsparseMatrix-method} \alias{triu,RsparseMatrix-method} \alias{band,TsparseMatrix-method} \alias{tril,TsparseMatrix-method} \alias{triu,TsparseMatrix-method} %FIXME! \alias{band,diagonalMatrix-method} \alias{tril,diagonalMatrix-method} \alias{triu,diagonalMatrix-method} \alias{tril,dsCMatrix-method} \alias{tril,lsCMatrix-method} \alias{tril,nsCMatrix-method} \alias{triu,dsCMatrix-method} \alias{triu,lsCMatrix-method} \alias{triu,nsCMatrix-method} \alias{band,ddenseMatrix-method} \alias{tril,ddenseMatrix-method} \alias{triu,ddenseMatrix-method} \alias{band,denseMatrix-method} \alias{tril,denseMatrix-method} \alias{triu,denseMatrix-method} \alias{band,matrix-method} \alias{tril,matrix-method} \alias{triu,matrix-method} % Begin{UGLY-disAMBIGUATION-hack} -- in ../R/triangularMatrix.R % we would want to define 'triangularMatrix' methods, but they ambiguate with the above! % \alias{tril,triangularMatrix-method} % \alias{triu,triangularMatrix-method} \alias{tril,dtCMatrix-method} \alias{tril,dtRMatrix-method} \alias{tril,dtTMatrix-method} \alias{tril,dtpMatrix-method} \alias{tril,dtrMatrix-method} \alias{tril,ltCMatrix-method} \alias{tril,ltRMatrix-method} \alias{tril,ltTMatrix-method} \alias{tril,ltpMatrix-method} \alias{tril,ltrMatrix-method} \alias{tril,ntCMatrix-method} \alias{tril,ntRMatrix-method} \alias{tril,ntTMatrix-method} \alias{tril,ntpMatrix-method} \alias{tril,ntrMatrix-method} \alias{tril,itTMatrix-method} \alias{tril,itCMatrix-method} \alias{tril,itRMatrix-method} \alias{triu,dtCMatrix-method} \alias{triu,dtRMatrix-method} \alias{triu,dtTMatrix-method} \alias{triu,dtpMatrix-method} \alias{triu,dtrMatrix-method} \alias{triu,ltCMatrix-method} \alias{triu,ltRMatrix-method} \alias{triu,ltTMatrix-method} \alias{triu,ltpMatrix-method} \alias{triu,ltrMatrix-method} \alias{triu,ntCMatrix-method} \alias{triu,ntRMatrix-method} \alias{triu,ntTMatrix-method} \alias{triu,ntpMatrix-method} \alias{triu,ntrMatrix-method} \alias{triu,itTMatrix-method} \alias{triu,itCMatrix-method} \alias{triu,itRMatrix-method} % End{UGLY-disAMBIGUATION-hack} % \alias{band} \alias{tril} \alias{triu} \title{Extract bands of a matrix} \description{ Returns a new matrix formed by extracting the lower triangle (\code{tril}) or the upper triangle (\code{triu}) or a general band relative to the diagonal (\code{band}), and setting other elements to zero. The general forms of these functions include integer arguments to specify how many diagonal bands above or below the main diagonal are not set to zero. } \usage{ band(x, k1, k2, \dots) tril(x, k = 0, \dots) triu(x, k = 0, \dots) } \arguments{ \item{x}{a matrix-like object} \item{k,k1,k2}{integers specifying the diagonal bands that will not be set to zero. These are given relative to the main diagonal, which is \code{k=0}. A negative value of \code{k} indicates a diagonal below the main diagonal and a positive value indicates a diagonal above the main diagonal.} \item{\dots}{Optional arguments used by specific methods. (None used at present.)} } \value{ An object of an appropriate matrix class. The class of the value of \code{tril} or \code{triu} inherits from \code{\linkS4class{triangularMatrix}} when appropriate. Note that the result is of class \code{\linkS4class{sparseMatrix}} only if \code{x} is. } \section{Methods}{ \describe{ \item{x = "CsparseMatrix"}{method for compressed, sparse, column-oriented matrices.} \item{x = "TsparseMatrix"}{method for sparse matrices in triplet format.} \item{x = "RsparseMatrix"}{method for compressed, sparse, row-oriented matrices.} \item{x = "ddenseMatrix"}{method for dense numeric matrices, including packed numeric matrices.} } } \seealso{ \code{\link{bandSparse}} for the \emph{construction} of a banded sparse matrix directly from its non-zero diagonals. } \examples{ ## A random sparse matrix : set.seed(7) m <- matrix(0, 5, 5) m[sample(length(m), size = 14)] <- rep(1:9, length=14) (mm <- as(m, "CsparseMatrix")) tril(mm) # lower triangle tril(mm, -1) # strict lower triangle triu(mm, 1) # strict upper triangle band(mm, -1, 2) # general band (m5 <- Matrix(rnorm(25), nc = 5)) tril(m5) # lower triangle tril(m5, -1) # strict lower triangle triu(m5, 1) # strict upper triangle band(m5, -1, 2) # general band (m65 <- Matrix(rnorm(30), nc = 5)) # not square triu(m65) # result not "dtrMatrix" unless square (sm5 <- crossprod(m65)) # symmetric band(sm5, -1, 1)# "dsyMatrix": symmetric band preserves symmetry property as(band(sm5, -1, 1), "sparseMatrix")# often preferable (sm <- round(crossprod(triu(mm/2)))) # sparse symmetric ("dsC*") band(sm, -1,1) # remains "dsC", *however* band(sm, -2,1) # -> "dgC" %% Problem is the underlying cholmod_band() which really does symmetric %% banding *only* *if* the matrix is cholmod-symmetric i.e. 'stype != 0' %% \dontshow{ ## this uses special methods (x.x <- crossprod(mm)) tril(x.x) xx <- tril(x.x) + triu(x.x, 1) ## the same as x.x (but stored differently): txx <- t(as(xx, "symmetricMatrix")) stopifnot(identical(triu(x.x), t(tril(x.x))), identical(class(x.x), class(txx)), identical(as(x.x, "generalMatrix"), as(txx, "generalMatrix"))) } } \keyword{methods} \keyword{algebra} Matrix/man/expand.Rd0000644000176200001440000000170014041756722014045 0ustar liggesusers\name{expand} \title{Expand a (Matrix) Decomposition into Factors} \alias{expand} \usage{ expand(x, \dots) } \description{ Expands decompositions stored in compact form into factors. } \arguments{ \item{x}{a matrix decomposition.} \item{\dots}{further arguments passed to or from other methods.} } \value{ The expanded decomposition, typically a list of matrix factors. } \details{ This is a generic function with special methods for different types of decompositions, see \code{\link{showMethods}(expand)} to list them all. } \note{ Factors for decompositions such as \code{lu} and \code{qr} can be stored in a compact form. The function \code{expand} allows all factors to be fully expanded. } \seealso{ The LU \code{\link{lu}}, and the \code{\link{Cholesky}} decompositions which have \code{expand} methods; \code{\link{facmul}}. } \examples{ (x <- Matrix(round(rnorm(9),2), 3, 3)) (ex <- expand(lux <- lu(x))) } \keyword{algebra} Matrix/man/all.equal-methods.Rd0000644000176200001440000000344212272147560016110 0ustar liggesusers\name{all.equal-methods} \title{Matrix Package Methods for Function all.equal()} \docType{methods} \alias{all.equal-methods} % \alias{all.equal,Matrix,Matrix-method} \alias{all.equal,Matrix,ANY-method} \alias{all.equal,ANY,Matrix-method} \alias{all.equal,sparseMatrix,sparseMatrix-method} \alias{all.equal,sparseMatrix,ANY-method} \alias{all.equal,ANY,sparseMatrix-method} \alias{all.equal,sparseVector,sparseVector-method} \alias{all.equal,sparseMatrix,sparseVector-method} \alias{all.equal,sparseVector,sparseMatrix-method} \alias{all.equal,sparseVector,ANY-method} \alias{all.equal,ANY,sparseVector-method} \alias{all.equal,abIndex,abIndex-method} \alias{all.equal,abIndex,numLike-method} \alias{all.equal,numLike,abIndex-method} % \description{ Methods for function \code{\link{all.equal}()} (from \R package \pkg{base}) are defined for all \code{\linkS4class{Matrix}} classes. } \section{Methods}{ \describe{ \item{target = "Matrix", current = "Matrix"}{\ } \item{target = "ANY", current = "Matrix"}{\ } \item{target = "Matrix", current = "ANY"}{these three methods are simply using \code{\link{all.equal.numeric}} directly and work via \code{\link{as.vector}()}.} } There are more methods, notably also for \code{"\linkS4class{sparseVector}"}'s, see \code{showMethods("all.equal")}. } \examples{ showMethods("all.equal") (A <- spMatrix(3,3, i= c(1:3,2:1), j=c(3:1,1:2), x = 1:5)) ex <- expand(lu. <- lu(A)) stopifnot( all.equal(as(A[lu.@p + 1L, lu.@q + 1L], "CsparseMatrix"), lu.@L \%*\% lu.@U), with(ex, all.equal(as(P \%*\% A \%*\% Q, "CsparseMatrix"), L \%*\% U)), with(ex, all.equal(as(A, "CsparseMatrix"), t(P) \%*\% L \%*\% U \%*\% t(Q)))) } \keyword{methods} \keyword{arith} Matrix/man/nnzero.Rd0000644000176200001440000000614412521705645014107 0ustar liggesusers\name{nnzero} \title{The Number of Non-Zero Values of a Matrix} \alias{nnzero} \alias{nnzero,ANY-method} \alias{nnzero,denseMatrix-method} \alias{nnzero,diagonalMatrix-method} \alias{nnzero,indMatrix-method} \alias{nnzero,sparseMatrix-method} \alias{nnzero,CHMfactor-method} \description{ Returns the number of non-zero values of a numeric-like \R object, and in particular an object \code{x} inheriting from class \code{\linkS4class{Matrix}}. } \usage{ nnzero(x, na.counted = NA) } \arguments{ \item{x}{an \R object, typically inheriting from class \code{\linkS4class{Matrix}} or \code{\link{numeric}}.} \item{na.counted}{a \code{\link{logical}} describing how \code{\link{NA}}s should be counted. There are three possible settings for \code{na.counted}: \describe{ \item{TRUE}{\code{NA}s \emph{are} counted as non-zero (since \dQuote{they are not zero}).} \item{NA}{(default)the result will be \code{NA} if there are \code{NA}'s in \code{x} (since \dQuote{NA's are not known, i.e., \emph{may be} zero}).} \item{FALSE}{\code{NA}s are \emph{omitted} from \code{x} before the non-zero entries are counted.} } For sparse matrices, you may often want to use \code{na.counted = TRUE}. } } % \details{ % } \section{Methods}{ \describe{ \item{\code{signature(x = "ANY")}}{the default method for non-\code{\linkS4class{Matrix}} class objects, simply counts the number \code{0}s in \code{x}, counting \code{NA}'s depending on the \code{na.counted} argument, see above.} \item{\code{signature(x = "denseMatrix")}}{conceptually the same as for traditional \code{\link{matrix}} objects, care has to be taken for \code{"\linkS4class{symmetricMatrix}"} objects.} \item{\code{signature(x = "diagonalMatrix")}, and \code{signature(x = "indMatrix")}}{fast simple methods for these special \code{"sparseMatrix"} classes.} \item{\code{signature(x = "sparseMatrix")}}{typically, the most interesting method, also carefully taking \code{"\linkS4class{symmetricMatrix}"} objects into account.} } } \value{ the number of non zero entries in \code{x} (typically \code{\link{integer}}). Note that for a \emph{symmetric} sparse matrix \code{S} (i.e., inheriting from class \code{\linkS4class{symmetricMatrix}}), \code{nnzero(S)} is typically \emph{twice} the \code{length(S@x)}. } %\author{Martin} \seealso{The \code{\linkS4class{Matrix}} class also has a \code{\link{length}} method; typically, \code{length(M)} is much larger than \code{nnzero(M)} for a sparse matrix M, and the latter is a better indication of the \emph{size} of \code{M}. \code{\link{drop0}}, \code{\link{zapsmall}}. } \examples{ m <- Matrix(0+1:28, nrow = 4) m[-3,c(2,4:5,7)] <- m[ 3, 1:4] <- m[1:3, 6] <- 0 (mT <- as(m, "dgTMatrix")) nnzero(mT) (S <- crossprod(mT)) nnzero(S) str(S) # slots are smaller than nnzero() stopifnot(nnzero(S) == sum(as.matrix(S) != 0))# failed earlier data(KNex) M <- KNex$mm class(M) dim(M) length(M); stopifnot(length(M) == prod(dim(M))) nnzero(M) # more relevant than length ## the above are also visible from str(M) } \keyword{attribute} Matrix/man/Matrix-class.Rd0000644000176200001440000001773713141330160015136 0ustar liggesusers\name{Matrix-class} \title{Virtual Class "Matrix" Class of Matrices} \docType{class} \alias{Matrix-class} \alias{!,Matrix-method} %% Group methods: \alias{-,Matrix,missing-method} \alias{+,Matrix,missing-method} \alias{Arith,Matrix,Matrix-method} \alias{Ops,Matrix,Matrix-method} \alias{Ops,Matrix,ANY-method} \alias{Ops,ANY,Matrix-method} \alias{Ops,Matrix,NULL-method} \alias{Ops,NULL,Matrix-method} \alias{Ops,Matrix,matrix-method} \alias{Ops,matrix,Matrix-method} \alias{Ops,logical,Matrix-method} \alias{Ops,Matrix,logical-method} \alias{Logic,logical,Matrix-method} \alias{Logic,Matrix,logical-method} \alias{Logic,Matrix,ANY-method} \alias{Logic,ANY,Matrix-method} \alias{Summary,Matrix-method} \alias{Math2,Matrix-method} \alias{mean,Matrix-method} % "[" ---> Xtrct-methods.Rd % "[<-" ---> Subassign-methods.Rd %\alias{solve,...} --> solve-methods.Rd %\alias{\%*%,... } --> matrix-products.Rd \alias{cbind2,ANY,Matrix-method} \alias{cbind2,Matrix,ANY-method} \alias{cbind2,Matrix,Matrix-method} \alias{cbind2,Matrix,NULL-method} \alias{cbind2,Matrix,atomicVector-method} \alias{cbind2,Matrix,missing-method} \alias{cbind2,NULL,Matrix-method} \alias{cbind2,atomicVector,Matrix-method} \alias{rbind2,ANY,Matrix-method} \alias{rbind2,Matrix,ANY-method} \alias{rbind2,Matrix,Matrix-method} \alias{rbind2,Matrix,NULL-method} \alias{rbind2,Matrix,atomicVector-method} \alias{rbind2,Matrix,missing-method} \alias{rbind2,NULL,Matrix-method} \alias{rbind2,atomicVector,Matrix-method} % \alias{cov2cor,Matrix-method} \alias{det}% "the function" (our copy of base::det) \alias{determinant,Matrix,missing-method} \alias{determinant,Matrix,logical-method} \alias{diag,Matrix-method} \alias{drop,Matrix-method} \alias{head,Matrix-method} \alias{tail,Matrix-method} \alias{diff,Matrix-method} \alias{dim,Matrix-method} \alias{dim<-,Matrix-method} \alias{dimnames,Matrix-method} \alias{dimnames<-,Matrix,list-method} \alias{dimnames<-,Matrix,NULL-method} \alias{length,Matrix-method} \alias{show,Matrix-method} \alias{as.array,Matrix-method} \alias{as.matrix,Matrix-method} \alias{as.vector,Matrix-method} \alias{as.numeric,Matrix-method} \alias{as.logical,Matrix-method} \alias{t,Matrix-method} \alias{unname,Matrix-method} \alias{coerce,Matrix,vector-method} \alias{coerce,Matrix,numeric-method} \alias{coerce,Matrix,logical-method} \alias{coerce,Matrix,integer-method} \alias{coerce,Matrix,complex-method} % \alias{coerce,Matrix,matrix-method}% \alias{coerce,matrix,Matrix-method} \alias{coerce,ANY,Matrix-method} \alias{coerce,Matrix,denseMatrix-method} \alias{coerce,Matrix,CsparseMatrix-method} \alias{coerce,Matrix,sparseMatrix-method} %\alias{solve,Matrix,....-method}--> ./solve-methods.Rd \alias{rep,Matrix-method} \alias{svd,Matrix-method}% only if(.Matrix.avoiding.as.matrix) \alias{unname,Matrix,missing-method} % Fake entries - so users find this: \alias{print.Matrix} % \description{ The \code{Matrix} class is a class contained by all actual classes in the \pkg{Matrix} package. It is a \dQuote{virtual} class. } \section{Slots}{ Common to \emph{all} matrix objects in the package: \describe{ \item{\code{Dim}:}{Object of class \code{"integer"} - the dimensions of the matrix - must be an integer vector with exactly two non-negative values.} \item{\code{Dimnames}:}{list of length two; each component containing NULL or a \code{\link{character}} vector length equal the corresponding \code{Dim} element.} } } \section{Methods}{ \describe{ \item{determinant}{\code{signature(x = "Matrix", logarithm = "missing")}: and} \item{determinant}{\code{signature(x = "Matrix", logarithm = "logical")}: compute the (\eqn{\log}) determinant of \code{x}. The method chosen depends on the actual Matrix class of \code{x}. Note that \code{\link[base]{det}} also works for all our matrices, calling the appropriate \code{determinant()} method. The \code{Matrix::det} is an exact copy of \code{base::det}, but in the correct namespace, and hence calling the S4-aware version of \code{determinant()}.).} \item{diff}{\code{signature(x = "Matrix")}: As \code{\link{diff}()} for traditional matrices, i.e., applying \code{diff()} to each column.} \item{dim}{\code{signature(x = "Matrix")}: extract matrix dimensions \code{\link{dim}}.} \item{dim<-}{\code{signature(x = "Matrix", value = "ANY")}: where \code{value} is integer of length 2. Allows to \emph{reshape} Matrix objects, but only when \code{prod(value) == prod(dim(x))}.} \item{dimnames}{\code{signature(x = "Matrix")}: extract \code{\link{dimnames}}.} \item{dimnames<-}{\code{signature(x = "Matrix", value = "list")}: set the \code{dimnames} to a \code{\link{list}} of length 2, see \code{\link{dimnames<-}}.} \item{length}{\code{signature(x = "Matrix")}: simply defined as \code{prod(dim(x))} (and hence of mode \code{"double"}).} \item{show}{\code{signature(object = "Matrix")}: \code{\link{show}} method for \code{\link{print}}ing. For printing \emph{sparse} matrices, see \code{\link{printSpMatrix}}.} \item{image}{\code{signature(object = "Matrix")}: draws an \code{\link{image}} of the matrix entries, using \code{\link[lattice]{levelplot}()} from package \pkg{lattice}.} \item{head}{\code{signature(object = "Matrix")}: return only the \emph{\dQuote{head}}, i.e., the first few rows.} \item{tail}{\code{signature(object = "Matrix")}: return only the \emph{\dQuote{tail}}, i.e., the last few rows of the respective matrix.} \cr %------------------------------------ \item{as.matrix, as.array}{\code{signature(x = "Matrix")}: the same as \code{as(x, "matrix")}; see also the note below.} \item{as.vector}{\code{signature(x = "Matrix", mode = "missing")}: \code{as.vector(m)} should be identical to \code{as.vector(as(m, "matrix"))}, implemented more efficiently for some subclasses.} \item{as(x, "vector"), as(x, "numeric")}{etc, similarly.} \item{coerce}{\code{signature(from = "ANY", to = "Matrix")}: This relies on a correct \code{\link{as.matrix}()} method for \code{from}.} } There are many more methods that (conceptually should) work for all \code{"Matrix"} objects, e.g., \code{\link{colSums}}, \code{\link{rowMeans}}. Even \pkg{base} functions may work automagically (if they first call \code{\link{as.matrix}()} on their principal argument), e.g., \code{\link{apply}}, \code{\link{eigen}}, \code{\link{svd}} or \code{\link{kappa}} all do work via coercion to a \dQuote{traditional} (dense) \code{\link{matrix}}. %% --> ../tests/base-matrix-fun.R } \note{ %% Matrix.avoding.as.matrix is in __contradiction__ to this (since 2005-09-30 !): Loading the \code{Matrix} namespace \dQuote{overloads} \code{\link{as.matrix}} and \code{\link{as.array}} in the \pkg{base} namespace by the equivalent of \code{function(x) as(x, "matrix")}. Consequently, \code{as.matrix(m)} or \code{as.array(m)} will properly work when \code{m} inherits from the \code{"Matrix"} class --- \emph{also} for functions in package \pkg{base} and other packages. E.g., \code{\link{apply}} or \code{\link{outer}} can therefore be applied to \code{"Matrix"} matrices. } %\references{} \author{Douglas Bates \email{bates@stat.wisc.edu} and Martin Maechler} \seealso{ the classes \code{\linkS4class{dgeMatrix}}, \code{\linkS4class{dgCMatrix}}, and function \code{\link{Matrix}} for construction (and examples). Methods, e.g., for \code{\link[=kronecker-methods]{kronecker}}. } \examples{ slotNames("Matrix") cl <- getClass("Matrix") names(cl@subclasses) # more than 40 .. showClass("Matrix")#> output with slots and all subclasses (M <- Matrix(c(0,1,0,0), 6, 4)) dim(M) diag(M) cm <- M[1:4,] + 10*Diagonal(4) diff(M) ## can reshape it even : dim(M) <- c(2, 12) M stopifnot(identical(M, Matrix(c(0,1,0,0), 2,12)), all.equal(det(cm), determinant(as(cm,"matrix"), log=FALSE)$modulus, check.attributes=FALSE)) } \keyword{classes} \keyword{algebra} Matrix/man/lsyMatrix-class.Rd0000644000176200001440000000457612001034107015657 0ustar liggesusers\name{lsyMatrix-class} \title{Symmetric Dense Logical Matrices} \docType{class} \alias{lspMatrix-class} \alias{lsyMatrix-class} % \alias{coerce,lspMatrix,dspMatrix-method} \alias{coerce,lspMatrix,lsyMatrix-method} \alias{coerce,lspMatrix,lgeMatrix-method} \alias{coerce,lsyMatrix,dsyMatrix-method} \alias{coerce,lsyMatrix,lgeMatrix-method} \alias{coerce,lsyMatrix,lspMatrix-method} \alias{coerce,matrix,lsyMatrix-method} \alias{coerce,matrix,lspMatrix-method} \alias{diag,lspMatrix-method} \alias{diag,lsyMatrix-method} \alias{diag<-,lspMatrix-method} \alias{diag<-,lsyMatrix-method} \alias{t,lspMatrix-method} \alias{t,lsyMatrix-method} % \description{ The \code{"lsyMatrix"} class is the class of symmetric, dense logical matrices in non-packed storage and \code{"lspMatrix"} is the class of of these in packed storage. In the packed form, only the upper triangle or the lower triangle is stored. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("lsyMatrix", ...)}. } \section{Slots}{ \describe{ \item{\code{uplo}:}{Object of class \code{"character"}. Must be either "U", for upper triangular, and "L", for lower triangular.} \item{\code{x}:}{Object of class \code{"logical"}. The logical values that constitute the matrix, stored in column-major order.} \item{\code{Dim},\code{Dimnames}:}{The dimension (a length-2 \code{"integer"}) and corresponding names (or \code{NULL}), see the \code{\linkS4class{Matrix}} class.} \item{\code{factors}:}{Object of class \code{"list"}. A named list of factorizations that have been computed for the matrix.} } } \section{Extends}{ Both extend classes \code{"\linkS4class{ldenseMatrix}"} and \code{"\linkS4class{symmetricMatrix}"}, directly; further, class \code{"Matrix"} and others, \emph{in}directly. Use \code{\link{showClass}("lsyMatrix")}, e.g., for details. } \section{Methods}{ Currently, mainly \code{\link{t}()} and coercion methods (for \code{\link{as}(.)}; use, e.g., \code{\link{showMethods}(class="dsyMatrix")} for details. } %\references{} %\author{} \seealso{ \code{\linkS4class{lgeMatrix}}, \code{\linkS4class{Matrix}}, \code{\link[base]{t}} } \examples{ (M2 <- Matrix(c(TRUE, NA,FALSE,FALSE), 2,2)) # logical dense (ltr) str(M2) # can (sM <- M2 | t(M2)) # "lge" as(sM, "lsyMatrix") str(sM <- as(sM, "lspMatrix")) # packed symmetric } \keyword{classes} Matrix/man/Hilbert.Rd0000644000176200001440000000107010435070553014151 0ustar liggesusers\name{Hilbert} \alias{Hilbert} \title{Generate a Hilbert matrix} \description{ Generate the \code{n} by \code{n} symmetric Hilbert matrix. Because these matrices are ill-conditioned for moderate to large \code{n}, they are often used for testing numerical linear algebra code. } \usage{ Hilbert(n) } \arguments{ \item{n}{a non-negative integer.} } \value{ the \code{n} by \code{n} symmetric Hilbert matrix as a \code{"dpoMatrix"} object. } \seealso{the class \code{\linkS4class{dpoMatrix}}} \examples{ Hilbert(6) } \keyword{array} \keyword{algebra} Matrix/man/ldenseMatrix-class.Rd0000644000176200001440000000365712622367447016352 0ustar liggesusers\name{ldenseMatrix-class} \title{Virtual Class "ldenseMatrix" of Dense Logical Matrices} \docType{class} \alias{ldenseMatrix-class} % Group \alias{!,ldenseMatrix-method} \alias{Ops,ldenseMatrix,ldenseMatrix-method} \alias{Logic,ldenseMatrix,lsparseMatrix-method} \alias{Logic,lsparseMatrix,ldenseMatrix-method} \alias{Summary,ldenseMatrix-method} % purely "sparse" are in ./lsparseMatrix-classes.Rd %%-- Matrix products: ---> ./matrix-products.Rd \alias{as.logical,ldenseMatrix-method} \alias{as.vector,ldenseMatrix-method} \alias{coerce,matrix,ldenseMatrix-method} \alias{coerce,ldenseMatrix,matrix-method} \alias{diag,ldenseMatrix-method} \alias{norm,ldenseMatrix,character-method} \alias{which,ldenseMatrix-method} \description{ \code{ldenseMatrix} is the virtual class of all dense \bold{l}ogical (S4) matrices. It extends both \code{\linkS4class{denseMatrix}} and \code{\linkS4class{lMatrix}} directly. } \section{Slots}{ \describe{ \item{\code{x}:}{logical vector containing the entries of the matrix.} \item{\code{Dim}, \code{Dimnames}:}{see \code{\linkS4class{Matrix}}.} } } \section{Extends}{ Class \code{"lMatrix"}, directly. Class \code{"denseMatrix"}, directly. Class \code{"Matrix"}, by class \code{"lMatrix"}. Class \code{"Matrix"}, by class \code{"denseMatrix"}. } \section{Methods}{ \describe{ \item{coerce}{\code{signature(from = "matrix", to = "ldenseMatrix")}: ... } \item{coerce}{\code{signature(from = "ldenseMatrix", to = "matrix")}: ... } \item{as.vector}{\code{signature(x = "ldenseMatrix", mode = "missing")}: ...} \item{which}{\code{signature(x = "ndenseMatrix")}, semantically equivalent to \pkg{base} function \code{\link{which}(x, arr.ind)}; for details, see the \code{\linkS4class{lMatrix}} class documentation.} } } \seealso{ Class \code{\linkS4class{lgeMatrix}} and the other subclasses. } \examples{ showClass("ldenseMatrix") as(diag(3) > 0, "ldenseMatrix") } \keyword{classes} Matrix/man/solve-methods.Rd0000644000176200001440000002760614132246333015365 0ustar liggesusers\name{solve-methods} \title{Methods in Package Matrix for Function \code{solve()}} \docType{methods} \alias{solve}%- catch ?solve too (is important enough) \alias{solve-methods} \alias{solve,ANY,Matrix-method} \alias{solve,CHMfactor,ANY-method} \alias{solve,CHMfactor,ddenseMatrix-method} \alias{solve,CHMfactor,diagonalMatrix-method} \alias{solve,CHMfactor,dsparseMatrix-method} \alias{solve,CHMfactor,matrix-method} \alias{solve,CHMfactor,missing-method} \alias{solve,CHMfactor,numeric-method} \alias{solve,ddenseMatrix,ANY-method} \alias{solve,ddenseMatrix,matrix-method} \alias{solve,ddenseMatrix,Matrix-method} \alias{solve,ddenseMatrix,missing-method} \alias{solve,ddenseMatrix,numeric-method} \alias{solve,denseLU,missing-method} \alias{solve,dgCMatrix,ddenseMatrix-method} \alias{solve,dgCMatrix,dsparseMatrix-method} \alias{solve,dgCMatrix,matrix-method} \alias{solve,dgCMatrix,missing-method} \alias{solve,dgeMatrix,ddenseMatrix-method} \alias{solve,dgeMatrix,matrix-method} \alias{solve,dgeMatrix,missing-method} \alias{solve,dgeMatrix,sparseMatrix-method} \alias{solve,diagonalMatrix,matrix-method} \alias{solve,diagonalMatrix,Matrix-method} \alias{solve,diagonalMatrix,missing-method} \alias{solve,dpoMatrix,dgeMatrix-method} \alias{solve,dpoMatrix,matrix-method} \alias{solve,dpoMatrix,missing-method} \alias{solve,dppMatrix,dgeMatrix-method} \alias{solve,dppMatrix,integer-method} \alias{solve,dppMatrix,matrix-method} \alias{solve,dppMatrix,missing-method} \alias{solve,dsCMatrix,ddenseMatrix-method} \alias{solve,dsCMatrix,denseMatrix-method} \alias{solve,dsCMatrix,dsparseMatrix-method} \alias{solve,dsCMatrix,matrix-method} \alias{solve,dsCMatrix,missing-method} \alias{solve,dsCMatrix,numeric-method} \alias{solve,dspMatrix,ddenseMatrix-method} \alias{solve,dspMatrix,matrix-method} \alias{solve,dspMatrix,missing-method} \alias{solve,dsyMatrix,ddenseMatrix-method} \alias{solve,dsyMatrix,denseMatrix-method} \alias{solve,dsyMatrix,matrix-method} \alias{solve,dsyMatrix,missing-method} \alias{solve,dtCMatrix,CsparseMatrix-method} \alias{solve,dtCMatrix,dgeMatrix-method} \alias{solve,dtCMatrix,matrix-method} \alias{solve,dtCMatrix,missing-method} \alias{solve,dtCMatrix,numeric-method} \alias{solve,dtpMatrix,ddenseMatrix-method} \alias{solve,dtpMatrix,matrix-method} \alias{solve,dtpMatrix,missing-method} \alias{solve,dtrMatrix,ddenseMatrix-method} \alias{solve,dtrMatrix,dMatrix-method} \alias{solve,dtrMatrix,matrix-method} \alias{solve,dtrMatrix,Matrix-method} \alias{solve,dtrMatrix,missing-method} \alias{solve,Matrix,ANY-method} \alias{solve,Matrix,diagonalMatrix-method} \alias{solve,matrix,Matrix-method} \alias{solve,Matrix,matrix-method} \alias{solve,Matrix,missing-method} \alias{solve,Matrix,numeric-method} \alias{solve,Matrix,pMatrix-method} \alias{solve,Matrix,sparseVector-method} \alias{solve,MatrixFactorization,ANY-method} \alias{solve,MatrixFactorization,missing-method} \alias{solve,MatrixFactorization,numeric-method} \alias{solve,pMatrix,matrix-method} \alias{solve,pMatrix,Matrix-method} \alias{solve,pMatrix,missing-method} \alias{solve,sparseQR,ANY-method} \alias{solve,TsparseMatrix,ANY-method} \alias{solve,TsparseMatrix,missing-method} \description{ Methods for function \code{\link{solve}} to solve a linear system of equations, or equivalently, solve for \eqn{X} in \deqn{A X = B} where \eqn{A} is a square matrix, and \eqn{X}, \eqn{B} are matrices or vectors (which are treated as 1-column matrices), and the \R syntax is \preformatted{ X <- solve(A,B) } In \code{solve(a,b)} in the \pkg{Matrix} package, \code{a} may also be a \code{\linkS4class{MatrixFactorization}} instead of directly a matrix. } \usage{% usage for those methods which have "surprising arguments" \S4method{solve}{CHMfactor,ddenseMatrix}(a, b, system = c("A", "LDLt", "LD", "DLt", "L", "Lt", "D", "P", "Pt"), \dots) \S4method{solve}{dgCMatrix,missing}(a, b, sparse = NA , tol = .Machine$double.eps, \dots) \S4method{solve}{dgCMatrix,matrix}(a, b, sparse = FALSE, tol = .Machine$double.eps, \dots) solve(a, b, ...) ## *the* two-argument version, almost always preferred to # solve(a) ## the *rarely* needed one-argument version % ^ must comment the above; otherwise 'R CMD check' waffles ... } \arguments{ \item{a}{a square numeric matrix, \eqn{A}, typically of one of the classes in \pkg{Matrix}. Logical matrices are coerced to corresponding numeric ones.} \item{b}{numeric vector or matrix (dense or sparse) as RHS of the linear system \eqn{Ax = b}.} \item{system}{only if \code{a} is a \code{\linkS4class{CHMfactor}}: character string indicating the kind of linear system to be solved, see below. Note that the default, \code{"A"}, does \emph{not} solve the triangular system (but \code{"L"} does).} \item{sparse}{only when \code{a} is a \code{\linkS4class{sparseMatrix}}, i.e., typically a \code{\linkS4class{dgCMatrix}}: logical specifying if the result should be a (formally) sparse matrix.}%% FIXME: mention %% pos.definite etc \item{tol}{only used when \code{a} is sparse, in the \code{\link{isSymmetric}(a, tol=*)} test, where that applies.} \item{\dots}{potentially further arguments to the methods.} } \section{Methods}{ \describe{ \item{\code{signature(a = "ANY", b = "ANY")}}{is simply the \pkg{base} package's S3 generic \code{\link{solve}}.} %% This is copy-paste in CHMfactor-class.Rd {FIXME ?} \item{\code{signature(a = "CHMfactor", b = "...."), system= *}}{The \code{solve} methods for a \code{"\linkS4class{CHMfactor}"} object take an optional third argument \code{system} whose value can be one of the character strings \code{"A"}, \code{"LDLt"}, \code{"LD"}, \code{"DLt"}, \code{"L"}, \code{"Lt"}, \code{"D"}, \code{"P"} or \code{"Pt"}. This argument describes the system to be solved. The default, \code{"A"}, is to solve \eqn{Ax = b} for \eqn{x} where \code{A} is sparse, positive-definite matrix that was factored to produce \code{a}. Analogously, \code{system = "L"} returns the solution \eqn{x}, of \eqn{Lx = b}; similarly, for all system codes \bold{but} \code{"P"} and \code{"Pt"} where, e.g., \code{x <- solve(a, b,system="P")} is equivalent to \code{x <- P \%*\% b}. If \code{b} is a \code{\linkS4class{sparseMatrix}}, \code{system} is used as above the corresponding sparse CHOLMOD algorithm is called. } \item{\code{signature(a = "ddenseMatrix", b = "....")}}{(for all \code{b}) work via \code{as(a, "dgeMatrix")}, using the its methods, see below.} \item{\code{signature(a = "denseLU", b = "missing")}}{ basically computes uses triangular forward- and back-solve.} \item{\code{signature(a = "dgCMatrix", b = "matrix")}}{, and} %% -> ../R/dgCMatrix.R \item{\code{signature(a = "dgCMatrix", b = "ddenseMatrix")}}{with extra argument list \code{( sparse = FALSE, tol = .Machine$double.eps ) }: Uses the sparse \code{\link{lu}(a)} decomposition (which is cached in \code{a}'s \code{factor} slot). By default, \code{sparse=FALSE}, returns a \code{\linkS4class{denseMatrix}}, since \eqn{U^{-1} L^{-1} B} may not be sparse at all, even when \eqn{L} and \eqn{U} are. If \code{sparse=TRUE}, returns a \code{\linkS4class{sparseMatrix}} (which may not be very sparse at all, even if \code{a} \emph{was} sparse). } \item{\code{signature(a = "dgCMatrix", b = "dsparseMatrix")}}{, and} \item{\code{signature(a = "dgCMatrix", b = "missing")}}{with extra argument list \code{( sparse=FALSE, tol = .Machine$double.eps ) }: Checks if \code{a} is symmetric, and in that case, coerces it to \code{"\linkS4class{symmetricMatrix}"}, and then computes a \emph{sparse} solution via sparse Cholesky factorization, independently of the \code{sparse} argument. If \code{a} is not symmetric, the sparse \code{\link{lu}} decomposition is used and the result will be sparse or dense, depending on the \code{sparse} argument, exactly as for the above (\code{b = "ddenseMatrix"}) case. } \item{\code{signature(a = "dgeMatrix", b = ".....")}}{ solve the system via internal LU, calling LAPACK routines \code{dgetri} or \code{dgetrs}. } \item{\code{signature(a = "diagonalMatrix", b = "matrix")}}{and other \code{b}s: Of course this is trivially implemented, as \eqn{D^{-1}} is diagonal with entries \eqn{1 / D[i,i]}.} \item{\code{signature(a = "dpoMatrix", b = "....Matrix")}}{, and} \item{\code{signature(a = "dppMatrix", b = "....Matrix")}}{ The Cholesky decomposition of \code{a} is calculated (if needed) while solving the system.} \item{\code{signature(a = "dsCMatrix", b = "....")}}{% ../R/dsCMatrix.R All these methods first try Cholmod's Cholesky factorization; if that works, i.e., typically if \code{a} is positive semi-definite, it is made use of. Otherwise, the sparse LU decomposition is used as for the \dQuote{general} matrices of class \code{"dgCMatrix"}.} \item{\code{signature(a = "dspMatrix", b = "....")}}{, and} \item{\code{signature(a = "dsyMatrix", b = "....")}}{% ../R/dsyMatrix.R all end up calling LAPACK routines \code{dsptri}, \code{dsptrs}, \code{dsytrs} and \code{dsytri}. } \item{\code{signature(a = "dtCMatrix", b = "CsparseMatrix")}}{,} \item{\code{signature(a = "dtCMatrix", b = "dgeMatrix")}}{, etc sparse triangular solve, in traditional S/\R also known as \code{\link{backsolve}}, or \code{\link{forwardsolve}}. \code{solve(a,b)} is a \code{\linkS4class{sparseMatrix}} if \code{b} is, and hence a \code{\linkS4class{denseMatrix}} otherwise. } \item{\code{signature(a = "dtrMatrix", b = "ddenseMatrix")}}{, and} \item{\code{signature(a = "dtpMatrix", b = "matrix")}}{, and% ../R/dtrMatrix.R similar \code{b}, including \code{"missing"}, and \code{"diagonalMatrix"}: all use LAPACK based versions of efficient triangular \code{\link{backsolve}}, or \code{\link{forwardsolve}}. } \item{\code{signature(a = "Matrix", b = "diagonalMatrix")}}{ works via \code{as(b, "CsparseMatrix")}.} \item{\code{signature(a = "sparseQR", b = "ANY")}}{ simply uses \code{\link{qr.coef}(a, b)}.} \item{\code{signature(a = "pMatrix", b = ".....")}}{ these methods typically use \code{\link{crossprod}(a,b)}, as the inverse of a permutation matrix is the same as its transpose.} \item{\code{signature(a = "TsparseMatrix", b = "ANY")}}{ all work via \code{as(a, "CsparseMatrix")}.} } }%{Methods} \seealso{ \code{\link{solve}}, \code{\link{lu}}, and class documentations \code{\linkS4class{CHMfactor}}, \code{\linkS4class{sparseLU}}, and \code{\linkS4class{MatrixFactorization}}. } \examples{ ## A close to symmetric example with "quite sparse" inverse: n1 <- 7; n2 <- 3 dd <- data.frame(a = gl(n1,n2), b = gl(n2,1,n1*n2))# balanced 2-way X <- sparse.model.matrix(~ -1+ a + b, dd)# no intercept --> even sparser XXt <- tcrossprod(X) diag(XXt) <- rep(c(0,0,1,0), length.out = nrow(XXt)) n <- nrow(ZZ <- kronecker(XXt, Diagonal(x=c(4,1)))) image(a <- 2*Diagonal(n) + ZZ \%*\% Diagonal(x=c(10, rep(1, n-1)))) isSymmetric(a) # FALSE image(drop0(skewpart(a))) image(ia0 <- solve(a)) # checker board, dense [but really, a is singular!] try(solve(a, sparse=TRUE))##-> error [ TODO: assertError ] ia. <- solve(a, sparse=TRUE, tol = 1e-19)##-> *no* error if(R.version$arch == "x86_64") ## Fails on 32-bit [Fedora 19, R 3.0.2] from Matrix 1.1-0 on [FIXME ??] only stopifnot(all.equal(as.matrix(ia.), as.matrix(ia0))) a <- a + Diagonal(n) iad <- solve(a) ias <- solve(a, sparse=TRUE) stopifnot(all.equal(as(ias,"denseMatrix"), iad, tolerance=1e-14)) I. <- iad \%*\% a ; image(I.) I0 <- drop0(zapsmall(I.)); image(I0) .I <- a \%*\% iad .I0 <- drop0(zapsmall(.I)) stopifnot( all.equal(as(I0, "diagonalMatrix"), Diagonal(n)), all.equal(as(.I0,"diagonalMatrix"), Diagonal(n)) ) } \keyword{methods} Matrix/man/ddenseMatrix-class.Rd0000644000176200001440000000422613556074411016324 0ustar liggesusers\name{ddenseMatrix-class} \docType{class} \alias{ddenseMatrix-class} \title{Virtual Class "ddenseMatrix" of Numeric Dense Matrices} % now separated from ./dgeMatrix-class.Rd - on purpose % METHODS: % undocu (FIXME) \alias{show,ddenseMatrix-method} \alias{coerce,ddenseMatrix,matrix-method} \alias{coerce,ddenseMatrix,dgeMatrix-method} %\alias{coerce,ddenseMatrix,CsparseMatrix-method} % % Group \alias{Arith,ddenseMatrix,ddenseMatrix-method} \alias{Arith,ddenseMatrix,logical-method} \alias{Arith,ddenseMatrix,numeric-method} \alias{Arith,logical,ddenseMatrix-method} \alias{Arith,numeric,ddenseMatrix-method} \alias{Math,ddenseMatrix-method} \alias{log,ddenseMatrix-method} \alias{Summary,ddenseMatrix-method} % \alias{as.numeric,ddenseMatrix-method} \alias{diag,ddenseMatrix-method} \alias{determinant,ddenseMatrix,missing-method} \alias{determinant,ddenseMatrix,logical-method} \alias{lu,ddenseMatrix-method} \alias{norm,ddenseMatrix,missing-method} \alias{norm,ddenseMatrix,character-method} \alias{rcond,ddenseMatrix,missing-method} \alias{rcond,ddenseMatrix,character-method} %% \alias{solve,ddenseMatrix,ANY-method}--> solve-methods.Rd \alias{t,ddenseMatrix-method} % \description{This is the virtual class of all dense numeric (i.e., \bold{d}ouble, hence \emph{\dQuote{ddense}}) S4 matrices. Its most important subclass is the \code{\linkS4class{dgeMatrix}} class. %% and now say what the difference is ! __ FIXME __ } \section{Extends}{ Class \code{"dMatrix"} directly; class \code{"Matrix"}, by the above. } \section{Slots}{ the same slots at its subclass \code{\linkS4class{dgeMatrix}}, see there. } \section{Methods}{ Most methods are implemented via \code{as(*, "dgeMatrix")} and are mainly used as \dQuote{fallbacks} when the subclass doesn't need its own specialized method. Use \code{\link{showMethods}(class = "ddenseMatrix", where = "package:Matrix")} for an overview. } %\references{} %\note{} \seealso{ The virtual classes \code{\linkS4class{Matrix}}, \code{\linkS4class{dMatrix}}, and \code{\linkS4class{dsparseMatrix}}. } \examples{ showClass("ddenseMatrix") showMethods(class = "ddenseMatrix", where = "package:Matrix") } \keyword{classes} Matrix/man/drop0.Rd0000644000176200001440000000407412521705645013620 0ustar liggesusers\name{drop0} \alias{drop0} \title{Drop "Explicit Zeroes" from a Sparse Matrix} \description{ Returns a sparse matrix with no \dQuote{explicit zeroes}, i.e., all zero or \code{FALSE} entries are dropped from the explicitly indexed matrix entries. } \usage{ drop0(x, tol = 0, is.Csparse = NA) } \arguments{ \item{x}{a Matrix, typically sparse, i.e., inheriting from \code{\linkS4class{sparseMatrix}}.} % \item{clx}{[optional:] the \code{\link{class}} or \dQuote{class % definition} (see \code{\link{getClassDef}}; it is of class % \code{\linkS4class{classRepresentation}}) of \code{x}.\cr % This argument just exists for the possibility of speedup.} \item{tol}{non-negative number to be used as tolerance for checking if an entry \eqn{x_{i,j}}{x[i,j]} should be considered to be zero.} \item{is.Csparse}{logical indicating prior knowledge about the \dQuote{Csparseness} of \code{x}. This exists for possible speedup reasons only.} } % \details{ % ~~ If necessary, more details than the description above ~~ % } \value{ a Matrix like \code{x} but with no explicit zeros, i.e., \code{!any(x@x == 0)}, always inheriting from \code{\linkS4class{CsparseMatrix}}. } % \author{Martin} \note{When a sparse matrix is the result of matrix multiplications, you may want to consider combining \code{drop0()} with \code{\link{zapsmall}()}, see the example. } \seealso{\code{\link{spMatrix}}, class \code{\linkS4class{sparseMatrix}}; \code{\link{nnzero}} } \examples{ m <- spMatrix(10,20, i= 1:8, j=2:9, x = c(0:2,3:-1)) m drop0(m) ## A larger example: t5 <- new("dtCMatrix", Dim = c(5L, 5L), uplo = "L", x = c(10, 1, 3, 10, 1, 10, 1, 10, 10), i = c(0L,2L,4L, 1L, 3L,2L,4L, 3L, 4L), p = c(0L, 3L, 5L, 7:9)) TT <- kronecker(t5, kronecker(kronecker(t5,t5), t5)) IT <- solve(TT) I. <- TT \%*\% IT ; nnzero(I.) # 697 ( = 625 + 72 ) I.0 <- drop0(zapsmall(I.)) ## which actually can be more efficiently achieved by I.. <- drop0(I., tol = 1e-15) stopifnot(all(I.0 == Diagonal(625)), nnzero(I..) == 625) } \keyword{utilities} \keyword{array} Matrix/man/chol2inv-methods.Rd0000644000176200001440000000362212023457647015762 0ustar liggesusers\name{chol2inv-methods} \docType{methods} % \alias{chol2inv}% needed, if we want \usage{} \alias{chol2inv-methods} \alias{chol2inv,ANY-method} \alias{chol2inv,dtrMatrix-method} \alias{chol2inv,CHMfactor-method} \alias{chol2inv,denseMatrix-method} \alias{chol2inv,sparseMatrix-method} \title{Inverse from Choleski or QR Decomposition -- Matrix Methods} \description{ Invert a symmetric, positive definite square matrix from its Choleski decomposition. Equivalently, compute \eqn{(X'X)^{-1}}{(X'X)^(-1)} from the (\eqn{R} part) of the QR decomposition of \eqn{X}. \cr Even more generally, given an upper triangular matrix \eqn{R}, compute \eqn{(R'R)^{-1}}{(R'R)^(-1)}. } % \usage{ % chol2inv(x, \dots) % } % \arguments{ % \item{x}{a matrix(-like) object; see below.} % \item{\dots}{not used here; for compatibility with other methods.} % } \section{Methods}{ \describe{ \item{x = "ANY"}{the default method from \pkg{base}, see \code{\link[base]{chol2inv}}, for traditional matrices.} \item{x = "dtrMatrix"}{method for the numeric triangular matrices, built on the same LAPACK \command{DPOTRI} function as the base method.} \item{x = "denseMatrix"}{if \code{x} is coercable to a \code{\linkS4class{triangularMatrix}}, call the \code{"dtrMatrix"} method above.} \item{x = "sparseMatrix"}{if \code{x} is coercable to a \code{\linkS4class{triangularMatrix}}, use \code{\link{solve}()} currently.} %% better algorithms are welcome! } } \seealso{ \code{\link{chol}} (for \code{\linkS4class{Matrix}} objects); further, \code{\link[base]{chol2inv}} (from the \pkg{base} package), \code{\link{solve}}. } \examples{ (M <- Matrix(cbind(1, 1:3, c(1,3,7)))) (cM <- chol(M)) # a "Cholesky" object, inheriting from "dtrMatrix" chol2inv(cM) \%*\% M # the identity stopifnot(all(chol2inv(cM) \%*\% M - Diagonal(nrow(M))) < 1e-10) } \keyword{methods} \keyword{algebra} Matrix/man/forceSymmetric.Rd0000644000176200001440000000712412417245712015564 0ustar liggesusers\name{forceSymmetric} \alias{forceSymmetric} \alias{forceSymmetric,matrix,ANY-method} \alias{forceSymmetric,Matrix,missing-method} \alias{forceSymmetric,denseMatrix,character-method} \alias{forceSymmetric,denseMatrix,missing-method} \alias{forceSymmetric,sparseMatrix,ANY-method} \alias{forceSymmetric,CsparseMatrix,ANY-method} % all the loop-generated "symmetricMatrix" methods: \alias{forceSymmetric,dsyMatrix,missing-method} \alias{forceSymmetric,dsyMatrix,character-method} \alias{forceSymmetric,dspMatrix,missing-method} \alias{forceSymmetric,dspMatrix,character-method} \alias{forceSymmetric,lsyMatrix,missing-method} \alias{forceSymmetric,lsyMatrix,character-method} \alias{forceSymmetric,lspMatrix,missing-method} \alias{forceSymmetric,lspMatrix,character-method} \alias{forceSymmetric,nsyMatrix,missing-method} \alias{forceSymmetric,nsyMatrix,character-method} \alias{forceSymmetric,nspMatrix,missing-method} \alias{forceSymmetric,nspMatrix,character-method} \alias{forceSymmetric,dsTMatrix,missing-method} \alias{forceSymmetric,dsTMatrix,character-method} \alias{forceSymmetric,dsCMatrix,missing-method} \alias{forceSymmetric,dsCMatrix,character-method} \alias{forceSymmetric,dsRMatrix,missing-method} \alias{forceSymmetric,dsRMatrix,character-method} \alias{forceSymmetric,lsTMatrix,missing-method} \alias{forceSymmetric,lsTMatrix,character-method} \alias{forceSymmetric,lsCMatrix,missing-method} \alias{forceSymmetric,lsCMatrix,character-method} \alias{forceSymmetric,lsRMatrix,missing-method} \alias{forceSymmetric,lsRMatrix,character-method} \alias{forceSymmetric,nsTMatrix,missing-method} \alias{forceSymmetric,nsTMatrix,character-method} \alias{forceSymmetric,nsCMatrix,missing-method} \alias{forceSymmetric,nsCMatrix,character-method} \alias{forceSymmetric,nsRMatrix,missing-method} \alias{forceSymmetric,nsRMatrix,character-method} \alias{forceSymmetric,dpoMatrix,missing-method} \alias{forceSymmetric,dpoMatrix,character-method} \alias{forceSymmetric,corMatrix,missing-method} \alias{forceSymmetric,corMatrix,character-method} \alias{forceSymmetric,dppMatrix,missing-method} \alias{forceSymmetric,dppMatrix,character-method} % \title{Force a Matrix to 'symmetricMatrix' Without Symmetry Checks} \description{ Force a square matrix \code{x} to a \code{\linkS4class{symmetricMatrix}}, \bold{without} a symmetry check as it would be applied for \code{as(x, "symmetricMatrix")}. } \usage{ forceSymmetric(x, uplo) } \arguments{ \item{x}{any square matrix (of numbers), either \dQuote{"traditional"} (\code{\link{matrix}}) or inheriting from \code{\linkS4class{Matrix}}.} \item{uplo}{optional string, \code{"U"} or \code{"L"} indicating which \dQuote{triangle} half of \code{x} should determine the result. The default is \code{"U"} unless \code{x} already has a \code{uplo} slot (i.e., when it is \code{\linkS4class{symmetricMatrix}}, or \code{\linkS4class{triangularMatrix}}), where the default will be \code{x@uplo}.} } % \details{ % % } \value{ a square matrix inheriting from class \code{\linkS4class{symmetricMatrix}}. } \seealso{\code{\link{symmpart}} for the symmetric part of a matrix, or the coercions \code{as(x, )}. } \examples{ ## Hilbert matrix i <- 1:6 h6 <- 1/outer(i - 1L, i, "+") sd <- sqrt(diag(h6)) hh <- t(h6/sd)/sd # theoretically symmetric isSymmetric(hh, tol=0) # FALSE; hence try( as(hh, "symmetricMatrix") ) # fails, but this works fine: H6 <- forceSymmetric(hh) ## result can be pretty surprising: (M <- Matrix(1:36, 6)) forceSymmetric(M) # symmetric, hence very different in lower triangle (tm <- tril(M)) forceSymmetric(tm) } \keyword{array} Matrix/man/all-methods.Rd0000644000176200001440000000314010647423674015004 0ustar liggesusers\name{all-methods} \docType{methods} \alias{all-methods} \alias{all,Matrix-method} \alias{any,Matrix-method} % \alias{all,lMatrix-method} \alias{all,ldenseMatrix-method} \alias{all,lsparseMatrix-method} \alias{all,lsyMatrix-method} % \alias{any,lMatrix-method} % \alias{any,ldenseMatrix-method} % \alias{any,lsparseMatrix-method} % \title{"Matrix" Methods for Functions all() and any()} \description{ The basic \R functions \code{\link{all}} and \code{\link{any}} now have methods for \code{\linkS4class{Matrix}} objects and should behave as for \code{\link{matrix}} ones. } \section{Methods}{ %% FIXME: write more \describe{ \item{all}{\code{signature(x = "Matrix", ..., na.rm = FALSE)}: ...} \item{any}{\code{signature(x = "Matrix", ..., na.rm = FALSE)}: ...} \item{all}{\code{signature(x = "ldenseMatrix", ..., na.rm = FALSE)}: ...} \item{all}{\code{signature(x = "lsparseMatrix", ..., na.rm = FALSE)}: ...} } } \keyword{methods} \examples{ M <- Matrix(1:12 +0, 3,4) all(M >= 1) # TRUE any(M < 0 ) # FALSE MN <- M; MN[2,3] <- NA; MN all(MN >= 0) # NA any(MN < 0) # NA any(MN < 0, na.rm = TRUE) # -> FALSE \dontshow{ sM <- as(MN, "sparseMatrix") stopifnot(all(M >= 1), !any(M < 0), all.equal((sM >= 1), as(MN >= 1, "sparseMatrix")), ## MN: any(MN < 2), !all(MN < 5), is.na(all(MN >= 0)), is.na(any(MN < 0)), all(MN >= 0, na.rm=TRUE), !any(MN < 0, na.rm=TRUE), ## same for sM : any(sM < 2), !all(sM < 5), is.na(all(sM >= 0)), is.na(any(sM < 0)), all(sM >= 0, na.rm=TRUE), !any(sM < 0, na.rm=TRUE) ) } } Matrix/man/SparseM-conv.Rd0000644000176200001440000000454513556256250015116 0ustar liggesusers\name{SparseM-conversions} \title{Sparse Matrix Coercion from and to those from package \pkg{SparseM}} \docType{methods} \alias{SparseM-coerce-methods} % \alias{coerce,matrix.coo,CsparseMatrix-method} \alias{coerce,matrix.coo,TsparseMatrix-method} \alias{coerce,matrix.csc,CsparseMatrix-method} \alias{coerce,matrix.csc,TsparseMatrix-method} \alias{coerce,matrix.csr,CsparseMatrix-method} \alias{coerce,matrix.csr,RsparseMatrix-method} \alias{coerce,matrix.csr,TsparseMatrix-method} % \alias{coerce,CsparseMatrix,matrix.csr-method} \alias{coerce,CsparseMatrix,matrix.coo-method} \alias{coerce,CsparseMatrix,matrix.csc-method} \alias{coerce,dsparseMatrix,matrix.csr-method} \alias{coerce,dgRMatrix,matrix.csr-method} \alias{coerce,dgCMatrix,matrix.csc-method} \alias{coerce,dgTMatrix,matrix.coo-method} \alias{coerce,matrix.csr,dgRMatrix-method} \alias{coerce,matrix.csc,dgCMatrix-method} \alias{coerce,matrix.coo,dgTMatrix-method} \alias{coerce,matrix.csr,dgCMatrix-method} \alias{coerce,matrix.coo,dgCMatrix-method} % \alias{coerce,matrix.csr,Matrix-method} \alias{coerce,matrix.coo,Matrix-method} \alias{coerce,matrix.csc,Matrix-method} % \description{ Methods for coercion from and to sparse matrices from package \pkg{SparseM} are provided here, for ease of porting functionality to the \pkg{Matrix} package, and comparing functionality of the two packages. All these work via the usual \code{\link{as}(., "")} coercion, \preformatted{ as(from, Class) }%pre } \section{Methods}{ \describe{ \item{from = "matrix.csr", to = "dgRMatrix"}{ ... } \item{from = "matrix.csc", to = "dgCMatrix"}{ ... } \item{from = "matrix.coo", to = "dgTMatrix"}{ ... } \item{from = "dgRMatrix", to = "matrix.csr"}{ ... } \item{from = "dgCMatrix", to = "matrix.csc"}{ ... } \item{from = "dgTMatrix", to = "matrix.coo"}{ ... } \item{from = "sparseMatrix", to = "matrix.csr"}{ ... } \item{from = "matrix.csr", to = "dgCMatrix"}{ ... } \item{from = "matrix.coo", to = "dgCMatrix"}{ ... } \item{from = "matrix.csr", to = "Matrix"}{ ... } \item{from = "matrix.csc", to = "Matrix"}{ ... } \item{from = "matrix.coo", to = "Matrix"}{ ... } } } \seealso{ The documentation in CRAN package \CRANpkg{SparseM}, such as \code{\link[SparseM]{SparseM.ontology}}, and one important class, \code{\link[SparseM:matrix.csr-class]{matrix.csr}}. } \keyword{methods} Matrix/man/Subassign-methods.Rd0000644000176200001440000001511112254575000016156 0ustar liggesusers\name{[<--methods} \docType{methods} \alias{[<--methods} \alias{Subassign-methods}% <- nicer to use in \link{.} % \title{Methods for "[<-" - Assigning to Subsets for 'Matrix'} % in ../R/Matrix.R \alias{[<-,Matrix,ANY,ANY,ANY-method} \alias{[<-,Matrix,ANY,ANY,Matrix-method} \alias{[<-,Matrix,ANY,missing,Matrix-method} \alias{[<-,Matrix,missing,ANY,Matrix-method} \alias{[<-,Matrix,ANY,ANY,matrix-method} \alias{[<-,Matrix,ANY,missing,matrix-method} \alias{[<-,Matrix,missing,ANY,matrix-method} \alias{[<-,Matrix,matrix,missing,replValue-method} \alias{[<-,Matrix,lsparseMatrix,missing,replValue-method} \alias{[<-,Matrix,nsparseMatrix,missing,replValue-method} \alias{[<-,Matrix,ldenseMatrix,missing,replValue-method} \alias{[<-,Matrix,ndenseMatrix,missing,replValue-method} % \alias{[<-,Matrix,missing,numeric,missing-method} % \alias{[<-,Matrix,numeric,missing,missing-method} % \alias{[<-,Matrix,numeric,numeric,missing-method} % in ../R/denseMatrix.R \alias{[<-,denseMatrix,index,missing,replValue-method} \alias{[<-,denseMatrix,index,index,replValue-method} \alias{[<-,denseMatrix,matrix,missing,replValue-method} \alias{[<-,denseMatrix,missing,index,replValue-method} \alias{[<-,denseMatrix,missing,missing,ANY-method} % in ../R/diagMatrix.R \alias{[<-,diagonalMatrix,index,index,replValue-method} \alias{[<-,diagonalMatrix,index,missing,replValue-method} \alias{[<-,diagonalMatrix,matrix,missing,replValue-method} \alias{[<-,diagonalMatrix,missing,index,replValue-method} \alias{[<-,diagonalMatrix,missing,missing,ANY-method} % \alias{[<-,diagonalMatrix,index,index,sparseMatrix-method} \alias{[<-,diagonalMatrix,index,missing,sparseMatrix-method} \alias{[<-,diagonalMatrix,missing,index,sparseMatrix-method} % \alias{[<-,diagonalMatrix,index,index,sparseVector-method} \alias{[<-,diagonalMatrix,index,missing,sparseVector-method} \alias{[<-,diagonalMatrix,missing,index,sparseVector-method} % % -> ../R/sparseMatrix.R : \alias{[<-,sparseMatrix,ANY,ANY,sparseMatrix-method} \alias{[<-,sparseMatrix,ANY,missing,sparseMatrix-method} \alias{[<-,sparseMatrix,missing,ANY,sparseMatrix-method} \alias{[<-,sparseMatrix,missing,missing,ANY-method} % -> ../R/indMatrix.R : -- these give errors \alias{[<-,indMatrix,index,ANY,ANY-method} \alias{[<-,indMatrix,missing,index,ANY-method} \alias{[<-,indMatrix,missing,missing,ANY-method} % -> ../R/Tsparse.R : replValue = { numeric, logical } \alias{[<-,TsparseMatrix,index,index,replValue-method} \alias{[<-,TsparseMatrix,index,missing,replValue-method} \alias{[<-,TsparseMatrix,matrix,missing,replValue-method} \alias{[<-,TsparseMatrix,Matrix,missing,replValue-method} \alias{[<-,TsparseMatrix,lMatrix,missing,replValue-method} \alias{[<-,TsparseMatrix,nMatrix,missing,replValue-method} \alias{[<-,TsparseMatrix,missing,index,replValue-method} \alias{[<-,TsparseMatrix,missing,index,sparseVector-method} \alias{[<-,TsparseMatrix,index,missing,sparseVector-method} \alias{[<-,TsparseMatrix,index,index,sparseVector-method} % \alias{[<-,dgTMatrix,missing,missing,numeric-method} % -> ../R/Csparse.R : \alias{[<-,CsparseMatrix,index,index,replValue-method} \alias{[<-,CsparseMatrix,index,missing,replValue-method} \alias{[<-,CsparseMatrix,Matrix,missing,replValue-method} \alias{[<-,CsparseMatrix,matrix,missing,replValue-method} \alias{[<-,CsparseMatrix,lsparseMatrix,missing,replValue-method} \alias{[<-,CsparseMatrix,nsparseMatrix,missing,replValue-method} \alias{[<-,CsparseMatrix,ldenseMatrix,missing,replValue-method} \alias{[<-,CsparseMatrix,ndenseMatrix,missing,replValue-method} \alias{[<-,CsparseMatrix,missing,index,replValue-method} \alias{[<-,CsparseMatrix,missing,index,sparseVector-method} \alias{[<-,CsparseMatrix,index,missing,sparseVector-method} \alias{[<-,CsparseMatrix,index,index,sparseVector-method} % % \alias{[<-,RsparseMatrix,index,index,replValue-method} \alias{[<-,RsparseMatrix,index,missing,replValue-method} \alias{[<-,RsparseMatrix,matrix,missing,replValue-method} \alias{[<-,RsparseMatrix,missing,index,replValue-method} \alias{[<-,RsparseMatrix,missing,index,sparseVector-method} \alias{[<-,RsparseMatrix,index,missing,sparseVector-method} \alias{[<-,RsparseMatrix,index,index,sparseVector-method} % % % \alias{[<-,dsparseMatrix,missing,index,numeric-method} % \alias{[<-,dsparseMatrix,index,missing,numeric-method} % \alias{[<-,dsparseMatrix,index,index,numeric-method} % % % \alias{[<-,lsparseMatrix,missing,numeric,logical-method} % \alias{[<-,lsparseMatrix,numeric,missing,logical-method} % \alias{[<-,lsparseMatrix,numeric,numeric,logical-method} %------- \description{ Methods for \code{"[<-"}, i.e., extraction or subsetting mostly of matrices, in package \pkg{Matrix}. \bold{Note}: Contrary to standard \code{\link{matrix}} assignment in base \R, in \code{x[..] <- val} it is typically an \bold{error} (see \code{\link{stop}}) when the \link{type} or \code{\link{class}} of \code{val} would require the class of \code{x} to be changed, e.g., when \code{x} is logical, say \code{"lsparseMatrix"}, and \code{val} is numeric. In other cases, e.g., when \code{x} is a \code{"nsparseMatrix"} and \code{val} is not \code{TRUE} or \code{FALSE}, a warning is signalled, and \code{val} is \dQuote{interpreted} as \code{\link{logical}}, and (logical) \code{\link{NA}} is interpreted as \code{TRUE}. } \section{Methods}{ There are \emph{many many} more than these: \describe{ \item{x = "Matrix", i = "missing", j = "missing", value= "ANY"}{ is currently a simple fallback method implementation which ensures \dQuote{readable} error messages.} \item{x = "Matrix", i = "ANY", j = "ANY", value= "ANY"}{ currently gives an error } \item{x = "denseMatrix", i = "index", j = "missing", value= "numeric"}{ ... } \item{x = "denseMatrix", i = "index", j = "index", value= "numeric"}{ ... } \item{x = "denseMatrix", i = "missing", j = "index", value= "numeric"}{ ... } } } \seealso{ %% ./Xtrct-methods.Rd: \code{\link{[-methods}} for subsetting \code{"Matrix"} objects; the \code{\linkS4class{index}} class; \code{\link{Extract}} about the standard subset assignment (and extraction). } \examples{ %% Note that ./Xtrct-methods.Rd has the indexing ones set.seed(101) (a <- m <- Matrix(round(rnorm(7*4),2), nrow = 7)) a[] <- 2.2 # <<- replaces **every** entry a ## as do these: a[,] <- 3 ; a[TRUE,] <- 4 m[2, 3] <- 3.14 # simple number m[3, 3:4]<- 3:4 # simple numeric of length 2 ## sub matrix assignment: m[-(4:7), 3:4] <- cbind(1,2:4) #-> upper right corner of 'm' m[3:5, 2:3] <- 0 m[6:7, 1:2] <- Diagonal(2) m ## rows or columns only: m[1,] <- 10 m[,2] <- 1:7 m[-(1:6), ] <- 3:0 # not the first 6 rows, i.e. only the 7th as(m, "sparseMatrix") } \keyword{methods} \keyword{array} Matrix/man/Cholesky.Rd0000644000176200001440000001611213336513331014343 0ustar liggesusers\name{Cholesky} \alias{Cholesky} \alias{Cholesky,dsCMatrix-method}% -> ../R/dsCMatrix.R \alias{Cholesky,CsparseMatrix-method}% coerce \alias{Cholesky,sparseMatrix-method}% coerce \alias{Cholesky,nsparseMatrix-method}% error for now; todo in the future \alias{Cholesky,Matrix-method}% <- "good" error message \alias{.SuiteSparse_version} \title{Cholesky Decomposition of a Sparse Matrix} \concept{Choleski}% alternative English form \usage{ Cholesky(A, perm = TRUE, LDL = !super, super = FALSE, Imult = 0, \dots) } \description{ Computes the Cholesky (aka \dQuote{Choleski}) decomposition of a sparse, symmetric, positive-definite matrix. However, typically \code{\link{chol}()} should rather be used unless you are interested in the different kinds of sparse Cholesky decompositions. } \arguments{ \item{A}{sparse symmetric matrix. No missing values or IEEE special values are allowed.} \item{perm}{logical scalar indicating if a fill-reducing permutation should be computed and applied to the rows and columns of \code{A}. Default is \code{TRUE}.}% NA not available here \item{LDL}{logical scalar indicating if the decomposition should be computed as LDL' where \code{L} is a unit lower triangular matrix. The alternative is LL' where \code{L} is lower triangular with arbitrary diagonal elements. Default is \code{TRUE}. Setting it to \code{\link{NA}} leaves the choice to a CHOLMOD-internal heuristic.} \item{super}{logical scalar indicating if a supernodal decomposition should be created. The alternative is a simplicial decomposition. Default is \code{FALSE}. Setting it to \code{\link{NA}} leaves the choice to a CHOLMOD-internal heuristic.} \item{Imult}{numeric scalar which defaults to zero. The matrix that is decomposed is \eqn{A+m*I} where \eqn{m} is the value of \code{Imult} and \code{I} is the identity matrix of order \code{ncol(A)}.} \item{\dots}{further arguments passed to or from other methods.} } \value{ an object inheriting from either \code{"\linkS4class{CHMsuper}"}, or \code{"\linkS4class{CHMsimpl}"}, depending on the \code{super} argument; both classes extend \code{"\linkS4class{CHMfactor}"} which extends \code{"\linkS4class{MatrixFactorization}"}. In other words, the result of \code{Cholesky()} is \emph{not} a matrix, and if you want one, you should probably rather use \code{\link{chol}()}, see Details. } %FAILS WHY??\newcommand{\tR}{\tilde{R}}% both \tR{} and simple '\tR' fails \details{ This is a generic function with special methods for different types of matrices. Use \code{\link{showMethods}("Cholesky")} to list all the methods for the \code{\link{Cholesky}} generic. The method for class \code{\linkS4class{dsCMatrix}} of sparse matrices --- the only one available currently --- is based on functions from the CHOLMOD library. Again: If you just want the Cholesky decomposition of a matrix in a straightforward way, you should probably rather use \code{\link{chol}(.)}. Note that if \code{perm=TRUE} (default), the decomposition is \deqn{A = P' \tilde{L} D \tilde{L}' P = P' L L' P,}{A = P' L~ D L~' P = P' L L' P,} where \eqn{L} can be extracted by \code{as(*, "Matrix")}, \eqn{P} by \code{as(*, "pMatrix")} and both by \code{\link{expand}(*)}, see the class \code{\linkS4class{CHMfactor}} documentation. Note that consequently, you cannot easily get the \dQuote{traditional} cholesky factor \eqn{R}, from this decomposition, as \deqn{R'R = A = P'LL'P = P'\tilde{R}'\tilde{R} P = (\tilde{R}P)' (\tilde{R}P),}{ R'R = A = P'LL'P = P' R~' R~ P = (R~ P)' (R~ P),} but \eqn{\tilde{R}P}{R~ P} is \emph{not} triangular even though \eqn{\tilde{R}}{R~} is. } \references{ Yanqing Chen, Timothy A. Davis, William W. Hager, and Sivasankaran Rajamanickam (2008) Algorithm 887: CHOLMOD, Supernodal Sparse Cholesky Factorization and Update/Downdate. \emph{ACM Trans. Math. Softw.} \bold{35}, 3, Article 22, 14 pages. \doi{10.1145/1391989.1391995} Timothy A. Davis (2006) \emph{Direct Methods for Sparse Linear Systems}, SIAM Series \dQuote{Fundamentals of Algorithms}. } \seealso{ Class definitions \code{\linkS4class{CHMfactor}} and \code{\linkS4class{dsCMatrix}} and function \code{\link{expand}}. Note the extra \code{\link{solve}(*, system = . )} options in \code{\linkS4class{CHMfactor}}. Note that \code{\link{chol}()} returns matrices (inheriting from \code{"\linkS4class{Matrix}"}) whereas \code{Cholesky()} returns a \code{"\linkS4class{CHMfactor}"} object, and hence a typical user will rather use \code{chol(A)}. } \examples{ data(KNex) mtm <- with(KNex, crossprod(mm)) str(mtm@factors) # empty list() (C1 <- Cholesky(mtm)) # uses show() str(mtm@factors) # 'sPDCholesky' (simpl) (Cm <- Cholesky(mtm, super = TRUE)) c(C1 = isLDL(C1), Cm = isLDL(Cm)) str(mtm@factors) # 'sPDCholesky' *and* 'SPdCholesky' str(cm1 <- as(C1, "sparseMatrix")) str(cmat <- as(Cm, "sparseMatrix"))# hmm: super is *less* sparse here cm1[1:20, 1:20] b <- matrix(c(rep(0, 711), 1), nc = 1) ## solve(Cm, b) by default solves Ax = b, where A = Cm'Cm (= mtm)! ## hence, the identical() check *should* work, but fails on some GOTOblas: x <- solve(Cm, b) stopifnot(identical(x, solve(Cm, b, system = "A")), all.equal(x, solve(mtm, b))) Cn <- Cholesky(mtm, perm = FALSE)# no permutation -- much worse: sizes <- c(simple = object.size(C1), super = object.size(Cm), noPerm = object.size(Cn)) ## simple is 100, super= 137, noPerm= 812 : noquote(cbind(format(100 * sizes / sizes[1], digits=4))) ## Visualize the sparseness: dq <- function(ch) paste('"',ch,'"', sep="") ## dQuote() gives bad plots image(mtm, main=paste("crossprod(mm) : Sparse", dq(class(mtm)))) image(cm1, main= paste("as(Cholesky(crossprod(mm)),\"sparseMatrix\"):", dq(class(cm1)))) \dontshow{% FIXME-- move to ../tests/factorizing.R : expand(C1) ## to check printing } ## Smaller example, with same matrix as in help(chol) : (mm <- Matrix(toeplitz(c(10, 0, 1, 0, 3)), sparse = TRUE)) # 5 x 5 (opts <- expand.grid(perm = c(TRUE,FALSE), LDL = c(TRUE,FALSE), super = c(FALSE,TRUE))) rr <- lapply(seq_len(nrow(opts)), function(i) do.call(Cholesky, c(list(A = mm), opts[i,]))) nn <- do.call(expand.grid, c(attr(opts, "out.attr")$dimnames, stringsAsFactors=FALSE,KEEP.OUT.ATTRS=FALSE)) names(rr) <- apply(nn, 1, function(r) paste(sub("(=.).*","\\\\1", r), collapse=","))% extra '\\' in Rd str(rr, max=1) str(re <- lapply(rr, expand), max=2) ## each has a 'P' and a 'L' matrix %% FIXME !! --- "check" them __unfinished__ R0 <- chol(mm, pivot=FALSE) R1 <- chol(mm, pivot=TRUE ) stopifnot(all.equal(t(R1), re[[1]]$L), all.equal(t(R0), re[[2]]$L), identical(as(1:5, "pMatrix"), re[[2]]$P), # no pivoting TRUE) %% --> ../TODO : .diag.dsC() should be renamed, documented, tested,... \dontshow{ str(dd <- .diag.dsC(mtm)) dc <- .diag.dsC(Chx=C1) # <- directly from the Cholesky stopifnot(all.equal(dd,dc)) }%dont # Version of the underlying SuiteSparse library by Tim Davis : .SuiteSparse_version() } \keyword{array} \keyword{algebra} Matrix/man/rep2abI.Rd0000644000176200001440000000125211352372065014050 0ustar liggesusers\name{rep2abI} \alias{rep2abI} \title{Replicate Vectors into 'abIndex' Result} \description{ \code{rep2abI(x, times)} conceptually computes \code{\link{rep.int}(x, times)} but with an \code{\linkS4class{abIndex}} class result. } \usage{ rep2abI(x, times) } \arguments{ \item{x}{numeric vector} \item{times}{integer (valued) scalar: the number of repetitions} } % \details{ % } \value{ a vector of \code{\link{class}} \code{\linkS4class{abIndex}} } \seealso{ \code{\link{rep.int}()}, the base function; \code{\link{abIseq}}, \code{\linkS4class{abIndex}}. } \examples{ (ab <- rep2abI(2:7, 4)) stopifnot(identical(as(ab, "numeric"), rep(2:7, 4))) } \keyword{manip} Matrix/man/dMatrix-class.Rd0000644000176200001440000001264713057762217015317 0ustar liggesusers\name{dMatrix-class} \docType{class} \title{(Virtual) Class "dMatrix" of "double" Matrices} \alias{dMatrix-class} \alias{lMatrix-class} % \alias{show,dMatrix-method} %\alias{coerce,dMatrix,matrix-method} \alias{coerce,dMatrix,lMatrix-method} \alias{coerce,lMatrix,dMatrix-method} \alias{coerce,lMatrix,dgCMatrix-method} \alias{coerce,matrix,lMatrix-method} %\alias{coerce,dMatrix,dgeMatrix-method} \alias{[,dMatrix,lMatrix,missing,ANY-method} \alias{[,dMatrix,logical,missing,ANY-method} % Group methods \alias{Ops,dMatrix,dMatrix-method} \alias{Ops,dMatrix,lMatrix-method} \alias{Ops,dMatrix,nMatrix-method} \alias{Ops,lMatrix,dMatrix-method} \alias{Ops,lMatrix,lMatrix-method} \alias{Ops,lMatrix,numeric-method} \alias{Ops,nMatrix,dMatrix-method} \alias{Ops,numeric,lMatrix-method} \alias{Arith,dMatrix,dMatrix-method} \alias{Arith,lMatrix,logical-method} \alias{Arith,lMatrix,numeric-method} \alias{Arith,logical,lMatrix-method} \alias{Arith,numeric,lMatrix-method} \alias{Compare,dMatrix,logical-method} \alias{Compare,dMatrix,numeric-method} \alias{Compare,lMatrix,logical-method} \alias{Compare,lMatrix,numeric-method} \alias{Compare,logical,dMatrix-method} \alias{Compare,logical,lMatrix-method} \alias{Compare,numeric,dMatrix-method} \alias{Compare,numeric,lMatrix-method} \alias{Logic,dMatrix,logical-method} \alias{Logic,dMatrix,numeric-method} \alias{Logic,lMatrix,logical-method} \alias{Logic,lMatrix,numeric-method} \alias{Logic,logical,dMatrix-method} \alias{Logic,logical,lMatrix-method} \alias{Logic,numeric,dMatrix-method} \alias{Logic,numeric,lMatrix-method} \alias{Summary,lMatrix-method} %% R <= 2.5.x : % \alias{Math2,dMatrix,ANY-method}% Math2 = round + signif,.., but % \alias{Math2,dMatrix,missing-method} % % for silly reasons, need these 2+3 as well: % \alias{round,dMatrix,numeric-method} % \alias{signif,dMatrix,numeric-method} %% R-2.6.0 - maybe \alias{Math2,dMatrix-method} \alias{log,dMatrix-method} \alias{gamma,dMatrix-method} \alias{lgamma,dMatrix-method} % \alias{zapsmall,dMatrix-method} \alias{which,lMatrix-method} % %\alias{solve,...} --> solve-methods.Rd \description{ The \code{dMatrix} class is a virtual class contained by all actual classes of numeric matrices in the \pkg{Matrix} package. Similarly, all the actual classes of logical matrices inherit from the \code{lMatrix} class. } %\section{Objects from the Class}{A virtual Class: No objects may be % created from it. %} \section{Slots}{ Common to \emph{all} matrix object in the package: \describe{ \item{\code{Dim}:}{Object of class \code{"integer"} - the dimensions of the matrix - must be an integer vector with exactly two non-negative values.} \item{\code{Dimnames}:}{list of length two; each component containing NULL or a \code{\link{character}} vector length equal the corresponding \code{Dim} element.} } } \section{Methods}{ There are (relatively simple) group methods (see, e.g., \code{\link{Arith}}) \describe{ \item{Arith}{\code{signature(e1 = "dMatrix", e2 = "dMatrix")}: ... } \item{Arith}{\code{signature(e1 = "dMatrix", e2 = "numeric")}: ... } \item{Arith}{\code{signature(e1 = "numeric", e2 = "dMatrix")}: ... } \item{Math}{\code{signature(x = "dMatrix")}: ... } \item{Math2}{\code{signature(x = "dMatrix", digits = "numeric")}: this group contains \code{\link{round}()} and \code{\link{signif}()}.} \item{Compare}{\code{signature(e1 = "numeric", e2 = "dMatrix")}: ... } \item{Compare}{\code{signature(e1 = "dMatrix", e2 = "numeric")}: ... } \item{Compare}{\code{signature(e1 = "dMatrix", e2 = "dMatrix")}: ... } \item{Summary}{\code{signature(x = "dMatrix")}: The \code{"Summary"} group contains the seven functions \code{\link{max}()}, \code{\link{min}()}, \code{\link{range}()}, \code{\link{prod}()}, \code{\link{sum}()}, \code{\link{any}()}, and \code{\link{all}()}.} } The following methods are also defined for all double matrices: \describe{ \item{coerce}{\code{signature(from = "dMatrix", to = "matrix")}: ... } % \item{expm}{\code{signature(x = "dMatrix")}: computes the \emph{\dQuote{Matrix Exponential}}, see \code{\link{expm}}.} \item{zapsmall}{\code{signature(x = "dMatrix")}: ... } } The following methods are defined for all logical matrices: \describe{ \item{which}{\code{signature(x = "lsparseMatrix")} and many other subclasses of \code{"lMatrix"}: as the \pkg{base} function \code{\link{which}(x, arr.ind)} returns the indices of the \code{\link{TRUE}} entries in \code{x}; if \code{arr.ind} is true, as a 2-column matrix of row and column indices. Since \pkg{Matrix} version 1.2-9, if \code{useNames} is true, as by default, with \code{\link{dimnames}}, the same as \code{base::which}.} } } %\references{} % Martin + Doug\author{Douglas Bates \email{bates@stat.wisc.edu}} \seealso{ The nonzero-pattern matrix class \code{\linkS4class{nMatrix}}, which can be used to store non-\code{\link{NA}} \code{\link{logical}} matrices even more compactly. The numeric matrix classes \code{\linkS4class{dgeMatrix}}, \code{\linkS4class{dgCMatrix}}, and \code{\linkS4class{Matrix}}. \code{\link{drop0}(x, tol=1e-10)} is sometimes preferable to (and more efficient than) \code{zapsmall(x, digits=10)}. } \examples{ showClass("dMatrix") set.seed(101) round(Matrix(rnorm(28), 4,7), 2) M <- Matrix(rlnorm(56, sd=10), 4,14) (M. <- zapsmall(M)) table(as.logical(M. == 0)) } \keyword{classes} \keyword{algebra} Matrix/man/Cholesky-class.Rd0000644000176200001440000001044012271746775015465 0ustar liggesusers\name{Cholesky-class} \docType{class} \alias{Cholesky-class} \alias{pCholesky-class} \alias{BunchKaufman-class} \alias{pBunchKaufman-class} % \alias{coerce,pCholesky,lMatrix-method} \alias{coerce,pBunchKaufman,lMatrix-method} \alias{coerce,Cholesky,lMatrix-method} \alias{coerce,BunchKaufman,lMatrix-method} \alias{show,BunchKaufman-method} \alias{show,pBunchKaufman-method} % \title{Cholesky and Bunch-Kaufman Decompositions} \description{The \code{"Cholesky"} class is the class of Cholesky decompositions of positive-semidefinite, real dense matrices. The \code{"BunchKaufman"} class is the class of Bunch-Kaufman decompositions of symmetric, real matrices. The \code{"pCholesky"} and \code{"pBunchKaufman"} classes are their \emph{\bold{p}acked} storage versions. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("Cholesky", ...)} or \code{new("BunchKaufman", ...)}, etc, or rather by calls of the form \code{\link{chol}(pm)} or \code{\link{BunchKaufman}(pm)} where \code{pm} inherits from the \code{"\linkS4class{dpoMatrix}"} or \code{"\linkS4class{dsyMatrix}"} class or as a side-effect of other functions applied to \code{"dpoMatrix"} objects (see \code{\linkS4class{dpoMatrix}}). } \note{ \enumerate{ \item Objects of class \code{"Cholesky"} typically stem from \code{\link{chol}(D)}, applied to a \emph{dense} matrix \code{D}. On the other hand, the \emph{function} \code{\link{Cholesky}(S)} applies to a \emph{sparse} matrix \code{S}, and results in objects inheriting from class \code{\linkS4class{CHMfactor}}. \item For traditional matrices \code{m}, \code{chol(m)} is a traditional matrix as well, triangular, but simply an \eqn{n\times n}{n * n} numeric \code{\link{matrix}}. Hence, for compatibility, the \code{"Cholesky"} and \code{"BunchKaufman"} classes (and their \code{"p*"} packed versions) also extend triangular Matrix classes (such as "dtrMatrix"). Consequently, \code{\link{determinant}(R)} for \code{R <- chol(A)} returns the determinant of \code{R}, not of \code{A}. This is in contrast to class \code{\linkS4class{CHMfactor}} objects \code{C}, where \code{determinant(C)} gives the determinant of the \emph{original} matrix \code{A}, for \code{C <- Cholesky(A)}, see also the \code{determinant} method documentation on the class \code{\linkS4class{CHMfactor}} page. } } \section{Slots}{ A Cholesky decomposition extends class \code{\linkS4class{MatrixFactorization}} but is basically a triangular matrix extending the \code{"\linkS4class{dtrMatrix}"} class. \describe{ \item{\code{uplo}:}{inherited from the \code{"dtrMatrix"} class.} \item{\code{diag}:}{inherited from the \code{"dtrMatrix"} class.} \item{\code{x}:}{inherited from the \code{"dtrMatrix"} class.} \item{\code{Dim}:}{inherited from the \code{"dtrMatrix"} class.} \item{\code{Dimnames}:}{inherited from the \code{"dtrMatrix"} class.} } A Bunch-Kaufman decomposition also extends the \code{"dtrMatrix"} class and has a \code{perm} slot representing a permutation matrix. The packed versions extend the \code{"dtpMatrix"} class. } \section{Extends}{ Class \code{"MatrixFactorization"} and \code{"dtrMatrix"}, directly. Class \code{"dgeMatrix"}, by class \code{"dtrMatrix"}. Class \code{"Matrix"}, by class \code{"dtrMatrix"}. } \section{Methods}{ Both these factorizations can \emph{directly} be treated as (triangular) matrices, as they extend \code{"dtrMatrix"}, see above. There are currently no further explicit methods defined with class \code{"Cholesky"} or \code{"BunchKaufman"} in the signature. } \seealso{ Classes \code{\linkS4class{dtrMatrix}}, \code{\linkS4class{dpoMatrix}}; function \code{\link{chol}}. Function \code{\link{Cholesky}} resulting in class \code{\linkS4class{CHMfactor}} objects, \emph{not} class "Cholesky" ones, see the section \sQuote{Note}. } \examples{ (sm <- as(as(Matrix(diag(5) + 1), "dsyMatrix"), "dspMatrix")) signif(csm <- chol(sm), 4) (pm <- crossprod(Matrix(rnorm(18), nrow = 6, ncol = 3))) (ch <- chol(pm)) if (toupper(ch@uplo) == "U") # which is TRUE crossprod(ch) stopifnot(all.equal(as(crossprod(ch), "matrix"), as(pm, "matrix"), tolerance=1e-14)) } \keyword{classes} \keyword{algebra} Matrix/man/Matrix.Rd0000644000176200001440000001114113561041725014026 0ustar liggesusers\name{Matrix} \alias{Matrix} \title{Construct a Classed Matrix} \usage{ Matrix(data=NA, nrow=1, ncol=1, byrow=FALSE, dimnames=NULL, sparse = NULL, doDiag = TRUE, forceCheck = FALSE) } \description{ Construct a Matrix of a class that inherits from \code{Matrix}. } \arguments{ \item{data}{an optional numeric data vector or matrix.} \item{nrow}{when \code{data} is not a matrix, the desired number of rows} \item{ncol}{when \code{data} is not a matrix, the desired number of columns} \item{byrow}{logical. If \code{FALSE} (the default) the matrix is filled by columns, otherwise the matrix is filled by rows.} \item{dimnames}{a \code{\link{dimnames}} attribute for the matrix: a \code{list} of two character components. They are set if not \code{\link{NULL}} (as per default).} \item{sparse}{logical or \code{NULL}, specifying if the result should be sparse or not. By default, it is made sparse when more than half of the entries are 0.} \item{doDiag}{logical indicating if a \code{\linkS4class{diagonalMatrix}} object should be returned when the resulting matrix is diagonal (\emph{mathematically}). As class \code{\linkS4class{diagonalMatrix}} \code{\link{extends}} \code{\linkS4class{sparseMatrix}}, this is a natural default for all values of \code{sparse}. Otherwise, if \code{doDiag} is false, a dense or sparse (depending on \code{sparse}) \emph{symmetric} matrix will be returned.} \item{forceCheck}{logical indicating if the checks for structure should even happen when \code{data} is already a \code{"Matrix"} object.} } \value{ Returns matrix of a class that inherits from \code{"Matrix"}. Only if \code{data} is not a \code{\link{matrix}} and does not already inherit from class \code{\linkS4class{Matrix}} are the arguments \code{nrow}, \code{ncol} and \code{byrow} made use of. } \details{ If either of \code{nrow} or \code{ncol} is not given, an attempt is made to infer it from the length of \code{data} and the other parameter. Further, \code{Matrix()} makes efforts to keep \code{\link{logical}} matrices logical, i.e., inheriting from class \code{\linkS4class{lMatrix}}, and to determine specially structured matrices such as symmetric, triangular or diagonal ones. Note that a \emph{symmetric} matrix also needs symmetric \code{\link{dimnames}}, e.g., by specifying \code{dimnames = list(NULL,NULL)}, see the examples. Most of the time, the function works via a traditional (\emph{full}) \code{\link{matrix}}. However, \code{Matrix(0, nrow,ncol)} directly constructs an \dQuote{empty} \linkS4class{sparseMatrix}, as does \code{Matrix(FALSE, *)}. Although it is sometime possible to mix unclassed matrices (created with \code{matrix}) with ones of class \code{"Matrix"}, it is much safer to always use carefully constructed ones of class \code{"Matrix"}. } \seealso{ The classes \code{\linkS4class{Matrix}}, \code{\linkS4class{symmetricMatrix}}, \code{\linkS4class{triangularMatrix}}, and \code{\linkS4class{diagonalMatrix}}; further, \code{\link{matrix}}. Special matrices can be constructed, e.g., via \code{\link{sparseMatrix}} (sparse), \code{\link{bdiag}} (block-diagonal), \code{\link{bandSparse}} (banded sparse), or \code{\link{Diagonal}}. } \examples{ Matrix(0, 3, 2) # 3 by 2 matrix of zeros -> sparse Matrix(0, 3, 2, sparse=FALSE)# -> 'dense' ## 4 cases - 3 different results : Matrix(0, 2, 2) # diagonal ! Matrix(0, 2, 2, sparse=FALSE)# (ditto) Matrix(0, 2, 2, doDiag=FALSE)# -> sparse symm. "dsCMatrix" Matrix(0, 2, 2, sparse=FALSE, doDiag=FALSE)# -> dense symm. "dsyMatrix" Matrix(1:6, 3, 2) # a 3 by 2 matrix (+ integer warning) Matrix(1:6 + 1, nrow=3) ## logical ones: Matrix(diag(4) > 0) # -> "ldiMatrix" with diag = "U" Matrix(diag(4) > 0, sparse=TRUE) # (ditto) Matrix(diag(4) >= 0) # -> "lsyMatrix" (of all 'TRUE') ## triangular l3 <- upper.tri(matrix(,3,3)) (M <- Matrix(l3)) # -> "ltCMatrix" Matrix(! l3) # -> "ltrMatrix" as(l3, "CsparseMatrix")# "lgCMatrix" Matrix(1:9, nrow=3, dimnames = list(c("a", "b", "c"), c("A", "B", "C"))) (I3 <- Matrix(diag(3)))# identity, i.e., unit "diagonalMatrix" str(I3) # note 'diag = "U"' and the empty 'x' slot (A <- cbind(a=c(2,1), b=1:2))# symmetric *apart* from dimnames Matrix(A) # hence 'dgeMatrix' (As <- Matrix(A, dimnames = list(NULL,NULL)))# -> symmetric forceSymmetric(A) # also symmetric, w/ symm. dimnames stopifnot(is(As, "symmetricMatrix"), is(Matrix(0, 3,3), "sparseMatrix"), is(Matrix(FALSE, 1,1), "sparseMatrix")) } \keyword{array} \keyword{algebra} Matrix/man/bandSparse.Rd0000644000176200001440000000676713711014657014667 0ustar liggesusers\name{bandSparse} \alias{bandSparse} \title{Construct Sparse Banded Matrix from (Sup-/Super-) Diagonals} \description{ Construct a sparse banded matrix by specifying its non-zero sup- and super-diagonals. } \usage{ bandSparse(n, m = n, k, diagonals, symmetric = FALSE, repr = "C", giveCsparse = (repr == "C")) } \arguments{ \item{n,m}{the matrix dimension \eqn{(n,m) = (nrow, ncol)}.} \item{k}{integer vector of \dQuote{diagonal numbers}, with identical meaning as in \code{\link{band}(*, k)}, i.e., relative to the main diagonal, which is \code{k=0}.} \item{diagonals}{optional list of sub-/super- diagonals; if missing, the result will be a patter\bold{n} matrix, i.e., inheriting from class \code{\linkS4class{nMatrix}}. \code{diagonals} can also be \eqn{n' \times d}{n' x d} matrix, where \code{d <- length(k)} and \eqn{n' >= min(n,m)}. In that case, the sub-/super- diagonals are taken from the columns of \code{diagonals}, where only the first several rows will be used (typically) for off-diagonals. } \item{symmetric}{logical; if true the result will be symmetric (inheriting from class \code{\linkS4class{symmetricMatrix}}) and only the upper or lower triangle must be specified (via \code{k} and \code{diagonals}).} \item{repr}{\code{\link{character}} string, one of \code{"C"}, \code{"T"}, or \code{"R"}, specifying the sparse \emph{repr}esentation to be used for the result, i.e., one from the super classes \code{\linkS4class{CsparseMatrix}}, \code{\linkS4class{TsparseMatrix}}, or \code{\linkS4class{RsparseMatrix}}.} \item{giveCsparse}{(\bold{deprecated}, replaced with \code{repr}): logical indicating if the result should be a \code{\linkS4class{CsparseMatrix}} or a \code{\linkS4class{TsparseMatrix}}, where the default was \code{TRUE}, and now is determined from \code{repr}; very often Csparse matrices are more efficient subsequently, but not always.} } % \details{ __needed ?__ % % } \value{ a sparse matrix (of \code{\link{class}} \code{\linkS4class{CsparseMatrix}}) of dimension \eqn{n \times m}{n x m} with diagonal \dQuote{bands} as specified. } %\author{Martin Maechler} \seealso{ \code{\link{band}}, for \emph{extraction} of matrix bands; \code{\link{bdiag}}, \code{\link{diag}}, \code{\link{sparseMatrix}}, \code{\link{Matrix}}. } \examples{ diags <- list(1:30, 10*(1:20), 100*(1:20)) s1 <- bandSparse(13, k = -c(0:2, 6), diag = c(diags, diags[2]), symm=TRUE) s1 s2 <- bandSparse(13, k = c(0:2, 6), diag = c(diags, diags[2]), symm=TRUE) stopifnot(identical(s1, t(s2)), is(s1,"dsCMatrix")) ## a pattern Matrix of *full* (sub-)diagonals: bk <- c(0:4, 7,9) (s3 <- bandSparse(30, k = bk, symm = TRUE)) ## If you want a pattern matrix, but with "sparse"-diagonals, ## you currently need to go via logical sparse: lLis <- lapply(list(rpois(20, 2), rpois(20,1), rpois(20,3))[c(1:3,2:3,3:2)], as.logical) (s4 <- bandSparse(20, k = bk, symm = TRUE, diag = lLis)) (s4. <- as(drop0(s4), "nsparseMatrix")) n <- 1e4 bk <- c(0:5, 7,11) bMat <- matrix(1:8, n, 8, byrow=TRUE) bLis <- as.data.frame(bMat) B <- bandSparse(n, k = bk, diag = bLis) Bs <- bandSparse(n, k = bk, diag = bLis, symmetric=TRUE) B [1:15, 1:30] Bs[1:15, 1:30] ## can use a list *or* a matrix for specifying the diagonals: stopifnot(identical(B, bandSparse(n, k = bk, diag = bMat)), identical(Bs, bandSparse(n, k = bk, diag = bMat, symmetric=TRUE)) , inherits(B, "dtCMatrix") # triangular! ) } \keyword{array} \keyword{algebra} Matrix/man/dtpMatrix-class.Rd0000644000176200001440000000755012271746775015670 0ustar liggesusers\name{dtpMatrix-class} \title{Packed Triangular Dense Matrices - "dtpMatrix"} \docType{class} \alias{dtpMatrix-class} \alias{coerce,dtpMatrix,dtTMatrix-method} \alias{coerce,dtpMatrix,dtrMatrix-method} \alias{coerce,dtpMatrix,ltpMatrix-method} \alias{coerce,dtpMatrix,matrix-method} \alias{coerce,matrix,dtpMatrix-method} \alias{determinant,dtpMatrix,missing-method} \alias{determinant,dtpMatrix,logical-method} \alias{diag,dtpMatrix-method} \alias{diag<-,dtpMatrix-method} \alias{norm,dtpMatrix,character-method} \alias{norm,dtpMatrix,missing-method} \alias{rcond,dtpMatrix,character-method} \alias{rcond,dtpMatrix,missing-method} %\alias{solve,dtpMatrix,...-method}%--> solve-methods.Rd \alias{t,dtpMatrix-method} \description{The \code{"dtpMatrix"} class is the class of triangular, dense, numeric matrices in packed storage. The \code{"dtrMatrix"} class is the same except in nonpacked storage.} \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("dtpMatrix", ...)} or by coercion from other classes of matrices. } \section{Slots}{ \describe{ \item{\code{uplo}:}{Object of class \code{"character"}. Must be either "U", for upper triangular, and "L", for lower triangular.} \item{\code{diag}:}{Object of class \code{"character"}. Must be either \code{"U"}, for unit triangular (diagonal is all ones), or \code{"N"}; see \code{\linkS4class{triangularMatrix}}.} \item{\code{x}:}{Object of class \code{"numeric"}. The numeric values that constitute the matrix, stored in column-major order. For a packed square matrix of dimension \eqn{d \times d}{d * d}, \code{length(x)} is of length \eqn{d(d+1)/2} (also when \code{diag == "U"}!).} \item{\code{Dim},\code{Dimnames}:}{The dimension (a length-2 \code{"integer"}) and corresponding names (or \code{NULL}), inherited from the \code{\linkS4class{Matrix}}, see there.} } } \section{Extends}{ Class \code{"ddenseMatrix"}, directly. Class \code{"triangularMatrix"}, directly. Class \code{"dMatrix"} and more by class \code{"ddenseMatrix"} etc, see the examples. } \section{Methods}{ \describe{ \item{\%*\%}{\code{signature(x = "dtpMatrix", y = "dgeMatrix")}: Matrix multiplication; ditto for several other signature combinations, see \code{showMethods("\%*\%", class = "dtpMatrix")}.} \item{coerce}{\code{signature(from = "dtpMatrix", to = "dtrMatrix")}} \item{coerce}{\code{signature(from = "dtpMatrix", to = "matrix")}} \item{determinant}{\code{signature(x = "dtpMatrix", logarithm = "logical")}: the \code{\link{determinant}(x)} trivially is \code{prod(diag(x))}, but computed on log scale to prevent over- and underflow.} \item{diag}{\code{signature(x = "dtpMatrix")}: ... } \item{norm}{\code{signature(x = "dtpMatrix", type = "character")}: ... } \item{rcond}{\code{signature(x = "dtpMatrix", norm = "character")}: ... } \item{solve}{\code{signature(a = "dtpMatrix", b = "...")}: efficiently using internal backsolve or forwardsolve, see \code{\link{solve-methods}}.} \item{t}{\code{signature(x = "dtpMatrix")}: \code{t(x)} remains a \code{"dtpMatrix"}, lower triangular if \code{x} is upper triangular, and vice versa.} } } \seealso{ Class \code{\linkS4class{dtrMatrix}} } \examples{ showClass("dtrMatrix") example("dtrMatrix-class", echo=FALSE) (p1 <- as(T2, "dtpMatrix")) str(p1) (pp <- as(T, "dtpMatrix")) ip1 <- solve(p1) stopifnot(length(p1@x) == 3, length(pp@x) == 3, p1 @ uplo == T2 @ uplo, pp @ uplo == T @ uplo, identical(t(pp), p1), identical(t(p1), pp), all((l.d <- p1 - T2) == 0), is(l.d, "dtpMatrix"), all((u.d <- pp - T ) == 0), is(u.d, "dtpMatrix"), l.d@uplo == T2@uplo, u.d@uplo == T@uplo, identical(t(ip1), solve(pp)), is(ip1, "dtpMatrix"), all.equal(as(solve(p1,p1), "diagonalMatrix"), Diagonal(2))) } \keyword{classes} Matrix/man/facmul.Rd0000644000176200001440000000352610027645165014043 0ustar liggesusers\name{facmul} \title{Multiplication by Decomposition Factors} \usage{ facmul(x, factor, y, transpose, left, \dots) } \alias{facmul} \alias{facmul.default} \description{ Performs multiplication by factors for certain decompositions (and allows explicit formation of those factors). } \arguments{ \item{x}{ a matrix decomposition. No missing values or IEEE special values are allowed. } \item{factor}{ an indicator for selecting a particular factor for multiplication. } \item{y}{ a matrix or vector to be multiplied by the factor or its transpose. No missing values or IEEE special values are allowed. } \item{transpose}{ a logical value. When \code{FALSE} (the default) the factor is applied. When \code{TRUE} the transpose of the factor is applied. } \item{left}{ a logical value. When \code{TRUE} (the default) the factor is applied from the left. When \code{FALSE} the factor is applied from the right. } \item{...}{ the method for \code{"qr.Matrix"} has additional arguments. } } \value{ the product of the selected factor (or its transpose) and \code{y} } \section{NOTE}{ Factors for decompositions such as \code{lu} and \code{qr} can be stored in a compact form. The function \code{facmul} allows multiplication without explicit formation of the factors, saving both storage and operations. } \references{ Golub, G., and Van Loan, C. F. (1989). \emph{Matrix Computations,} 2nd edition, Johns Hopkins, Baltimore. } % \seealso{ % \code{\link{facmul.lu.Matrix}}, \code{\link{facmul.lu.Hermitian}}, \code{\link{facmul.qr.Matrix}}, \code{\link{expand}}. % } \examples{ library(Matrix) x <- Matrix(rnorm(9), 3, 3) \dontrun{ qrx <- qr(x) # QR factorization of x y <- rnorm(3) facmul( qr(x), factor = "Q", y) # form Q y } } \keyword{array} \keyword{algebra} Matrix/man/sparseMatrix.Rd0000644000176200001440000002367313711014657015262 0ustar liggesusers\name{sparseMatrix} \alias{sparseMatrix} \title{General Sparse Matrix Construction from Nonzero Entries} \description{ User friendly construction of a compressed, column-oriented, sparse matrix, inheriting from \code{\link{class}} \code{\linkS4class{CsparseMatrix}} (or \code{\linkS4class{TsparseMatrix}} if \code{giveCsparse} is false), from locations (and values) of its non-zero entries. This is the recommended user interface rather than direct \code{\link{new}("***Matrix", ....)} calls. } \usage{ sparseMatrix(i = ep, j = ep, p, x, dims, dimnames, symmetric = FALSE, triangular = FALSE, index1 = TRUE, repr = "C", giveCsparse = (repr == "C"), check = TRUE, use.last.ij = FALSE) } \arguments{ \item{i,j}{integer vectors of the same length specifying the locations (row and column indices) of the non-zero (or non-\code{TRUE}) entries of the matrix. Note that for \emph{repeated} pairs \eqn{(i_k,j_k)}, when \code{x} is not missing, the corresponding \eqn{x_k} are \emph{added}, in consistency with the definition of the \code{"\linkS4class{TsparseMatrix}"} class, unless \code{use.last.ij} is true, in which case only the \emph{last} of the corresponding \eqn{(i_k, j_k, x_k)} triplet is used.} \item{p}{numeric (integer valued) vector of pointers, one for each column (or row), to the initial (zero-based) index of elements in the column (or row). Exactly one of \code{i}, \code{j} or \code{p} must be missing.} \item{x}{ optional values of the matrix entries. If specified, must be of the same length as \code{i} / \code{j}, or of length one where it will be recycled to full length. If missing, the resulting matrix will be a 0/1 patter\bold{n} matrix, i.e., extending class \code{\linkS4class{nsparseMatrix}}. } \item{dims}{optional, non-negative, integer, dimensions vector of length 2. Defaults to \code{c(max(i), max(j))}.} \item{dimnames}{optional list of \code{\link{dimnames}}; if not specified, none, i.e., \code{\link{NULL}} ones, are used.} \item{symmetric}{logical indicating if the resulting matrix should be symmetric. In that case, only the lower or upper triangle needs to be specified via \eqn{(i/j/p)}.} \item{triangular}{logical indicating if the resulting matrix should be triangular. In that case, the lower or upper triangle needs to be specified via \eqn{(i/j/p)}.} \item{index1}{logical scalar. If \code{TRUE}, the default, the index vectors \code{i} and/or \code{j} are 1-based, as is the convention in \R. That is, counting of rows and columns starts at 1. If \code{FALSE} the index vectors are 0-based so counting of rows and columns starts at 0; this corresponds to the internal representation.} \item{repr}{\code{\link{character}} string, one of \code{"C"}, \code{"T"}, or \code{"R"}, specifying the sparse \emph{repr}esentation to be used for the result, i.e., one from the super classes \code{\linkS4class{CsparseMatrix}}, \code{\linkS4class{TsparseMatrix}}, or \code{\linkS4class{RsparseMatrix}}.} \item{giveCsparse}{(\bold{deprecated}, replaced with \code{repr}): logical indicating if the result should be a \code{\linkS4class{CsparseMatrix}} or a \code{\linkS4class{TsparseMatrix}}, where the default was \code{TRUE}, and now is determined from \code{repr}; very often Csparse matrices are more efficient subsequently, but not always.} \item{check}{logical indicating if a validity check is performed; do not set to \code{FALSE} unless you know what you're doing!} \item{use.last.ij}{logical indicating if in the case of repeated, i.e., duplicated pairs \eqn{(i_k, j_k)} only the last one should be used. The default, \code{FALSE}, corresponds to the \code{"\linkS4class{TsparseMatrix}"} definition.} } \value{ A sparse matrix, by default (from \code{repr = "C"}) in compressed, column-oriented form, as an \R object inheriting from both \code{\linkS4class{CsparseMatrix}} and \code{\linkS4class{generalMatrix}}. } \details{ Exactly one of the arguments \code{i}, \code{j} and \code{p} must be missing. In typical usage, \code{p} is missing, \code{i} and \code{j} are vectors of positive integers and \code{x} is a numeric vector. These three vectors, which must have the same length, form the triplet representation of the sparse matrix. If \code{i} or \code{j} is missing then \code{p} must be a non-decreasing integer vector whose first element is zero. It provides the compressed, or \dQuote{pointer} representation of the row or column indices, whichever is missing. The expanded form of \code{p}, \code{rep(seq_along(dp),dp)} where \code{dp <- diff(p)}, is used as the (1-based) row or column indices. You cannot set both \code{singular} and \code{triangular} to true; rather use \code{\link{Diagonal}()} (or its alternatives, see there). The values of \code{i}, \code{j}, \code{p} and \code{index1} are used to create 1-based index vectors \code{i} and \code{j} from which a \code{\linkS4class{TsparseMatrix}} is constructed, with numerical values given by \code{x}, if non-missing. Note that in that case, when some pairs \eqn{(i_k,j_k)} are repeated (aka \dQuote{duplicated}), the corresponding \eqn{x_k} are \emph{added}, in consistency with the definition of the \code{"\linkS4class{TsparseMatrix}"} class, unless \code{use.last.ij} is set to true. %% By default, when \code{repr = "C"}, the \code{\linkS4class{CsparseMatrix}} derived from this triplet form is returned, where \code{repr = "R"} now allows to directly get an \code{\linkS4class{RsparseMatrix}} and \code{repr = "T"} leaves the result as \code{\linkS4class{TsparseMatrix}}. The reason for returning a \code{\linkS4class{CsparseMatrix}} object instead of the triplet format by default is that the compressed column form is easier to work with when performing matrix operations. In particular, if there are no zeros in \code{x} then a \code{\linkS4class{CsparseMatrix}} is a unique representation of the sparse matrix. } \note{% We say so above (-> {index1}), but some do not read that You \emph{do} need to use \code{index1 = FALSE} (or add \code{+ 1} to \code{i} and \code{j}) if you want use the 0-based \code{i} (and \code{j}) slots from existing sparse matrices. } \seealso{\code{\link{Matrix}(*, sparse=TRUE)} for the constructor of such matrices from a \emph{dense} matrix. That is easier in small sample, but much less efficient (or impossible) for large matrices, where something like \code{sparseMatrix()} is needed. Further \code{\link{bdiag}} and \code{\link{Diagonal}} for (block-)diagonal and \code{\link{bandSparse}} for banded sparse matrix constructors. Random sparse matrices via \code{\link{rsparsematrix}()}. The standard \R \code{\link{xtabs}(*, sparse=TRUE)}, for sparse tables and \code{\link{sparse.model.matrix}()} for building sparse model matrices. Consider \code{\linkS4class{CsparseMatrix}} and similar class definition help files. } \examples{ ## simple example i <- c(1,3:8); j <- c(2,9,6:10); x <- 7 * (1:7) (A <- sparseMatrix(i, j, x = x)) ## 8 x 10 "dgCMatrix" summary(A) str(A) # note that *internally* 0-based row indices are used (sA <- sparseMatrix(i, j, x = x, symmetric = TRUE)) ## 10 x 10 "dsCMatrix" (tA <- sparseMatrix(i, j, x = x, triangular= TRUE)) ## 10 x 10 "dtCMatrix" stopifnot( all(sA == tA + t(tA)) , identical(sA, as(tA + t(tA), "symmetricMatrix"))) ## dims can be larger than the maximum row or column indices (AA <- sparseMatrix(c(1,3:8), c(2,9,6:10), x = 7 * (1:7), dims = c(10,20))) summary(AA) ## i, j and x can be in an arbitrary order, as long as they are consistent set.seed(1); (perm <- sample(1:7)) (A1 <- sparseMatrix(i[perm], j[perm], x = x[perm])) stopifnot(identical(A, A1)) ## The slots are 0-index based, so try( sparseMatrix(i=A@i, p=A@p, x= seq_along(A@x)) ) ## fails and you should say so: 1-indexing is FALSE: sparseMatrix(i=A@i, p=A@p, x= seq_along(A@x), index1 = FALSE) ## the (i,j) pairs can be repeated, in which case the x's are summed (args <- data.frame(i = c(i, 1), j = c(j, 2), x = c(x, 2))) (Aa <- do.call(sparseMatrix, args)) ## explicitly ask for elimination of such duplicates, so ## that the last one is used: (A. <- do.call(sparseMatrix, c(args, list(use.last.ij = TRUE)))) stopifnot(Aa[1,2] == 9, # 2+7 == 9 A.[1,2] == 2) # 2 was *after* 7 ## for a pattern matrix, of course there is no "summing": (nA <- do.call(sparseMatrix, args[c("i","j")])) dn <- list(LETTERS[1:3], letters[1:5]) ## pointer vectors can be used, and the (i,x) slots are sorted if necessary: m <- sparseMatrix(i = c(3,1, 3:2, 2:1), p= c(0:2, 4,4,6), x = 1:6, dimnames = dn) m str(m) stopifnot(identical(dimnames(m), dn)) sparseMatrix(x = 2.72, i=1:3, j=2:4) # recycling x sparseMatrix(x = TRUE, i=1:3, j=2:4) # recycling x, |--> "lgCMatrix" ## no 'x' --> patter*n* matrix: (n <- sparseMatrix(i=1:6, j=rev(2:7)))# -> ngCMatrix ## an empty sparse matrix: (e <- sparseMatrix(dims = c(4,6), i={}, j={})) ## a symmetric one: (sy <- sparseMatrix(i= c(2,4,3:5), j= c(4,7:5,5), x = 1:5, dims = c(7,7), symmetric=TRUE)) stopifnot(isSymmetric(sy), identical(sy, ## switch i <-> j {and transpose } t( sparseMatrix(j= c(2,4,3:5), i= c(4,7:5,5), x = 1:5, dims = c(7,7), symmetric=TRUE)))) ## rsparsematrix() calls sparseMatrix() : M1 <- rsparsematrix(1000, 20, nnz = 200) summary(M1) ## pointers example in converting from other sparse matrix representations. if(require(SparseM) && packageVersion("SparseM") >= 0.87 && nzchar(dfil <- system.file("extdata", "rua_32_ax.rua", package = "SparseM"))) { X <- model.matrix(read.matrix.hb(dfil)) XX <- sparseMatrix(j = X@ja, p = X@ia - 1L, x = X@ra, dims = X@dimension) validObject(XX) ## Alternatively, and even more user friendly : X. <- as(X, "Matrix") # or also X2 <- as(X, "sparseMatrix") stopifnot(identical(XX, X.), identical(X., X2)) }% if }% example \keyword{array} Matrix/man/condest.Rd0000644000176200001440000001007313712734704014230 0ustar liggesusers\name{condest} \alias{condest} \alias{onenormest} \title{Compute Approximate CONDition number and 1-Norm of (Large) Matrices} \description{ \dQuote{Estimate}, i.e. compute approximately the CONDition number of a (potentially large, often sparse) matrix \code{A}. It works by apply a fast \emph{randomized} approximation of the 1-norm, \code{norm(A,"1")}, through \code{onenormest(.)}. } \usage{ condest(A, t = min(n, 5), normA = norm(A, "1"), silent = FALSE, quiet = TRUE) onenormest(A, t = min(n, 5), A.x, At.x, n, silent = FALSE, quiet = silent, iter.max = 10, eps = 4 * .Machine$double.eps) } \arguments{ \item{A}{a square matrix, optional for \code{onenormest()}, where instead of \code{A}, \code{A.x} and \code{At.x} can be specified, see there.} \item{t}{number of columns to use in the iterations.} \item{normA}{number; (an estimate of) the 1-norm of \code{A}, by default \code{\link{norm}(A, "1")}; may be replaced by an estimate.} \item{silent}{logical indicating if warning and (by default) convergence messages should be displayed.} \item{quiet}{logical indicating if convergence messages should be displayed.} \item{A.x, At.x}{when \code{A} is missing, these two must be given as functions which compute \code{A \%\% x}, or \code{t(A) \%\% x}, respectively.} \item{n}{\code{ == nrow(A)}, only needed when \code{A} is not specified.} \item{iter.max}{maximal number of iterations for the 1-norm estimator.} \item{eps}{the relative change that is deemed irrelevant.} } \details{ \code{\link{condest}()} calls \code{\link{lu}(A)}, and subsequently \code{onenormest(A.x = , At.x = )} to compute an approximate norm of the \emph{inverse} of \code{A}, \eqn{A^{-1}}, in a way which keeps using sparse matrices efficiently when \code{A} is sparse. Note that \code{onenormest()} uses random vectors and hence \emph{both} functions' results are random, i.e., depend on the random seed, see, e.g., \code{\link{set.seed}()}. } \value{Both functions return a \code{\link{list}}; \code{condest()} with components, \item{est}{a number \eqn{> 0}, the estimated (1-norm) condition number \eqn{\hat\kappa}{k.}; when \eqn{r :=}\code{rcond(A)}, \eqn{1/\hat\kappa \approx r}{1/k. ~= r}.} \item{v}{the maximal \eqn{A x} column, scaled to norm(v) = 1. Consequently, \eqn{norm(A v) = norm(A) / est}; when \code{est} is large, \code{v} is an approximate null vector.} The function \code{onenormest()} returns a list with components, \item{est}{a number \eqn{> 0}, the estimated \code{norm(A, "1")}.} \item{v}{0-1 integer vector length \code{n}, with an \code{1} at the index \code{j} with maximal column \code{A[,j]} in \eqn{A}.} \item{w}{numeric vector, the largest \eqn{A x} found.} \item{iter}{the number of iterations used.} } \references{ %% See also Tim Davis(2006, p.96): Nicholas J. Higham and Françoise Tisseur (2000). A Block Algorithm for Matrix 1-Norm Estimation, with an Application to 1-Norm Pseudospectra. \emph{SIAM J. Matrix Anal. Appl.} \bold{21}, 4, 1185--1201. %% ok for ETH etc, but not free: \doi{10.1137/S0895479899356080} \url{https://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.7.9804} William W. Hager (1984). Condition Estimates. \emph{SIAM J. Sci. Stat. Comput.} \bold{5}, 311--316. } \author{This is based on octave's \code{condest()} and \code{onenormest()} implementations with original author Jason Riedy, U Berkeley; translation to \R and adaption by Martin Maechler. } \seealso{ \code{\link{norm}}, \code{\link{rcond}}. } \examples{ data(KNex) mtm <- with(KNex, crossprod(mm)) system.time(ce <- condest(mtm)) sum(abs(ce$v)) ## || v ||_1 == 1 ## Prove that || A v || = || A || / est (as ||v|| = 1): stopifnot(all.equal(norm(mtm \%*\% ce$v), norm(mtm) / ce$est)) ## reciprocal 1 / ce$est system.time(rc <- rcond(mtm)) # takes ca 3 x longer rc all.equal(rc, 1/ce$est) # TRUE -- the approxmation was good one <- onenormest(mtm) str(one) ## est = 12.3 ## the maximal column: which(one$v == 1) # mostly 4, rarely 1, depending on random seed } Matrix/man/ngeMatrix-class.Rd0000644000176200001440000000411112622367447015633 0ustar liggesusers\name{ngeMatrix-class} \docType{class} \title{Class "ngeMatrix" of General Dense Nonzero-pattern Matrices} \alias{ngeMatrix-class} % \alias{!,ngeMatrix-method} \alias{Arith,ngeMatrix,ngeMatrix-method} \alias{Compare,ngeMatrix,ngeMatrix-method} \alias{Logic,ngeMatrix,ngeMatrix-method} \alias{as.vector,ngeMatrix-method} \alias{coerce,matrix,ngeMatrix-method} \alias{coerce,ngeMatrix,dgeMatrix-method} \alias{coerce,ngeMatrix,matrix-method} \alias{coerce,ngeMatrix,ngCMatrix-method} \alias{coerce,ngeMatrix,ngTMatrix-method} \alias{coerce,ngeMatrix,nsyMatrix-method} \alias{coerce,ngeMatrix,ntrMatrix-method} \alias{coerce,ngeMatrix,ntpMatrix-method} \alias{coerce,ngeMatrix,nspMatrix-method} \alias{diag<-,ngeMatrix-method} \alias{t,ngeMatrix-method} % \description{This is the class of general dense nonzero-pattern matrices, see \code{\linkS4class{nMatrix}}. } \section{Slots}{ \describe{ \item{\code{x}:}{Object of class \code{"logical"}. The logical values that constitute the matrix, stored in column-major order.} \item{\code{Dim},\code{Dimnames}:}{The dimension (a length-2 \code{"integer"}) and corresponding names (or \code{NULL}), see the \code{\linkS4class{Matrix}} class.} \item{\code{factors}:}{Object of class \code{"list"}. A named list of factorizations that have been computed for the matrix.} } } \section{Extends}{ Class \code{"ndenseMatrix"}, directly. Class \code{"lMatrix"}, by class \code{"ndenseMatrix"}. Class \code{"denseMatrix"}, by class \code{"ndenseMatrix"}. Class \code{"Matrix"}, by class \code{"ndenseMatrix"}. Class \code{"Matrix"}, by class \code{"ndenseMatrix"}. } \section{Methods}{ Currently, mainly \code{\link{t}()} and coercion methods (for \code{\link{as}(.)}); use, e.g., \code{\link{showMethods}(class="ngeMatrix")} for details. } \seealso{ Non-general logical dense matrix classes such as \code{\linkS4class{ntrMatrix}}, or \code{\linkS4class{nsyMatrix}}; \emph{sparse} logical classes such as \code{\linkS4class{ngCMatrix}}. } \examples{ showClass("ngeMatrix") ## "lgeMatrix" is really more relevant } \keyword{classes} Matrix/man/dtRMatrix-class-def.Rd0000644000176200001440000000531511004024375016335 0ustar liggesusers\name{dtRMatrix-class} \title{Triangular Sparse Compressed Row Matrices} \docType{class} \alias{dtRMatrix-class} %%--- No methods currently --- see ./dtCMatrix-class.Rd for more \description{The \code{dtRMatrix} class is a class of triangular, sparse matrices in the compressed, row-oriented format. In this implementation the non-zero elements in the rows are sorted into increasing columnd order. } \section{Objects from the Class}{ This class is currently still mostly unimplemented! Objects can be created by calls of the form \code{new("dtRMatrix", ...)}. } \section{Slots}{ \describe{ \item{\code{uplo}:}{Object of class \code{"character"}. Must be either "U", for upper triangular, and "L", for lower triangular. At present only the lower triangle form is allowed.} \item{\code{diag}:}{Object of class \code{"character"}. Must be either \code{"U"}, for unit triangular (diagonal is all ones), or \code{"N"}; see \code{\linkS4class{triangularMatrix}}.} \item{\code{j}:}{Object of class \code{"integer"} of length \code{\link{nnzero}(.)} (number of non-zero elements). These are the row numbers for each non-zero element in the matrix.} \item{\code{p}:}{Object of class \code{"integer"} of pointers, one for each row, to the initial (zero-based) index of elements in the row. (Only present in the \code{dsRMatrix} class.)} \item{\code{x}:}{Object of class \code{"numeric"} - the non-zero elements of the matrix.} \item{\code{Dim}:}{The dimension (a length-2 \code{"integer"})} \item{\code{Dimnames}:}{corresponding names (or \code{NULL}), inherited from the \code{\linkS4class{Matrix}}, see there.} } } \section{Extends}{ Class \code{"dgRMatrix"}, directly. Class \code{"dsparseMatrix"}, by class \code{"dgRMatrix"}. Class \code{"dMatrix"}, by class \code{"dgRMatrix"}. Class \code{"sparseMatrix"}, by class \code{"dgRMatrix"}. Class \code{"Matrix"}, by class \code{"dgRMatrix"}. } \section{Methods}{ No methods currently with class "dsRMatrix" in the signature. % \describe{ % \item{solve}{\code{signature(a = "dsRMatrix", b = "matrix")}: Solve % a linear system of equations defined by \code{x} using a Cholesky % decomposition.} % ...... % \item{coerce}{\code{signature(from = "dsRMatrix", to = "dgTMatrix")}} % ...... % } } %\references{} %\author{} %\note{} \seealso{ Classes \code{\linkS4class{dgCMatrix}}, \code{\linkS4class{dgTMatrix}}, \code{\linkS4class{dgeMatrix}} } \examples{ (m0 <- new("dtRMatrix")) (m2 <- new("dtRMatrix", Dim = c(2L,2L), x = c(5, 1:2), p = c(0L,2:3), j= c(0:1,1L))) str(m2) (m3 <- as(Diagonal(2), "RsparseMatrix"))# --> dtRMatrix } \keyword{classes} \keyword{algebra} Matrix/man/colSums.Rd0000644000176200001440000001132012533262160014202 0ustar liggesusers\name{colSums} \alias{colSums} \alias{colMeans} \alias{rowSums} \alias{rowMeans} \alias{colMeans,diagonalMatrix-method} \alias{colSums,diagonalMatrix-method} \alias{rowMeans,diagonalMatrix-method} \alias{rowSums,diagonalMatrix-method} \alias{colMeans,CsparseMatrix-method} \alias{colSums,CsparseMatrix-method} \alias{rowMeans,CsparseMatrix-method} \alias{rowSums,CsparseMatrix-method} \alias{colMeans,TsparseMatrix-method} \alias{colSums,TsparseMatrix-method} \alias{rowMeans,TsparseMatrix-method} \alias{rowSums,TsparseMatrix-method} \alias{colMeans,RsparseMatrix-method} \alias{colSums,RsparseMatrix-method} \alias{rowMeans,RsparseMatrix-method} \alias{rowSums,RsparseMatrix-method} \alias{colMeans,dgCMatrix-method} \alias{colSums,dgCMatrix-method} \alias{rowMeans,dgCMatrix-method} \alias{rowSums,dgCMatrix-method} \alias{colMeans,igCMatrix-method} \alias{colSums,igCMatrix-method} \alias{rowMeans,igCMatrix-method} \alias{rowSums,igCMatrix-method} \alias{colMeans,lgCMatrix-method} \alias{colSums,lgCMatrix-method} \alias{rowMeans,lgCMatrix-method} \alias{rowSums,lgCMatrix-method} \alias{colMeans,ngCMatrix-method} \alias{colSums,ngCMatrix-method} \alias{rowMeans,ngCMatrix-method} \alias{rowSums,ngCMatrix-method} % dense ones \alias{colMeans,denseMatrix-method} \alias{colSums,denseMatrix-method} \alias{rowMeans,denseMatrix-method} \alias{rowSums,denseMatrix-method} \alias{colMeans,ddenseMatrix-method} \alias{colSums,ddenseMatrix-method} \alias{rowMeans,ddenseMatrix-method} \alias{rowSums,ddenseMatrix-method} % NB: kept those documented in ./dgeMatrix-class.Rd % \title{Form Row and Column Sums and Means} % see also ~/R/D/r-devel/R/src/library/base/man/colSums.Rd \description{ Form row and column sums and means for objects, for \code{\linkS4class{sparseMatrix}} the result may optionally be sparse (\code{\linkS4class{sparseVector}}), too. Row or column names are kept respectively as for \pkg{base} matrices and \code{\link{colSums}} methods, when the result is \code{\link{numeric}} vector. } \usage{ colSums (x, na.rm = FALSE, dims = 1, \dots) rowSums (x, na.rm = FALSE, dims = 1, \dots) colMeans(x, na.rm = FALSE, dims = 1, \dots) rowMeans(x, na.rm = FALSE, dims = 1, \dots) \S4method{colSums}{CsparseMatrix}(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) \S4method{rowSums}{CsparseMatrix}(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) \S4method{colMeans}{CsparseMatrix}(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) \S4method{rowMeans}{CsparseMatrix}(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) } \arguments{ \item{x}{a Matrix, i.e., inheriting from \code{\linkS4class{Matrix}}.} \item{na.rm}{logical. Should missing values (including \code{NaN}) be omitted from the calculations?} \item{dims}{completely ignored by the \code{Matrix} methods.} \item{\dots}{potentially further arguments, for method \code{<->} generic compatibility.} \item{sparseResult}{logical indicating if the result should be sparse, i.e., inheriting from class \code{\linkS4class{sparseVector}}. Only applicable when \code{x} is inheriting from a \code{\linkS4class{sparseMatrix}} class.} } % \details{ % ~~ If necessary, more details than the description above ~~ % } \value{ returns a numeric vector if \code{sparseResult} is \code{FALSE} as per default. Otherwise, returns a \code{\linkS4class{sparseVector}}. \code{\link{dimnames}(x)} are only kept (as \code{\link{names}(v)}) when the resulting \code{v} is \code{\link{numeric}}, since \code{\link{sparseVector}}s do not have names. } %\author{Martin} \seealso{\code{\link[base]{colSums}} and the \code{\linkS4class{sparseVector}} classes. } \examples{ (M <- bdiag(Diagonal(2), matrix(1:3, 3,4), diag(3:2))) # 7 x 8 colSums(M) d <- Diagonal(10, c(0,0,10,0,2,rep(0,5))) MM <- kronecker(d, M) dim(MM) # 70 80 length(MM@x) # 160, but many are '0' ; drop those: MM <- drop0(MM) length(MM@x) # 32 cm <- colSums(MM) (scm <- colSums(MM, sparseResult = TRUE)) stopifnot(is(scm, "sparseVector"), identical(cm, as.numeric(scm))) rowSums (MM, sparseResult = TRUE) # 14 of 70 are not zero colMeans(MM, sparseResult = TRUE) # 16 of 80 are not zero ## Since we have no 'NA's, these two are equivalent : stopifnot(identical(rowMeans(MM, sparseResult = TRUE), rowMeans(MM, sparseResult = TRUE, na.rm = TRUE)), rowMeans(Diagonal(16)) == 1/16, colSums(Diagonal(7)) == 1) ## dimnames(x) --> names( ) : dimnames(M) <- list(paste0("r", 1:7), paste0("V",1:8)) M colSums(M) rowMeans(M) ## Assertions : stopifnot(all.equal(colSums(M), setNames(c(1,1,6,6,6,6,3,2), colnames(M))), all.equal(rowMeans(M), structure(c(1,1,4,8,12,3,2) / 8, .Names = paste0("r", 1:7)))) } \keyword{array} \keyword{algebra} \keyword{arith} Matrix/man/BunchKaufman-methods.Rd0000644000176200001440000000534313753445524016604 0ustar liggesusers\name{BunchKaufman-methods} \title{Bunch-Kaufman Decomposition Methods} \docType{methods} \alias{BunchKaufman} \alias{BunchKaufman-methods} \alias{BunchKaufman,dspMatrix-method} \alias{BunchKaufman,dsyMatrix-method} \alias{BunchKaufman,matrix-method} \description{ The Bunch-Kaufman Decomposition of a square symmetric matrix \eqn{A} is \eqn{A = P LDL' P'} where \eqn{P} is a permutation matrix, \eqn{L} is \emph{unit}-lower triangular and \eqn{D} is \emph{block}-diagonal with blocks of dimension \eqn{1\times 1}{1 x 1} or \eqn{2\times2}{2 x 2}. This is generalization of a pivoting \eqn{LDL'} Cholesky decomposition. } \usage{ \S4method{BunchKaufman}{dsyMatrix}(x, \dots) \S4method{BunchKaufman}{dspMatrix}(x, \dots) \S4method{BunchKaufman}{matrix}(x, uplo = NULL, \dots) } \arguments{ \item{x}{a symmetric square matrix.} \item{uplo}{optional string, \code{"U"} or \code{"L"} indicating which \dQuote{triangle} half of \code{x} should determine the result. The default is \code{"U"} unless \code{x} has a \code{uplo} slot which is the case for those inheriting from class \code{\linkS4class{symmetricMatrix}}, where \code{x@uplo} will be used.} \item{\dots}{potentially further arguments passed to methods.} } \section{Methods}{ Currently, only methods for \bold{dense} numeric symmetric matrices are implemented. To compute the Bunch-Kaufman decomposition, the methods use either one of two Lapack routines: \describe{ \item{\code{x = "dspMatrix"}}{routine \code{dsptrf()}; whereas} \item{\code{x = "dsyMatrix"}}{, and} \item{\code{x = "matrix"}}{use \code{dsytrf()}.} } } \value{ an object of class \code{\linkS4class{BunchKaufman}}, which can also be used as a (triangular) matrix directly. Somewhat amazingly, it inherits its \code{uplo} slot from \code{x}.% FIXME? } \details{ FIXME: We really need an \code{expand()} method in order to \emph{work} with the result! } \references{ The original LAPACK source code, including documentation; \url{https://www.netlib.org/lapack/double/dsytrf.f} and \url{https://www.netlib.org/lapack/double/dsptrf.f} } \seealso{ The resulting class, \code{\linkS4class{BunchKaufman}}. Related decompositions are the LU, \code{\link{lu}}, and the Cholesky, \code{\link{chol}} (and for \emph{sparse} matrices, \code{\link{Cholesky}}). } \examples{ data(CAex) dim(CAex) isSymmetric(CAex)# TRUE CAs <- as(CAex, "symmetricMatrix") if(FALSE) # no method defined yet for *sparse* : bk. <- BunchKaufman(CAs) ## does apply to *dense* symmetric matrices: bkCA <- BunchKaufman(as(CAs, "denseMatrix")) bkCA image(bkCA)# shows how sparse it is, too str(R.CA <- as(bkCA, "sparseMatrix")) ## an upper triangular 72x72 matrix with only 144 non-zero entries } \keyword{methods} Matrix/man/symmetricMatrix-class.Rd0000644000176200001440000000731713153267746017112 0ustar liggesusers\name{symmetricMatrix-class} \docType{class} \alias{symmetricMatrix-class} \alias{coerce,matrix,symmetricMatrix-method} \alias{coerce,denseMatrix,symmetricMatrix-method} \alias{coerce,CsparseMatrix,symmetricMatrix-method} \alias{dimnames,symmetricMatrix-method} % \title{Virtual Class of Symmetric Matrices in Package Matrix} \description{ The virtual class of symmetric matrices, \code{"symmetricMatrix"}, from the package \pkg{Matrix} contains numeric and logical, dense and sparse matrices, e.g., see the examples with the \dQuote{actual} subclasses. The main use is in methods (and C functions) that can deal with all symmetric matrices, and in \code{as(*, "symmetricMatrix")}. } % \section{Objects from the Class}{A virtual Class: No objects may be created from it.} \section{Slots}{ \describe{ \item{\code{uplo}:}{Object of class \code{"character"}. Must be either "U", for upper triangular, and "L", for lower triangular.} %% below {Dim, Dimnames} work around Slot parsing buglet (< 2.2.0) %% \item{\code{Dim},\code{Dimnames}:}{The dimension (a length-2 \item{\code{Dim, Dimnames}:}{The dimension (a length-2 \code{"integer"}) and corresponding names (or \code{NULL}), inherited from the \code{\linkS4class{Matrix}}, see there. See below, about storing only one of the two \code{Dimnames} components.} \item{\code{factors}:}{a list of matrix factorizations, also from the \code{Matrix} class.} } } \section{Extends}{ Class \code{"Matrix"}, directly. } \section{Methods}{ \describe{ \item{coerce}{\code{signature(from = "ddiMatrix", to = "symmetricMatrix")}: and many other coercion methods, some of which are particularly optimized.} \item{dimnames}{\code{signature(object = "symmetricMatrix")}: returns \emph{symmetric} \code{\link{dimnames}}, even when the \code{Dimnames} slot only has row or column names. This allows to save storage for large (typically sparse) symmetric matrices.} \item{isSymmetric}{\code{signature(object = "symmetricMatrix")}: returns \code{TRUE} trivially.} } There's a C function \code{symmetricMatrix_validate()}% in ../src/dsyMatrix.c called by the internal validity checking functions, and also from \code{\link{getValidity}(getClass("symmetricMatrix"))}. } \section{Validity and \code{\link{dimnames}}}{ The validity checks do not require a symmetric \code{Dimnames} slot, so it can be \code{list(NULL, )}, e.g., for efficiency. However, \code{\link{dimnames}()} and other functions and methods should behave as if the dimnames were symmetric, i.e., with both list components identical. } \seealso{ \code{\link{isSymmetric}} which has efficient methods (\link{isSymmetric-methods}) for the \pkg{Matrix} classes. Classes \code{\linkS4class{triangularMatrix}}, and, e.g., \code{\linkS4class{dsyMatrix}} for numeric \emph{dense} matrices, or \code{\linkS4class{lsCMatrix}} for a logical \emph{sparse} matrix class. } \examples{ ## An example about the symmetric Dimnames: sy <- sparseMatrix(i= c(2,4,3:5), j= c(4,7:5,5), x = 1:5, dims = c(7,7), symmetric=TRUE, dimnames = list(NULL, letters[1:7])) sy # shows symmetrical dimnames sy@Dimnames # internally only one part is stored dimnames(sy) # both parts - as sy *is* symmetrical \dontshow{ local({ nm <- letters[1:7] stopifnot(identical(dimnames(sy), list( nm, nm)), identical(sy@Dimnames , list(NULL, nm))) }) }%dont showClass("symmetricMatrix") ## The names of direct subclasses: scl <- getClass("symmetricMatrix")@subclasses directly <- sapply(lapply(scl, slot, "by"), length) == 0 names(scl)[directly] ## Methods -- applicaple to all subclasses above: showMethods(classes = "symmetricMatrix") } \keyword{classes} Matrix/man/ldiMatrix-class.Rd0000644000176200001440000000312111061674131015615 0ustar liggesusers\name{ldiMatrix-class} \docType{class} \alias{ldiMatrix-class} \alias{!,ldiMatrix-method} %%----> put almost all methods into ./diagonalMatrix-class.Rd % Deprecated: \alias{coerce,ldiMatrix,lgCMatrix-method} \alias{coerce,ldiMatrix,lgTMatrix-method} \title{Class "ldiMatrix" of Diagonal Logical Matrices} \description{The class \code{"ldiMatrix"} of logical diagonal matrices. %% FIXME add more } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("ldiMatrix", ...)} but typically rather via \code{\link{Diagonal}}. } \section{Slots}{ \describe{ \item{\code{x}:}{\code{"logical"} vector.} \item{\code{diag}:}{\code{"character"} string, either "U" or "N", see \code{\linkS4class{ddiMatrix}}.} \item{\code{Dim},\code{Dimnames}:}{matrix dimension and \code{\link{dimnames}}, see the \code{\linkS4class{Matrix}} class description.} } } \section{Extends}{ Class \code{"\linkS4class{diagonalMatrix}"} and class \code{"\linkS4class{lMatrix}"}, directly. Class \code{"\linkS4class{sparseMatrix}"}, by class \code{"diagonalMatrix"}. } % \section{Methods}{ % No methods defined with class "ldiMatrix" in the signature. % } % \references{ ~put references to the literature/web site here ~ } \seealso{ Classes \code{\linkS4class{ddiMatrix}} and \code{\linkS4class{diagonalMatrix}}; function \code{\link{Diagonal}}. } \examples{ (lM <- Diagonal(x = c(TRUE,FALSE,FALSE))) str(lM)#> gory details (slots) crossprod(lM) # numeric (nM <- as(lM, "nMatrix"))# -> sparse (not formally ``diagonal'') crossprod(nM) # logical sparse } \keyword{classes} Matrix/man/sparseVector.Rd0000644000176200001440000000275213057576763015271 0ustar liggesusers\name{sparseVector} \alias{sparseVector} \title{Sparse Vector Construction from Nonzero Entries} \description{ User friendly construction of sparse vectors, i.e., objects inheriting from \code{\link{class}} \code{\linkS4class{sparseVector}}, from indices and values of its non-zero entries. } \details{ zero entries in \code{x} are dropped automatically, analogously as \code{\link{drop0}()} acts on sparse matrices. } \usage{ sparseVector(x, i, length) } \arguments{ \item{x}{vector of the non zero entries; may be missing in which case a \code{"nsparseVector"} will be returned.} \item{i}{integer vector (of the same length as \code{x}) specifying the indices of the non-zero (or non-\code{TRUE}) entries of the sparse vector.} \item{length}{length of the sparse vector.} } \value{ a sparse vector, i.e., inheriting from \code{\link{class}} \code{\linkS4class{sparseVector}}. } \author{Martin Maechler} \seealso{ \code{\link{sparseMatrix}()} constructor for sparse matrices; the class \code{\linkS4class{sparseVector}}. } \examples{ str(sv <- sparseVector(x = 1:10, i = sample(999, 10), length=1000)) sx <- c(0,0,3, 3.2, 0,0,0,-3:1,0,0,2,0,0,5,0,0) ss <- as(sx, "sparseVector") stopifnot(identical(ss, sparseVector(x = c(2, -1, -2, 3, 1, -3, 5, 3.2), i = c(15L, 10:9, 3L,12L,8L,18L, 4L), length = 20L))) (ns <- sparseVector(i= c(7, 3, 2), length = 10)) stopifnot(identical(ns, new("nsparseVector", length = 10, i = c(2, 3, 7)))) } \keyword{array} Matrix/man/kronecker-methods.Rd0000644000176200001440000000467313153267746016234 0ustar liggesusers\name{kronecker-methods} \docType{methods} \title{Methods for Function 'kronecker()' in Package 'Matrix'} \alias{kronecker-methods} % \alias{kronecker,ANY,Matrix-method} \alias{kronecker,ANY,diagonalMatrix-method} \alias{kronecker,ANY,sparseMatrix-method} \alias{kronecker,Matrix,ANY-method} \alias{kronecker,Matrix,diagonalMatrix-method} \alias{kronecker,diagonalMatrix,ANY-method} \alias{kronecker,diagonalMatrix,Matrix-method} \alias{kronecker,indMatrix,indMatrix-method} \alias{kronecker,sparseMatrix,ANY-method} \alias{kronecker,sparseMatrix,TsparseMatrix-method} % \alias{kronecker,TsparseMatrix,sparseMatrix-method} \alias{kronecker,TsparseMatrix,TsparseMatrix-method} \alias{kronecker,dgTMatrix,dgTMatrix-method} \alias{kronecker,dgTMatrix,dtTMatrix-method} \alias{kronecker,dtTMatrix,dgTMatrix-method} \alias{kronecker,dtTMatrix,dtTMatrix-method} \alias{kronecker,dsparseMatrix,dsparseMatrix-method} % \description{ Computes Kronecker products for objects inheriting from \code{"\linkS4class{Matrix}"}. In order to preserver sparseness, we treat \code{0 * NA} as \code{0}, not as \code{\link{NA}} as usually in \R (and as used for the \pkg{base} function \code{\link[base]{kronecker}}). } \section{Methods}{ \describe{ \item{kronecker}{\code{signature(X = "Matrix", Y = "ANY")} .......} \item{kronecker}{\code{signature(X = "ANY", Y = "Matrix")} .......} \item{kronecker}{\code{signature(X = "diagonalMatrix", Y = "ANY")} .......} \item{kronecker}{\code{signature(X = "sparseMatrix", Y = "ANY")} .......} \item{kronecker}{\code{signature(X = "TsparseMatrix", Y = "TsparseMatrix")} .......} \item{kronecker}{\code{signature(X = "dgTMatrix", Y = "dgTMatrix")} .......} \item{kronecker}{\code{signature(X = "dtTMatrix", Y = "dtTMatrix")} .......} \item{kronecker}{\code{signature(X = "indMatrix", Y = "indMatrix")} .......} } } \examples{ (t1 <- spMatrix(5,4, x= c(3,2,-7,11), i= 1:4, j=4:1)) # 5 x 4 (t2 <- kronecker(Diagonal(3, 2:4), t1)) # 15 x 12 ## should also work with special-cased logical matrices l3 <- upper.tri(matrix(,3,3)) M <- Matrix(l3) (N <- as(M, "nsparseMatrix")) # "ntCMatrix" (upper triangular) N2 <- as(N, "generalMatrix") # (lost "t"riangularity) MM <- kronecker(M,M) NN <- kronecker(N,N) # "dtTMatrix" i.e. did keep NN2 <- kronecker(N2,N2) stopifnot(identical(NN,MM), is(NN2, "sparseMatrix"), all(NN2 == NN), is(NN, "triangularMatrix")) } \keyword{methods} \keyword{array} Matrix/man/Xtrct-methods.Rd0000644000176200001440000000602414036605236015334 0ustar liggesusers\name{[-methods} \docType{methods} \alias{[-methods} \title{Methods for "[": Extraction or Subsetting in Package 'Matrix'} % NB: "[<-" are in ./Subassign-methods.Rd % ~~~~~~~~~~~~~~~~~~~~~~ \alias{[,Matrix,missing,missing,ANY-method} \alias{[,Matrix,missing,missing,logical-method} \alias{[,Matrix,missing,missing,missing-method} \alias{[,Matrix,missing,index,missing-method} \alias{[,Matrix,index,missing,missing-method} \alias{[,Matrix,index,index,missing-method} \alias{[,Matrix,lMatrix,missing,ANY-method} \alias{[,Matrix,logical,missing,ANY-method} \alias{[,Matrix,matrix,missing,ANY-method} \alias{[,Matrix,lMatrix,missing,missing-method} \alias{[,Matrix,logical,missing,missing-method} \alias{[,Matrix,matrix,missing,missing-method} \alias{[,Matrix,ANY,ANY,ANY-method}% bail out if no explicit method % \alias{[,denseMatrix,matrix,missing,ANY-method} \alias{[,denseMatrix,matrix,missing,missing-method} \alias{[,denseMatrix,index,missing,logical-method} \alias{[,denseMatrix,index,index,logical-method} \alias{[,denseMatrix,missing,index,logical-method} \alias{[,diagonalMatrix,index,missing,logical-method} \alias{[,diagonalMatrix,index,index,logical-method} \alias{[,diagonalMatrix,missing,index,logical-method} % \alias{[,CsparseMatrix,missing,index,logical-method} \alias{[,CsparseMatrix,index,missing,logical-method} \alias{[,CsparseMatrix,index,index,logical-method} % \alias{[,TsparseTMatrix,missing,missing,ANY-method} \alias{[,TsparseMatrix,index,missing,logical-method} \alias{[,TsparseMatrix,missing,index,logical-method} \alias{[,TsparseMatrix,index,index,logical-method} % \alias{[,sparseMatrix,missing,index,logical-method} \alias{[,sparseMatrix,index,missing,logical-method} \alias{[,sparseMatrix,index,index,logical-method} % \alias{[,indMatrix,index,missing,logical-method} %------- \description{ Methods for \code{"["}, i.e., extraction or subsetting mostly of matrices, in package \pkg{Matrix}. } \section{Methods}{ There are more than these: \describe{ \item{x = "Matrix", i = "missing", j = "missing", drop= "ANY"}{ ... } \item{x = "Matrix", i = "numeric", j = "missing", drop= "missing"}{ ... } \item{x = "Matrix", i = "missing", j = "numeric", drop= "missing"}{ ... } \item{x = "dsparseMatrix", i = "missing", j = "numeric", drop= "logical"}{ ... } \item{x = "dsparseMatrix", i = "numeric", j = "missing", drop= "logical"}{ ... } \item{x = "dsparseMatrix", i = "numeric", j = "numeric", drop= "logical"}{ ... } } } \seealso{ \code{\link{[<--methods}} for sub\emph{assign}ment to \code{"Matrix"} objects. \code{\link{Extract}} about the standard extraction. } \examples{ % regression tests are in ../tests/indexing.R str(m <- Matrix(round(rnorm(7*4),2), nrow = 7)) stopifnot(identical(m, m[])) m[2, 3] # simple number m[2, 3:4] # simple numeric of length 2 m[2, 3:4, drop=FALSE] # sub matrix of class 'dgeMatrix' ## rows or columns only: m[1,] # first row, as simple numeric vector m[,1:2] # sub matrix of first two columns showMethods("[", inherited = FALSE) } \keyword{methods} \keyword{array} Matrix/man/bdiag.Rd0000644000176200001440000000745614014503624013641 0ustar liggesusers\name{bdiag} \alias{bdiag} \alias{.bdiag} \title{Construct a Block Diagonal Matrix} \description{ Build a block diagonal matrix given several building block matrices. } \usage{ bdiag(\dots) .bdiag(lst) } \arguments{ \item{\dots}{individual matrices or a \code{\link{list}} of matrices.} \item{lst}{non-empty \code{\link{list}} of matrices.} } \details{ For non-trivial argument list, \code{bdiag()} calls \code{.bdiag()}. The latter maybe useful to programmers. } \note{This function has been written and is efficient for the case of relatively few block matrices which are typically sparse themselves. It is currently \emph{inefficient} for the case of many small dense block matrices. For the case of \emph{many} dense \eqn{k \times k}{k * k} matrices, the \code{bdiag_m()} function in the \sQuote{Examples} is an order of magnitude faster. } \value{ A \emph{sparse} matrix obtained by combining the arguments into a block diagonal matrix. The value of \code{bdiag()} inherits from class \code{\linkS4class{CsparseMatrix}}, whereas \code{.bdiag()} returns a \code{\linkS4class{TsparseMatrix}}. } \author{Martin Maechler, built on a version posted by Berton Gunter to R-help; earlier versions have been posted by other authors, notably Scott Chasalow to S-news. Doug Bates's faster implementation builds on \code{\linkS4class{TsparseMatrix}} objects. } \seealso{\code{\link{Diagonal}} for constructing matrices of class \code{\linkS4class{diagonalMatrix}}, or \code{\link{kronecker}} which also works for \code{"Matrix"} inheriting matrices. \code{\link{bandSparse}} constructs a \emph{banded} sparse matrix from its non-zero sub-/super - diagonals. Note that other CRAN \R packages have own versions of \code{bdiag()} which return traditional matrices. } \examples{ bdiag(matrix(1:4, 2), diag(3)) ## combine "Matrix" class and traditional matrices: bdiag(Diagonal(2), matrix(1:3, 3,4), diag(3:2)) mlist <- list(1, 2:3, diag(x=5:3), 27, cbind(1,3:6), 100:101) bdiag(mlist) stopifnot(identical(bdiag(mlist), % <- used to fail in earlier versions bdiag(lapply(mlist, as.matrix)))) ml <- c(as(matrix((1:24)\%\% 11 == 0, 6,4),"nMatrix"), rep(list(Diagonal(2, x=TRUE)), 3)) mln <- c(ml, Diagonal(x = 1:3)) stopifnot(is(bdiag(ml), "lsparseMatrix"),% failed in Matrix <= 1.0-2 is(bdiag(mln),"dsparseMatrix") ) ## random (diagonal-)block-triangular matrices: rblockTri <- function(nb, max.ni, lambda = 3) { .bdiag(replicate(nb, { n <- sample.int(max.ni, 1) tril(Matrix(rpois(n*n, lambda=lambda), n,n)) })) } (T4 <- rblockTri(4, 10, lambda = 1)) image(T1 <- rblockTri(12, 20)) ##' Fast version of Matrix :: .bdiag() -- for the case of *many* (k x k) matrices: ##' @param lmat list(, , ....., ) where each mat_j is a k x k 'matrix' ##' @return a sparse (N*k x N*k) matrix of class \code{"\linkS4class{dgCMatrix}"}. bdiag_m <- function(lmat) { ## Copyright (C) 2016 Martin Maechler, ETH Zurich if(!length(lmat)) return(new("dgCMatrix")) stopifnot(is.list(lmat), is.matrix(lmat[[1]]), (k <- (d <- dim(lmat[[1]]))[1]) == d[2], # k x k all(vapply(lmat, dim, integer(2)) == k)) # all of them N <- length(lmat) if(N * k > .Machine$integer.max) stop("resulting matrix too large; would be M x M, with M=", N*k) M <- as.integer(N * k) ## result: an M x M matrix new("dgCMatrix", Dim = c(M,M), ## 'i :' maybe there's a faster way (w/o matrix indexing), but elegant? i = as.vector(matrix(0L:(M-1L), nrow=k)[, rep(seq_len(N), each=k)]), p = k * 0L:M, x = as.double(unlist(lmat, recursive=FALSE, use.names=FALSE))) } l12 <- replicate(12, matrix(rpois(16, lambda = 6.4), 4,4), simplify=FALSE) dim(T12 <- bdiag_m(l12))# 48 x 48 T12[1:20, 1:20] } \keyword{array} Matrix/man/KNex.Rd0000644000176200001440000000207413336513331013431 0ustar liggesusers\name{KNex} \alias{KNex} \docType{data} \title{Koenker-Ng Example Sparse Model Matrix and Response Vector} \description{ A model matrix \code{mm} and corresponding response vector \code{y} used in an example by Koenker and Ng. The matrix \code{mm} is a sparse matrix with 1850 rows and 712 columns but only 8758 non-zero entries. It is a \code{"dgCMatrix"} object. The vector \code{y} is just \code{\link{numeric}} of length 1850. } \usage{data(KNex)} %\details{} %\source{} \references{ Roger Koenker and Pin Ng (2003). SparseM: A sparse matrix package for R; \emph{J. of Statistical Software}, \bold{8} (6), \doi{10.18637/jss.v008.i06} } \examples{ data(KNex) class(KNex$mm) dim(KNex$mm) image(KNex$mm) str(KNex) system.time( # a fraction of a second sparse.sol <- with(KNex, solve(crossprod(mm), crossprod(mm, y)))) head(round(sparse.sol,3)) ## Compare with QR-based solution ("more accurate, but slightly slower"): system.time( sp.sol2 <- with(KNex, qr.coef(qr(mm), y) )) all.equal(sparse.sol, sp.sol2, tolerance = 1e-13) # TRUE } \keyword{datasets} Matrix/man/ntrMatrix-class.Rd0000644000176200001440000000515512001034107015645 0ustar liggesusers\name{ntrMatrix-class} \docType{class} \alias{ntpMatrix-class} \alias{ntrMatrix-class} % \alias{!,ntpMatrix-method} \alias{!,ntrMatrix-method} \alias{coerce,ntpMatrix,dtpMatrix-method} \alias{coerce,ntpMatrix,ngeMatrix-method} \alias{coerce,ntpMatrix,ntrMatrix-method} \alias{coerce,ntrMatrix,dtrMatrix-method} \alias{coerce,ntrMatrix,ngeMatrix-method} \alias{coerce,ntrMatrix,ntpMatrix-method} \alias{coerce,matrix,ntrMatrix-method} \alias{coerce,matrix,ntpMatrix-method} \alias{diag<-,ntpMatrix-method} \alias{diag<-,ntrMatrix-method} \alias{t,ntpMatrix-method} \alias{t,ntrMatrix-method} % \title{Triangular Dense Logical Matrices} \description{ The \code{"ntrMatrix"} class is the class of triangular, dense, logical matrices in nonpacked storage. The \code{"ntpMatrix"} class is the same except in packed storage. } \section{Slots}{ \describe{ \item{\code{x}:}{Object of class \code{"logical"}. The logical values that constitute the matrix, stored in column-major order.} \item{\code{uplo}:}{Object of class \code{"character"}. Must be either "U", for upper triangular, and "L", for lower triangular.} \item{\code{diag}:}{Object of class \code{"character"}. Must be either \code{"U"}, for unit triangular (diagonal is all ones), or \code{"N"}; see \code{\linkS4class{triangularMatrix}}.} \item{\code{Dim},\code{Dimnames}:}{The dimension (a length-2 \code{"integer"}) and corresponding names (or \code{NULL}), see the \code{\linkS4class{Matrix}} class.} \item{\code{factors}:}{Object of class \code{"list"}. A named list of factorizations that have been computed for the matrix.} } } \section{Extends}{ \code{"ntrMatrix"} extends class \code{"ngeMatrix"}, directly, whereas\cr \code{"ntpMatrix"} extends class \code{"ndenseMatrix"}, directly. Both extend Class \code{"triangularMatrix"}, directly, and class \code{"denseMatrix"}, \code{"lMatrix"} and others, \emph{in}directly, use \code{\link{showClass}("nsyMatrix")}, e.g., for details. } \section{Methods}{ Currently, mainly \code{\link{t}()} and coercion methods (for \code{\link{as}(.)}; use, e.g., \code{\link{showMethods}(class="nsyMatrix")} for details. } \seealso{ Classes \code{\linkS4class{ngeMatrix}}, \code{\linkS4class{Matrix}}; function \code{\link[base]{t}} } \examples{ showClass("ntrMatrix") str(new("ntpMatrix")) (nutr <- as(upper.tri(matrix(,4,4)), "ntrMatrix")) str(nutp <- as(nutr, "ntpMatrix"))# packed matrix: only 10 = (4+1)*4/2 entries !nutp ## the logical negation (is *not* logical triangular !) ## but this one is: stopifnot(all.equal(nutp, as(!!nutp, "ntpMatrix"))) } \keyword{classes} Matrix/man/dsyMatrix-class.Rd0000644000176200001440000001253714151637577015677 0ustar liggesusers\name{dsyMatrix-class} \title{Symmetric Dense (Packed | Non-packed) Numeric Matrices} \docType{class} \alias{dspMatrix-class} \alias{dsyMatrix-class} % % \alias{solve, ..} --> solve-methods.Rd % \alias{\%*%, ..} --> matrix-products.Rd \alias{coerce,dspMatrix,dsyMatrix-method} \alias{coerce,dspMatrix,lspMatrix-method} \alias{coerce,dspMatrix,matrix-method} \alias{coerce,dspMatrix,CsparseMatrix-method} \alias{coerce,dspMatrix,sparseMatrix-method} \alias{coerce,dgeMatrix,dspMatrix-method} \alias{coerce,matrix,dspMatrix-method} \alias{coerce,dgeMatrix,dsyMatrix-method}% or rather setIs? \alias{coerce,dsyMatrix,corMatrix-method} \alias{coerce,dsyMatrix,dpoMatrix-method}% instead of setIs \alias{coerce,dsyMatrix,dspMatrix-method} \alias{coerce,dsyMatrix,lsyMatrix-method} \alias{.dsy2mat}% hidden but exported \alias{coerce,dsyMatrix,matrix-method} \alias{coerce,matrix,dsyMatrix-method} \alias{diag,dspMatrix-method} \alias{diag,dsyMatrix-method} \alias{diag<-,dspMatrix-method} \alias{diag<-,dsyMatrix-method} % \alias{show,dsyMatrix-method} \alias{norm,dspMatrix,character-method} \alias{norm,dspMatrix,missing-method} \alias{norm,dsyMatrix,character-method} \alias{norm,dsyMatrix,missing-method} \alias{rcond,dspMatrix,character-method} \alias{rcond,dspMatrix,missing-method} \alias{rcond,dsyMatrix,character-method} \alias{rcond,dsyMatrix,missing-method} \alias{t,dspMatrix-method} \alias{t,dsyMatrix-method} \description{ \itemize{ \item{The \code{"dsyMatrix"} class is the class of symmetric, dense matrices in \emph{non-packed} storage and} \item{\code{"dspMatrix"} is the class of symmetric dense matrices in \emph{packed} storage, see \code{\link{pack}()}. Only the upper triangle or the lower triangle is stored.} } } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("dsyMatrix", ...)} or \code{new("dspMatrix", ...)}, respectively. } \section{Slots}{ \describe{ \item{\code{uplo}:}{Object of class \code{"character"}. Must be either "U", for upper triangular, and "L", for lower triangular.} \item{\code{x}:}{Object of class \code{"numeric"}. The numeric values that constitute the matrix, stored in column-major order.} \item{\code{Dim},\code{Dimnames}:}{The dimension (a length-2 \code{"integer"}) and corresponding names (or \code{NULL}), see the \code{\linkS4class{Matrix}}.} \item{\code{factors}:}{Object of class \code{"list"}. A named list of factorizations that have been computed for the matrix.} } } \section{Extends}{ \code{"dsyMatrix"} extends class \code{"dgeMatrix"}, directly, whereas\cr \code{"dspMatrix"} extends class \code{"ddenseMatrix"}, directly. Both extend class \code{"symmetricMatrix"}, directly, and class \code{"Matrix"} and others, \emph{in}directly, use \code{\link{showClass}("dsyMatrix")}, e.g., for details. } \section{Methods}{ \describe{ \item{coerce}{\code{signature(from = "ddenseMatrix", to = "dgeMatrix")}} % \item{coerce}{\code{signature(from = "dspMatrix", to = "matrix")}} \item{coerce}{\code{signature(from = "dsyMatrix", to = "matrix")}} \item{coerce}{\code{signature(from = "dsyMatrix", to = "dspMatrix")}} \item{coerce}{\code{signature(from = "dspMatrix", to = "dsyMatrix")}} \item{norm}{\code{signature(x = "dspMatrix", type = "character")}, or \code{x = "dsyMatrix"} or \code{type = "missing"}: Computes the matrix norm of the desired type, see, \code{\link{norm}}.} \item{rcond}{\code{signature(x = "dspMatrix", type = "character")}, or \code{x = "dsyMatrix"} or \code{type = "missing"}: Computes the reciprocal condition number, \code{\link{rcond}()}.} \item{solve}{\code{signature(a = "dspMatrix", b = "....")}, and} \item{solve}{\code{signature(a = "dsyMatrix", b = "....")}: \code{x <- solve(a,b)} solves \eqn{A x = b} for \eqn{x}; see \code{\link{solve-methods}}.} \item{t}{\code{signature(x = "dsyMatrix")}: Transpose; swaps from upper triangular to lower triangular storage, i.e., the uplo slot from \code{"U"} to \code{"L"} or vice versa, the same as for all symmetric matrices.} } } %\references{} \seealso{ The \emph{positive (Semi-)definite} dense (packed or non-packed numeric matrix classes \code{\linkS4class{dpoMatrix}}, \code{\linkS4class{dppMatrix}} and \code{\linkS4class{corMatrix}}, Classes \code{\linkS4class{dgeMatrix}} and \code{\linkS4class{Matrix}}; \code{\link[base]{solve}}, \code{\link{norm}}, \code{\link{rcond}}, \code{\link[base]{t}} } \examples{ ## Only upper triangular part matters (when uplo == "U" as per default) (sy2 <- new("dsyMatrix", Dim = as.integer(c(2,2)), x = c(14, NA,32,77))) str(t(sy2)) # uplo = "L", and the lower tri. (i.e. NA is replaced). chol(sy2) #-> "Cholesky" matrix (sp2 <- pack(sy2)) # a "dspMatrix" ## Coercing to dpoMatrix gives invalid object: sy3 <- new("dsyMatrix", Dim = as.integer(c(2,2)), x = c(14, -1, 2, -7)) try(as(sy3, "dpoMatrix")) # -> error: not positive definite \dontshow{ tr <- try(as(sy3, "dpoMatrix"), silent=TRUE) stopifnot(1 == grep("not a positive definite matrix", as.character(tr)), is(sp2, "dspMatrix")) } ## 4x4 example m <- matrix(0,4,4); m[upper.tri(m)] <- 1:6 sym <- m+t(m)+diag(11:14, 4); sym S1 <- as(sym, "dspMatrix") (S2 <- t(S1)) stopifnot(all(S1 == S2)) # equal "seen as matrix", but differ internally : str(S1) S2@x } \keyword{classes} Matrix/man/boolean-matprod.Rd0000644000176200001440000000771312507220752015655 0ustar liggesusers\name{\%&\%-methods} \title{Boolean Arithmetic Matrix Products: \code{\%&\%} and Methods} \docType{methods} \alias{\%&\%} \alias{\%&\%-methods} \alias{\%&\%,ANY,ANY-method} \alias{\%&\%,ANY,matrix-method} \alias{\%&\%,ANY,Matrix-method} \alias{\%&\%,matrix,ANY-method} \alias{\%&\%,Matrix,ANY-method} \alias{\%&\%,matrix,matrix-method} \alias{\%&\%,Matrix,Matrix-method} \alias{\%&\%,mMatrix,mMatrix-method} \alias{\%&\%,mMatrix,nMatrix-method} \alias{\%&\%,nMatrix,mMatrix-method} \alias{\%&\%,nMatrix,nMatrix-method} \alias{\%&\%,nMatrix,nsparseMatrix-method} \alias{\%&\%,nsparseMatrix,nMatrix-method} \alias{\%&\%,nsparseMatrix,nsparseMatrix-method} \alias{\%&\%,nCsparseMatrix,nCsparseMatrix-method} \alias{\%&\%,nCsparseMatrix,nsparseMatrix-method} \alias{\%&\%,nsparseMatrix,nCsparseMatrix-method} \alias{\%&\%,diagonalMatrix,geMatrix-method} \alias{\%&\%,geMatrix,diagonalMatrix-method} \alias{\%&\%,CsparseMatrix,diagonalMatrix-method} \alias{\%&\%,diagonalMatrix,CsparseMatrix-method} \alias{\%&\%,diagonalMatrix,diagonalMatrix-method} \alias{\%&\%,diagonalMatrix,sparseMatrix-method} \alias{\%&\%,sparseMatrix,diagonalMatrix-method} \alias{\%&\%,mMatrix,sparseVector-method} \alias{\%&\%,numLike,sparseVector-method} \alias{\%&\%,sparseVector,mMatrix-method} \alias{\%&\%,sparseVector,numLike-method} \alias{\%&\%,sparseVector,sparseVector-method} \description{ For boolean or \dQuote{patter\bold{n}} matrices, i.e., \R objects of class \code{\linkS4class{nMatrix}}, it is natural to allow matrix products using boolean instead of numerical arithmetic. In package \pkg{Matrix}, we use the binary operator \code{\%&\%} (aka \dQuote{infix}) function) for this and provide methods for all our matrices and the traditional \R matrices (see \code{\link{matrix}}). } \section{Methods}{ We provide methods for both the \dQuote{traditional} (\R base) matrices and numeric vectors and conceptually all matrices and \code{\linkS4class{sparseVector}}s in package \pkg{Matrix}. \describe{ \item{\code{signature(x = "ANY", y = "ANY")}}{ } \item{\code{signature(x = "ANY", y = "Matrix")}}{ } \item{\code{signature(x = "Matrix", y = "ANY")}}{ } \item{\code{signature(x = "mMatrix", y = "mMatrix")}}{ } \item{\code{signature(x = "nMatrix", y = "nMatrix")}}{ } \item{\code{signature(x = "nMatrix", y = "nsparseMatrix")}}{ } \item{\code{signature(x = "nsparseMatrix", y = "nMatrix")}}{ } \item{\code{signature(x = "nsparseMatrix", y = "nsparseMatrix")}}{ } \item{\code{signature(x = "sparseVector", y = "mMatrix")}}{ } \item{\code{signature(x = "mMatrix", y = "sparseVector")}}{ } \item{\code{signature(x = "sparseVector", y = "sparseVector")}}{ } }% {describe} }% {Methods} \note{ The current implementation ends up coercing both \code{x} and \code{y} to (virtual) class \code{\linkS4class{nsparseMatrix}} which may be quite inefficient. A future implementation may well return a matrix with \bold{different} class, but the \dQuote{same} content, i.e., the same matrix entries \eqn{m_ij}{m[i,j]}. } \value{ a pattern matrix, i.e., inheriting from \code{"\linkS4class{nMatrix}"}, or an \code{"\linkS4class{ldiMatrix}"} in case of a diagonal matrix. } \examples{ set.seed(7) L <- Matrix(rnorm(20) > 1, 4,5) (N <- as(L, "nMatrix")) D <- Matrix(round(rnorm(30)), 5,6) # -> values in -1:1 (for this seed) L \%&\% D stopifnot(identical(L \%&\% D, N \%&\% D), all(L \%&\% D == as((L \%*\% abs(D)) > 0, "sparseMatrix"))) ## cross products , possibly with boolArith = TRUE : crossprod(N) # -> sparse patter'n' (TRUE/FALSE : boolean arithmetic) crossprod(N +0) # -> numeric Matrix (with same "pattern") stopifnot(all(crossprod(N) == t(N) \%&\% N), identical(crossprod(N), crossprod(N +0, boolArith=TRUE)), identical(crossprod(L), crossprod(N , boolArith=FALSE))) crossprod(D, boolArith = TRUE) # pattern: "nsCMatrix" crossprod(L, boolArith = TRUE) # ditto crossprod(L, boolArith = FALSE) # numeric: "dsCMatrix" } \keyword{methods} Matrix/man/qr-methods.Rd0000644000176200001440000001117013775317466014666 0ustar liggesusers\name{qr-methods} \title{QR Decomposition -- S4 Methods and Generic} \docType{methods} \alias{qr} \alias{qrR} \alias{qr-methods} \alias{qr,dgCMatrix-method} \alias{qr,sparseMatrix-method} \alias{qr,ddenseMatrix-method}% only if(.Matrix.avoiding.as.matrix) \alias{qr,denseMatrix-method}% only if(.Matrix.avoiding.as.matrix) \description{ The \pkg{Matrix} package provides methods for the QR decomposition of special classes of matrices. There is a generic function which uses \code{\link[base]{qr}} as default, but methods defined in this package can take extra arguments. In particular there is an option for determining a fill-reducing permutation of the columns of a sparse, rectangular matrix. } \usage{ qr(x, \dots) qrR(qr, complete=FALSE, backPermute=TRUE, row.names = TRUE) } \arguments{ \item{x}{a numeric or complex matrix whose QR decomposition is to be computed. Logical matrices are coerced to numeric.} \item{qr}{a QR decomposition of the type computed by \code{qr}.} \item{complete}{logical indicating whether the \eqn{\bold{R}} matrix is to be completed by binding zero-value rows beneath the square upper triangle.} \item{backPermute}{logical indicating if the rows of the \eqn{\bold{R}} matrix should be back permuted such that \code{qrR()}'s result can be used directly to reconstruct the original matrix \eqn{\bold{X}}.} \item{row.names}{logical indicating if \code{\link{rownames}} should propagated to the result.} \item{\dots}{further arguments passed to or from other methods} } \section{Methods}{ \describe{ \item{x = "dgCMatrix"}{QR decomposition of a general sparse double-precision matrix with \code{nrow(x) >= ncol(x)}. Returns an object of class \code{"\linkS4class{sparseQR}"}.} \item{x = "sparseMatrix"}{works via \code{"dgCMatrix"}.} } } \seealso{\code{\link[base]{qr}}; then, the class documentations, mainly \code{\linkS4class{sparseQR}}, and also \code{\linkS4class{dgCMatrix}}. } \examples{ %% FIXME: Currently mixing example + regression tests <--> ../tests/factorizing.R ##------------- example of pivoting -- from base' qraux.Rd ------------- X <- cbind(int = 1, b1=rep(1:0, each=3), b2=rep(0:1, each=3), c1=rep(c(1,0,0), 2), c2=rep(c(0,1,0), 2), c3=rep(c(0,0,1),2)) rownames(X) <- paste0("r", seq_len(nrow(X))) dnX <- dimnames(X) bX <- X # [b]ase version of X X <- as(bX, "sparseMatrix") X # is singular, columns "b2" and "c3" are "extra" stopifnot(identical(dimnames(X), dnX))# some versions changed X's dimnames! c(rankMatrix(X)) # = 4 (not 6) m <- function(.) as(., "matrix") ##----- regular case ------------------------------------------ Xr <- X[ , -c(3,6)] # the "regular" (non-singular) version of X stopifnot(rankMatrix(Xr) == ncol(Xr)) Y <- cbind(y <- setNames(1:6, paste0("y", 1:6))) ## regular case: qXr <- qr( Xr) qxr <- qr(m(Xr)) qxrLA <- qr(m(Xr), LAPACK=TRUE) # => qr.fitted(), qr.resid() not supported qcfXy <- qr.coef (qXr, y) # vector qcfXY <- qr.coef (qXr, Y) # 4x1 dgeMatrix cf <- c(int=6, b1=-3, c1=-2, c2=-1) doExtras <- interactive() || nzchar(Sys.getenv("R_MATRIX_CHECK_EXTRA")) || identical("true", unname(Sys.getenv("R_PKG_CHECKING_doExtras"))) tolE <- if(doExtras) 1e-15 else 1e-13 stopifnot(exprs = { all.equal(qr.coef(qxr, y), cf, tol=tolE) all.equal(qr.coef(qxrLA,y), cf, tol=tolE) all.equal(qr.coef(qxr, Y), m(cf), tol=tolE) all.equal( qcfXy, cf, tol=tolE) all.equal(m(qcfXY), m(cf), tol=tolE) all.equal(y, qr.fitted(qxr, y), tol=2*tolE) all.equal(y, qr.fitted(qXr, y), tol=2*tolE) all.equal(m(qr.fitted(qXr, Y)), qr.fitted(qxr, Y), tol=tolE) all.equal( qr.resid (qXr, y), qr.resid (qxr, y), tol=tolE) all.equal(m(qr.resid (qXr, Y)), qr.resid (qxr, Y), tol=tolE) }) ##----- rank-deficient ("singular") case ------------------------------------ (qX <- qr( X)) # both @p and @q are non-trivial permutations qx <- qr(m(X)) ; str(qx) # $pivot is non-trivial, too drop0(R. <- qr.R(qX), tol=tolE) # columns *permuted*: c3 b1 .. Q. <- qr.Q(qX) qI <- sort.list(qX@q) # the inverse 'q' permutation (X. <- drop0(Q. \%*\% R.[, qI], tol=tolE))## just = X, incl. correct colnames stopifnot(all(X - X.) < 8*.Machine$double.eps, ## qrR(.) returns R already "back permuted" (as with qI): identical(R.[, qI], qrR(qX)) ) ## ## In this sense, classical qr.coef() is fine: cfqx <- qr.coef(qx, y) # quite different from nna <- !is.na(cfqx) stopifnot(all.equal(unname(qr.fitted(qx,y)), as.numeric(X[,nna] \%*\% cfqx[nna]))) ## FIXME: do these make *any* sense? --- should give warnings ! qr.coef(qX, y) qr.coef(qX, Y) rm(m) } \keyword{methods} \keyword{algebra} \keyword{array} Matrix/man/atomicVector-class.Rd0000644000176200001440000000231211252551775016332 0ustar liggesusers\name{atomicVector-class} \docType{class} \alias{atomicVector-class} \title{Virtual Class "atomicVector" of Atomic Vectors} \description{ The \code{\link{class}} \code{"atomicVector"} is a \emph{virtual} class containing all atomic vector classes of base \R, as also implicitly defined via \code{\link{is.atomic}}. } \section{Objects from the Class}{A virtual Class: No objects may be created from it.} \section{Methods}{ In the \pkg{Matrix} package, the "atomicVector" is used in signatures where typically \dQuote{old-style} "matrix" objects can be used and can be substituted by simple vectors. } \section{Extends}{%% FIXME: promptClass() should show the direct subclasses ! The atomic classes \code{"logical"}, \code{"integer"}, \code{"double"}, \code{"numeric"}, \code{"complex"}, \code{"raw"} and \code{"character"} are extended directly. Note that \code{"numeric"} already contains \code{"integer"} and \code{"double"}, but we want all of them to be direct subclasses of \code{"atomicVector"}. } \author{Martin Maechler} \seealso{ \code{\link{is.atomic}}, \code{\link{integer}}, \code{\link{numeric}}, \code{\link{complex}}, etc. } \examples{ showClass("atomicVector") } \keyword{classes} Matrix/man/dsRMatrix-class.Rd0000644000176200001440000000541410757763005015616 0ustar liggesusers\name{dsRMatrix-class} \title{Symmetric Sparse Compressed Row Matrices} \docType{class} \alias{dsRMatrix-class} % \description{The \code{dsRMatrix} class is a class of symmetric, sparse matrices in the compressed, row-oriented format. In this implementation the non-zero elements in the rows are sorted into increasing column order. } \section{Objects from the Class}{ These \code{"..RMatrix"} classes are currently still mostly unimplemented! Objects can be created by calls of the form \code{new("dsRMatrix", ...)}. } \section{Slots}{ \describe{ \item{\code{uplo}:}{A character object indicating if the upper triangle (\code{"U"}) or the lower triangle (\code{"L"}) is stored. At present only the lower triangle form is allowed.} \item{\code{j}:}{Object of class \code{"integer"} of length \code{nnzero} (number of non-zero elements). These are the row numbers for each non-zero element in the matrix.} \item{\code{p}:}{Object of class \code{"integer"} of pointers, one for each row, to the initial (zero-based) index of elements in the row.} \item{\code{factors}:}{Object of class \code{"list"} - a list of factorizations of the matrix.} \item{\code{x}:}{Object of class \code{"numeric"} - the non-zero elements of the matrix.} \item{\code{Dim}:}{Object of class \code{"integer"} - the dimensions of the matrix - must be an integer vector with exactly two non-negative values.} \item{\code{Dimnames}:}{List of length two, see \code{\link{Matrix}}.} } } \section{Extends}{ Classes \code{\linkS4class{RsparseMatrix}}, \code{\linkS4class{dsparseMatrix}} and \code{\linkS4class{symmetricMatrix}}, directly. Class \code{"dMatrix"}, by class \code{"dsparseMatrix"}, class \code{"sparseMatrix"}, by class \code{"dsparseMatrix"} or \code{"RsparseMatrix"}; class \code{"compMatrix"} by class \code{"symmetricMatrix"} and of course, class \code{"Matrix"}. } \section{Methods}{ \describe{ \item{forceSymmetric}{\code{signature(x = "dsRMatrix", uplo = "missing")}: a trivial method just returning \code{x}} \item{forceSymmetric}{\code{signature(x = "dsRMatrix", uplo = "character")}: if \code{uplo == x@uplo}, this trivially returns \code{x}; otherwise \code{t(x)}.} \item{coerce}{\code{signature(from = "dsCMatrix", to = "dsRMatrix")}} } } \seealso{ the classes \code{\linkS4class{dgCMatrix}}, \code{\linkS4class{dgTMatrix}}, and \code{\linkS4class{dgeMatrix}}. } \examples{ (m0 <- new("dsRMatrix")) m2 <- new("dsRMatrix", Dim = c(2L,2L), x = c(3,1), j = c(1L,1L), p = 0:2) m2 stopifnot(colSums(as(m2, "TsparseMatrix")) == 3:4) str(m2) (ds2 <- forceSymmetric(diag(2))) # dsy* dR <- as(ds2, "RsparseMatrix") dR # dsRMatrix } \keyword{classes} \keyword{algebra} Matrix/man/wrld_1deg.Rd0000644000176200001440000000570713556256250014452 0ustar liggesusers\name{wrld_1deg} \title{World 1-degree grid contiguity matrix} \alias{wrld_1deg} \docType{data} \description{ This matrix represents the distance-based contiguities of 15260 one-degree grid cells of land areas. The representation is as a row standardised spatial weights matrix transformed to a symmetric matrix (see Ord (1975), p. 125). } \usage{data(wrld_1deg)} \format{ A \eqn{15260 ^2} symmetric sparse matrix of class \code{\linkS4class{dsCMatrix}} with 55973 non-zero entries. } \details{ The data were created into \R using the coordinates of a \sQuote{SpatialPixels} object containing approximately one-degree grid cells for land areas only (world excluding Antarctica), using package \CRANpkg{spdep}'s \code{\link[spdep]{dnearneigh}} with a cutoff distance of \code{sqrt(2)}, and row-standardised and transformed to symmetry using \code{\link[spdep]{nb2listw}} and \code{\link[spdep]{similar.listw}}. This spatial weights object was converted to a \code{\linkS4class{dsTMatrix}} using \code{\link[spdep]{as_dsTMatrix_listw}} and then coerced (column-compressed). } \source{ The shoreline data was read into \R using \code{\link[maptools]{Rgshhs}} from the GSHHS coarse shoreline database distributed with the \CRANpkg{maptools} package, omitting Antarctica. A matching approximately one-degree grid was generated using \code{\link[maptools]{Sobj_SpatialGrid}}, and the grids on land were found using the appropriate \code{\link[sp]{over}}% was {overlay} till 2016-02 method for the \sQuote{SpatialPolygons} and \sQuote{SpatialGrid} objects, yielding a \sQuote{SpatialPixels} one containing only the grid cells with centres on land. } \references{ Ord, J. K. (1975) Estimation methods for models of spatial interaction; \emph{Journal of the American Statistical Association} \bold{70}, 120--126. } \examples{ data(wrld_1deg) (n <- ncol(wrld_1deg)) IM <- .symDiagonal(n) doExtras <- interactive() || nzchar(Sys.getenv("R_MATRIX_CHECK_EXTRA")) || identical("true", unname(Sys.getenv("R_PKG_CHECKING_doExtras"))) nn <- if(doExtras) 20 else 3 set.seed(1) rho <- runif(nn, 0, 1) system.time(MJ <- sapply(rho, function(x) determinant(IM - x * wrld_1deg, logarithm = TRUE)$modulus)) nWC <- -wrld_1deg C1 <- Cholesky(nWC, Imult = 2) ## Note that det() = det(L) = sqrt(det(A)) ## ====> log det(A) = log( det(L)^2 ) = 2 * log det(L) : system.time(MJ1 <- n * log(rho) + sapply(rho, function(x) c(2* determinant(update(C1, nWC, 1/x))$modulus)) ) stopifnot(all.equal(MJ, MJ1)) C2 <- Cholesky(nWC, super = TRUE, Imult = 2) system.time(MJ2 <- n * log(rho) + sapply(rho, function(x) c(2* determinant(update(C2, nWC, 1/x))$modulus)) ) system.time(MJ3 <- n * log(rho) + Matrix:::ldetL2up(C1, nWC, 1/rho)) system.time(MJ4 <- n * log(rho) + Matrix:::ldetL2up(C2, nWC, 1/rho)) stopifnot(all.equal(MJ, MJ2), all.equal(MJ, MJ3), all.equal(MJ, MJ4)) } \keyword{datasets} Matrix/man/sparseLU-class.Rd0000644000176200001440000000637712526663046015450 0ustar liggesusers\name{sparseLU-class} \docType{class} \alias{sparseLU-class} \alias{expand,sparseLU-method} \title{Sparse LU decomposition of a square sparse matrix} \description{Objects of this class contain the components of the LU decomposition of a sparse square matrix.} \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("sparseLU", ...)} but are more commonly created by function \code{\link{lu}()} applied to a sparse matrix, such as a matrix of class \code{\linkS4class{dgCMatrix}}. } \section{Slots}{ \describe{ \item{\code{L}:}{Object of class \code{"\linkS4class{dtCMatrix}"}, the lower triangular factor from the left.} \item{\code{U}:}{Object of class \code{"\linkS4class{dtCMatrix}"}, the upper triangular factor from the right.} \item{\code{p}:}{Object of class \code{"integer"}, permutation applied from the left. } \item{\code{q}:}{Object of class \code{"integer"}, permutation applied from the right.} \item{\code{Dim}:}{the dimension of the original matrix; inherited from class \code{\linkS4class{MatrixFactorization}}.} } } \section{Extends}{ Class \code{"\linkS4class{LU}"}, directly. Class \code{"\linkS4class{MatrixFactorization}"}, by class \code{"LU"}. } \section{Methods}{ \describe{ \item{expand}{\code{signature(x = "sparseLU")} Returns a list with components \code{P}, \code{L}, \code{U}, and \code{Q}, where \eqn{P} and \eqn{Q} represent fill-reducing permutations, and \eqn{L}, and \eqn{U} the lower and upper triangular matrices of the decomposition. The original matrix corresponds to the product \eqn{P'LUQ}.} } } %\references{} \note{ The decomposition is of the form \deqn{A = P'LUQ,} %% --------- or equivalently \eqn{PAQ' = LU}, where all matrices are sparse and of size \eqn{n\times n}{n by n}. The matrices \eqn{P} and \eqn{Q}, and their transposes \eqn{P'} and \eqn{Q'} are permutation matrices, \eqn{L} is lower triangular and \eqn{U} is upper triangular. } \seealso{ \code{\link{lu}}, \code{\link[base]{solve}}, \code{\linkS4class{dgCMatrix}} } \examples{ ## Extending the one in examples(lu), calling the matrix A, ## and confirming the factorization identities : A <- as(readMM(system.file("external/pores_1.mtx", package = "Matrix")), "CsparseMatrix") ## with dimnames(.) - to see that they propagate to L, U : dimnames(A) <- dnA <- list(paste0("r", seq_len(nrow(A))), paste0("C", seq_len(ncol(A)))) str(luA <- lu(A)) # p is a 0-based permutation of the rows # q is a 0-based permutation of the columns xA <- expand(luA) ## which is simply doing stopifnot(identical(xA$ L, luA@L), identical(xA$ U, luA@U), identical(xA$ P, as(luA@p +1L, "pMatrix")), identical(xA$ Q, as(luA@q +1L, "pMatrix"))) P.LUQ <- with(xA, t(P) \%*\% L \%*\% U \%*\% Q) stopifnot(all.equal(A, P.LUQ, tolerance = 1e-12), identical(dimnames(P.LUQ), dnA)) ## permute rows and columns of original matrix pA <- A[luA@p + 1L, luA@q + 1L] stopifnot(identical(pA, with(xA, P \%*\% A \%*\% t(Q)))) pLU <- drop0(luA@L \%*\% luA@U) # L \%*\% U -- dropping extra zeros stopifnot(all.equal(pA, pLU, tolerance = 1e-12)) } \keyword{classes} Matrix/man/formatSparseM.Rd0000644000176200001440000000667712622365126015370 0ustar liggesusers\name{formatSparseM} \alias{formatSparseM} \alias{.formatSparseSimple} \title{Formatting Sparse Numeric Matrices Utilities} \description{ Utilities for formatting sparse numeric matrices in a flexible way. These functions are used by the \code{\link{format}} and \code{print} methods for sparse matrices and can be applied as well to standard \R matrices. Note that \emph{all} arguments but the first are optional. \code{formatSparseM()} is the main \dQuote{workhorse} of \code{\link{formatSpMatrix}}, the \code{format} method for sparse matrices. \code{.formatSparseSimple()} is a simple helper function, also dealing with (short/empty) column names construction. } \usage{ formatSparseM(x, zero.print = ".", align = c("fancy", "right"), m = as(x,"matrix"), asLogical=NULL, uniDiag=NULL, digits=NULL, cx, iN0, dn = dimnames(m)) .formatSparseSimple(m, asLogical=FALSE, digits=NULL, col.names, note.dropping.colnames = TRUE, dn=dimnames(m)) } \arguments{ \item{x}{an \R object inheriting from class \code{\linkS4class{sparseMatrix}}.} \item{zero.print}{character which should be used for \emph{structural} zeroes. The default \code{"."} may occasionally be replaced by \code{" "} (blank); using \code{"0"} would look almost like \code{print()}ing of non-sparse matrices.} \item{align}{a string specifying how the \code{zero.print} codes should be aligned, see \code{\link{formatSpMatrix}}.} \item{m}{(optional) a (standard \R) \code{\link{matrix}} version of \code{x}.} \item{asLogical}{should the matrix be formatted as a logical matrix (or rather as a numeric one); mostly for \code{formatSparseM()}.} \item{uniDiag}{logical indicating if the diagonal entries of a sparse unit triangular or unit-diagonal matrix should be formatted as \code{"I"} instead of \code{"1"} (to emphasize that the 1's are \dQuote{structural}).} \item{digits}{significant digits to use for printing, see \code{\link{print.default}}.} \item{cx}{(optional) character matrix; a formatted version of \code{x}, still with strings such as \code{"0.00"} for the zeros.} \item{iN0}{(optional) integer vector, specifying the location of the \emph{non}-zeroes of \code{x}.} \item{col.names, note.dropping.colnames}{see \code{\link{formatSpMatrix}}.} \item{dn}{\code{\link{dimnames}} to be used; a list (of length two) with row and column names (or \code{\link{NULL}}).} } \seealso{ \code{\link{formatSpMatrix}} which calls \code{formatSparseM()} and is the \code{\link{format}} method for sparse matrices.\cr \code{\link{printSpMatrix}} which is used by the (typically implicitly called) \code{\link{show}} and \code{\link{print}} methods for sparse matrices. } \value{ a character matrix like \code{cx}, where the zeros have been replaced with (padded versions of) \code{zero.print}. As this is a \emph{dense} matrix, do not use these functions for really large (really) sparse matrices! } \author{Martin Maechler} \examples{ m <- suppressWarnings(matrix(c(0, 3.2, 0,0, 11,0,0,0,0,-7,0), 4,9)) fm <- formatSparseM(m) noquote(fm) ## nice, but this is nicer {with "units" vertically aligned}: print(fm, quote=FALSE, right=TRUE) ## and "the same" as : Matrix(m) ## align = "right" is cheaper --> the "." are not aligned: noquote(f2 <- formatSparseM(m,align="r")) stopifnot(f2 == fm | m == 0, dim(f2) == dim(m), (f2 == ".") == (m == 0)) } \keyword{utilities} \keyword{print} Matrix/man/number-class.Rd0000644000176200001440000000111510746336135015161 0ustar liggesusers\name{number-class} \docType{class} \alias{number-class} \title{Class "number" of Possibly Complex Numbers} \description{The class \code{"number"} is a virtual class, currently used for vectors of eigen values which can be \code{"numeric"} or \code{"complex"}. It is a simple class union (\code{\link{setClassUnion}}) of \code{"numeric"} and \code{"complex"}. } \section{Objects from the Class}{Since it is a virtual Class, no objects may be created from it.} \examples{ showClass("number") stopifnot( is(1i, "number"), is(pi, "number"), is(1:3, "number") ) } \keyword{classes} Matrix/man/diagU2N.Rd0000644000176200001440000000477012531270632014022 0ustar liggesusers\name{diagU2N} \title{Transform Triangular Matrices from Unit Triangular to General Triangular and Back} \alias{diagN2U} \alias{diagU2N} \alias{.diagU2N} \description{ Transform a triangular matrix \code{x}, i.e., of \code{\link{class}} \code{"\linkS4class{triangularMatrix}"}, from (internally!) unit triangular (\dQuote{unitriangular}) to \dQuote{general} triangular (\code{diagU2N(x)}) or back (\code{diagN2U(x)}). Note that the latter, \code{diagN2U(x)}, also sets the diagonal to one in cases where \code{diag(x)} was not all one. \code{.diagU2N(x)} assumes but does \emph{not} check that \code{x} is a \code{\linkS4class{triangularMatrix}} with \code{diag} slot \code{"U"}, and should hence be used with care. } \usage{ diagN2U(x, cl = getClassDef(class(x)), checkDense = FALSE) diagU2N(x, cl = getClassDef(class(x)), checkDense = FALSE) .diagU2N(x, cl, checkDense = FALSE) } \arguments{ \item{x}{a \code{\linkS4class{triangularMatrix}}, often sparse.} \item{cl}{(optional, for speedup only:) class (definition) of \code{x}.} \item{checkDense}{logical indicating if dense (see \code{\linkS4class{denseMatrix}}) matrices should be considered at all; i.e., when false, as per default, the result will be sparse even when \code{x} is dense.} } \details{ The concept of unit triangular matrices with a \code{diag} slot of \code{"U"} stems from LAPACK. } \note{Such internal storage details should rarely be of relevance to the user. Hence, these functions really are rather \emph{internal} utilities. } \value{ a triangular matrix of the same \code{\link{class}} but with a different \code{diag} slot. For \code{diagU2N} (semantically) with identical entries as \code{x}, whereas in \code{diagN2U(x)}, the off-diagonal entries are unchanged and the diagonal is set to all \code{1} even if it was not previously. } \seealso{ \code{"\linkS4class{triangularMatrix}"}, \code{"\linkS4class{dtCMatrix}"}. } \examples{ (T <- Diagonal(7) + triu(Matrix(rpois(49, 1/4), 7,7), k = 1)) (uT <- diagN2U(T)) # "unitriangular" (t.u <- diagN2U(10*T))# changes the diagonal! stopifnot(all(T == uT), diag(t.u) == 1, identical(T, diagU2N(uT))) T[upper.tri(T)] <- 5 T <- diagN2U(as(T,"triangularMatrix")) stopifnot(T@diag == "U") dT <- as(T, "denseMatrix") dt. <- diagN2U(dT) dtU <- diagN2U(dT, checkDense=TRUE) stopifnot(is(dtU, "denseMatrix"), is(dt., "sparseMatrix"), all(dT == dt.), all(dT == dtU), dt.@diag == "U", dtU@diag == "U") } \keyword{utilities} \keyword{classes} Matrix/man/unused-classes.Rd0000644000176200001440000000111611055522413015513 0ustar liggesusers\name{Unused-classes} %% This is just a stub, not yet used really: -- move to own page when used \docType{class} \alias{iMatrix-class} \alias{zMatrix-class} \title{Virtual Classes Not Yet Really Implemented and Used} \description{ \code{iMatrix} is the virtual class of all \bold{i}nteger (S4) matrices. It extends the \code{\linkS4class{Matrix}} class directly. \code{zMatrix} is the virtual class of all \code{\link{complex}} (S4) matrices. It extends the \code{\linkS4class{Matrix}} class directly. } \examples{ showClass("iMatrix") showClass("zMatrix") } \keyword{classes} Matrix/man/CsparseMatrix-class.Rd0000644000176200001440000001264013556074411016461 0ustar liggesusers\name{CsparseMatrix-class} \docType{class} \alias{CsparseMatrix-class} \alias{coerce,CsparseMatrix,lsparseMatrix-method} \alias{coerce,CsparseMatrix,lMatrix-method} \alias{coerce,CsparseMatrix,nsparseMatrix-method} \alias{coerce,CsparseMatrix,nMatrix-method} \alias{coerce,CsparseMatrix,TsparseMatrix-method} \alias{coerce,CsparseMatrix,denseMatrix-method} \alias{coerce,matrix,CsparseMatrix-method} \alias{coerce,numeric,CsparseMatrix-method} \alias{diag,CsparseMatrix-method} \alias{t,CsparseMatrix-method} % "[" are in ./Xtrct-methods.Rd; "[<-" in ./Subassign-methods.Rd %% Group methods --------- FIXME: not tested yet (or documented) \alias{Compare,CsparseMatrix,CsparseMatrix-method} \alias{Arith,CsparseMatrix,CsparseMatrix-method} \alias{Arith,CsparseMatrix,numeric-method} \alias{Arith,numeric,CsparseMatrix-method} \alias{Logic,CsparseMatrix,CsparseMatrix-method} \alias{Math,CsparseMatrix-method} \alias{log,CsparseMatrix-method} % \alias{.validateCsparse} % \title{Class "CsparseMatrix" of Sparse Matrices in Column-compressed Form} \description{The \code{"CsparseMatrix"} class is the virtual class of all sparse matrices coded in sorted compressed column-oriented form. Since it is a virtual class, no objects may be created from it. See \code{showClass("CsparseMatrix")} for its subclasses. } \section{Slots}{ \describe{ \item{\code{i}:}{Object of class \code{"integer"} of length nnzero (number of non-zero elements). These are the \emph{0-based} row numbers for each non-zero element in the matrix, i.e., \code{i} must be in \code{0:(nrow(.)-1)}.} \item{\code{p}:}{\code{\link{integer}} vector for providing pointers, one for each column, to the initial (zero-based) index of elements in the column. \code{.@p} is of length \code{ncol(.) + 1}, with \code{p[1] == 0} and \code{p[length(p)] == nnzero}, such that in fact, \code{diff(.@p)} are the number of non-zero elements for each column. In other words, \code{m@p[1:ncol(m)]} contains the indices of those elements in \code{m@x} that are the first elements in the respective column of \code{m}. } \item{\code{Dim}, \code{Dimnames}:}{inherited from the superclass, see the \code{\linkS4class{sparseMatrix}} class.} } } \section{Extends}{ Class \code{"sparseMatrix"}, directly. Class \code{"Matrix"}, by class \code{"sparseMatrix"}. } \section{Methods}{ \describe{ matrix products \code{\link[=crossprod-methods]{\%*\%}}, \code{\link[=crossprod-methods]{crossprod}()} and \code{tcrossprod()}, several \code{\link{solve}} methods, and other matrix methods available: %% The following is generated by promptClass(..) -- %% FIXME: write a script that update all the *-class.Rd files \item{Arith}{\code{signature(e1 = "CsparseMatrix", e2 = "numeric")}: ... } \item{Arith}{\code{signature(e1 = "numeric", e2 = "CsparseMatrix")}: ... } \item{Math}{\code{signature(x = "CsparseMatrix")}: ... } \item{band}{\code{signature(x = "CsparseMatrix")}: ... } \item{-}{\code{signature(e1 = "CsparseMatrix", e2 = "numeric")}: ... } \item{-}{\code{signature(e1 = "numeric", e2 = "CsparseMatrix")}: ... } \item{+}{\code{signature(e1 = "CsparseMatrix", e2 = "numeric")}: ... } \item{+}{\code{signature(e1 = "numeric", e2 = "CsparseMatrix")}: ... } \item{coerce}{\code{signature(from = "CsparseMatrix", to = "TsparseMatrix")}: ... } \item{coerce}{\code{signature(from = "CsparseMatrix", to = "denseMatrix")}: ... } \item{coerce}{\code{signature(from = "CsparseMatrix", to = "matrix")}: ... } \item{coerce}{\code{signature(from = "CsparseMatrix", to = "lsparseMatrix")}: ... } \item{coerce}{\code{signature(from = "CsparseMatrix", to = "nsparseMatrix")}: ... } \item{coerce}{\code{signature(from = "TsparseMatrix", to = "CsparseMatrix")}: ... } \item{coerce}{\code{signature(from = "denseMatrix", to = "CsparseMatrix")}: ... } \item{diag}{\code{signature(x = "CsparseMatrix")}: ... } \item{gamma}{\code{signature(x = "CsparseMatrix")}: ... } \item{lgamma}{\code{signature(x = "CsparseMatrix")}: ... } \item{log}{\code{signature(x = "CsparseMatrix")}: ... } \item{t}{\code{signature(x = "CsparseMatrix")}: ... } \item{tril}{\code{signature(x = "CsparseMatrix")}: ... } \item{triu}{\code{signature(x = "CsparseMatrix")}: ... } } } \note{ All classes extending \code{CsparseMatrix} have a common validity (see \code{\link{validObject}}) check function. That function additionally checks the \code{i} slot for each column to contain increasing row numbers. \cr In earlier versions of \pkg{Matrix} (\code{<= 0.999375-16}), \code{\link{validObject}} automatically re-sorted the entries when necessary, and hence \code{new()} calls with somewhat permuted \code{i} and \code{x} slots worked, as \code{\link{new}(...)} (\emph{with} slot arguments) automatically checks the validity. Now, you have to use \code{\link{sparseMatrix}} to achieve the same functionality or know how to use \code{.validateCsparse()} to do so. } \seealso{ \code{\link{colSums}}, \code{\link{kronecker}}, and other such methods with own help pages. Further, the super class of \code{CsparseMatrix}, \code{\linkS4class{sparseMatrix}}, and, e.g., class \code{\linkS4class{dgCMatrix}} for the links to other classes. } \examples{ getClass("CsparseMatrix") ## The common validity check function (based on C code): getValidity(getClass("CsparseMatrix")) } \keyword{classes} Matrix/man/dsCMatrix-class.Rd0000644000176200001440000001473212622367447015605 0ustar liggesusers\name{dsCMatrix-class} \title{Numeric Symmetric Sparse (column compressed) Matrices} \docType{class} \alias{dsCMatrix-class} \alias{dsTMatrix-class} % %\alias{solve,dsCMatrix,...-method}--> solve-methods.Rd \alias{t,dsCMatrix-method} \alias{t,dsTMatrix-method} \alias{as.vector,dsCMatrix-method} \alias{coerce,dgeMatrix,dsCMatrix-method} \alias{coerce,dgeMatrix,dsTMatrix-method} \alias{coerce,dsCMatrix,dgCMatrix-method} \alias{coerce,dsCMatrix,dgTMatrix-method} \alias{coerce,dsCMatrix,dgeMatrix-method} \alias{coerce,dsCMatrix,dsRMatrix-method} \alias{coerce,dsCMatrix,dsTMatrix-method} \alias{coerce,dsCMatrix,dsyMatrix-method} \alias{coerce,dsCMatrix,lsCMatrix-method} \alias{coerce,dsCMatrix,generalMatrix-method} \alias{coerce,dsCMatrix,denseMatrix-method} \alias{coerce,dsCMatrix,matrix-method} \alias{coerce,dsCMatrix,vector-method} \alias{coerce,dsCMatrix,nsCMatrix-method} \alias{coerce,dsTMatrix,dgTMatrix-method} \alias{coerce,dsTMatrix,dgeMatrix-method} \alias{coerce,dsTMatrix,dsCMatrix-method} \alias{coerce,dsTMatrix,dsyMatrix-method} \alias{coerce,dsTMatrix,lsTMatrix-method} \alias{coerce,dsTMatrix,matrix-method} \alias{coerce,dsyMatrix,dsCMatrix-method} \alias{coerce,dsyMatrix,dsTMatrix-method} \alias{coerce,dtCMatrix,dtRMatrix-method} \alias{coerce,matrix,dsCMatrix-method} \alias{coerce,matrix,dsTMatrix-method} \alias{coerce,graphNEL,dsCMatrix-method} %% Group methods \alias{Arith,dsCMatrix,dsCMatrix-method} \alias{determinant,dsCMatrix,missing-method} \alias{determinant,dsCMatrix,logical-method} \description{The \code{dsCMatrix} class is a class of symmetric, sparse numeric matrices in the compressed, \bold{c}olumn-oriented format. In this implementation the non-zero elements in the columns are sorted into increasing row order. The \code{dsTMatrix} class is the class of symmetric, sparse numeric matrices in \bold{t}riplet format. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("dsCMatrix", ...)} or \code{new("dsTMatrix", ...)}, or automatically via e.g., \code{as(*, "symmetricMatrix")}, or (for \code{dsCMatrix}) also from \code{\link{Matrix}(.)}. Creation \dQuote{from scratch} most efficiently happens via \code{\link{sparseMatrix}(*, symmetric=TRUE)}. } \section{Slots}{ \describe{ \item{\code{uplo}:}{A character object indicating if the upper triangle (\code{"U"}) or the lower triangle (\code{"L"}) is stored.} \item{\code{i}:}{Object of class \code{"integer"} of length nnZ (\emph{half} number of non-zero elements). These are the row numbers for each non-zero element in the lower triangle of the matrix.} \item{\code{p}:}{(only in class \code{"dsCMatrix"}:) an \code{\link{integer}} vector for providing pointers, one for each column, see the detailed description in \code{\linkS4class{CsparseMatrix}}.} \item{\code{j}:}{(only in class \code{"dsTMatrix"}:) Object of class \code{"integer"} of length nnZ (as \code{i}). These are the column numbers for each non-zero element in the lower triangle of the matrix.} \item{\code{x}:}{Object of class \code{"numeric"} of length nnZ -- the non-zero elements of the matrix (to be duplicated for full matrix).} \item{\code{factors}:}{Object of class \code{"list"} - a list of factorizations of the matrix. } \item{\code{Dim}:}{Object of class \code{"integer"} - the dimensions of the matrix - must be an integer vector with exactly two non-negative values.} } } \section{Extends}{ Both classes extend classes and \code{\linkS4class{symmetricMatrix}} \code{\linkS4class{dsparseMatrix}} directly; \code{dsCMatrix} further directly extends \code{\linkS4class{CsparseMatrix}}, where \code{dsTMatrix} does \code{\linkS4class{TsparseMatrix}}. } \section{Methods}{ \describe{ \item{solve}{\code{signature(a = "dsCMatrix", b = "....")}: \code{x <- solve(a,b)} solves \eqn{A x = b} for \eqn{x}; see \code{\link{solve-methods}}.} \item{chol}{\code{signature(x = "dsCMatrix", pivot = "logical")}: Returns (and stores) the Cholesky decomposition of \code{x}, see \code{\link{chol}}.} \item{Cholesky}{\code{signature(A = "dsCMatrix",...)}: Computes more flexibly Cholesky decompositions, see \code{\link{Cholesky}}.} \item{determinant}{\code{signature(x = "dsCMatrix", logarithm = "missing")}: Evaluate the determinant of \code{x} on the logarithm scale. This creates and stores the Cholesky factorization.} \item{determinant}{\code{signature(x = "dsCMatrix", logarithm = "logical")}: Evaluate the determinant of \code{x} on the logarithm scale or not, according to the \code{logarithm} argument. This creates and stores the Cholesky factorization.} \item{t}{\code{signature(x = "dsCMatrix")}: Transpose. As for all symmetric matrices, a matrix for which the upper triangle is stored produces a matrix for which the lower triangle is stored and vice versa, i.e., the \code{uplo} slot is swapped, and the row and column indices are interchanged.} \item{t}{\code{signature(x = "dsTMatrix")}: Transpose. The \code{uplo} slot is swapped from \code{"U"} to \code{"L"} or vice versa, as for a \code{"dsCMatrix"}, see above.} \item{coerce}{\code{signature(from = "dsCMatrix", to = "dgTMatrix")}} \item{coerce}{\code{signature(from = "dsCMatrix", to = "dgeMatrix")}} \item{coerce}{\code{signature(from = "dsCMatrix", to = "matrix")}} \item{coerce}{\code{signature(from = "dsTMatrix", to = "dgeMatrix")}} \item{coerce}{\code{signature(from = "dsTMatrix", to = "dsCMatrix")}} \item{coerce}{\code{signature(from = "dsTMatrix", to = "dsyMatrix")}} \item{coerce}{\code{signature(from = "dsTMatrix", to = "matrix")}} } } %\references{} %\author{} %\note{} \seealso{ Classes \code{\linkS4class{dgCMatrix}}, \code{\linkS4class{dgTMatrix}}, \code{\linkS4class{dgeMatrix}} and those mentioned above. } \examples{ mm <- Matrix(toeplitz(c(10, 0, 1, 0, 3)), sparse = TRUE) mm # automatically dsCMatrix str(mm) ## how would we go from a manually constructed Tsparse* : mT <- as(mm, "dgTMatrix") ## Either (symM <- as(mT, "symmetricMatrix"))# dsT (symC <- as(symM, "CsparseMatrix"))# dsC ## or sC <- Matrix(mT, sparse=TRUE, forceCheck=TRUE) sym2 <- as(symC, "TsparseMatrix") ## --> the same as 'symM', a "dsTMatrix" \dontshow{ stopifnot(identical(symC, sC), identical(sym2, symM), class(sym2) == "dsTMatrix", identical(sym2[1,], sC[1,]), identical(sym2[,2], sC[,2])) } } \keyword{classes} \keyword{algebra} Matrix/man/KhatriRao.Rd0000644000176200001440000000657412760263240014462 0ustar liggesusers\name{KhatriRao} \title{Khatri-Rao Matrix Product} \alias{KhatriRao} \description{ Computes Khatri-Rao products for any kind of matrices. The Khatri-Rao product is a column-wise Kronecker product. Originally introduced by Khatri and Rao (1968), it has many different applications, see Liu and Trenkler (2008) for a survey. Notably, it is used in higher-dimensional tensor decompositions, see Bader and Kolda (2008). } \usage{ KhatriRao(X, Y = X, FUN = "*", make.dimnames = FALSE) } \arguments{ \item{X,Y}{matrices of with the same number of columns.} \item{FUN}{the (name of the) \code{\link{function}} to be used for the column-wise Kronecker products, see \code{\link{kronecker}}, defaulting to the usual multiplication.} \item{make.dimnames}{logical indicating if the result should inherit \code{\link{dimnames}} from \code{X} and \code{Y} in a simple way.} } %\details{ %} \value{ a \code{"\linkS4class{CsparseMatrix}"}, say \code{R}, the Khatri-Rao product of \code{X} (\eqn{n \times k}{n x k}) and \code{Y} (\eqn{m \times k}{m x k}), is of dimension \eqn{(n\cdot m) \times k}{(n*m) x k}, where the j-th column, \code{R[,j]} is the kronecker product \code{\link{kronecker}(X[,j], Y[,j])}. } \note{%% TODO? Could make it generic, and have dense and sparse methods The current implementation is efficient for large sparse matrices. } \references{ Khatri, C. G., and Rao, C. Radhakrishna (1968) Solutions to Some Functional Equations and Their Applications to Characterization of Probability Distributions. \emph{Sankhya: Indian J. Statistics, Series A} \bold{30}, 167--180. Liu, Shuangzhe, and G\enc{õ}{oe}tz Trenkler (2008) Hadamard, Khatri-Rao, Kronecker and Other Matrix Products. \emph{International J. Information and Systems Sciences} \bold{4}, 160--177. Bader, Brett W, and Tamara G Kolda (2008) Efficient MATLAB Computations with Sparse and Factored Tensors. \emph{SIAM J. Scientific Computing} \bold{30}, 205--231. } \author{ Original by Michael Cysouw, Univ. Marburg; minor tweaks, bug fixes etc, by Martin Maechler. } \seealso{ \code{\link{kronecker}}. } \examples{ ## Example with very small matrices: m <- matrix(1:12,3,4) d <- diag(1:4) KhatriRao(m,d) KhatriRao(d,m) dimnames(m) <- list(LETTERS[1:3], letters[1:4]) KhatriRao(m,d, make.dimnames=TRUE) KhatriRao(d,m, make.dimnames=TRUE) dimnames(d) <- list(NULL, paste0("D", 1:4)) KhatriRao(m,d, make.dimnames=TRUE) KhatriRao(d,m, make.dimnames=TRUE) dimnames(d) <- list(paste0("d", 10*1:4), paste0("D", 1:4)) (Kmd <- KhatriRao(m,d, make.dimnames=TRUE)) (Kdm <- KhatriRao(d,m, make.dimnames=TRUE)) nm <- as(m,"nMatrix") nd <- as(d,"nMatrix") KhatriRao(nm,nd, make.dimnames=TRUE) KhatriRao(nd,nm, make.dimnames=TRUE) stopifnot(dim(KhatriRao(m,d)) == c(nrow(m)*nrow(d), ncol(d))) ## border cases / checks: zm <- nm; zm[] <- 0 # all 0 matrix stopifnot(all(K1 <- KhatriRao(nd, zm) == 0), identical(dim(K1), c(12L, 4L)), all(K2 <- KhatriRao(zm, nd) == 0), identical(dim(K2), c(12L, 4L))) d0 <- d; d0[] <- 0; m0 <- Matrix(d0[-1,]) stopifnot(all(K3 <- KhatriRao(d0, m) == 0), identical(dim(K3), dim(Kdm)), all(K4 <- KhatriRao(m, d0) == 0), identical(dim(K4), dim(Kmd)), all(KhatriRao(d0, d0) == 0), all(KhatriRao(m0, d0) == 0), all(KhatriRao(d0, m0) == 0), all(KhatriRao(m0, m0) == 0), identical(dimnames(KhatriRao(m, d0, make.dimnames=TRUE)), dimnames(Kmd))) } \keyword{methods} \keyword{array} Matrix/man/expm.Rd0000644000176200001440000000432513753445524013551 0ustar liggesusers\name{expm} \title{Matrix Exponential} \alias{expm} \alias{expm,Matrix-method} \alias{expm,dMatrix-method} \alias{expm,dgeMatrix-method} \alias{expm,triangularMatrix-method} \alias{expm,symmetricMatrix-method} \alias{expm,ddiMatrix-method} \alias{expm,matrix-method}% < for now \description{ Compute the exponential of a matrix. } \usage{ expm(x) } \arguments{ \item{x}{a matrix, typically inheriting from the \code{\linkS4class{dMatrix}} class.} } \details{ The exponential of a matrix is defined as the infinite Taylor series \code{expm(A) = I + A + A^2/2! + A^3/3! + ...} (although this is definitely not the way to compute it). The method for the \code{dgeMatrix} class uses Ward's diagonal Pade' approximation with three step preconditioning. %% which used to be the state-of-the-art of the original %% Moler & Van Loan (1978) "Nineteen dubious ..." } \value{ The matrix exponential of \code{x}. } \references{ \url{https://en.wikipedia.org/wiki/Matrix_exponential} Cleve Moler and Charles Van Loan (2003) Nineteen dubious ways to compute the exponential of a matrix, twenty-five years later. \emph{SIAM Review} \bold{45}, 1, 3--49. %% MM: Till we have something better, this is quite good: Eric W. Weisstein et al. (1999) \emph{Matrix Exponential}. From MathWorld, \url{https://mathworld.wolfram.com/MatrixExponential.html} } \author{This is a translation of the implementation of the corresponding Octave function contributed to the Octave project by A. Scottedward Hodel \email{A.S.Hodel@Eng.Auburn.EDU}. A bug in there has been fixed by Martin Maechler. } %\note{} \seealso{\code{\link{Schur}}; additionally, \code{\link[expm]{expm}}, \code{\link[expm]{logm}}, etc in package \CRANpkg{expm}. } \note{The \CRANpkg{expm} package contains newer (partly faster and more accurate) algorithms for \code{expm()} and includes \code{\link[expm]{logm}} and \code{\link[expm]{sqrtm}}. } \examples{ (m1 <- Matrix(c(1,0,1,1), nc = 2)) (e1 <- expm(m1)) ; e <- exp(1) stopifnot(all.equal(e1@x, c(e,0,e,e), tolerance = 1e-15)) (m2 <- Matrix(c(-49, -64, 24, 31), nc = 2)) (e2 <- expm(m2)) (m3 <- Matrix(cbind(0,rbind(6*diag(3),0))))# sparse! (e3 <- expm(m3)) # upper triangular } \keyword{algebra} \keyword{math} Matrix/man/LU-class.Rd0000644000176200001440000000634012210462526014206 0ustar liggesusers\name{LU-class} \docType{class} \alias{LU-class} \alias{denseLU-class} \alias{expand,denseLU-method} %% \alias{solve,denseLU,missing-method} \title{LU (dense) Matrix Decompositions} \description{ The \code{"LU"} class is the \emph{virtual} class of LU decompositions of real matrices. \code{"denseLU"} the class of LU decompositions of dense real matrices. } \details{ The decomposition is of the form \deqn{A = P L U}{A = P L U} where typically all matrices are of size \eqn{n\times n}{n by n}, and the matrix \eqn{P} is a permutation matrix, \eqn{L} is lower triangular and \eqn{U} is upper triangular (both of class \code{\linkS4class{dtrMatrix}}). Note that the \emph{dense} decomposition is also implemented for a \eqn{m\times n}{m by n} matrix \eqn{A}, when \eqn{m \ne n}{m != n}. If \eqn{m < n} (\dQuote{wide case}), \eqn{U} is \eqn{m\times n}{m by n}, and hence not triangular.\cr If \eqn{m > n} (\dQuote{long case}), \eqn{L} is \eqn{m\times n}{m by n}, and hence not triangular. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("denseLU", ...)}. More commonly the objects are created explicitly from calls of the form \code{\link{lu}(mm)} where \code{mm} is an object that inherits from the \code{"dgeMatrix"} class or as a side-effect of other functions applied to \code{"dgeMatrix"} objects. } \section{Extends}{ \code{"LU"} directly extends the virtual class \code{"\linkS4class{MatrixFactorization}"}. \code{"denseLU"} directly extends \code{"LU"}. } \section{Slots}{ \describe{ \item{\code{x}:}{object of class \code{"numeric"}. The \code{"L"} (unit lower triangular) and \code{"U"} (upper triangular) factors of the original matrix. These are stored in a packed format described in the Lapack manual, and can retrieved by the \code{expand()} method, see below.} \item{\code{perm}:}{Object of class \code{"integer"} - a vector of length \code{min(Dim)} that describes the permutation applied to the rows of the original matrix. The contents of this vector are described in the Lapack manual.} \item{\code{Dim}:}{the dimension of the original matrix; inherited from class \code{\linkS4class{MatrixFactorization}} .} } } \section{Methods}{ \describe{ \item{expand}{\code{signature(x = "denseLU")}: Produce the \code{"L"} and \code{"U"} (and \code{"P"}) factors as a named list of matrices, see also the example below.} \item{solve}{\code{signature(a = "denseLU", b = "missing")}: Compute the inverse of A, \eqn{A^{-1}}{A^(-1)}, \code{solve(A)} using the LU decomposition, see also \code{\link{solve-methods}}.} } } % \references{} \seealso{ class \code{\linkS4class{sparseLU}} for LU decompositions of \emph{sparse} matrices; further, class \code{\linkS4class{dgeMatrix}} and functions \code{\link{lu}}, \code{\link{expand}}. } \examples{ set.seed(1) mm <- Matrix(round(rnorm(9),2), nrow = 3) mm str(lum <- lu(mm)) elu <- expand(lum) elu # three components: "L", "U", and "P", the permutation elu$L \%*\% elu$U (m2 <- with(elu, P \%*\% L \%*\% U)) # the same as 'mm' stopifnot(all.equal(as(mm, "matrix"), as(m2, "matrix"))) } \keyword{classes} \keyword{algebra} Matrix/man/rsparsematrix.Rd0000644000176200001440000000603613711014657015476 0ustar liggesusers\name{rsparsematrix} \alias{rsparsematrix} \title{Random Sparse Matrix} \description{ Generate a random sparse matrix efficiently. The default has rounded gaussian non-zero entries, and \code{rand.x = NULL} generates random patter\bold{n} matrices, i.e. inheriting from \code{\linkS4class{nsparseMatrix}}. } \usage{ rsparsematrix(nrow, ncol, density, nnz = round(density * maxE), symmetric = FALSE, rand.x = function(n) signif(rnorm(n), 2), \dots) } \arguments{ \item{nrow, ncol}{number of rows and columns, i.e., the matrix dimension (\code{\link{dim}}).} \item{density}{optional number in \eqn{[0,1]}, the density is the proportion of non-zero entries among all matrix entries. If specified it determines the default for \code{nnz}, otherwise \code{nnz} needs to be specified.} \item{nnz}{number of non-zero entries, for a sparse matrix typically considerably smaller than \code{nrow*ncol}. Must be specified if \code{density} is not.} \item{symmetric}{logical indicating if result should be a matrix of class \code{\linkS4class{symmetricMatrix}}. Note that in the symmetric case, \code{nnz} denotes the number of non zero entries of the upper (or lower) part of the matrix, including the diagonal.} \item{rand.x}{\code{\link{NULL}} or the random number generator for the \code{x} slot, a \code{\link{function}} such that \code{rand.x(n)} generates a numeric vector of length \code{n}. Typical examples are \code{rand.x = rnorm}, or \code{rand.x = runif}; the default is nice for didactical purposes.} \item{\dots}{optionally further arguments passed to \code{\link{sparseMatrix}()}, notably \code{repr}.} } \details{ The algorithm first samples \dQuote{encoded} \eqn{(i,j)}s without replacement, via one dimensional indices, if not \code{symmetric} \code{\link{sample.int}(nrow*ncol, nnz)}, then---if \code{rand.x} is not \code{NULL}---gets \code{x <- rand.x(nnz)} and calls \code{\link{sparseMatrix}(i=i, j=j, x=x, ..)}. When \code{rand.x=NULL}, \code{\link{sparseMatrix}(i=i, j=j, ..)} will return a patter\bold{n} matrix (i.e., inheriting from \code{\linkS4class{nsparseMatrix}}). } \value{ a \code{\linkS4class{sparseMatrix}}, say \code{M} of dimension (nrow, ncol), i.e., with \code{dim(M) == c(nrow, ncol)}, if \code{symmetric} is not true, with \code{nzM <- \link{nnzero}(M)} fulfilling \code{nzM <= nnz} and typically, \code{nzM == nnz}. } \author{Martin Maechler} \examples{ set.seed(17)# to be reproducible M <- rsparsematrix(8, 12, nnz = 30) # small example, not very sparse M M1 <- rsparsematrix(1000, 20, nnz = 123, rand.x = runif) summary(M1) ## a random *symmetric* Matrix (S9 <- rsparsematrix(9, 9, nnz = 10, symmetric=TRUE)) # dsCMatrix nnzero(S9)# ~ 20: as 'nnz' only counts one "triangle" ## a random patter*n* aka boolean Matrix (no 'x' slot): (n7 <- rsparsematrix(5, 12, nnz = 10, rand.x = NULL)) ## a [T]riplet representation sparseMatrix: T2 <- rsparsematrix(40, 12, nnz = 99, repr = "T") head(T2) } \keyword{array} \keyword{distribution} Matrix/man/spMatrix.Rd0000644000176200001440000000544112651647132014402 0ustar liggesusers\name{spMatrix} \alias{spMatrix} \title{Sparse Matrix Constructor From Triplet} \description{ User friendly construction of a sparse matrix (inheriting from class \code{\linkS4class{TsparseMatrix}}) from the triplet representation. This is much less flexible than \code{\link{sparseMatrix}()} and hence somewhat \emph{deprecated}. } \usage{ spMatrix(nrow, ncol, i = integer(), j = integer(), x = numeric()) } \arguments{ \item{nrow, ncol}{integers specifying the desired number of rows and columns.} \item{i,j}{integer vectors of the same length specifying the locations of the non-zero (or non-\code{TRUE}) entries of the matrix.} \item{x}{atomic vector of the same length as \code{i} and \code{j}, specifying the values of the non-zero entries.} } \value{ A sparse matrix in triplet form, as an \R object inheriting from both \code{\linkS4class{TsparseMatrix}} and \code{\linkS4class{generalMatrix}}. The matrix \eqn{M} will have \code{M[i[k], j[k]] == x[k]}, for \eqn{k = 1,2,\ldots, n}, where \code{n = length(i)} and \code{M[ i', j' ] == 0} for all other pairs \eqn{(i',j')}. } \seealso{\code{\link{Matrix}(*, sparse=TRUE)} for the more usual constructor of such matrices. Then, \code{\link{sparseMatrix}} is more general and flexible than \code{spMatrix()} and by default returns a \code{\linkS4class{CsparseMatrix}} which is often slightly more desirable. Further, \code{\link{bdiag}} and \code{\link{Diagonal}} for (block-)diagonal matrix constructors. Consider \code{\linkS4class{TsparseMatrix}} and similar class definition help files. } \examples{ ## simple example A <- spMatrix(10,20, i = c(1,3:8), j = c(2,9,6:10), x = 7 * (1:7)) A # a "dgTMatrix" summary(A) str(A) # note that *internally* 0-based indices (i,j) are used L <- spMatrix(9, 30, i = rep(1:9, 3), 1:27, (1:27) \%\% 4 != 1) L # an "lgTMatrix" ## A simplified predecessor of Matrix' rsparsematrix() function : rSpMatrix <- function(nrow, ncol, nnz, rand.x = function(n) round(rnorm(nnz), 2)) { ## Purpose: random sparse matrix ## -------------------------------------------------------------- ## Arguments: (nrow,ncol): dimension ## nnz : number of non-zero entries ## rand.x: random number generator for 'x' slot ## -------------------------------------------------------------- ## Author: Martin Maechler, Date: 14.-16. May 2007 stopifnot((nnz <- as.integer(nnz)) >= 0, nrow >= 0, ncol >= 0, nnz <= nrow * ncol) spMatrix(nrow, ncol, i = sample(nrow, nnz, replace = TRUE), j = sample(ncol, nnz, replace = TRUE), x = rand.x(nnz)) } M1 <- rSpMatrix(100000, 20, nnz = 200) summary(M1) } \keyword{array} Matrix/man/isTriangular.Rd0000644000176200001440000000647013775317466015256 0ustar liggesusers\name{isTriangular} \title{isTriangular() and isDiagonal() Checking if Matrix is Triangular or Diagonal} %\docType{methods} both generic *and* methods \alias{isDiagonal} \alias{isDiagonal-methods} \alias{isDiagonal,symmetricMatrix-method} \alias{isDiagonal,triangularMatrix-method} \alias{isDiagonal,denseMatrix-method} \alias{isDiagonal,diagonalMatrix-method} \alias{isDiagonal,sparseMatrix-method} \alias{isDiagonal,CsparseMatrix-method} \alias{isDiagonal,TsparseMatrix-method} \alias{isDiagonal,matrix-method} % \alias{isTriangular} \alias{isTriangular-methods} \alias{isTriangular,triangularMatrix-method} \alias{isTriangular,denseMatrix-method} \alias{isTriangular,diagonalMatrix-method} \alias{isTriangular,BunchKaufman-method} \alias{isTriangular,Cholesky-method} \alias{isTriangular,CsparseMatrix-method} \alias{isTriangular,TsparseMatrix-method} \alias{isTriangular,dtCMatrix-method} \alias{isTriangular,dtRMatrix-method} \alias{isTriangular,dtTMatrix-method} \alias{isTriangular,dtpMatrix-method} \alias{isTriangular,dtrMatrix-method} \alias{isTriangular,ltCMatrix-method} \alias{isTriangular,ltRMatrix-method} \alias{isTriangular,ltTMatrix-method} \alias{isTriangular,ltpMatrix-method} \alias{isTriangular,ltrMatrix-method} \alias{isTriangular,ntCMatrix-method} \alias{isTriangular,ntRMatrix-method} \alias{isTriangular,ntTMatrix-method} \alias{isTriangular,ntpMatrix-method} \alias{isTriangular,ntrMatrix-method} \alias{isTriangular,pBunchKaufman-method} \alias{isTriangular,pCholesky-method} \alias{isTriangular,matrix-method} % \description{ \code{isTriangular(M)} returns a \code{\link{logical}} indicating if \code{M} is a triangular matrix. Analogously, \code{isDiagonal(M)} is true iff \code{M} is a diagonal matrix. Contrary to \code{\link{isSymmetric}()}, these two functions are generically from package \pkg{Matrix}, and hence also define methods for traditional (\code{\link{class}} \code{"matrix"}) matrices. By our definition, triangular, diagonal and symmetric matrices are all \emph{square}, i.e. have the same number of rows and columns. } \usage{ isDiagonal(object) isTriangular(object, upper = NA, \dots) } \arguments{ \item{object}{any \R object, typically a matrix (traditional or Matrix package).} \item{upper}{logical, one of \code{NA} (default), \code{FALSE}, or \code{TRUE} where the last two cases require a lower or upper triangular \code{object} to result in \code{TRUE}.} \item{\dots}{potentially further arguments for other methods.} } \value{ a (\dQuote{scalar}) logical, \code{TRUE} or \code{FALSE}, never \code{\link{NA}}. For \code{isTriangular()}, if the result is \code{TRUE}, it may contain an attribute (see \code{\link{attributes}} \code{"kind"}, either \code{"L"} or \code{"U"} indicating if it is a \bold{l}ower or \bold{u}pper triangular matrix. } \seealso{ \code{\link{isSymmetric}}; formal class (and subclasses) \code{"\linkS4class{triangularMatrix}"} and \code{"\linkS4class{diagonalMatrix}"}. } \examples{ isTriangular(Diagonal(4)) ## is TRUE: a diagonal matrix is also (both upper and lower) triangular (M <- Matrix(c(1,2,0,1), 2,2)) isTriangular(M) # TRUE (*and* of formal class "dtrMatrix") isTriangular(as(M, "dgeMatrix")) # still triangular, even if not "formally" isTriangular(crossprod(M)) # FALSE isDiagonal(matrix(c(2,0,0,1), 2,2)) # TRUE } \keyword{methods} Matrix/man/is.na-methods.Rd0000644000176200001440000000525612314067537015251 0ustar liggesusers\name{is.na-methods} \title{is.na(), is.{in}finite() Methods for 'Matrix' Objects} \docType{methods} \alias{is.finite,ddenseMatrix-method} \alias{is.finite,dgeMatrix-method} \alias{is.finite,dsparseMatrix-method} \alias{is.finite,diagonalMatrix-method} \alias{is.finite,lMatrix-method} \alias{is.finite,nMatrix-method} \alias{is.finite,indMatrix-method} \alias{is.infinite,ddenseMatrix-method} \alias{is.infinite,dsparseMatrix-method} \alias{is.infinite,diagonalMatrix-method} \alias{is.infinite,lMatrix-method} \alias{is.infinite,nMatrix-method} \alias{is.infinite,indMatrix-method} \alias{is.na,denseMatrix-method} \alias{is.na,indMatrix-method} \alias{is.na,sparseMatrix-method} \alias{anyNA,nsparseMatrix-method} \alias{anyNA,nsparseVector-method} \alias{anyNA,sparseVector-method} \alias{anyNA,xMatrix-method} %% xMatrix (classUnion) dispatching failing, --> workaround: \alias{anyNA,dMatrix-method} \alias{anyNA,iMatrix-method} \alias{anyNA,lMatrix-method} \alias{anyNA,zMatrix-method} \alias{anyNA,ndenseMatrix-method} %%end{workaround} \alias{is.na-methods} \description{ Methods for function \code{\link{is.na}()}, \code{\link{is.finite}()}, and \code{\link{is.infinite}()} for all Matrices (objects extending the \code{\linkS4class{Matrix}} class): \describe{ \item{x = "denseMatrix"}{returns a \code{"nMatrix"} object of same dimension as \code{x}, with TRUE's whenever \code{x} is \code{\link{NA}}, finite, or infinite, respectively.} \item{x = "sparseMatrix"}{ditto.} } } \usage{ \S4method{is.na}{sparseMatrix}(x) \S4method{is.finite}{dsparseMatrix}(x) \S4method{is.infinite}{ddenseMatrix}(x) ## ... ## and for other classes \S4method{anyNA}{xMatrix}(x) \S4method{anyNA}{nsparseMatrix}(x) \S4method{anyNA}{sparseVector}(x) \S4method{anyNA}{nsparseVector}(x) } \arguments{ \item{x}{sparse or dense matrix or sparse vector (here; any \R object in general).} } \seealso{ \code{\link{NA}}, \code{\link{is.na}}; \code{\link{is.finite}}, \code{\link{is.infinite}}; \code{\linkS4class{nMatrix}}, \code{\linkS4class{denseMatrix}}, \code{\linkS4class{sparseMatrix}}. The \code{\linkS4class{sparseVector}} class. } \examples{ M <- Matrix(1:6, nrow=4, ncol=3, dimnames = list(c("a", "b", "c", "d"), c("A", "B", "C"))) stopifnot(all(!is.na(M))) M[2:3,2] <- NA is.na(M) if(exists("anyNA", mode="function")) anyNA(M) A <- spMatrix(10,20, i = c(1,3:8), j = c(2,9,6:10), x = 7 * (1:7)) stopifnot(all(!is.na(A))) %TODO stopifnot(all(!is.na(A)), !anyNA(A)) A[2,3] <- A[1,2] <- A[5, 5:9] <- NA inA <- is.na(A) stopifnot(sum(inA) == 1+1+5) \dontshow{ if(exists("anyNA", mode="function")) stopifnot(anyNA(M), anyNA(A)) }% dont.. } \keyword{methods} Matrix/man/updown.Rd0000644000176200001440000000346111745552731014112 0ustar liggesusers\name{updown} \alias{updown} \alias{updown-methods} \alias{updown,ANY,ANY,ANY-method} \alias{updown,character,mMatrix,CHMfactor-method} \alias{updown,logical,mMatrix,CHMfactor-method} \title{Up- and Down-Dating a Cholesky Decomposition} \description{ Compute the up- or down-dated Cholesky decomposition } \usage{ updown(update, C, L) } \arguments{ \item{update}{logical (\code{TRUE} or \code{FALSE}) or \code{"+"} or \code{"-"} indicating if an up- or a down-date is to be computed.} \item{C}{any \R object, coercable to a sparse matrix (i.e., of subclass of \code{\linkS4class{sparseMatrix}}).} \item{L}{a Cholesky factor, specifically, of class \code{"\linkS4class{CHMfactor}"}.} } % \details{ % } \value{ an updated Cholesky factor, of the same dimension as \code{L}. Typically of class \code{"\linkS4class{dCHMsimpl}"} (a sub class of \code{"\linkS4class{CHMfactor}"}). } \references{ CHOLMOD manual, currently beginning of chapter~18. ... %% FIXME } \author{Contributed by Nicholas Nagle, University of Tennessee, Knoxville, USA} \section{Methods}{ \describe{ \item{\code{signature(update = "character", C = "mMatrix", L = "CHMfactor")}}{..} \item{\code{signature(update = "logical", C = "mMatrix", L = "CHMfactor")}}{ .. } } } \seealso{ \code{\link{Cholesky}}, } \examples{ dn <- list(LETTERS[1:3], letters[1:5]) ## pointer vectors can be used, and the (i,x) slots are sorted if necessary: m <- sparseMatrix(i = c(3,1, 3:2, 2:1), p= c(0:2, 4,4,6), x = 1:6, dimnames = dn) cA <- Cholesky(A <- crossprod(m) + Diagonal(5)) 166 * as(cA,"Matrix") ^ 2 uc1 <- updown("+", Diagonal(5), cA) ## Hmm: this loses positive definiteness: uc2 <- updown("-", 2*Diagonal(5), cA) image(show(as(cA, "Matrix"))) image(show(c2 <- as(uc2,"Matrix")))# severely negative entries ##--> Warning } \keyword{methods} Matrix/man/matrix-products.Rd0000644000176200001440000004455214041756722015747 0ustar liggesusers\name{matrix-products} \docType{methods} \title{Matrix (Cross) Products (of Transpose)} %%-- %*% ------------------------------------- \alias{\%*\%-methods} \alias{\%*\%,ddenseMatrix,ldenseMatrix-method} \alias{\%*\%,ddenseMatrix,matrix-method} \alias{\%*\%,ddenseMatrix,ndenseMatrix-method} \alias{\%*\%,ldenseMatrix,ddenseMatrix-method} \alias{\%*\%,ldenseMatrix,ldenseMatrix-method} \alias{\%*\%,ldenseMatrix,matrix-method} \alias{\%*\%,ldenseMatrix,ndenseMatrix-method} \alias{\%*\%,matrix,ddenseMatrix-method} \alias{\%*\%,matrix,ldenseMatrix-method} \alias{\%*\%,matrix,ndenseMatrix-method} \alias{\%*\%,ndenseMatrix,ddenseMatrix-method} \alias{\%*\%,ndenseMatrix,ldenseMatrix-method} \alias{\%*\%,ndenseMatrix,matrix-method} \alias{\%*\%,ndenseMatrix,ndenseMatrix-method} \alias{\%*\%,dgeMatrix,dgeMatrix-method} \alias{\%*\%,dgeMatrix,matrix-method} \alias{\%*\%,dgeMatrix,numLike-method} \alias{\%*\%,matrix,dgeMatrix-method} \alias{\%*\%,numLike,dgeMatrix-method} \alias{\%*\%,numLike,CsparseMatrix-method} \alias{\%*\%,CsparseMatrix,CsparseMatrix-method} \alias{\%*\%,CsparseMatrix,ddenseMatrix-method} \alias{\%*\%,CsparseMatrix,matrix-method} \alias{\%*\%,CsparseMatrix,numLike-method} \alias{\%*\%,ddenseMatrix,CsparseMatrix-method} \alias{\%*\%,matrix,CsparseMatrix-method} \alias{\%*\%,matrix,sparseMatrix-method} \alias{\%*\%,sparseMatrix,matrix-method} \alias{\%*\%,ddenseMatrix,ddenseMatrix-method} \alias{\%*\%,dgeMatrix,diagonalMatrix-method} \alias{\%*\%,matrix,diagonalMatrix-method} \alias{\%*\%,diagonalMatrix,dgeMatrix-method} \alias{\%*\%,diagonalMatrix,diagonalMatrix-method} \alias{\%*\%,diagonalMatrix,matrix-method} \alias{\%*\%,diagonalMatrix,CsparseMatrix-method} \alias{\%*\%,diagonalMatrix,sparseMatrix-method} \alias{\%*\%,CsparseMatrix,diagonalMatrix-method} \alias{\%*\%,sparseMatrix,diagonalMatrix-method} \alias{\%*\%,denseMatrix,diagonalMatrix-method} \alias{\%*\%,diagonalMatrix,denseMatrix-method} \alias{\%*\%,diagonalMatrix,lgeMatrix-method} \alias{\%*\%,lgeMatrix,diagonalMatrix-method} \alias{\%*\%,nMatrix,lMatrix-method} \alias{\%*\%,lMatrix,nMatrix-method} \alias{\%*\%,lMatrix,lMatrix-method} \alias{\%*\%,nMatrix,nMatrix-method} \alias{\%*\%,dMatrix,lMatrix-method} \alias{\%*\%,dMatrix,nMatrix-method} \alias{\%*\%,lMatrix,dMatrix-method} \alias{\%*\%,nMatrix,dMatrix-method} \alias{\%*\%,dMatrix,integer-method} \alias{\%*\%,integer,dMatrix-method} \alias{\%*\%,Matrix,numLike-method} \alias{\%*\%,numLike,Matrix-method} \alias{\%*\%,Matrix,ANY-method} \alias{\%*\%,ANY,Matrix-method} \alias{\%*\%,Matrix,matrix-method} \alias{\%*\%,matrix,Matrix-method} \alias{\%*\%,ddenseMatrix,dsparseMatrix-method} \alias{\%*\%,dgeMatrix,dsparseMatrix-method} \alias{\%*\%,dsparseMatrix,ddenseMatrix-method} \alias{\%*\%,dsparseMatrix,dgeMatrix-method} \alias{\%*\%,ddenseMatrix,dsyMatrix-method} \alias{\%*\%,matrix,dsyMatrix-method} \alias{\%*\%,dsyMatrix,dsyMatrix-method} \alias{\%*\%,dspMatrix,ddenseMatrix-method} \alias{\%*\%,dspMatrix,matrix-method} \alias{\%*\%,dsyMatrix,ddenseMatrix-method} \alias{\%*\%,dsyMatrix,matrix-method} \alias{\%*\%,dtpMatrix,ddenseMatrix-method} \alias{\%*\%,dgeMatrix,dtpMatrix-method} \alias{\%*\%,dtpMatrix,matrix-method} \alias{\%*\%,matrix,dtpMatrix-method} \alias{\%*\%,dtrMatrix,dtrMatrix-method} \alias{\%*\%,ddenseMatrix,dtrMatrix-method} \alias{\%*\%,dtrMatrix,ddenseMatrix-method} \alias{\%*\%,dtrMatrix,matrix-method} \alias{\%*\%,matrix,dtrMatrix-method} \alias{\%*\%,matrix,indMatrix-method} \alias{\%*\%,indMatrix,matrix-method} \alias{\%*\%,indMatrix,indMatrix-method} \alias{\%*\%,Matrix,indMatrix-method} \alias{\%*\%,indMatrix,Matrix-method} \alias{\%*\%,lgCMatrix,lgCMatrix-method} \alias{\%*\%,lsparseMatrix,lsparseMatrix-method} \alias{\%*\%,lsparseMatrix,ldenseMatrix-method} \alias{\%*\%,ldenseMatrix,lsparseMatrix-method} \alias{\%*\%,ngCMatrix,ngCMatrix-method} \alias{\%*\%,nsparseMatrix,nsparseMatrix-method} \alias{\%*\%,nsparseMatrix,ndenseMatrix-method} \alias{\%*\%,ndenseMatrix,nsparseMatrix-method} \alias{\%*\%,matrix,pMatrix-method} \alias{\%*\%,pMatrix,matrix-method} \alias{\%*\%,pMatrix,pMatrix-method} \alias{\%*\%,Matrix,pMatrix-method} \alias{\%*\%,pMatrix,Matrix-method} \alias{\%*\%,mMatrix,sparseVector-method} \alias{\%*\%,sparseVector,mMatrix-method} \alias{\%*\%,sparseVector,sparseVector-method} \alias{\%*\%,numLike,sparseVector-method} \alias{\%*\%,sparseVector,numLike-method} \alias{\%*\%,TsparseMatrix,ANY-method} \alias{\%*\%,ANY,TsparseMatrix-method} \alias{\%*\%,TsparseMatrix,Matrix-method} \alias{\%*\%,Matrix,TsparseMatrix-method} \alias{\%*\%,TsparseMatrix,TsparseMatrix-method} %%-- crossprod ------------------------------- \alias{crossprod-methods} \alias{crossprod,dgeMatrix,dgeMatrix-method} \alias{crossprod,dgeMatrix,matrix-method} \alias{crossprod,dgeMatrix,numLike-method} \alias{crossprod,dgeMatrix,missing-method} \alias{crossprod,matrix,dgeMatrix-method} \alias{crossprod,numLike,dgeMatrix-method} \alias{crossprod,numLike,CsparseMatrix-method} \alias{crossprod,CsparseMatrix,missing-method} \alias{crossprod,CsparseMatrix,CsparseMatrix-method} \alias{crossprod,CsparseMatrix,ddenseMatrix-method} \alias{crossprod,CsparseMatrix,matrix-method} \alias{crossprod,CsparseMatrix,numLike-method} \alias{crossprod,ddenseMatrix,CsparseMatrix-method} \alias{crossprod,matrix,CsparseMatrix-method} \alias{crossprod,ddenseMatrix,missing-method} \alias{crossprod,ddenseMatrix,dgCMatrix-method} \alias{crossprod,dgCMatrix,dgeMatrix-method} \alias{crossprod,CsparseMatrix,diagonalMatrix-method} \alias{crossprod,diagonalMatrix,CsparseMatrix-method} \alias{crossprod,diagonalMatrix,dgeMatrix-method} \alias{crossprod,diagonalMatrix,diagonalMatrix-method} \alias{crossprod,diagonalMatrix,lgeMatrix-method} \alias{crossprod,diagonalMatrix,matrix-method} \alias{crossprod,diagonalMatrix,missing-method} \alias{crossprod,diagonalMatrix,sparseMatrix-method} \alias{crossprod,sparseMatrix,diagonalMatrix-method} \alias{crossprod,ANY,Matrix-method} \alias{crossprod,Matrix,numLike-method} \alias{crossprod,numLike,Matrix-method} \alias{crossprod,Matrix,ANY-method} \alias{crossprod,Matrix,missing-method} \alias{crossprod,Matrix,Matrix-method} \alias{crossprod,Matrix,matrix-method} \alias{crossprod,matrix,Matrix-method} \alias{crossprod,matrix,diagonalMatrix-method} \alias{crossprod,ddenseMatrix,dsparseMatrix-method} \alias{crossprod,dgeMatrix,dsparseMatrix-method} \alias{crossprod,dsparseMatrix,ddenseMatrix-method} \alias{crossprod,dsparseMatrix,dgeMatrix-method} \alias{crossprod,dtpMatrix,ddenseMatrix-method} \alias{crossprod,dtpMatrix,matrix-method} \alias{crossprod,dtrMatrix,ddenseMatrix-method} \alias{crossprod,dtrMatrix,dtrMatrix-method} \alias{crossprod,dtrMatrix,matrix-method} \alias{crossprod,matrix,dtrMatrix-method} \alias{crossprod,dtrMatrix,missing-method} \alias{crossprod,indMatrix,matrix-method} \alias{crossprod,indMatrix,Matrix-method} \alias{crossprod,indMatrix,indMatrix-method} \alias{crossprod,indMatrix,missing-method} \alias{crossprod,lgCMatrix,missing-method} \alias{crossprod,lgTMatrix,missing-method} \alias{crossprod,lsparseMatrix-method} \alias{crossprod,lsparseMatrix,missing-method} \alias{crossprod,lsparseMatrix,lsparseMatrix-method} \alias{crossprod,lsparseMatrix,ldenseMatrix-method} \alias{crossprod,ldenseMatrix,lsparseMatrix-method} \alias{crossprod,ngCMatrix,missing-method} \alias{crossprod,ngTMatrix,missing-method} \alias{crossprod,nsparseMatrix-method} \alias{crossprod,nsparseMatrix,missing-method} \alias{crossprod,nsparseMatrix,nsparseMatrix-method} \alias{crossprod,nsparseMatrix,ndenseMatrix-method} \alias{crossprod,ndenseMatrix,nsparseMatrix-method} \alias{crossprod,pMatrix,matrix-method} \alias{crossprod,pMatrix,Matrix-method} \alias{crossprod,pMatrix,pMatrix-method} \alias{crossprod,pMatrix,missing-method} \alias{crossprod,mMatrix,sparseVector-method} \alias{crossprod,sparseVector,mMatrix-method} \alias{crossprod,sparseVector,missing-method} \alias{crossprod,sparseVector,sparseVector-method} \alias{crossprod,numLike,sparseVector-method} \alias{crossprod,sparseVector,numLike-method} \alias{crossprod,TsparseMatrix,ANY-method} \alias{crossprod,ANY,TsparseMatrix-method} \alias{crossprod,TsparseMatrix,Matrix-method} \alias{crossprod,Matrix,TsparseMatrix-method} \alias{crossprod,TsparseMatrix,TsparseMatrix-method} \alias{crossprod,TsparseMatrix,missing-method} \alias{crossprod,symmetricMatrix,Matrix-method} \alias{crossprod,symmetricMatrix,missing-method} \alias{crossprod,symmetricMatrix,ANY-method} \alias{crossprod,ddenseMatrix,ddenseMatrix-method} \alias{crossprod,ddenseMatrix,ldenseMatrix-method} \alias{crossprod,ddenseMatrix,matrix-method} \alias{crossprod,ddenseMatrix,ndenseMatrix-method} \alias{crossprod,ldenseMatrix,ddenseMatrix-method} \alias{crossprod,ldenseMatrix,ldenseMatrix-method} \alias{crossprod,ldenseMatrix,matrix-method} \alias{crossprod,ldenseMatrix,missing-method} \alias{crossprod,ldenseMatrix,ndenseMatrix-method} \alias{crossprod,ndenseMatrix,ddenseMatrix-method} \alias{crossprod,ndenseMatrix,ldenseMatrix-method} \alias{crossprod,ndenseMatrix,matrix-method} \alias{crossprod,ndenseMatrix,missing-method} \alias{crossprod,ndenseMatrix,ndenseMatrix-method} %%-- tcrossprod ------------------------------ \alias{tcrossprod-methods} \alias{tcrossprod,dgeMatrix,missing-method} \alias{tcrossprod,dgeMatrix,dgeMatrix-method} \alias{tcrossprod,dgeMatrix,matrix-method} \alias{tcrossprod,dgeMatrix,numLike-method} \alias{tcrossprod,matrix,dgeMatrix-method} \alias{tcrossprod,numLike,dgeMatrix-method} \alias{tcrossprod,CsparseMatrix,ddenseMatrix-method} \alias{tcrossprod,CsparseMatrix,matrix-method} \alias{tcrossprod,CsparseMatrix,numLike-method} \alias{tcrossprod,ddenseMatrix,CsparseMatrix-method} \alias{tcrossprod,matrix,CsparseMatrix-method} \alias{tcrossprod,numLike,CsparseMatrix-method} \alias{tcrossprod,CsparseMatrix,CsparseMatrix-method} \alias{tcrossprod,CsparseMatrix,missing-method} \alias{tcrossprod,ddenseMatrix,missing-method} \alias{tcrossprod,CsparseMatrix,diagonalMatrix-method} \alias{tcrossprod,dgeMatrix,diagonalMatrix-method} \alias{tcrossprod,diagonalMatrix,CsparseMatrix-method} \alias{tcrossprod,diagonalMatrix,diagonalMatrix-method} \alias{tcrossprod,diagonalMatrix,matrix-method} \alias{tcrossprod,diagonalMatrix,missing-method} \alias{tcrossprod,diagonalMatrix,sparseMatrix-method} \alias{tcrossprod,lgeMatrix,diagonalMatrix-method} \alias{tcrossprod,matrix,diagonalMatrix-method} \alias{tcrossprod,sparseMatrix,diagonalMatrix-method} \alias{tcrossprod,ANY,Matrix-method} \alias{tcrossprod,numLike,Matrix-method} \alias{tcrossprod,Matrix,numLike-method} \alias{tcrossprod,Matrix,ANY-method} \alias{tcrossprod,Matrix,missing-method} \alias{tcrossprod,Matrix,Matrix-method} \alias{tcrossprod,Matrix,matrix-method} \alias{tcrossprod,matrix,Matrix-method} \alias{tcrossprod,ddenseMatrix,dtrMatrix-method} \alias{tcrossprod,dtrMatrix,dtrMatrix-method} \alias{tcrossprod,matrix,dtrMatrix-method} \alias{tcrossprod,matrix,indMatrix-method} \alias{tcrossprod,Matrix,indMatrix-method} \alias{tcrossprod,indMatrix,indMatrix-method} \alias{tcrossprod,indMatrix,missing-method} \alias{tcrossprod,lgCMatrix,missing-method} \alias{tcrossprod,lgTMatrix,missing-method} \alias{tcrossprod,lsparseMatrix,missing-method} \alias{tcrossprod,ngCMatrix,missing-method} \alias{tcrossprod,ngTMatrix,missing-method} \alias{tcrossprod,nsparseMatrix,missing-method} \alias{tcrossprod,matrix,pMatrix-method} \alias{tcrossprod,Matrix,pMatrix-method} \alias{tcrossprod,pMatrix,pMatrix-method} \alias{tcrossprod,pMatrix,missing-method} \alias{tcrossprod,mMatrix,sparseVector-method} \alias{tcrossprod,sparseMatrix,sparseVector-method} \alias{tcrossprod,sparseVector,mMatrix-method} \alias{tcrossprod,sparseVector,missing-method} \alias{tcrossprod,sparseVector,sparseMatrix-method} \alias{tcrossprod,sparseVector,sparseVector-method} \alias{tcrossprod,numLike,sparseVector-method} \alias{tcrossprod,sparseVector,numLike-method} \alias{tcrossprod,TsparseMatrix,ANY-method} \alias{tcrossprod,ANY,TsparseMatrix-method} \alias{tcrossprod,TsparseMatrix,Matrix-method} \alias{tcrossprod,Matrix,TsparseMatrix-method} \alias{tcrossprod,TsparseMatrix,TsparseMatrix-method} \alias{tcrossprod,TsparseMatrix,missing-method} \alias{tcrossprod,Matrix,symmetricMatrix-method} \alias{tcrossprod,ANY,symmetricMatrix-method} \alias{tcrossprod,ddenseMatrix,ddenseMatrix-method} \alias{tcrossprod,ddenseMatrix,ldenseMatrix-method} \alias{tcrossprod,ddenseMatrix,matrix-method} \alias{tcrossprod,ddenseMatrix,ndenseMatrix-method} \alias{tcrossprod,ldenseMatrix,ddenseMatrix-method} \alias{tcrossprod,ldenseMatrix,ldenseMatrix-method} \alias{tcrossprod,ldenseMatrix,matrix-method} \alias{tcrossprod,ldenseMatrix,missing-method} \alias{tcrossprod,ldenseMatrix,ndenseMatrix-method} \alias{tcrossprod,ndenseMatrix,ddenseMatrix-method} \alias{tcrossprod,ndenseMatrix,ldenseMatrix-method} \alias{tcrossprod,ndenseMatrix,matrix-method} \alias{tcrossprod,ndenseMatrix,missing-method} \alias{tcrossprod,ndenseMatrix,ndenseMatrix-method} % (special class methods, added only for speedup:) \alias{tcrossprod,ddenseMatrix,dsCMatrix-method} \alias{tcrossprod,ddenseMatrix,lsCMatrix-method} \alias{tcrossprod,ddenseMatrix,nsCMatrix-method} \alias{tcrossprod,matrix,dsCMatrix-method} \alias{tcrossprod,matrix,lsCMatrix-method} \alias{tcrossprod,matrix,nsCMatrix-method} %%--------------- %- these three are needed for R CMD check: \alias{\%*\%} \alias{crossprod} \alias{tcrossprod} %% no longer (don't want to mask 'base' functionality): % \alias{tcrossprod,matrix,missing-method} % \alias{tcrossprod,numeric,missing-method} \description{ The basic matrix product, \code{\%*\%} is implemented for all our \code{\linkS4class{Matrix}} and also for \code{\linkS4class{sparseVector}} classes, fully analogously to \R's base \code{matrix} and vector objects. The functions \code{\link{crossprod}} and \code{\link{tcrossprod}} are matrix products or \dQuote{cross products}, ideally implemented efficiently without computing \code{\link{t}(.)}'s unnecessarily. They also return \code{\linkS4class{symmetricMatrix}} classed matrices when easily detectable, e.g., in \code{crossprod(m)}, the one argument case. \code{tcrossprod()} takes the cross-product of the transpose of a matrix. \code{tcrossprod(x)} is formally equivalent to, but faster than, the call \code{x \%*\% t(x)}, and so is \code{tcrossprod(x, y)} instead of \code{x \%*\% t(y)}. \emph{Boolean} matrix products are computed via either \code{\link{\%&\%}} or \code{boolArith = TRUE}. } \usage{ \S4method{\%*\%}{CsparseMatrix,diagonalMatrix}(x, y) \S4method{crossprod}{dgeMatrix,missing}(x, y = NULL, boolArith = NA, \dots) \S4method{crossprod}{CsparseMatrix,diagonalMatrix}(x, y = NULL, boolArith = NA, \dots) ## .... and for many more signatures \S4method{tcrossprod}{CsparseMatrix,ddenseMatrix}(x, y = NULL, boolArith = NA, \dots) \S4method{tcrossprod}{TsparseMatrix,missing}(x, y = NULL, boolArith = NA, \dots) ## .... and for many more signatures } \arguments{ \item{x}{a matrix-like object} \item{y}{a matrix-like object, or for \code{[t]crossprod()} \code{NULL} (by default); the latter case is formally equivalent to \code{y = x}.} \item{boolArith}{\code{\link{logical}}, i.e., \code{NA}, \code{TRUE}, or \code{FALSE}. If true the result is (coerced to) a pattern matrix, i.e., \code{"\linkS4class{nMatrix}"}, unless there are \code{NA} entries and the result will be a \code{"\linkS4class{lMatrix}"}. If false the result is (coerced to) numeric. When \code{NA}, currently the default, the result is a pattern matrix when \code{x} and \code{y} are \code{"\linkS4class{nsparseMatrix}"} and numeric otherwise.} \item{\dots}{potentially more arguments passed to and from methods.} } \details{ For some classes in the \code{Matrix} package, such as \code{\linkS4class{dgCMatrix}}, it is much faster to calculate the cross-product of the transpose directly instead of calculating the transpose first and then its cross-product. \code{boolArith = TRUE} for regular (\dQuote{non cross}) matrix products, \code{\%*\%} cannot be specified. Instead, we provide the \code{\link{\%&\%}} operator for \emph{boolean} matrix products. } \note{ \code{boolArith = TRUE}, \code{FALSE} or \code{NA} has been newly introduced for \pkg{Matrix} 1.2.0 (March 2015). Its implementation may be incomplete and partly missing. Please report such omissions if detected! Currently, \code{boolArith = TRUE} is implemented via \code{\linkS4class{CsparseMatrix}} coercions which may be quite inefficient for dense matrices. Contributions for efficiency improvements are welcome. } \value{ A \code{\linkS4class{Matrix}} object, in the one argument case of an appropriate \emph{symmetric} matrix class, i.e., inheriting from \code{\linkS4class{symmetricMatrix}}. } \section{Methods}{ \describe{ \item{\%*\%}{\code{signature(x = "dgeMatrix", y = "dgeMatrix")}: Matrix multiplication; ditto for several other signature combinations, see \code{showMethods("\%*\%", class = "dgeMatrix")}.} \item{\%*\%}{\code{signature(x = "dtrMatrix", y = "matrix")} and other signatures (use \code{showMethods("\%*\%", class="dtrMatrix")}): matrix multiplication. Multiplication of (matching) triangular matrices now should remain triangular (in the sense of class \linkS4class{triangularMatrix}).} \item{crossprod}{\code{signature(x = "dgeMatrix", y = "dgeMatrix")}: ditto for several other signatures, use \code{showMethods("crossprod", class = "dgeMatrix")}, matrix crossproduct, an efficient version of \code{t(x) \%*\% y}.} \item{crossprod}{\code{signature(x = "CsparseMatrix", y = "missing")} returns \code{t(x) \%*\% x} as an \code{dsCMatrix} object.} \item{crossprod}{\code{signature(x = "TsparseMatrix", y = "missing")} returns \code{t(x) \%*\% x} as an \code{dsCMatrix} object.} \item{crossprod,tcrossprod}{\code{signature(x = "dtrMatrix", y = "matrix")} and other signatures, see \code{"\%*\%"} above.} }%{describe} } \seealso{\code{\link[base]{tcrossprod}} in \R's base, \code{\link{crossprod}} and \code{\link{\%*\%}}.} \examples{ ## A random sparse "incidence" matrix : m <- matrix(0, 400, 500) set.seed(12) m[runif(314, 0, length(m))] <- 1 mm <- as(m, "dgCMatrix") object.size(m) / object.size(mm) # smaller by a factor of > 200 ## tcrossprod() is very fast: system.time(tCmm <- tcrossprod(mm))# 0 (PIII, 933 MHz) system.time(cm <- crossprod(t(m))) # 0.16 system.time(cm. <- tcrossprod(m)) # 0.02 stopifnot(cm == as(tCmm, "matrix")) ## show sparse sub matrix tCmm[1:16, 1:30] } \keyword{methods} \keyword{algebra} Matrix/man/generalMatrix-class.Rd0000644000176200001440000000206010435070553016465 0ustar liggesusers\name{generalMatrix-class} \docType{class} \alias{generalMatrix-class} \title{Class "generalMatrix" of General Matrices} \description{ Virtual class of \dQuote{general} matrices; i.e., matrices that do not have a known property such as symmetric, triangular, or diagonal. } \section{Objects from the Class}{A virtual Class: No objects may be created from it.} \section{Slots}{ \describe{ \item{\code{factors}}{,} \item{\code{Dim}}{,} \item{\code{Dimnames}:}{all slots inherited from \code{\linkS4class{compMatrix}}; see its description.} } } \section{Extends}{ Class \code{"compMatrix"}, directly. Class \code{"Matrix"}, by class \code{"compMatrix"}. } % \section{Methods}{ % No methods defined with class "generalMatrix" in the signature. % } \seealso{ Classes \code{\linkS4class{compMatrix}}, and the non-general virtual classes: \code{\linkS4class{symmetricMatrix}}, \code{\linkS4class{triangularMatrix}}, \code{\linkS4class{diagonalMatrix}}. } % \examples{ % ##---- Should be DIRECTLY executable !! ---- % } \keyword{classes} Matrix/man/is.null.DN.Rd0000644000176200001440000000321012102200250014420 0ustar liggesusers\name{is.null.DN} \alias{is.null.DN} \title{Are the Dimnames \code{dn} NULL-like ?} \description{ Are the \code{\link{dimnames}} \code{dn} \code{\link{NULL}}-like? \code{is.null.DN(dn)} is less strict than \code{\link{is.null}(dn)}, because it is also true (\code{\link{TRUE}}) when the dimnames \code{dn} are \dQuote{like} \code{NULL}, or \code{list(NULL,NULL)}, as they can easily be for the traditional \R matrices (\code{\link{matrix}}) which have no formal \code{\link{class}} definition, and hence much freedom in how their \code{\link{dimnames}} look like. } \usage{ is.null.DN(dn) } \arguments{ \item{dn}{\code{\link{dimnames}()} of a \code{\link{matrix}}-like \R object. } } \note{ This function is really to be used on \dQuote{traditional} matrices rather than those inheriting from \code{\linkS4class{Matrix}}, as the latter will always have dimnames \code{list(NULL,NULL)} exactly, in such a case. } \value{ \code{\link{logical}} \code{\link{TRUE}} or \code{\link{FALSE}}. } %% \details{ %% } \author{Martin Maechler} \seealso{ \code{\link{is.null}}, \code{\link{dimnames}}, \code{\link{matrix}}. } \examples{ m <- matrix(round(100 * rnorm(6)), 2,3); m1 <- m2 <- m3 <- m4 <- m dimnames(m1) <- list(NULL, NULL) dimnames(m2) <- list(NULL, character()) dimnames(m3) <- rev(dimnames(m2)) dimnames(m4) <- rep(list(character()),2) m4 ## prints absolutely identically to m stopifnot(m == m1, m1 == m2, m2 == m3, m3 == m4, identical(capture.output(m) -> cm, capture.output(m1)), identical(cm, capture.output(m2)), identical(cm, capture.output(m3)), identical(cm, capture.output(m4))) } \keyword{utilities} Matrix/man/RsparseMatrix-class.Rd0000644000176200001440000000535614020107701016470 0ustar liggesusers\name{RsparseMatrix-class} \docType{class} \alias{RsparseMatrix-class} % \alias{coerce,RsparseMatrix,CsparseMatrix-method} \alias{coerce,RsparseMatrix,TsparseMatrix-method} \alias{coerce,RsparseMatrix,denseMatrix-method} \alias{coerce,RsparseMatrix,dgeMatrix-method} \alias{coerce,RsparseMatrix,generalMatrix-method} \alias{coerce,RsparseMatrix,matrix-method} \alias{coerce,RsparseMatrix,dsparseMatrix-method} \alias{coerce,RsparseMatrix,lsparseMatrix-method} \alias{coerce,RsparseMatrix,nsparseMatrix-method} \alias{coerce,RsparseMatrix,dMatrix-method} \alias{coerce,RsparseMatrix,lMatrix-method} \alias{coerce,RsparseMatrix,nMatrix-method} \alias{coerce,matrix,RsparseMatrix-method} \alias{coerce,denseMatrix,RsparseMatrix-method} \alias{coerce,sparseMatrix,RsparseMatrix-method} % all other ..RMatrix coercions -- here as well for now -- \alias{coerce,matrix,dgRMatrix-method} % \alias{t,RsparseMatrix-method} % \title{Class "RsparseMatrix" of Sparse Matrices in Row-compressed Form} \description{The \code{"RsparseMatrix"} class is the virtual class of all sparse matrices coded in sorted compressed row-oriented form. Since it is a virtual class, no objects may be created from it. See \code{showClass("RsparseMatrix")} for its subclasses. } \section{Slots}{ \describe{ \item{\code{j}:}{Object of class \code{"integer"} of length \code{nnzero} (number of non-zero elements). These are the row numbers for each non-zero element in the matrix.} \item{\code{p}:}{Object of class \code{"integer"} of pointers, one for each row, to the initial (zero-based) index of elements in the row.} \item{\code{Dim}, \code{Dimnames}:}{inherited from the superclass, see \code{\linkS4class{sparseMatrix}}.} } } \section{Extends}{ Class \code{"sparseMatrix"}, directly. Class \code{"Matrix"}, by class \code{"sparseMatrix"}. } \section{Methods}{ Originally, \bold{few} methods were defined on purpose, as we rather use the \code{\linkS4class{CsparseMatrix}} in \pkg{Matrix}. Then, more methods were added but \emph{beware} that these typically do \emph{not} return \code{"RsparseMatrix"} results, but rather Csparse* or Tsparse* ones; e.g., \code{R[i, j] <- v} for an \code{"RsparseMatrix"} \code{R} works, but after the assignment, \code{R} is a (triplet) \code{"TsparseMatrix"}. \describe{ \item{t}{\code{signature(x = "RsparseMatrix")}: ... } \item{coerce}{\code{signature(from = "RsparseMatrix", to = "CsparseMatrix")}: ... } \item{coerce}{\code{signature(from = "RsparseMatrix", to = "TsparseMatrix")}: ... } } } \seealso{ its superclass, \code{\linkS4class{sparseMatrix}}, and, e.g., class \code{\linkS4class{dgRMatrix}} for the links to other classes. } \examples{ showClass("RsparseMatrix") } \keyword{classes} Matrix/man/lu.Rd0000644000176200001440000001070112532076334013204 0ustar liggesusers\name{lu} \title{(Generalized) Triangular Decomposition of a Matrix} \alias{lu} \alias{lu,matrix-method} \alias{lu,dgeMatrix-method} \alias{lu,dgCMatrix-method} \alias{lu,dtCMatrix-method} \usage{ lu(x, \dots) \S4method{lu}{matrix}(x, warnSing = TRUE, \dots) \S4method{lu}{dgeMatrix}(x, warnSing = TRUE, \dots) \S4method{lu}{dgCMatrix}(x, errSing = TRUE, order = TRUE, tol = 1, keep.dimnames = TRUE, \dots) } \description{ Computes (generalized) triangular decompositions of square (sparse or dense) and non-square dense matrices. } \arguments{ \item{x}{a dense or sparse matrix, in the latter case of square dimension. No missing values or IEEE special values are allowed.} \item{warnSing}{(when \code{x} is a \code{"\linkS4class{denseMatrix}"}) logical specifying if a \code{\link{warning}} should be signalled when \code{x} is singular.} \item{errSing}{(when \code{x} is a \code{"\linkS4class{sparseMatrix}"}) logical specifying if an error (see \code{\link{stop}}) should be signalled when \code{x} is singular. When \code{x} is singular, \code{lu(x, errSing=FALSE)} returns \code{\link{NA}} instead of an LU decomposition. No warning is signalled and the useR should be careful in that case. } \item{order}{logical or integer, used to choose which fill-reducing permutation technique will be used internally. Do not change unless you know what you are doing.} \item{tol}{positive number indicating the pivoting tolerance used in \code{cs_lu}. Do only change with much care.} \item{keep.dimnames}{logical indicating that \code{\link{dimnames}} should be propagated to the result, i.e., \dQuote{kept}. This was hardcoded to \code{FALSE} in upto \pkg{Matrix} version 1.2-0. Setting to \code{FALSE} may gain some performance.} \item{\dots}{further arguments passed to or from other methods.} } \value{ An object of class \code{"LU"}, i.e., \code{"\linkS4class{denseLU}"}%% ./LU-class.Rd (see its separate help page), or \code{"sparseLU"}, see \code{\linkS4class{sparseLU}}; this is a representation of a triangular decomposition of \code{x}. } \details{ \code{lu()} is a generic function with special methods for different types of matrices. Use \code{\link{showMethods}("lu")} to list all the methods for the \code{\link{lu}} generic. The method for class \code{\linkS4class{dgeMatrix}} (and all dense matrices) is based on LAPACK's \code{"dgetrf"} subroutine. It returns a decomposition also for singular and non-square matrices. The method for class \code{\linkS4class{dgCMatrix}} (and all sparse matrices) is based on functions from the CSparse library. It signals an error (or returns \code{NA}, when \code{errSing = FALSE}, see above) when the decomposition algorithm fails, as when \code{x} is (too close to) singular.% yes, it would be nice if we could have it % behave more similar to the dense method: still give an LU, % and an optional warning. } \note{ Because the underlying algorithm differ entirely, in the \emph{dense} case (class \code{\linkS4class{denseLU}}), the decomposition is \deqn{A = P L U,} %% --------- where as in the \emph{sparse} case (class \code{\linkS4class{sparseLU}}), it is \deqn{A = P' L U Q.} %% ------------ } \references{ Golub, G., and Van Loan, C. F. (1989). \emph{Matrix Computations,} 2nd edition, Johns Hopkins, Baltimore. %% Tim Davis (2005) %% \url{http://www.cise.ufl.edu/research/sparse/CSparse/} Timothy A. Davis (2006) \emph{Direct Methods for Sparse Linear Systems}, SIAM Series \dQuote{Fundamentals of Algorithms}. } \seealso{ Class definitions \code{\linkS4class{denseLU}} and \code{\linkS4class{sparseLU}} and function \code{\link{expand}}; \code{\link{qr}}, \code{\link{chol}}. } \examples{ ##--- Dense ------------------------- x <- Matrix(rnorm(9), 3, 3) lu(x) dim(x2 <- round(10 * x[,-3]))# non-square expand(lu2 <- lu(x2)) ##--- Sparse (see more in ?"sparseLU-class")----- % ./sparseLU-class.Rd pm <- as(readMM(system.file("external/pores_1.mtx", package = "Matrix")), "CsparseMatrix") str(pmLU <- lu(pm)) # p is a 0-based permutation of the rows # q is a 0-based permutation of the columns ## permute rows and columns of original matrix ppm <- pm[pmLU@p + 1L, pmLU@q + 1L] pLU <- drop0(pmLU@L \%*\% pmLU@U) # L \%*\% U -- dropping extra zeros ## equal up to "rounding" ppm[1:14, 1:5] pLU[1:14, 1:5] } \keyword{array} \keyword{algebra} Matrix/man/rankMatrix.Rd0000644000176200001440000002076113775317466014731 0ustar liggesusers\name{rankMatrix} \title{Rank of a Matrix} \alias{rankMatrix} \alias{qr2rankMatrix} \description{ Compute \sQuote{the} matrix rank, a well-defined functional in theory(*), somewhat ambiguous in practice. We provide several methods, the default corresponding to Matlab's definition. (*) The rank of a \eqn{n \times m}{n x m} matrix \eqn{A}, \eqn{rk(A)}, is the maximal number of linearly independent columns (or rows); hence \eqn{rk(A) \le min(n,m)}{rk(A) <= min(n,m)}. } \usage{ rankMatrix(x, tol = NULL, method = c("tolNorm2", "qr.R", "qrLINPACK", "qr", "useGrad", "maybeGrad"), sval = svd(x, 0, 0)$d, warn.t = TRUE, warn.qr = TRUE) qr2rankMatrix(qr, tol = NULL, isBqr = is.qr(qr), do.warn = TRUE) } \arguments{ \item{x}{numeric matrix, of dimension \eqn{n \times m}{n x m}, say.} \item{tol}{nonnegative number specifying a (relative, \dQuote{scalefree}) tolerance for testing of \dQuote{practically zero} with specific meaning depending on \code{method}; by default, \code{max(dim(x)) * \link{.Machine}$double.eps} is according to Matlab's default (for its only method which is our \code{method="tolNorm2"}).} \item{method}{a character string specifying the computational method for the rank, can be abbreviated: \describe{ \item{\code{"tolNorm2"}:}{the number of singular values \code{>= tol * max(sval)};} \item{\code{"qrLINPACK"}:}{for a dense matrix, this is the rank of \code{\link[base]{qr}(x, tol, LAPACK=FALSE)} (which is \code{qr(...)$rank}); \cr This ("qr*", dense) version used to be \emph{the} recommended way to compute a matrix rank for a while in the past. For sparse \code{x}, this is equivalent to \code{"qr.R"}. } \item{\code{"qr.R"}:}{this is the rank of triangular matrix \eqn{R}, where \code{qr()} uses LAPACK or a "sparseQR" method (see \code{\link{qr-methods}}) to compute the decomposition \eqn{QR}. The rank of \eqn{R} is then defined as the number of \dQuote{non-zero} diagonal entries \eqn{d_i} of \eqn{R}, and \dQuote{non-zero}s fulfill \eqn{|d_i| \ge \mathrm{tol}\cdot\max(|d_i|)}{|d_i| >= tol * max(|d_i|)}. } \item{\code{"qr"}:}{is for back compatibility; for dense \code{x}, it corresponds to \code{"qrLINPACK"}, whereas for sparse \code{x}, it uses \code{"qr.R"}. For all the "qr*" methods, singular values \code{sval} are not used, which may be crucially important for a large sparse matrix \code{x}, as in that case, when \code{sval} is not specified, the default, computing \code{\link{svd}()} currently coerces \code{x} to a dense matrix. } \item{\code{"useGrad"}:}{considering the \dQuote{gradient} of the (decreasing) singular values, the index of the \emph{smallest} gap.} \item{\code{"maybeGrad"}:}{choosing method \code{"useGrad"} only when that seems \emph{reasonable}; otherwise using \code{"tolNorm2"}.} %% FIXME say more } } \item{sval}{numeric vector of non-increasing singular values of \code{x}; typically unspecified and computed from \code{x} when needed, i.e., unless \code{method = "qr"}.} \item{warn.t}{logical indicating if \code{rankMatrix()} should warn when it needs \code{\link{t}(x)} instead of \code{x}. Currently, for \code{method = "qr"} only, gives a warning by default because the caller often could have passed \code{t(x)} directly, more efficiently.} \item{warn.qr}{in the \eqn{QR} cases (i.e., if \code{method} starts with \code{"qr"}), \code{rankMatrix()} calls \code{qr2rankMarix(.., do.warn = warn.qr)}, see below.} %% qr2rankMatrix(): \item{qr}{an \R object resulting from \code{\link{qr}(x,..)}, i.e., typically inheriting from \code{\link{class}} \code{"\link{qr}"} or \code{"\linkS4class{sparseQR}"}.} \item{isBqr}{\code{\link{logical}} indicating if \code{qr} is resulting from \pkg{base} \code{\link[base]{qr}()}. (Otherwise, it is typically from \pkg{Matrix} package sparse \code{\link[Matrix]{qr}}.)} \item{do.warn}{logical; if true, warn about non-finite (or in the \code{sparseQR} case negative) diagonal entries in the \eqn{R} matrix of the \eqn{QR} decomposition. Do not change lightly!} } \details{ \code{qr2rankMatrix()} is typically called from \code{rankMatrix()} for the \code{"qr"}* \code{method}s, but can be used directly - much more efficiently in case the \code{qr}-decomposition is available anyway. } \note{For large sparse matrices \code{x}, unless you can specify \code{sval} yourself, currently \code{method = "qr"} may be the only feasible one, as the others need \code{sval} and call \code{\link{svd}()} which currently coerces \code{x} to a \code{\linkS4class{denseMatrix}} which may be very slow or impossible, depending on the matrix dimensions. Note that in the case of sparse \code{x}, \code{method = "qr"}, all non-strictly zero diagonal entries \eqn{d_i} where counted, up to including \pkg{Matrix} version 1.1-0, i.e., that method implicitly used \code{tol = 0}, see also the \code{set.seed(42)} example below. } \value{ If \code{x} is a matrix of all \code{0} (or of zero dimension), the rank is zero; otherwise, typically a positive integer in \code{1:min(dim(x))} with attributes detailing the method used. There are rare cases where the sparse \eqn{QR} decomposition \dQuote{fails} in so far as the diagonal entries of \eqn{R}, the \eqn{d_i} (see above), end with non-finite, typically \code{\link{NaN}} entries. Then, a warning is signalled (unless \code{warn.qr} / \code{do.warn} is not true) and \code{NA} (specifically, \code{\link{NA_integer_}}) is returned. } % \references{ % %% ~put references to the literature/web site here ~ % } \author{Martin Maechler; for the "*Grad" methods building on suggestions by Ravi Varadhan. } \seealso{ \code{\link{qr}}, \code{\link{svd}}. } \examples{ rankMatrix(cbind(1, 0, 1:3)) # 2 (meths <- eval(formals(rankMatrix)$method)) ## a "border" case: H12 <- Hilbert(12) rankMatrix(H12, tol = 1e-20) # 12; but 11 with default method & tol. sapply(meths, function(.m.) rankMatrix(H12, method = .m.)) ## tolNorm2 qr.R qrLINPACK qr useGrad maybeGrad ## 11 11 12 12 11 11 ## The meaning of 'tol' for method="qrLINPACK" and *dense* x is not entirely "scale free" rMQL <- function(ex, M) rankMatrix(M, method="qrLINPACK",tol = 10^-ex) rMQR <- function(ex, M) rankMatrix(M, method="qr.R", tol = 10^-ex) sapply(5:15, rMQL, M = H12) # result is platform dependent ## 7 7 8 10 10 11 11 11 12 12 12 {x86_64} sapply(5:15, rMQL, M = 1000 * H12) # not identical unfortunately ## 7 7 8 10 11 11 12 12 12 12 12 sapply(5:15, rMQR, M = H12) ## 5 6 7 8 8 9 9 10 10 11 11 sapply(5:15, rMQR, M = 1000 * H12) # the *same* \dontshow{ (r12 <- sapply(5:15, rMQR, M = H12)) stopifnot(identical(r12, sapply(5:15, rMQR, M = H12 / 100)), identical(r12, sapply(5:15, rMQR, M = H12 * 1e5))) rM1 <- function(ex, M) rankMatrix(M, tol = 10^-ex) (r12 <- sapply(5:15, rM1, M = H12)) stopifnot(identical(r12, sapply(5:15, rM1, M = H12 / 100)), identical(r12, sapply(5:15, rM1, M = H12 * 1e5))) } ## "sparse" case: M15 <- kronecker(diag(x=c(100,1,10)), Hilbert(5)) sapply(meths, function(.m.) rankMatrix(M15, method = .m.)) #--> all 15, but 'useGrad' has 14. sapply(meths, function(.m.) rankMatrix(M15, method = .m., tol = 1e-7)) # all 14 ## "large" sparse n <- 250000; p <- 33; nnz <- 10000 L <- sparseMatrix(i = sample.int(n, nnz, replace=TRUE), j = sample.int(p, nnz, replace=TRUE), x = rnorm(nnz)) (st1 <- system.time(r1 <- rankMatrix(L))) # warning+ ~1.5 sec (2013) (st2 <- system.time(r2 <- rankMatrix(L, method = "qr"))) # considerably faster! r1[[1]] == print(r2[[1]]) ## --> ( 33 TRUE ) \dontshow{ stopifnot(r1[[1]] == 33, 33 == r2[[1]]) if(doExtras <- interactive() || identical("true", unname(Sys.getenv("R_PKG_CHECKING_doExtras")))) stopifnot(st2[[1]] < 0.2) # seeing 0.03 (on ~ 2010-hardware; R 3.0.2) } ## another sparse-"qr" one, which ``failed'' till 2013-11-23: set.seed(42) f1 <- factor(sample(50, 1000, replace=TRUE)) f2 <- factor(sample(50, 1000, replace=TRUE)) f3 <- factor(sample(50, 1000, replace=TRUE)) D <- t(do.call(rbind, lapply(list(f1,f2,f3), as, 'sparseMatrix'))) dim(D); nnzero(D) ## 1000 x 150 // 3000 non-zeros (= 2\%) stopifnot(rankMatrix(D, method='qr') == 148, rankMatrix(crossprod(D),method='qr') == 148) ## zero matrix has rank 0 : stopifnot(sapply(meths, function(.m.) rankMatrix(matrix(0, 2, 2), method = .m.)) == 0) } \keyword{algebra} \keyword{array} Matrix/man/MatrixFactorization-class.Rd0000644000176200001440000000364712210462526017676 0ustar liggesusers\name{MatrixFactorization-class} \alias{MatrixFactorization-class} \alias{CholeskyFactorization-class} \docType{class} \title{Class "MatrixFactorization" of Matrix Factorizations} % \alias{dim,MatrixFactorization-method} \alias{expand,MatrixFactorization-method} \alias{show,MatrixFactorization-method} %\alias{solve,MatrixFactorization,ANY-method}--> solve-methods.Rd \description{ The class \code{"MatrixFactorization"} is the virtual (super) class of (potentially) all matrix factorizations of matrices from package \pkg{Matrix}. The class \code{"CholeskyFactorization"} is the virtual class of all Cholesky decompositions from \pkg{Matrix} (and trivial sub class of \code{"MatrixFactorization"}). } \section{Objects from the Class}{A virtual Class: No objects may be created from it.} \section{Slots}{ \describe{ \item{\code{Dim}:}{Object of class \code{"integer"} - the dimensions of the original matrix - must be an integer vector with exactly two non-negative values.} } } \section{Methods}{ \describe{ \item{dim}{\code{(x)} simply returns \code{x@Dim}, see above.} \item{expand}{\code{signature(x = "MatrixFactorization")}: this has not been implemented yet for all matrix factorizations. It should return a list whose components are matrices which when multiplied return the original \code{\linkS4class{Matrix}} object.} \item{show}{\code{signature(object = "MatrixFactorization")}: simple printing, see \code{\link{show}}.} \item{solve}{\code{signature(a = "MatrixFactorization", b= .)}: solve \eqn{A x = b} for \eqn{x}; see \code{\link{solve-methods}}.} } } \seealso{ classes inheriting from \code{"MatrixFactorization"}, such as \code{\linkS4class{LU}}, \code{\linkS4class{Cholesky}}, \code{\linkS4class{CHMfactor}}, and \code{\linkS4class{sparseQR}}. } \examples{ showClass("MatrixFactorization") getClass("CholeskyFactorization") } \keyword{classes} Matrix/man/Schur-class.Rd0000644000176200001440000000270610773452776014776 0ustar liggesusers\name{Schur-class} \docType{class} \alias{Schur-class} % \title{Class "Schur" of Schur Matrix Factorizations} \description{Class \code{"Schur"} is the class of Schur matrix factorizations. These are a generalization of eigen value (or \dQuote{spectral}) decompositions for general (possibly asymmmetric) square matrices, see the \code{\link{Schur}()} function. } \section{Objects from the Class}{ Objects of class \code{"Schur"} are typically created by \code{\link{Schur}()}. } \section{Slots}{ \code{"Schur"} has slots \describe{ \item{\code{T}:}{Upper Block-triangular \code{\linkS4class{Matrix}} object.} \item{\code{Q}:}{Square \emph{orthogonal} \code{"Matrix"}.} \item{\code{EValues}:}{numeric or complex vector of eigenvalues of \code{T}.} \item{\code{Dim}:}{the matrix dimension: equal to \code{c(n,n)} of class \code{"integer"}.} } } \section{Extends}{ Class \code{"\linkS4class{MatrixFactorization}"}, directly. } % \section{Methods}{ % are all inherited from the MatrixFactorization class % } % \note{There's not yet a class for \emph{sparse} Schur decompositions; % mainly because there's no \code{\link{Schur}()} method for those neither. % } \seealso{ \code{\link{Schur}()} for object creation; \code{\linkS4class{MatrixFactorization}}. } \examples{ showClass("Schur") Schur(M <- Matrix(c(1:7, 10:2), 4,4)) ## Trivial, of course: str(Schur(Diagonal(5))) ## for more examples, see Schur() } \keyword{classes} Matrix/man/replValue-class.Rd0000644000176200001440000000140613141330160015613 0ustar liggesusers\name{replValue-class} \docType{class} \alias{replValue-class} %% >>>>>>> The "[<-" methods are in ./Subassign-methods.Rd \title{Virtual Class "replValue" - Simple Class for subassignment Values} \description{The class \code{"replValue"} is a virtual class used for values in signatures for sub-assignment of \pkg{Matrix} matrices. In fact, it is a simple class union (\code{\link{setClassUnion}}) of \code{"numeric"} and \code{"logical"} (and maybe \code{"complex"} in the future). } \section{Objects from the Class}{Since it is a virtual Class, no objects may be created from it.} \seealso{ %% FIXME: bug in Rdconv needs '[Matrix]' below: \code{\link[Matrix]{Subassign-methods}}, also for examples. } \examples{ showClass("replValue") } \keyword{classes} Matrix/man/rleDiff-class.Rd0000644000176200001440000000265111314233025015234 0ustar liggesusers\name{rleDiff-class} \docType{class} \Rdversion{1.1} \title{Class "rleDiff" of rle(diff(.)) Stored Vectors} \alias{rleDiff-class} \alias{show,rleDiff-method} \description{ Class \code{"rleDiff"} is for compactly storing long vectors which mainly consist of \emph{linear} stretches. For such a vector \code{x}, \code{\link{diff}(x)} consists of \emph{constant} stretches and is hence well compressable via \code{\link{rle}()}. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("rleDiff", ...)}. Currently experimental, see below. } \section{Slots}{ \describe{ \item{\code{first}:}{A single number (of class \code{"numLike"}, a class union of \code{"numeric"} and \code{"logical"}).} \item{\code{rle}:}{Object of class \code{"rle"}, basically a \code{\link{list}} with components \code{"lengths"} and \code{"values"}, see \code{\link{rle}()}. As this is used to encode potentially huge index vectors, \code{lengths} may be of type \code{\link{double}} here.} } } \section{Methods}{ There is a simple \code{\link{show}} method only.% currently } \note{ This is currently an \emph{experimental} auxiliary class for the class \code{\linkS4class{abIndex}}, see there. } \seealso{ \code{\link{rle}}, \code{\linkS4class{abIndex}}. } \examples{ showClass("rleDiff") ab <- c(abIseq(2, 100), abIseq(20, -2)) ab@rleD # is "rleDiff" } \keyword{classes} Matrix/man/triangularMatrix-class.Rd0000644000176200001440000000500212501122043017203 0ustar liggesusers\name{triangularMatrix-class} \docType{class} \alias{triangularMatrix-class} \alias{coerce,triangularMatrix,symmetricMatrix-method} \alias{coerce,lgeMatrix,triangularMatrix-method} \alias{coerce,ngeMatrix,triangularMatrix-method} \alias{coerce,matrix,triangularMatrix-method} % \title{Virtual Class of Triangular Matrices in Package Matrix} \description{ The virtual class of triangular matrices,\code{"triangularMatrix"}, the package \pkg{Matrix} contains \emph{square} (\code{\link{nrow} == \link{ncol}}) numeric and logical, dense and sparse matrices, e.g., see the examples. A main use of the virtual class is in methods (and C functions) that can deal with all triangular matrices. } % \section{Objects from the Class}{A virtual Class: No objects may be created from it.} \section{Slots}{ \describe{ \item{\code{uplo}:}{String (of class \code{"character"}). Must be either "U", for upper triangular, and "L", for lower triangular.} \item{\code{diag}:}{String (of class \code{"character"}). Must be either \code{"U"}, for unit triangular (diagonal is all ones), or \code{"N"} for non-unit. The diagonal elements are not accessed internally when \code{diag} is \code{"U"}. For \code{\linkS4class{denseMatrix}} classes, they need to be allocated though, i.e., the length of the \code{x} slot does not depend on \code{diag}.} \item{\code{Dim}, \code{Dimnames}:}{The dimension (a length-2 \code{"integer"}) and corresponding names (or \code{NULL}), inherited from the \code{\linkS4class{Matrix}}, see there.} } } \section{Extends}{ Class \code{"Matrix"}, directly. } \section{Methods}{ There's a C function \code{triangularMatrix_validity()} called by the internal validity checking functions. Currently, \code{\link{Schur}}, \code{\link{isSymmetric}} and \code{as()} (i.e. \code{\link{coerce}}) have methods with \code{triangularMatrix} in their signature. } \seealso{ \code{\link{isTriangular}()} for testing any matrix for triangularity; classes \code{\linkS4class{symmetricMatrix}}, and, e.g., \code{\linkS4class{dtrMatrix}} for numeric \emph{dense} matrices, or \code{\linkS4class{ltCMatrix}} for a logical \emph{sparse} matrix subclass of \code{"triangularMatrix"}. } \examples{ showClass("triangularMatrix") ## The names of direct subclasses: scl <- getClass("triangularMatrix")@subclasses directly <- sapply(lapply(scl, slot, "by"), length) == 0 names(scl)[directly] (m <- matrix(c(5,1,0,3), 2)) as(m, "triangularMatrix") } \keyword{classes} Matrix/man/sparseQR-class.Rd0000644000176200001440000001741413141330160015422 0ustar liggesusers\name{sparseQR-class} \docType{class} \title{Sparse QR decomposition of a sparse matrix} \alias{sparseQR-class} \alias{qr.R,sparseQR-method} \alias{qr.Q}% the generic \alias{qr.Q,sparseQR-method} \alias{qr.coef,sparseQR,ddenseMatrix-method} \alias{qr.coef,sparseQR,matrix-method} \alias{qr.coef,sparseQR,Matrix-method} \alias{qr.coef,sparseQR,numeric-method} \alias{qr.fitted,sparseQR,ddenseMatrix-method} \alias{qr.fitted,sparseQR,matrix-method} \alias{qr.fitted,sparseQR,Matrix-method} \alias{qr.fitted,sparseQR,numeric-method} \alias{qr.qty,sparseQR,ddenseMatrix-method} \alias{qr.qty,sparseQR,matrix-method} \alias{qr.qty,sparseQR,numeric-method} \alias{qr.qty,sparseQR,Matrix-method} \alias{qr.qy,sparseQR,ddenseMatrix-method} \alias{qr.qy,sparseQR,matrix-method} \alias{qr.qy,sparseQR,numeric-method} \alias{qr.qy,sparseQR,Matrix-method} \alias{qr.resid,sparseQR,ddenseMatrix-method} \alias{qr.resid,sparseQR,matrix-method} \alias{qr.resid,sparseQR,Matrix-method} \alias{qr.resid,sparseQR,numeric-method} %\alias{solve,sparseQR,ANY-method}--> solve-methods.Rd % \description{Objects class \code{"sparseQR"} represent a QR decomposition of a sparse \eqn{m \times n}{m x n} (\dQuote{long}: \eqn{m \ge n}{m >= n}) rectangular matrix \eqn{A}, typically resulting from \code{\link{qr}()}, see \sQuote{Details} notably about row and column permutations for pivoting. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("sparseQR", ...)} but are more commonly created by function \code{\link[base]{qr}} applied to a sparse matrix such as a matrix of class \code{\linkS4class{dgCMatrix}}. } \section{Slots}{ \describe{ \item{\code{V}:}{Object of class \code{"dgCMatrix"}. The columns of \code{V} are the vectors that generate the Householder transformations of which the matrix Q is composed.} \item{\code{beta}:}{Object of class \code{"numeric"}, the normalizing factors for the Householder transformations.} \item{\code{p}:}{Object of class \code{"integer"}: Permutation (of \code{0:(n-1)}) applied to the rows of the original matrix.} \item{\code{R}:}{Object of class \code{"dgCMatrix"}: An upper triangular matrix of the same dimension as \eqn{X}.} \item{\code{q}:}{Object of class \code{"integer"}: Permutation applied from the right, i.e., to the \emph{columns} of the original matrix. Can be of length 0 which implies no permutation.} } } \section{Methods}{ \describe{ \item{qr.R}{\code{signature(qr = "sparseQR")}: compute the upper triangular \eqn{R} matrix of the QR decomposition. Note that this currently warns because of possible permutation mismatch with the classical \code{qr.R()} result, \emph{and} you can suppress these warnings by setting \code{\link{options}()} either \code{"Matrix.quiet.qr.R"} or (the more general) either \code{"Matrix.quiet"} to \code{\link{TRUE}}.} \item{qr.Q}{\code{signature(qr = "sparseQR")}: compute the orthogonal \eqn{Q} matrix of the QR decomposition.} \item{qr.coef}{\code{signature(qr = "sparseQR", y = "ddenseMatrix")}: ... } \item{qr.coef}{\code{signature(qr = "sparseQR", y = "matrix")}: ... } \item{qr.coef}{\code{signature(qr = "sparseQR", y = "numeric")}: ... } \item{qr.fitted}{\code{signature(qr = "sparseQR", y = "ddenseMatrix")}: ... } \item{qr.fitted}{\code{signature(qr = "sparseQR", y = "matrix")}: ... } \item{qr.fitted}{\code{signature(qr = "sparseQR", y = "numeric")}: ... } \item{qr.qty}{\code{signature(qr = "sparseQR", y = "ddenseMatrix")}: ... } \item{qr.qty}{\code{signature(qr = "sparseQR", y = "matrix")}: ... } \item{qr.qty}{\code{signature(qr = "sparseQR", y = "numeric")}: ... } \item{qr.qy}{\code{signature(qr = "sparseQR", y = "ddenseMatrix")}: ... } \item{qr.qy}{\code{signature(qr = "sparseQR", y = "matrix")}: ... } \item{qr.qy}{\code{signature(qr = "sparseQR", y = "numeric")}: ... } \item{qr.resid}{\code{signature(qr = "sparseQR", y = "ddenseMatrix")}: ... } \item{qr.resid}{\code{signature(qr = "sparseQR", y = "matrix")}: ... } \item{qr.resid}{\code{signature(qr = "sparseQR", y = "numeric")}: ... } \item{solve}{\code{signature(a = "sparseQR", b = "ANY")}: For \code{solve(a,b)}, simply uses \code{qr.coef(a,b)}.} } } %\references{} %\author{} \details{ For a sparse \eqn{m \times n}{m x n} (\dQuote{long}: \eqn{m \ge n}{m >= n}) rectangular matrix \eqn{A}, the sparse QR decomposition is either \cr of the form \eqn{P A = Q R} with a (row) permutation matrix \eqn{P}, (encoded in the \code{p} slot of the result) if the \code{q} slot is of length 0, \cr or of the form \eqn{P A P* = Q R} with an extra (column) permutation matrix \eqn{P*} (encoded in the \code{q} slot). Note that the row permutation \eqn{P A} in \R is simply \code{A[p+1, ]} where \code{p} is the \code{p}-slot, a 0-based permutation of \code{1:m} applied to the rows of the original matrix. If the \code{q} slot has length \code{n} it is a 0-based permutation of \code{1:n} applied to the columns of the original matrix to reduce the amount of \dQuote{fill-in} in the matrix \eqn{R}, and \eqn{A P*} in \R is simply \code{A[ , q+1]}. \eqn{R} is an \eqn{m\times n}{m by n} matrix that is zero below the main diagonal, i.e., upper triangular (\eqn{m\times m}{m by n}) with \eqn{m-n} extra zero rows. The matrix \eqn{Q} is a "virtual matrix". It is the product of \eqn{n} Householder transformations. The information to generate these Householder transformations is stored in the \code{V} and \code{beta} slots. \cr Note however that \code{qr.Q()} returns the row permuted matrix \eqn{Q* := P^{-1}Q = P'Q}{Q* := P^(-1) Q = P'Q} as permutation matrices are orthogonal; and \eqn{Q*} is orthogonal itself because \eqn{Q} and \eqn{P} are. This is useful because then, as in the dense matrix and \pkg{base} \R matrix \code{\link{qr}} case, we have the mathematical identity \deqn{P A = Q* R,} in \R as \preformatted{ A[p+1,] == qr.Q(*) \%*\% R .} The \code{"sparseQR"} methods for the \code{qr.*} functions return objects of class \code{"dgeMatrix"} (see \code{\linkS4class{dgeMatrix}}). Results from \code{qr.coef}, \code{qr.resid} and \code{qr.fitted} (when \code{k == ncol(R)}) are well-defined and should match those from the corresponding dense matrix calculations. However, because the matrix \code{Q} is not uniquely defined, the results of \code{qr.qy} and \code{qr.qty} do not necessarily match those from the corresponding dense matrix calculations. Also, the results of \code{qr.qy} and \code{qr.qty} apply to the permuted column order when the \code{q} slot has length \code{n}. } \seealso{ \code{\link[base]{qr}}, \code{\link{qr.Q}}, \code{\link{qr.R}}, \code{\link{qr.fitted}}, \code{\link{qr.resid}}, \code{\link{qr.coef}}, \code{\link{qr.qty}}, \code{\link{qr.qy}}, Permutation matrices in the \pkg{Matrix} package: \code{\linkS4class{pMatrix}}; \code{\linkS4class{dgCMatrix}}, \code{\linkS4class{dgeMatrix}}. %%% not (yet) in CRAN-released version of Matrix: %% \code{\linkS4class{SPQR}} an alternative QR decomposition resulting %% from \code{\link{spqr}()}. } \examples{ data(KNex) mm <- KNex $ mm y <- KNex $ y y. <- as(as.matrix(y), "dgCMatrix") str(qrm <- qr(mm)) qc <- qr.coef (qrm, y); qc. <- qr.coef (qrm, y.) # 2nd failed in Matrix <= 1.1-0 qf <- qr.fitted(qrm, y); qf. <- qr.fitted(qrm, y.) qs <- qr.resid (qrm, y); qs. <- qr.resid (qrm, y.) stopifnot(all.equal(qc, as.numeric(qc.), tolerance=1e-12), all.equal(qf, as.numeric(qf.), tolerance=1e-12), all.equal(qs, as.numeric(qs.), tolerance=1e-12), all.equal(qf+qs, y, tolerance=1e-12)) %% FIXME: add more similarly to ./lu.Rd, see also ./qr-methods.Rd } \keyword{classes} \keyword{algebra} \keyword{array} Matrix/man/CAex.Rd0000644000176200001440000000232512467733634013421 0ustar liggesusers\name{CAex} \alias{CAex} \docType{data} \title{Albers' example Matrix with "Difficult" Eigen Factorization} \description{ An example of a sparse matrix for which \code{\link{eigen}()} seemed to be difficult, an unscaled version of this has been posted to the web, accompanying an E-mail to R-help (\url{https://stat.ethz.ch/mailman/listinfo/r-help}), by Casper J Albers, Open University, UK. } \usage{data(CAex)} \format{ This is a \eqn{72 \times 72}{72 * 72} symmetric matrix with 216 non-zero entries in five bands, stored as sparse matrix of class \code{\linkS4class{dgCMatrix}}. } \details{ Historical note (2006-03-30): In earlier versions of \R, \code{\link{eigen}(CAex)} fell into an infinite loop whereas \code{\link{eigen}(CAex, EISPACK=TRUE)} had been okay. } % \source{ see above % } \examples{ data(CAex) str(CAex) # of class "dgCMatrix" image(CAex)# -> it's a simple band matrix with 5 bands ## and the eigen values are basically 1 (42 times) and 0 (30 x): zapsmall(ev <- eigen(CAex, only.values=TRUE)$values) ## i.e., the matrix is symmetric, hence sCA <- as(CAex, "symmetricMatrix") ## and stopifnot(class(sCA) == "dsCMatrix", as(sCA, "matrix") == as(CAex, "matrix")) } \keyword{datasets} Matrix/man/index-class.Rd0000644000176200001440000000147713141330160014773 0ustar liggesusers\name{index-class} \docType{class} \alias{index-class} %% The "[" and "[<-" methods are %% in ./Xtrct-methods.Rd and ./Subassign-methods.Rd \title{Virtual Class "index" - Simple Class for Matrix Indices} \description{The class \code{"index"} is a virtual class used for indices (in signatures) for matrix indexing and sub-assignment of \pkg{Matrix} matrices. In fact, it is currently implemented as a simple class union (\code{\link{setClassUnion}}) of \code{"numeric"}, \code{"logical"} and \code{"character"}. } \section{Objects from the Class}{Since it is a virtual Class, no objects may be created from it.} \seealso{ \code{\link{[-methods}}, and %% FIXME: bug in Rdconv needs '[Matrix]' below: \code{\link[Matrix]{Subassign-methods}}, also for examples. } \examples{ showClass("index") } \keyword{classes} Matrix/man/norm.Rd0000644000176200001440000000552013141330160013525 0ustar liggesusers\name{norm} \title{Matrix Norms} \alias{norm} \alias{norm,ANY,missing-method} \alias{norm,matrix,character-method} \alias{norm,Matrix,character-method} \usage{ norm(x, type, \dots) } \description{ Computes a matrix norm of \code{x}, using Lapack for dense matrices. The norm can be the one (\code{"O"}, or \code{"1"}) norm, the infinity (\code{"I"}) norm, the Frobenius (\code{"F"}) norm, the maximum modulus (\code{"M"}) among elements of a matrix, or the spectral norm or 2-norm (\code{"2"}), as determined by the value of \code{type}. } \arguments{ \item{x}{ a real or complex matrix. } \item{type}{ A character indicating the type of norm desired. \describe{ \item{\code{"O"}, \code{"o"} or \code{"1"}}{specifies the one norm, (maximum absolute column sum);} \item{\code{"I"} or \code{"i"}}{specifies the infinity norm (maximum absolute row sum);} \item{\code{"F"} or \code{"f"}}{specifies the Frobenius norm (the Euclidean norm of \code{x} treated as if it were a vector);} \item{\code{"M"} or \code{"m"}}{specifies the maximum modulus of all the elements in \code{x}; and} \item{\code{"2"}}{specifies the \dQuote{spectral norm} or {2-norm}, which is the largest singular value (\code{\link{svd}}) of \code{x}.} } The default is \code{"O"}. Only the first character of \code{type[1]} is used. } \item{\dots}{further arguments passed to or from other methods.} } \value{ A numeric value of class \code{"norm"}, representing the quantity chosen according to \code{type}. } \details{ For dense matrices, the methods eventually call the Lapack functions \code{dlange}, \code{dlansy}, \code{dlantr}, \code{zlange}, \code{zlansy}, and \code{zlantr}. } \seealso{ \code{\link{onenormest}()}, an \emph{approximate} randomized estimate of the 1-norm condition number, efficient for large sparse matrices. The \code{\link[base]{norm}()} function from \R's \pkg{base} package. } \references{ Anderson, E., et al. (1994). \emph{LAPACK User's Guide,} 2nd edition, SIAM, Philadelphia. } \examples{ x <- Hilbert(9) norm(x)# = "O" = "1" stopifnot(identical(norm(x), norm(x, "1"))) norm(x, "I")# the same, because 'x' is symmetric allnorms <- function(d) vapply(c("1","I","F","M","2"), norm, x = d, double(1)) allnorms(x) allnorms(Hilbert(10)) i <- c(1,3:8); j <- c(2,9,6:10); x <- 7 * (1:7) A <- sparseMatrix(i, j, x = x) ## 8 x 10 "dgCMatrix" (sA <- sparseMatrix(i, j, x = x, symmetric = TRUE)) ## 10 x 10 "dsCMatrix" (tA <- sparseMatrix(i, j, x = x, triangular= TRUE)) ## 10 x 10 "dtCMatrix" (allnorms(A) -> nA) allnorms(sA) allnorms(tA) stopifnot(all.equal(nA, allnorms(as(A, "matrix"))), all.equal(nA, allnorms(tA))) # because tA == rbind(A, 0, 0) A. <- A; A.[1,3] <- NA stopifnot(is.na(allnorms(A.))) # gave error } \keyword{algebra} Matrix/man/Schur.Rd0000644000176200001440000000656112271746775013676 0ustar liggesusers\name{Schur} \title{Schur Decomposition of a Matrix} \usage{ Schur(x, vectors, \dots) } \alias{Schur} \alias{Schur,dgeMatrix,logical-method} \alias{Schur,dgeMatrix,missing-method} \alias{Schur,diagonalMatrix,logical-method} \alias{Schur,diagonalMatrix,missing-method} \alias{Schur,triangularMatrix,logical-method} \alias{Schur,triangularMatrix,missing-method} \alias{Schur,dsyMatrix,ANY-method} \alias{Schur,generalMatrix,logical-method} \alias{Schur,generalMatrix,missing-method} \alias{Schur,symmetricMatrix,logical-method} \alias{Schur,symmetricMatrix,missing-method} % \alias{Schur,matrix,logical-method} \alias{Schur,matrix,missing-method} \description{ Computes the Schur decomposition and eigenvalues of a square matrix; see the BACKGROUND information below. } \arguments{ \item{x}{ numeric %(or complex, in future) square Matrix (inheriting from class \code{"Matrix"}) or traditional \code{\link{matrix}}. Missing values (NAs) are not allowed. } \item{vectors}{logical. When \code{TRUE} (the default), the Schur vectors are computed, and the result is a proper \code{\linkS4class{MatrixFactorization}} of class \code{\linkS4class{Schur}}. } \item{\dots}{further arguments passed to or from other methods.} } \value{ If \code{vectors} are \code{TRUE}, as per default: If \code{x} is a \code{\linkS4class{Matrix}} an object of class \code{\linkS4class{Schur}}, otherwise, for a traditional \code{\link{matrix}} \code{x}, a \code{\link{list}} with components \code{T}, \code{Q}, and \code{EValues}. If \code{vectors} are \code{FALSE}, a list with components \item{T}{the upper quasi-triangular (square) matrix of the Schur decomposition.} \item{EValues}{the vector of \code{\link{numeric}} or \code{\link{complex}} eigen values of \eqn{T} or \eqn{A}.} } \details{ Based on the Lapack subroutine \code{dgees}. } \section{BACKGROUND}{ If \code{A} is a square matrix, then \code{A = Q T t(Q)}, where \code{Q} is orthogonal, and \code{T} is upper block-triangular (nearly triangular with either 1 by 1 or 2 by 2 blocks on the diagonal) where the 2 by 2 blocks correspond to (non-real) complex eigenvalues. The eigenvalues of \code{A} are the same as those of \code{T}, which are easy to compute. The Schur form is used most often for computing non-symmetric eigenvalue decompositions, and for computing functions of matrices such as matrix exponentials. } \references{ Anderson, E., et al. (1994). \emph{LAPACK User's Guide,} 2nd edition, SIAM, Philadelphia. } \examples{ Schur(Hilbert(9)) # Schur factorization (real eigenvalues) (A <- Matrix(round(rnorm(5*5, sd = 100)), nrow = 5)) (Sch.A <- Schur(A)) eTA <- eigen(Sch.A@T) str(SchA <- Schur(A, vectors=FALSE))# no 'T' ==> simple list stopifnot(all.equal(eTA$values, eigen(A)$values, tolerance = 1e-13), all.equal(eTA$values, local({z <- Sch.A@EValues z[order(Mod(z), decreasing=TRUE)]}), tolerance = 1e-13), identical(SchA$T, Sch.A@T), identical(SchA$EValues, Sch.A@EValues)) ## For the faint of heart, we provide Schur() also for traditional matrices: a.m <- function(M) unname(as(M, "matrix")) a <- a.m(A) Sch.a <- Schur(a) stopifnot(identical(Sch.a, list(Q = a.m(Sch.A @ Q), T = a.m(Sch.A @ T), EValues = Sch.A@EValues)), all.equal(a, with(Sch.a, Q \%*\% T \%*\% t(Q))) ) } \keyword{algebra} Matrix/man/denseMatrix-class.Rd0000644000176200001440000000347513556074411016165 0ustar liggesusers\name{denseMatrix-class} \docType{class} \title{Virtual Class "denseMatrix" of All Dense Matrices} \alias{denseMatrix-class} %% Group methods \alias{Math,denseMatrix-method} \alias{log,denseMatrix-method} \alias{-,denseMatrix,missing-method} % \alias{show,denseMatrix-method} \alias{coerce,ANY,denseMatrix-method} \alias{coerce,denseMatrix,CsparseMatrix-method} \alias{coerce,denseMatrix,TsparseMatrix-method} \alias{coerce,denseMatrix,generalMatrix-method} \alias{coerce,denseMatrix,sparseMatrix-method} \alias{cbind2,denseMatrix,denseMatrix-method} \alias{cbind2,denseMatrix,matrix-method} \alias{cbind2,matrix,denseMatrix-method} \alias{cbind2,denseMatrix,numeric-method} \alias{cbind2,numeric,denseMatrix-method} \alias{rbind2,denseMatrix,denseMatrix-method} \alias{rbind2,denseMatrix,matrix-method} \alias{rbind2,matrix,denseMatrix-method} \alias{rbind2,denseMatrix,numeric-method} \alias{rbind2,numeric,denseMatrix-method} \alias{dim<-,denseMatrix-method} \alias{rcond,denseMatrix,character-method} % \description{This is the virtual class of all dense (S4) matrices. It is the direct superclass of \code{\linkS4class{ddenseMatrix}}, \code{\linkS4class{ldenseMatrix}} } \section{Extends}{ class \code{"Matrix"} directly. } \section{Slots}{ exactly those of its superclass \code{"\linkS4class{Matrix}"}. } % \section{Methods}{ Use \code{\link{showMethods}(class = "denseMatrix", where = "package:Matrix")} for an overview of methods. Extraction (\code{"["}) methods, see \code{\link{[-methods}}.%-> ./Xtrct-methods.Rd } \seealso{ \code{\link{colSums}}, \code{\link{kronecker}}, and other such methods with own help pages. Its superclass \code{\linkS4class{Matrix}}, and main subclasses, \code{\linkS4class{ddenseMatrix}} and \code{\linkS4class{sparseMatrix}}. } \examples{ showClass("denseMatrix") } \keyword{classes} Matrix/man/ltrMatrix-class.Rd0000644000176200001440000000514112001034107015636 0ustar liggesusers\name{ltrMatrix-class} \docType{class} \alias{ltpMatrix-class} \alias{ltrMatrix-class} % \alias{!,ltpMatrix-method} \alias{!,ltrMatrix-method} \alias{coerce,ltpMatrix,dtpMatrix-method} \alias{coerce,ltpMatrix,lgeMatrix-method} \alias{coerce,ltpMatrix,ltrMatrix-method} \alias{coerce,ltrMatrix,dtrMatrix-method} \alias{coerce,ltrMatrix,lgeMatrix-method} \alias{coerce,ltrMatrix,ltpMatrix-method} \alias{coerce,matrix,ltrMatrix-method} \alias{coerce,matrix,ltpMatrix-method} \alias{diag,ltrMatrix-method} \alias{diag,ltpMatrix-method} \alias{diag<-,ltpMatrix-method} \alias{diag<-,ltrMatrix-method} \alias{t,ltpMatrix-method} \alias{t,ltrMatrix-method} % \title{Triangular Dense Logical Matrices} \description{ The \code{"ltrMatrix"} class is the class of triangular, dense, logical matrices in nonpacked storage. The \code{"ltpMatrix"} class is the same except in packed storage. } \section{Slots}{ \describe{ \item{\code{x}:}{Object of class \code{"logical"}. The logical values that constitute the matrix, stored in column-major order.} \item{\code{uplo}:}{Object of class \code{"character"}. Must be either "U", for upper triangular, and "L", for lower triangular.} \item{\code{diag}:}{Object of class \code{"character"}. Must be either \code{"U"}, for unit triangular (diagonal is all ones), or \code{"N"}; see \code{\linkS4class{triangularMatrix}}.} \item{\code{Dim},\code{Dimnames}:}{The dimension (a length-2 \code{"integer"}) and corresponding names (or \code{NULL}), see the \code{\linkS4class{Matrix}} class.} \item{\code{factors}:}{Object of class \code{"list"}. A named list of factorizations that have been computed for the matrix.} } } \section{Extends}{ Both extend classes \code{"\linkS4class{ldenseMatrix}"} and \code{"\linkS4class{triangularMatrix}"}, directly; further, class \code{"Matrix"}, \code{"\linkS4class{lMatrix}"} and others, \emph{in}directly. Use \code{\link{showClass}("ltrMatrix")}, e.g., for details. } \section{Methods}{ Currently, mainly \code{\link{t}()} and coercion methods (for \code{\link{as}(.)}; use, e.g., \code{\link{showMethods}(class="ltpMatrix")} for details. } \seealso{ Classes \code{\linkS4class{lgeMatrix}}, \code{\linkS4class{Matrix}}; function \code{\link[base]{t}} } \examples{ showClass("ltrMatrix") str(new("ltpMatrix")) (lutr <- as(upper.tri(matrix(,4,4)), "ltrMatrix")) str(lutp <- as(lutr, "ltpMatrix"))# packed matrix: only 10 = (4+1)*4/2 entries !lutp ## the logical negation (is *not* logical triangular !) ## but this one is: stopifnot(all.equal(lutp, as(!!lutp, "ltpMatrix"))) } \keyword{classes} Matrix/man/USCounties.Rd0000644000176200001440000000437613753445524014647 0ustar liggesusers\name{USCounties} \alias{USCounties} \docType{data} \title{USCounties Contiguity Matrix} \description{ This matrix represents the contiguities of 3111 US counties using the Queen criterion of at least a single shared boundary point. The representation is as a row standardised spatial weights matrix transformed to a symmetric matrix (see Ord (1975), p. 125). } \usage{data(USCounties)} \format{ A \eqn{3111 ^2} symmetric sparse matrix of class \code{\linkS4class{dsCMatrix}} with 9101 non-zero entries. } \details{ The data were read into \R using \code{\link[spdep]{read.gal}}, and row-standardised and transformed to symmetry using \code{\link[spdep]{nb2listw}} and \code{\link[spdep]{similar.listw}}. This spatial weights object was converted to class \code{\linkS4class{dsCMatrix}} using \code{\link[spdep]{as_dsTMatrix_listw}} and coercion. } \source{ %% no \url anymore, as broken (Jan. 2015) The data were retrieved from \code{http://sal.uiuc.edu/weights/zips/usc.zip}, files \dQuote{usc.txt} and \dQuote{usc\_q.GAL}, with permission for use and distribution from Luc Anselin (in early 2008). } \references{ Ord, J. K. (1975) Estimation methods for models of spatial interaction; \emph{Journal of the American Statistical Association} \bold{70}, 120--126. } \examples{ data(USCounties) (n <- ncol(USCounties)) IM <- .symDiagonal(n) nn <- 50 set.seed(1) rho <- runif(nn, 0, 1) system.time(MJ <- sapply(rho, function(x) determinant(IM - x * USCounties, logarithm = TRUE)$modulus)) ## can be done faster, by update()ing the Cholesky factor: nWC <- -USCounties C1 <- Cholesky(nWC, Imult = 2) system.time(MJ1 <- n * log(rho) + sapply(rho, function(x) 2 * c(determinant(update(C1, nWC, 1/x))$modulus))) all.equal(MJ, MJ1) \dontshow{stopifnot( all.equal(MJ, MJ1) )} C2 <- Cholesky(nWC, super = TRUE, Imult = 2) system.time(MJ2 <- n * log(rho) + sapply(rho, function(x) 2 * c(determinant(update(C2, nWC, 1/x))$modulus))) all.equal(MJ, MJ2) \dontshow{stopifnot(all.equal(MJ, MJ2))} system.time(MJ3 <- n * log(rho) + Matrix:::ldetL2up(C1, nWC, 1/rho)) stopifnot(all.equal(MJ, MJ3)) system.time(MJ4 <- n * log(rho) + Matrix:::ldetL2up(C2, nWC, 1/rho)) stopifnot(all.equal(MJ, MJ4)) } \keyword{datasets} Matrix/man/lgeMatrix-class.Rd0000644000176200001440000000435312622367447015641 0ustar liggesusers\name{lgeMatrix-class} \docType{class} \title{Class "lgeMatrix" of General Dense Logical Matrices} \alias{lgeMatrix-class} % \alias{!,lgeMatrix-method} \alias{Arith,lgeMatrix,lgeMatrix-method} \alias{Compare,lgeMatrix,lgeMatrix-method} \alias{Logic,lgeMatrix,lgeMatrix-method} \alias{as.vector,lgeMatrix-method} \alias{coerce,matrix,lgeMatrix-method} \alias{coerce,lgeMatrix,dgeMatrix-method} \alias{coerce,lgeMatrix,matrix-method} \alias{coerce,lgeMatrix,lgCMatrix-method} \alias{coerce,lgeMatrix,lgTMatrix-method} \alias{coerce,lgeMatrix,lsyMatrix-method} \alias{coerce,lgeMatrix,ltrMatrix-method} \alias{coerce,lgeMatrix,ltpMatrix-method} \alias{coerce,lgeMatrix,lspMatrix-method} \alias{diag,lgeMatrix-method} \alias{diag<-,lgeMatrix-method} \alias{t,lgeMatrix-method} % \description{This is the class of general dense \code{\link{logical}} matrices. } \section{Slots}{ \describe{ \item{\code{x}:}{Object of class \code{"logical"}. The logical values that constitute the matrix, stored in column-major order.} \item{\code{Dim},\code{Dimnames}:}{The dimension (a length-2 \code{"integer"}) and corresponding names (or \code{NULL}), see the \code{\linkS4class{Matrix}} class.} \item{\code{factors}:}{Object of class \code{"list"}. A named list of factorizations that have been computed for the matrix.} } } \section{Extends}{ Class \code{"ldenseMatrix"}, directly. Class \code{"lMatrix"}, by class \code{"ldenseMatrix"}. Class \code{"denseMatrix"}, by class \code{"ldenseMatrix"}. Class \code{"Matrix"}, by class \code{"ldenseMatrix"}. Class \code{"Matrix"}, by class \code{"ldenseMatrix"}. } \section{Methods}{ Currently, mainly \code{\link{t}()} and coercion methods (for \code{\link{as}(.)}); use, e.g., \code{\link{showMethods}(class="lgeMatrix")} for details. } \seealso{ Non-general logical dense matrix classes such as \code{\linkS4class{ltrMatrix}}, or \code{\linkS4class{lsyMatrix}}; \emph{sparse} logical classes such as \code{\linkS4class{lgCMatrix}}. } \examples{ showClass("lgeMatrix") str(new("lgeMatrix")) set.seed(1) (lM <- Matrix(matrix(rnorm(28), 4,7) > 0))# a simple random lgeMatrix set.seed(11) (lC <- Matrix(matrix(rnorm(28), 4,7) > 0))# a simple random lgCMatrix as(lM, "lgCMatrix") } \keyword{classes} Matrix/man/nMatrix-class.Rd0000644000176200001440000000750012507176717015324 0ustar liggesusers\name{nMatrix-class} \docType{class} \alias{nMatrix-class} \alias{show,nMatrix-method} \alias{coerce,matrix,nMatrix-method} \alias{coerce,nMatrix,matrix-method} \alias{coerce,nMatrix,dMatrix-method} \alias{coerce,dMatrix,nMatrix-method} \alias{coerce,nMatrix,lMatrix-method} \alias{coerce,lMatrix,nMatrix-method} % %\alias{coerce,dMatrix,dgeMatrix-method} % %% Group methods \alias{Arith,logical,nMatrix-method} \alias{Arith,nMatrix,logical-method} \alias{Arith,nMatrix,numeric-method} \alias{Arith,numeric,nMatrix-method} \alias{Compare,logical,nMatrix-method} \alias{Compare,nMatrix,logical-method} \alias{Compare,nMatrix,nMatrix-method} \alias{Compare,nMatrix,numeric-method} \alias{Compare,numeric,nMatrix-method} \alias{Logic,Matrix,nMatrix-method} \alias{Logic,nMatrix,Matrix-method} \alias{Logic,nMatrix,nMatrix-method} \alias{Logic,nMatrix,logical-method} \alias{Logic,nMatrix,numeric-method} \alias{Logic,logical,nMatrix-method} \alias{Logic,numeric,nMatrix-method} \alias{Ops,lMatrix,nMatrix-method} \alias{Ops,nMatrix,lMatrix-method} \alias{Ops,nMatrix,numeric-method} \alias{Ops,numeric,nMatrix-method} \alias{Summary,nMatrix-method} %\alias{which,nMatrix-method} % \title{Class "nMatrix" of Non-zero Pattern Matrices} \description{ The \code{nMatrix} class is the virtual \dQuote{mother} class of all \emph{\bold{n}on-zero pattern} (or simply \emph{patter\bold{n}}) matrices in the \pkg{Matrix} package. } %\section{Objects from the Class}{A virtual Class: No objects may be % created from it. %} \section{Slots}{ Common to \emph{all} matrix object in the package: \describe{ \item{\code{Dim}:}{Object of class \code{"integer"} - the dimensions of the matrix - must be an integer vector with exactly two non-negative values.} \item{\code{Dimnames}:}{list of length two; each component containing NULL or a \code{\link{character}} vector length equal the corresponding \code{Dim} element.} } } \section{Methods}{ There is a bunch of coercion methods (for \code{\link{as}(..)}), e.g., \describe{ \item{coerce}{\code{signature(from = "matrix", to = "nMatrix")}: Note that these coercions (must) coerce \code{\link{NA}}s to non-zero, hence conceptually \code{TRUE}. This is particularly important when \code{\linkS4class{sparseMatrix}} objects are coerced to \code{"nMatrix"} and hence to \code{\linkS4class{nsparseMatrix}}. } \item{coerce}{\code{signature(from = "dMatrix", to = "nMatrix")}, and} \item{coerce}{\code{signature(from = "lMatrix", to = "nMatrix")}: For dense matrices with \code{\link{NA}}s, these coercions are valid since \pkg{Matrix} version 1.2.0 (still with a \code{\link{warning}} or a \code{\link{message}} if \code{"Matrix.warn"}, or \code{"Matrix.verbose"} \code{\link{options}} are set.)} \item{coerce}{\code{signature(from = "nMatrix", to = "matrix")}: ... } \item{coerce}{\code{signature(from = "nMatrix", to = "dMatrix")}: ... } \item{coerce}{\code{signature(from = "nMatrix", to = "lMatrix")}: ... } } --- --- --- Additional methods contain group methods, such as \describe{ \item{Ops}{\code{signature(e1 = "nMatrix", e2 = "....")}, \dots} \item{Arith}{\code{signature(e1 = "nMatrix", e2 = "....")}, \dots} \item{Compare}{\code{signature(e1 = "nMatrix", e2 = "....")}, \dots} \item{Logic}{\code{signature(e1 = "nMatrix", e2 = "....")}, \dots} \item{Summary}{\code{signature(x = "nMatrix", "....")}, \dots} } } \seealso{ The classes \code{\linkS4class{lMatrix}}, \code{\linkS4class{nsparseMatrix}}, and the mother class, \code{\linkS4class{Matrix}}. } \examples{ getClass("nMatrix") L3 <- Matrix(upper.tri(diag(3))) L3 # an "ltCMatrix" as(L3, "nMatrix") # -> ntC* ## similar, not using Matrix() as(upper.tri(diag(3)), "nMatrix")# currently "ngTMatrix" } \keyword{classes} \keyword{algebra} Matrix/man/nsyMatrix-class.Rd0000644000176200001440000000475712001034107015662 0ustar liggesusers\name{nsyMatrix-class} \title{Symmetric Dense Nonzero-Pattern Matrices} \docType{class} \alias{nspMatrix-class} \alias{nsyMatrix-class} % \alias{coerce,nspMatrix,dspMatrix-method} \alias{coerce,nspMatrix,nsyMatrix-method} \alias{coerce,nspMatrix,ngeMatrix-method} \alias{coerce,nsyMatrix,dsyMatrix-method} \alias{coerce,nsyMatrix,ngeMatrix-method} \alias{coerce,nsyMatrix,nspMatrix-method} \alias{coerce,matrix,nsyMatrix-method} \alias{coerce,matrix,nspMatrix-method} \alias{diag<-,nspMatrix-method} \alias{diag<-,nsyMatrix-method} \alias{t,nspMatrix-method} \alias{t,nsyMatrix-method} % \description{ The \code{"nsyMatrix"} class is the class of symmetric, dense nonzero-pattern matrices in non-packed storage and \code{"nspMatrix"} is the class of of these in packed storage. Only the upper triangle or the lower triangle is stored. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("nsyMatrix", ...)}. } \section{Slots}{ \describe{ \item{\code{uplo}:}{Object of class \code{"character"}. Must be either "U", for upper triangular, and "L", for lower triangular.} \item{\code{x}:}{Object of class \code{"logical"}. The logical values that constitute the matrix, stored in column-major order.} \item{\code{Dim},\code{Dimnames}:}{The dimension (a length-2 \code{"integer"}) and corresponding names (or \code{NULL}), see the \code{\linkS4class{Matrix}} class.} \item{\code{factors}:}{Object of class \code{"list"}. A named list of factorizations that have been computed for the matrix.} } } \section{Extends}{ \code{"nsyMatrix"} extends class \code{"ngeMatrix"}, directly, whereas\cr \code{"nspMatrix"} extends class \code{"ndenseMatrix"}, directly. Both extend class \code{"symmetricMatrix"}, directly, and class \code{"Matrix"} and others, \emph{in}directly, use \code{\link{showClass}("nsyMatrix")}, e.g., for details. } \section{Methods}{ Currently, mainly \code{\link{t}()} and coercion methods (for \code{\link{as}(.)}; use, e.g., \code{\link{showMethods}(class="dsyMatrix")} for details. } %\references{} %\author{} \seealso{ \code{\linkS4class{ngeMatrix}}, \code{\linkS4class{Matrix}}, \code{\link[base]{t}} } \examples{ (s0 <- new("nsyMatrix")) (M2 <- Matrix(c(TRUE, NA,FALSE,FALSE), 2,2)) # logical dense (ltr) (sM <- M2 & t(M2)) # "lge" class(sM <- as(sM, "nMatrix")) # -> "nge" (sM <- as(sM, "nsyMatrix")) # -> "nsy" str ( sM <- as(sM, "nspMatrix")) # -> "nsp": packed symmetric } \keyword{classes} Matrix/man/dtrMatrix-class.Rd0000644000176200001440000000751514151637577015671 0ustar liggesusers\name{dtrMatrix-class} \title{Triangular, dense, numeric matrices} \docType{class} \alias{coerce,dgeMatrix,dtrMatrix-method}% or rather setIs? \alias{coerce,dtrMatrix,dtpMatrix-method} \alias{coerce,dtrMatrix,ltrMatrix-method} \alias{coerce,dtrMatrix,matrix-method} \alias{coerce,dtrMatrix,sparseMatrix-method} \alias{coerce,dtrMatrix,CsparseMatrix-method} \alias{coerce,matrix,dtrMatrix-method} \alias{determinant,dtrMatrix,logical-method} \alias{determinant,dtrMatrix,missing-method} \alias{diag,dtrMatrix-method} \alias{diag<-,dtrMatrix-method} \alias{norm,dtrMatrix,character-method} \alias{norm,dtrMatrix,missing-method} \alias{rcond,dtrMatrix,character-method} \alias{rcond,dtrMatrix,missing-method} \alias{show,dtrMatrix-method} %\alias{solve,dtrMatrix,matrix-method}--> solve-methods.Rd \alias{t,dtrMatrix-method} \alias{dtrMatrix-class} \description{ The \code{"dtrMatrix"} class is the class of triangular, dense, numeric matrices in nonpacked storage. The \code{"dtpMatrix"} class is the same except in packed storage, see \code{\link{pack}()}. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("dtrMatrix", ...)}. } \section{Slots}{ \describe{ \item{\code{uplo}:}{Object of class \code{"character"}. Must be either "U", for upper triangular, and "L", for lower triangular.} \item{\code{diag}:}{Object of class \code{"character"}. Must be either \code{"U"}, for unit triangular (diagonal is all ones), or \code{"N"}; see \code{\linkS4class{triangularMatrix}}.} \item{\code{x}:}{Object of class \code{"numeric"}. The numeric values that constitute the matrix, stored in column-major order.} \item{\code{Dim}:}{Object of class \code{"integer"}. The dimensions of the matrix which must be a two-element vector of non-negative integers.} } } \section{Extends}{ Class \code{"ddenseMatrix"}, directly. Class \code{"triangularMatrix"}, directly. Class \code{"Matrix"} and others, by class \code{"ddenseMatrix"}. } \section{Methods}{ Among others (such as matrix products, e.g. \code{?\link{crossprod-methods}}), \describe{ \item{coerce}{\code{signature(from = "dgeMatrix", to = "dtrMatrix")}} \item{coerce}{\code{signature(from = "dtrMatrix", to = "matrix")}} \item{coerce}{\code{signature(from = "dtrMatrix", to = "ltrMatrix")}} \item{coerce}{\code{signature(from = "dtrMatrix", to = "matrix")}} \item{coerce}{\code{signature(from = "matrix", to = "dtrMatrix")}} \item{norm}{\code{signature(x = "dtrMatrix", type = "character")}} \item{rcond}{\code{signature(x = "dtrMatrix", norm = "character")}} \item{solve}{\code{signature(a = "dtrMatrix", b = "....")}}{efficientely use a \dQuote{forwardsolve} or \code{backsolve} for a lower or upper triangular matrix, respectively, see also \code{\link{solve-methods}}.} \item{+, -, *, \dots, ==, >=, \dots}{all the \code{\link{Ops}} group methods are available. When applied to two triangular matrices, these return a triangular matrix when easily possible.} } } %\references{} %\author{} \seealso{ Classes \code{\linkS4class{ddenseMatrix}}, \code{\linkS4class{dtpMatrix}}, \code{\linkS4class{triangularMatrix}} } \examples{%% this is used from ./dtpMatrix-class.Rd (change with care!) (m <- rbind(2:3, 0:-1)) (M <- as(m, "dgeMatrix")) (T <- as(M, "dtrMatrix")) ## upper triangular is default (T2 <- as(t(M), "dtrMatrix")) stopifnot(T@uplo == "U", T2@uplo == "L", identical(T2, t(T))) m <- matrix(0,4,4); m[upper.tri(m)] <- 1:6 (t1 <- Matrix(m+diag(,4))) str(t1p <- pack(t1)) (t1pu <- diagN2U(t1p)) stopifnot(exprs = { inherits(t1 , "dtrMatrix"); validObject(t1) inherits(t1p, "dtpMatrix"); validObject(t1p) inherits(t1pu,"dtCMatrix"); validObject(t1pu) t1pu@x == 1:6 all(t1pu == t1p) identical((t1pu - t1)@x, numeric())# sparse all-0 }) } \keyword{classes} Matrix/man/ddiMatrix-class.Rd0000644000176200001440000000346311140343613015612 0ustar liggesusers\name{ddiMatrix-class} \title{Class "ddiMatrix" of Diagonal Numeric Matrices} \docType{class} \alias{ddiMatrix-class} %%----> put all methods into ./diagonalMatrix-class.Rd % \description{The class \code{"ddiMatrix"} of numerical diagonal matrices. %% FIXME add more Note that diagonal matrices now extend \emph{\code{sparseMatrix}}, whereas they did extend dense matrices earlier.% up to early summer 2008. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("ddiMatrix", ...)} but typically rather via \code{\link{Diagonal}}. } \section{Slots}{ \describe{ \item{\code{x}:}{numeric vector. For an \eqn{n \times n}{n * n} matrix, the \code{x} slot is of length \eqn{n} or \code{0}, depending on the \code{diag} slot:} \item{\code{diag}:}{\code{"character"} string, either \code{"U"} or \code{"N"} where \code{"U"} denotes unit-diagonal, i.e., identity matrices.} \item{\code{Dim},\code{Dimnames}:}{matrix dimension and \code{\link{dimnames}}, see the \code{\linkS4class{Matrix}} class description.} } } \section{Extends}{ Class \code{"\linkS4class{diagonalMatrix}"}, directly. Class \code{"\linkS4class{dMatrix}"}, directly. Class \code{"\linkS4class{sparseMatrix}"}, indirectly, see \code{\link{showClass}("ddiMatrix")}. } \section{Methods}{ \describe{ \item{\%*\%}{\code{signature(x = "ddiMatrix", y = "ddiMatrix")}: ... } } } \seealso{ Class \code{\linkS4class{diagonalMatrix}} and function \code{\link{Diagonal}}. } \examples{ (d2 <- Diagonal(x = c(10,1))) str(d2) ## slightly larger in internal size: str(as(d2, "sparseMatrix")) M <- Matrix(cbind(1,2:4)) M \%*\% d2 #> `fast' multiplication chol(d2) # trivial stopifnot(is(cd2 <- chol(d2), "ddiMatrix"), all.equal(cd2@x, c(sqrt(10),1))) } \keyword{classes} Matrix/man/cBind.Rd0000644000176200001440000000741413775317466013630 0ustar liggesusers\name{cBind} \title{'cbind()' and 'rbind()' recursively built on cbind2/rbind2} \alias{cBind} \alias{rBind} %no \alias{cbind2} or \alias{rbind2} % many more cbind2|rbind2 methods are in *-class.Rd, e.g. ./sparseMatrix-class.Rd \alias{cbind2,denseMatrix,sparseMatrix-method} \alias{cbind2,sparseMatrix,denseMatrix-method} \alias{rbind2,denseMatrix,sparseMatrix-method} \alias{rbind2,sparseMatrix,denseMatrix-method} % \description{ The base functions \code{\link{cbind}} and \code{\link{rbind}} are defined for an arbitrary number of arguments and hence have the first formal argument \code{...}. Now, when S4 objects are found among the arguments, base \code{cbind()} and \code{rbind()} internally \dQuote{dispatch} \emph{recursively}, calling \code{\link{cbind2}} or \code{\link{rbind2}} respectively, where these have methods defined and so should dispatch appropriately. \code{\link{cbind2}()} and \code{\link{rbind2}()} are from the \pkg{methods} package, i.e., standard \R, and have been provided for binding together \emph{two} matrices, where in \pkg{Matrix}, we have defined methods for these and the \code{'Matrix'} matrices. } \section{Historical Remark}{ Before \R version 3.2.0 (April 2015), we have needed a substitute for \emph{S4-enabled} versions of \code{cbind} and \code{rbind}, and provided \code{cBind} and \code{rBind} with identical syntax and semantic in order to bind together multiple matrices (\code{"matrix"} or \code{"Matrix"} and vectors. With \R version 3.2.0 and newer, \code{cBind} and \code{rBind} are \emph{deprecated} and produce a deprecation warning (via \code{\link{.Deprecated}}), and your code should start using \code{cbind()} and \code{rbind()} instead. } \usage{ ## cbind(..., deparse.level = 1) ## rbind(..., deparse.level = 1) ## and e.g., \S4method{cbind2}{denseMatrix,sparseMatrix}(x,y, sparse = NA, ...) \S4method{cbind2}{sparseMatrix,denseMatrix}(x,y, sparse = NA, ...) \S4method{rbind2}{denseMatrix,sparseMatrix}(x,y, sparse = NA, ...) \S4method{rbind2}{sparseMatrix,denseMatrix}(x,y, sparse = NA, ...) } \arguments{ \item{\dots, x, y}{matrix-like \R objects to be bound together, see \code{\link{cbind}} and \code{\link{rbind}}.} \item{sparse}{option \code{\link{logical}} indicating if the result should be sparse, i.e., formally inheriting from \code{"\linkS4class{sparseMatrix}"}. The default, \code{\link{NA}}, decides from the \dQuote{sparsity} of \code{x} and \code{y}, see e.g., the \R code in \code{selectMethod(cbind2, c("sparseMatrix","denseMatrix"))}.} \item{deparse.level}{integer determining under which circumstances column and row names are built from the actual arguments' \sQuote{expression}, see \code{\link{cbind}}.} } \value{ typically a \sQuote{matrix-like} object of a similar \code{\link{class}} as the first argument in \code{\dots}. Note that sometimes by default, the result is a \code{\linkS4class{sparseMatrix}} if one of the arguments is (even in the case where this is not efficient). In other cases, the result is chosen to be sparse when there are more zero entries is than non-zero ones (as the default \code{sparse} in \code{\link{Matrix}()}). } \author{Martin Maechler} \seealso{\code{\link{cbind2}}, \code{\link{cbind}}, Documentation in base \R's \pkg{methods} package. Our class definition help pages mentioning \code{cbind2()} and \code{rbind2()} methods: \code{"\linkS4class{denseMatrix}"}, \code{"\linkS4class{diagonalMatrix}"}, \code{"\linkS4class{indMatrix}"}. } \examples{ (a <- matrix(c(2:1,1:2), 2,2)) (M1 <- cbind(0, rbind(a, 7))) # a traditional matrix D <- Diagonal(2) (M2 <- cbind(4, a, D, -1, D, 0)) # a sparse Matrix stopifnot(validObject(M2), inherits(M2, "sparseMatrix"), dim(M2) == c(2,9)) } \keyword{array} \keyword{manip} Matrix/man/nsparseMatrix-classes.Rd0000644000176200001440000002035013057762217017065 0ustar liggesusers\name{nsparseMatrix-classes} \title{Sparse "pattern" Matrices} \docType{class} \alias{nsparseMatrix-class} %not yet \alias{nCsparseMatrix-class} \alias{ngCMatrix-class} \alias{ntCMatrix-class} \alias{nsCMatrix-class} \alias{ngRMatrix-class} \alias{ntRMatrix-class} \alias{nsRMatrix-class} \alias{ngTMatrix-class} \alias{ntTMatrix-class} \alias{nsTMatrix-class} % \alias{all,nsparseMatrix-method} \alias{any,nsparseMatrix-method} \alias{-,nsparseMatrix,missing-method} \alias{!,nsparseMatrix-method} \alias{coerce,nsparseMatrix,dsparseMatrix-method} \alias{coerce,matrix,ngCMatrix-method} \alias{coerce,matrix,ngTMatrix-method} \alias{coerce,matrix,ntCMatrix-method} \alias{coerce,matrix,ntTMatrix-method} \alias{coerce,ngCMatrix,dMatrix-method} \alias{coerce,ngCMatrix,dgCMatrix-method} \alias{coerce,ngCMatrix,dsparseMatrix-method} \alias{coerce,ngCMatrix,lMatrix-method} \alias{coerce,ngCMatrix,lgCMatrix-method} \alias{coerce,ngCMatrix,lsparseMatrix-method} \alias{coerce,ngCMatrix,matrix-method} \alias{coerce,ngCMatrix,ngTMatrix-method} \alias{coerce,ngCMatrix,ngeMatrix-method} \alias{coerce,ngCMatrix,ntCMatrix-method} \alias{coerce,ngTMatrix,dMatrix-method} \alias{coerce,ngTMatrix,dgTMatrix-method} \alias{coerce,ngTMatrix,dsparseMatrix-method} \alias{coerce,ngTMatrix,generalMatrix-method} \alias{coerce,ngTMatrix,lMatrix-method} \alias{coerce,ngTMatrix,lgTMatrix-method} \alias{coerce,ngTMatrix,matrix-method} \alias{coerce,ngTMatrix,ngCMatrix-method} \alias{coerce,ngTMatrix,lgeMatrix-method} \alias{coerce,ngTMatrix,ngeMatrix-method} \alias{coerce,ngTMatrix,ntTMatrix-method} \alias{coerce,ngTMatrix,symmetricMatrix-method} \alias{coerce,ngTMatrix,triangularMatrix-method} \alias{coerce,nsCMatrix,dMatrix-method} \alias{coerce,nsCMatrix,dsCMatrix-method} \alias{coerce,nsCMatrix,dsparseMatrix-method} \alias{coerce,nsCMatrix,generalMatrix-method} \alias{coerce,nsCMatrix,lMatrix-method} \alias{coerce,nsCMatrix,lsCMatrix-method} \alias{coerce,nsCMatrix,lsparseMatrix-method} \alias{coerce,nsCMatrix,matrix-method} \alias{coerce,nsCMatrix,ngCMatrix-method} \alias{coerce,nsCMatrix,nsTMatrix-method} \alias{coerce,nsTMatrix,dsTMatrix-method} \alias{coerce,nsTMatrix,matrix-method} \alias{coerce,nsTMatrix,ngCMatrix-method} \alias{coerce,nsTMatrix,ngTMatrix-method} \alias{coerce,nsTMatrix,nsCMatrix-method} \alias{coerce,nsTMatrix,nsyMatrix-method} \alias{coerce,ntCMatrix,dMatrix-method} \alias{coerce,ntCMatrix,dsparseMatrix-method} \alias{coerce,ntCMatrix,dtCMatrix-method} \alias{coerce,ntCMatrix,lMatrix-method} \alias{coerce,ntCMatrix,lsparseMatrix-method} \alias{coerce,ntCMatrix,ltCMatrix-method} \alias{coerce,ntCMatrix,matrix-method} \alias{coerce,ntCMatrix,ngCMatrix-method} \alias{coerce,ntCMatrix,TsparseMatrix-method} \alias{coerce,ntTMatrix,dtTMatrix-method} \alias{coerce,ntTMatrix,generalMatrix-method} \alias{coerce,ntTMatrix,matrix-method} \alias{coerce,ntTMatrix,ngCMatrix-method} \alias{coerce,ntTMatrix,ngTMatrix-method} \alias{coerce,ntTMatrix,ntCMatrix-method} \alias{coerce,ntTMatrix,ntrMatrix-method} % \alias{t,ngCMatrix-method} \alias{t,ngTMatrix-method} \alias{t,nsCMatrix-method} \alias{t,ntCMatrix-method} \alias{t,nsTMatrix-method} \alias{t,ntTMatrix-method} \alias{is.na,nsparseMatrix-method} \alias{which,ngTMatrix-method} \alias{which,nsparseMatrix-method} \alias{which,nsTMatrix-method} \alias{which,ntTMatrix-method} % Group \alias{Ops,dsparseMatrix,nsparseMatrix-method} \alias{Ops,nsparseMatrix,dsparseMatrix-method} \alias{Ops,lsparseMatrix,nsparseMatrix-method} \alias{Ops,nsparseMatrix,lsparseMatrix-method} \alias{Ops,sparseMatrix,nsparseMatrix-method} \alias{Ops,nsparseMatrix,sparseMatrix-method} \alias{Arith,nsparseMatrix,Matrix-method} \alias{Arith,Matrix,nsparseMatrix-method} % \description{The \code{nsparseMatrix} class is a virtual class of sparse \emph{\dQuote{pattern}} matrices, i.e., binary matrices conceptually with \code{TRUE}/\code{FALSE} entries. Only the positions of the elements that are \code{TRUE} are stored. These can be stored in the \dQuote{triplet} form (\code{\linkS4class{TsparseMatrix}}, subclasses \code{ngTMatrix}, \code{nsTMatrix}, and \code{ntTMatrix} which really contain pairs, not triplets) or in compressed column-oriented form (class \code{\linkS4class{CsparseMatrix}}, subclasses \code{ngCMatrix}, \code{nsCMatrix}, and \code{ntCMatrix}) or--\emph{rarely}--in compressed row-oriented form (class \code{\linkS4class{RsparseMatrix}}, subclasses \code{ngRMatrix}, \code{nsRMatrix}, and \code{ntRMatrix}). The second letter in the name of these non-virtual classes indicates \code{g}eneral, \code{s}ymmetric, or \code{t}riangular. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("ngCMatrix", ...)} and so on. More frequently objects are created by coercion of a numeric sparse matrix to the pattern form for use in the symbolic analysis phase of an algorithm involving sparse matrices. Such algorithms often involve two phases: a symbolic phase wherein the positions of the non-zeros in the result are determined and a numeric phase wherein the actual results are calculated. During the symbolic phase only the positions of the non-zero elements in any operands are of interest, hence numeric sparse matrices can be treated as sparse pattern matrices. } \section{Slots}{ \describe{ \item{\code{uplo}:}{Object of class \code{"character"}. Must be either "U", for upper triangular, and "L", for lower triangular. Present in the triangular and symmetric classes but not in the general class.} \item{\code{diag}:}{Object of class \code{"character"}. Must be either \code{"U"}, for unit triangular (diagonal is all ones), or \code{"N"} for non-unit. The implicit diagonal elements are not explicitly stored when \code{diag} is \code{"U"}. Present in the triangular classes only.} \item{\code{p}:}{Object of class \code{"integer"} of pointers, one for each column (row), to the initial (zero-based) index of elements in the column. Present in compressed column-oriented and compressed row-oriented forms only.} \item{\code{i}:}{Object of class \code{"integer"} of length nnzero (number of non-zero elements). These are the row numbers for each TRUE element in the matrix. All other elements are FALSE. Present in triplet and compressed column-oriented forms only.} \item{\code{j}:}{Object of class \code{"integer"} of length nnzero (number of non-zero elements). These are the column numbers for each TRUE element in the matrix. All other elements are FALSE. Present in triplet and compressed column-oriented forms only.} \item{\code{Dim}:}{Object of class \code{"integer"} - the dimensions of the matrix.} } } \section{Methods}{ \describe{ \item{coerce}{\code{signature(from = "dgCMatrix", to = "ngCMatrix")}, and many similar ones; typically you should coerce to \code{"nsparseMatrix"} (or \code{"nMatrix"}). Note that coercion to a sparse pattern matrix records all the potential non-zero entries, i.e., explicit (\dQuote{non-structural}) zeroes are coerced to \code{TRUE}, not \code{FALSE}, see the example. } \item{t}{\code{signature(x = "ngCMatrix")}: returns the transpose of \code{x}} \item{which}{\code{signature(x = "lsparseMatrix")}, semantically equivalent to \pkg{base} function \code{\link{which}(x, arr.ind)}; for details, see the \code{\linkS4class{lMatrix}} class documentation.} } } %\references{} %\author{} %\note{} \seealso{ the class \code{\linkS4class{dgCMatrix}} } \examples{ (m <- Matrix(c(0,0,2:0), 3,5, dimnames=list(LETTERS[1:3],NULL))) ## ``extract the nonzero-pattern of (m) into an nMatrix'': nm <- as(m, "nsparseMatrix") ## -> will be a "ngCMatrix" str(nm) # no 'x' slot nnm <- !nm # no longer sparse (nnm <- as(nnm, "sparseMatrix"))# "lgCMatrix" ## consistency check: stopifnot(xor(as( nm, "matrix"), as(nnm, "matrix"))) ## low-level way of adding "non-structural zeros" : nnm@x[2:4] <- c(FALSE,NA,NA) nnm as(nnm, "nMatrix") # NAs *and* non-structural 0 |---> 'TRUE' data(KNex) nmm <- as(KNex $ mm, "ngCMatrix") str(xlx <- crossprod(nmm))# "nsCMatrix" stopifnot(isSymmetric(xlx)) image(xlx, main=paste("crossprod(nmm) : Sparse", class(xlx))) } \keyword{classes} \keyword{algebra} Matrix/man/TsparseMatrix-class.Rd0000644000176200001440000000635513711014657016507 0ustar liggesusers\name{TsparseMatrix-class} \title{Class "TsparseMatrix" of Sparse Matrices in Triplet Form} \docType{class} \alias{TsparseMatrix-class} %% Methods: \alias{coerce,TsparseMatrix,CsparseMatrix-method} \alias{coerce,TsparseMatrix,lsparseMatrix-method} \alias{coerce,TsparseMatrix,lMatrix-method} \alias{coerce,TsparseMatrix,nsparseMatrix-method} \alias{coerce,TsparseMatrix,nMatrix-method} \alias{coerce,TsparseMatrix,matrix-method} \alias{coerce,Matrix,TsparseMatrix-method} \alias{coerce,matrix,TsparseMatrix-method} \alias{coerce,numeric,TsparseMatrix-method} % % "[" are in ./Xtrct-methods.Rd; "[<-" in ./Subassign-methods.Rd %\alias{solve,...} --> solve-methods.Rd %\alias{\%*%,... } --> matrix-products.Rd \alias{t,TsparseMatrix-method} % \description{The \code{"TsparseMatrix"} class is the virtual class of all sparse matrices coded in triplet form. Since it is a virtual class, no objects may be created from it. See \code{showClass("TsparseMatrix")} for its subclasses. } \section{Slots}{ \describe{ \item{\code{Dim}, \code{Dimnames}:}{from the \code{"\linkS4class{Matrix}"} class,} \item{\code{i}:}{Object of class \code{"integer"} - the row indices of non-zero entries \emph{in 0-base}, i.e., must be in \code{0:(nrow(.)-1)}.} \item{\code{j}:}{Object of class \code{"integer"} - the column indices of non-zero entries. Must be the same length as slot \code{i} and \emph{0-based} as well, i.e., in \code{0:(ncol(.)-1)}. For numeric Tsparse matrices, \code{(i,j)} pairs can occur more than once, see \code{\linkS4class{dgTMatrix}}. } } } \section{Extends}{ Class \code{"sparseMatrix"}, directly. Class \code{"Matrix"}, by class \code{"sparseMatrix"}. } \section{Methods}{ Extraction (\code{"["}) methods, see \code{\link{[-methods}}.%-> ./Xtrct-methods.Rd } \note{ Most operations with sparse matrices are performed using the compressed, column-oriented or \code{\linkS4class{CsparseMatrix}} representation. The triplet representation is convenient for creating a sparse matrix or for reading and writing such matrices. Once it is created, however, the matrix is generally coerced to a \code{\linkS4class{CsparseMatrix}} for further operations. Note that all \code{new(.)}, \code{\link{spMatrix}} and \code{\link{sparseMatrix}(*, repr="T")} constructors for \code{"TsparseMatrix"} classes implicitly add (i.e., \dQuote{sum up}) \eqn{x_k}'s that belong to identical \eqn{(i_k, j_k)} pairs, see, the example below, or also \code{"\linkS4class{dgTMatrix}"}. For convenience, methods for some operations such as \code{\%*\%} and \code{crossprod} are defined for \code{\linkS4class{TsparseMatrix}} objects. These methods simply coerce the \code{\linkS4class{TsparseMatrix}} object to a \code{\linkS4class{CsparseMatrix}} object then perform the operation. } % \author{Martin Maechler} \seealso{ its superclass, \code{\linkS4class{sparseMatrix}}, and the \code{\linkS4class{dgTMatrix}} class, for the links to other classes. } \examples{ showClass("TsparseMatrix") ## or just the subclasses' names names(getClass("TsparseMatrix")@subclasses) T3 <- spMatrix(3,4, i=c(1,3:1), j=c(2,4:2), x=1:4) T3 # only 3 non-zero entries, 5 = 1+4 ! \dontshow{stopifnot(nnzero(T3) == 3)} } \keyword{classes} Matrix/man/isSymmetric-methods.Rd0000644000176200001440000000333712272147560016545 0ustar liggesusers\name{isSymmetric-methods} \docType{methods} \alias{isSymmetric-methods} \alias{isSymmetric,symmetricMatrix-method} \alias{isSymmetric,triangularMatrix-method} \alias{isSymmetric,denseMatrix-method} \alias{isSymmetric,diagonalMatrix-method} \alias{isSymmetric,sparseMatrix-method} \title{Methods for Function isSymmetric in Package 'Matrix'} \description{ \code{isSymmetric(M)} returns a \code{\link{logical}} indicating if \code{M} is a symmetric matrix. This (now) is a \pkg{base} function with a default method for the traditional matrices of \code{\link{class}} \code{"matrix"}. Methods here are defined for virtual Matrix classes such that it works for all objects inheriting from class \code{\linkS4class{Matrix}}. } \seealso{\code{\link{forceSymmetric}}, \code{\link{symmpart}}, and the formal class (and subclasses) \code{"\linkS4class{symmetricMatrix}"}. } %% \usage{ %% ## some methods have a 'tol' : %% \S4method{isSymmetric}{denseMatrix}(object, tol = 100 * .Machine$double.eps, ...) %% \S4method{isSymmetric}{sparseMatrix}(object, tol = 100 * .Machine$double.eps, ...) %% } %% \section{Methods}{ %% \describe{ %% \item{object = "symmetricMatrix"}{ ... } %% \item{object = "triangularMatrix"}{ ... } %% \item{object = "denseMatrix"}{ ... } %% \item{object = "diagonalMatrix"}{ ... } %% \item{object = "sparseMatrix"}{ ... } %% } %% } \examples{ isSymmetric(Diagonal(4)) # TRUE of course M <- Matrix(c(1,2,2,1), 2,2) isSymmetric(M) # TRUE (*and* of formal class "dsyMatrix") isSymmetric(as(M, "dgeMatrix")) # still symmetric, even if not "formally" isSymmetric(triu(M)) # FALSE ## Look at implementations: showMethods("isSymmetric", includeDefs=TRUE)# "ANY": base's S3 generic; 6 more } \keyword{methods} Matrix/man/pMatrix-class.Rd0000644000176200001440000001370212322331041015301 0ustar liggesusers\name{pMatrix-class} \docType{class} \alias{pMatrix-class} \alias{-,pMatrix,missing-method} \alias{coerce,integer,pMatrix-method} \alias{coerce,numeric,pMatrix-method} \alias{coerce,matrix,pMatrix-method} \alias{coerce,sparseMatrix,pMatrix-method} \alias{coerce,pMatrix,matrix-method} \alias{coerce,pMatrix,ngeMatrix-method} \alias{coerce,pMatrix,ngTMatrix-method} \alias{coerce,pMatrix,lMatrix-method} \alias{coerce,pMatrix,dMatrix-method} \alias{coerce,pMatrix,nMatrix-method} \alias{coerce,pMatrix,CsparseMatrix-method} \alias{coerce,pMatrix,TsparseMatrix-method} \alias{coerce,pMatrix,dsparseMatrix-method} \alias{coerce,pMatrix,nsparseMatrix-method} \alias{coerce,nMatrix,pMatrix-method} \alias{determinant,pMatrix,logical-method} \alias{Summary,pMatrix-method} %\alias{solve,pMatrix,missing-method}--> solve-methods.Rd \alias{t,pMatrix-method} % \title{Permutation matrices} \description{The \code{"pMatrix"} class is the class of permutation matrices, stored as 1-based integer permutation vectors. Matrix (vector) multiplication with permutation matrices is equivalent to row or column permutation, and is implemented that way in the \pkg{Matrix} package, see the \sQuote{Details} below. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("pMatrix", ...)} or by coercion from an integer permutation vector, see below. } \section{Slots}{ \describe{ \item{\code{perm}:}{An integer, 1-based permutation vector, i.e. an integer vector of length \code{Dim[1]} whose elements form a permutation of \code{1:Dim[1]}.} \item{\code{Dim}:}{Object of class \code{"integer"}. The dimensions of the matrix which must be a two-element vector of equal, non-negative integers.} \item{\code{Dimnames}:}{list of length two; each component containing NULL or a \code{\link{character}} vector length equal the corresponding \code{Dim} element.} } } \section{Extends}{ Class \code{"\linkS4class{indMatrix}"}, directly. } \section{Methods}{ \describe{ \item{\%*\%}{\code{signature(x = "matrix", y = "pMatrix")} and other signatures (use \code{showMethods("\%*\%", class="pMatrix")}): ... } \item{coerce}{\code{signature(from = "integer", to = "pMatrix")}: This is enables typical \code{"pMatrix"} construction, given a permutation vector of \code{1:n}, see the first example.} \item{coerce}{\code{signature(from = "numeric", to = "pMatrix")}: a user convenience, to allow \code{as(perm, "pMatrix")} for numeric \code{perm} with integer values.} \item{coerce}{\code{signature(from = "pMatrix", to = "matrix")}: coercion to a traditional FALSE/TRUE \code{\link{matrix}} of \code{\link{mode}} \code{logical}. (in earlier version of \pkg{Matrix}, it resulted in a 0/1-integer matrix; \code{logical} makes slightly more sense, corresponding better to the \dQuote{natural} sparseMatrix counterpart, \code{"ngTMatrix"}.)} \item{coerce}{\code{signature(from = "pMatrix", to = "ngTMatrix")}: coercion to sparse logical matrix of class \code{\linkS4class{ngTMatrix}}.} \item{determinant}{\code{signature(x = "pMatrix", logarithm="logical")}: Since permutation matrices are orthogonal, the determinant must be +1 or -1. In fact, it is exactly the \emph{sign of the permutation}.} \item{solve}{\code{signature(a = "pMatrix", b = "missing")}: return the inverse permutation matrix; note that \code{solve(P)} is identical to \code{t(P)} for permutation matrices. See \code{\link{solve-methods}} for other methods.} \item{t}{\code{signature(x = "pMatrix")}: return the transpose of the permutation matrix (which is also the inverse of the permutation matrix).} } } \details{ Matrix multiplication with permutation matrices is equivalent to row or column permutation. Here are the four different cases for an arbitrary matrix \eqn{M} and a permutation matrix \eqn{P} (where we assume matching dimensions): \tabular{lclcl}{ \eqn{MP }\tab= \tab\code{M \%*\% P} \tab= \tab\code{M[, i(p)]}\cr \eqn{PM }\tab= \tab\code{P \%*\% M} \tab= \tab\code{M[ p , ]} \cr \eqn{P'M}\tab= \tab\code{crossprod(P,M)} (\eqn{\approx}{~=}\code{t(P) \%*\% M})\tab= \tab\code{M[i(p), ]}\cr \eqn{MP'}\tab= \tab\code{tcrossprod(M,P)} (\eqn{\approx}{~=}\code{M \%*\% t(P)})\tab= \tab\code{M[ , p ]} \cr } where \code{p} is the \dQuote{permutation vector} corresponding to the permutation matrix \code{P} (see first note), and \code{i(p)} is short for \code{\link{invPerm}(p)}. Also one could argue that these are really only two cases if you take into account that inversion (\code{\link{solve}}) and transposition (\code{\link{t}}) are the same for permutation matrices \eqn{P}. } \note{ For every permutation matrix \code{P}, there is a corresponding permutation vector \code{p} (of indices, 1:n), and these are related by \preformatted{ P <- as(p, "pMatrix") p <- P@perm } see also the \sQuote{Examples}. \dQuote{Row-indexing} a permutation matrix typically returns an \code{"indMatrix"}. See \code{"\linkS4class{indMatrix}"} for all other subsetting/indexing and subassignment (\code{A[..] <- v}) operations. } \seealso{\code{\link{invPerm}(p)} computes the inverse permutation of an integer (index) vector \code{p}. } \examples{ (pm1 <- as(as.integer(c(2,3,1)), "pMatrix")) t(pm1) # is the same as solve(pm1) pm1 \%*\% t(pm1) # check that the transpose is the inverse stopifnot(all(diag(3) == as(pm1 \%*\% t(pm1), "matrix")), is.logical(as(pm1, "matrix"))) set.seed(11) ## random permutation matrix : (p10 <- as(sample(10),"pMatrix")) ## Permute rows / columns of a numeric matrix : (mm <- round(array(rnorm(3 * 3), c(3, 3)), 2)) mm \%*\% pm1 pm1 \%*\% mm try(as(as.integer(c(3,3,1)), "pMatrix"))# Error: not a permutation as(pm1, "ngTMatrix") p10[1:7, 1:4] # gives an "ngTMatrix" (most economic!) ## row-indexing of a keeps it as an : p10[1:3, ] } \keyword{classes} Matrix/man/uniqTsparse.Rd0000644000176200001440000000630313015274275015106 0ustar liggesusers\name{uniqTsparse} \title{Unique (Sorted) TsparseMatrix Representations} \alias{uniqTsparse} \alias{anyDuplicatedT} \description{ Detect or \dQuote{unify} (or \dQuote{standardize}) non-unique \code{\linkS4class{TsparseMatrix}} matrices, prducing unique \eqn{(i,j,x)} triplets which are \emph{sorted}, first in \eqn{j}, then in \eqn{i} (in the sense of \code{\link{order}(j,i)}). Note that \code{new(.)}, \code{\link{spMatrix}} or \code{\link{sparseMatrix}} constructors for \code{"dgTMatrix"} (and other \code{"\linkS4class{TsparseMatrix}"} classes) implicitly add \eqn{x_k}'s that belong to identical \eqn{(i_k, j_k)} pairs. \code{anyDuplicatedT()} reports the index of the first duplicated pair, or \code{0} if there is none. \code{uniqTsparse(x)} replaces duplicated index pairs \eqn{(i,j)} and their corresponding \code{x} slot entries by the triple \eqn{(i,j, sx)} where \code{sx = sum(x [])}, and for logical \code{x}, addition is replaced by logical \eqn{or}. } \usage{ uniqTsparse(x, class.x = c(class(x))) anyDuplicatedT(x, di = dim(x)) } \arguments{ \item{x}{a sparse matrix stored in triplet form, i.e., inheriting from class \code{\linkS4class{TsparseMatrix}}.} \item{class.x}{optional character string specifying \code{class(x)}.} \item{di}{the matrix dimension of \code{x}, \code{\link{dim}(x)}.} } %% \details{ %% } \value{ \code{uniqTsparse(x)} returns a \code{\linkS4class{TsparseMatrix}} \dQuote{like x}, of the same class and with the same elements, just internally possibly changed to \dQuote{unique} \eqn{(i,j,x)} triplets in \emph{sorted} order. \code{anyDuplicatedT(x)} returns an \code{\link{integer}} as \code{\link{anyDuplicated}}, the \emph{index} of the first duplicated entry (from the \eqn{(i,j)} pairs) if there is one, and \code{0} otherwise. } \seealso{ \code{\linkS4class{TsparseMatrix}}, for uniqueness, notably \code{\linkS4class{dgTMatrix}}. } \examples{ example("dgTMatrix-class", echo=FALSE) ## -> 'T2' with (i,j,x) slots of length 5 each T2u <- uniqTsparse(T2) stopifnot(## They "are" the same (and print the same): all.equal(T2, T2u, tol=0), ## but not internally: anyDuplicatedT(T2) == 2, anyDuplicatedT(T2u) == 0, length(T2 @x) == 5, length(T2u@x) == 3) ## is 'x' a "uniq Tsparse" Matrix ? [requires x to be TsparseMatrix!] non_uniqT <- function(x, di = dim(x)) is.unsorted(x@j) || anyDuplicatedT(x, di) non_uniqT(T2 ) # TRUE non_uniqT(T2u) # FALSE T3 <- T2u T3[1, c(1,3)] <- 10; T3[2, c(1,5)] <- 20 T3u <- uniqTsparse(T3) str(T3u) # sorted in 'j', and within j, sorted in i stopifnot(!non_uniqT(T3u)) ## Logical l.TMatrix and n.TMatrix : (L2 <- T2 > 0) validObject(L2u <- uniqTsparse(L2)) (N2 <- as(L2, "nMatrix")) validObject(N2u <- uniqTsparse(N2)) stopifnot(N2u@i == L2u@i, L2u@i == T2u@i, N2@i == L2@i, L2@i == T2@i, N2u@j == L2u@j, L2u@j == T2u@j, N2@j == L2@j, L2@j == T2@j) # now with a nasty NA [partly failed in Matrix 1.1-5]: L2.N <- L2; L2.N@x[2] <- NA; L2.N validObject(L2.N) (m2N <- as.matrix(L2.N)) # looks "ok" iL <- as.integer(m2N) stopifnot(identical(10L, which(is.na(match(iL, 0:1))))) symnum(m2N) } \keyword{utilities} \keyword{classes} Matrix/man/mat2triplet.Rd0000644000176200001440000000507213560017242015033 0ustar liggesusers\name{mat2triplet} \alias{mat2triplet} \title{Map Matrix to its Triplet Representation} \description{ From an \R object coercible to \code{"\linkS4class{TsparseMatrix}"}, typically a (sparse) matrix, produce its triplet representation which may collapse to a \dQuote{Duplet} in the case of binary aka pattern, such as \code{"\linkS4class{nMatrix}"} objects. } \usage{ mat2triplet(x, uniqT = FALSE) } \arguments{ \item{x}{any \R object for which \code{as(x, "\linkS4class{TsparseMatrix}")} works; typically a \code{\link{matrix}} of one of the \pkg{Matrix} package matrices.} \item{uniqT}{\code{\link{logical}} indicating if the triplet representation should be \sQuote{unique} in the sense of \code{\link{uniqTsparse}()}.} } \value{ A \code{\link{list}}, typically with three components, \item{i}{vector of row indices for all non-zero entries of \code{x}} \item{i}{vector of columns indices for all non-zero entries of \code{x}} \item{x}{vector of all non-zero entries of \code{x}; exists \bold{only} when \code{as(x, "TsparseMatrix")} is \bold{not} a \code{"\linkS4class{nsparseMatrix}"}.} Note that the \code{\link{order}} of the entries is determined by the coercion to \code{"\linkS4class{TsparseMatrix}"} and hence typically with increasing \code{j} (and increasing \code{i} within ties of \code{j}). } \note{ The \code{mat2triplet()} utility was created to be a more efficient and more predictable substitute for \code{\link{summary}()}. UseRs have wrongly expected the latter to return a data frame with columns \code{i} and \code{j} which however is wrong for a \code{"\linkS4class{diagonalMatrix}"}. } \seealso{ The \code{summary()} method for \code{"sparseMatrix"}, \code{\link{summary,sparseMatrix-method}}. \code{mat2triplet()} is conceptually the \emph{inverse} function of \code{\link{spMatrix}} and (one case of) \code{\link{sparseMatrix}}. } \examples{% ../R/sparseMatrix.R if(FALSE) ## The function is defined (don't redefine here!), simply as mat2triplet <- function(x, uniqT = FALSE) { T <- as(x, "TsparseMatrix") if(uniqT && anyDuplicatedT(T)) T <- .uniqTsparse(T) if(is(T, "nsparseMatrix")) list(i = T@i + 1L, j = T@j + 1L) else list(i = T@i + 1L, j = T@j + 1L, x = T@x) } i <- c(1,3:8); j <- c(2,9,6:10); x <- 7 * (1:7) (Ax <- sparseMatrix(i, j, x = x)) ## 8 x 10 "dgCMatrix" str(trA <- mat2triplet(Ax)) stopifnot(i == sort(trA$i), sort(j) == trA$j, x == sort(trA$x)) D <- Diagonal(x=4:2) summary(D) str(mat2triplet(D)) } \keyword{classes} \keyword{manip} \keyword{utilities} Matrix/man/sparseMatrix-class.Rd0000644000176200001440000001550713775317466016400 0ustar liggesusers\name{sparseMatrix-class} \docType{class} \title{Virtual Class "sparseMatrix" --- Mother of Sparse Matrices} \alias{sparseMatrix-class} %% Group methods \alias{Math,sparseMatrix-method} \alias{log,sparseMatrix-method} %\alias{Math2,sparseMatrix,numeric-method} \alias{Ops,sparseMatrix,sparseMatrix-method} \alias{Ops,sparseMatrix,numeric-method} \alias{Ops,numeric,sparseMatrix-method} \alias{Ops,diagonalMatrix,sparseMatrix-method} \alias{Ops,sparseMatrix,diagonalMatrix-method} % \alias{cbind2,sparseMatrix,sparseMatrix-method} %\alias{cbind2,denseMatrix,sparseMatrix-method} in ./cBind.Rd %\alias{cbind2,sparseMatrix,denseMatrix-method} ditto \alias{cbind2,sparseMatrix,matrix-method} \alias{cbind2,matrix,sparseMatrix-method} \alias{cbind2,sparseMatrix,numeric-method} \alias{cbind2,numeric,sparseMatrix-method} \alias{rbind2,sparseMatrix,sparseMatrix-method} %\alias{rbind2,denseMatrix,sparseMatrix-method} in ./cBind.Rd %\alias{rbind2,sparseMatrix,denseMatrix-method} ditto \alias{rbind2,sparseMatrix,matrix-method} \alias{rbind2,matrix,sparseMatrix-method} \alias{rbind2,sparseMatrix,numeric-method} \alias{rbind2,numeric,sparseMatrix-method} % \alias{coerce,ANY,sparseMatrix-method} \alias{coerce,table,sparseMatrix-method} \alias{coerce,factor,sparseMatrix-method} \alias{coerce,sparseMatrix,generalMatrix-method} \alias{coerce,sparseMatrix,symmetricMatrix-method} \alias{coerce,sparseMatrix,triangularMatrix-method} \alias{-,sparseMatrix,missing-method} \alias{cov2cor,sparseMatrix-method} \alias{diag,sparseMatrix-method} \alias{dim<-,sparseMatrix-method} \alias{format,sparseMatrix-method} \alias{lu,sparseMatrix-method} \alias{mean,sparseMatrix-method} \alias{print,sparseMatrix-method} \alias{show,sparseMatrix-method} \alias{summary,sparseMatrix-method} \alias{norm,sparseMatrix,character-method} \alias{determinant,dgCMatrix,logical-method} \alias{determinant,dsparseMatrix,logical-method} \alias{determinant,dtCMatrix,logical-method} \alias{determinant,sparseMatrix,missing-method} \alias{determinant,sparseMatrix,logical-method} \alias{rep,sparseMatrix-method} % Fake, just so it is found by the naive user:} \alias{print.sparseMatrix} % "[" are in ./Xtrct-methods.Rd %\alias{colMeans,..} etc are now in ./colSums.Rd % \description{Virtual Mother Class of All Sparse Matrices} \section{Slots}{ \describe{ \item{\code{Dim}:}{Object of class \code{"integer"} - the dimensions of the matrix - must be an integer vector with exactly two non-negative values.} \item{\code{Dimnames}:}{a list of length two - inherited from class \code{Matrix}, see \code{\linkS4class{Matrix}}.} } } \section{Extends}{ Class \code{"Matrix"}, directly. } \section{Methods}{ \describe{ \item{show}{\code{(object = "sparseMatrix")}: The \code{\link{show}} method for sparse matrices prints \emph{\dQuote{structural}} zeroes as \code{"."} using \code{\link{printSpMatrix}()} which allows further customization.} \item{print}{\code{signature(x = "sparseMatrix")}, ....\cr The \code{\link{print}} method for sparse matrices by default is the same as \code{show()} but can be called with extra optional arguments, see \code{\link{printSpMatrix}()}.} \item{format}{\code{signature(x = "sparseMatrix")}, ....\cr The \code{\link{format}} method for sparse matrices, see \code{\link{formatSpMatrix}()} for details such as the extra optional arguments.} \item{summary}{\code{(object = "sparseMatrix", uniqT=FALSE)}: Returns an object of S3 class \code{"sparseSummary"} which is basically a \code{\link{data.frame}} with columns \code{(i,j,x)} (or just \code{(i,j)} for \code{\linkS4class{nsparseMatrix}} class objects) with the stored (typically non-zero) entries. The \code{\link{print}} method resembles Matlab's way of printing sparse matrices, and also the MatrixMarket format, see \code{\link{writeMM}}.} \item{cbind2}{\code{(x = *, y = *)}: several methods for binding matrices together, column-wise, see the basic \code{\link{cbind}} and \code{\link{rbind}} functions.\cr Note that the result will typically be sparse, even when one argument is dense and larger than the sparse one. } \item{rbind2}{\code{(x = *, y = *)}: binding matrices together row-wise, see \code{cbind2} above.} \item{determinant}{\code{(x = "sparseMatrix", logarithm=TRUE)}: \code{\link{determinant}()} methods for sparse matrices typically work via \code{\link{Cholesky}} or \code{\link{lu}} decompositions.} \item{diag}{\code{(x = "sparseMatrix")}: extracts the diagonal of a sparse matrix.} \item{dim<-}{\code{signature(x = "sparseMatrix", value = "ANY")}: allows to \emph{reshape} a sparse matrix to a sparse matrix with the same entries but different dimensions. \code{value} must be of length two and fulfill \code{prod(value) == prod(dim(x))}.} \item{coerce}{\code{signature(from = "factor", to = "sparseMatrix")}: Coercion of a factor to \code{"sparseMatrix"} produces the matrix of indicator \bold{rows} stored as an object of class \code{"dgCMatrix"}. To obtain columns representing the interaction of the factor and a numeric covariate, replace the \code{"x"} slot of the result by the numeric covariate then take the transpose. Missing values (\code{\link{NA}}) from the factor are translated to columns of all \code{0}s.} } See also \code{\link{colSums}}, \code{\link{norm}}, ... %% FIXME for methods with separate help pages. } \seealso{ \code{\link{sparseMatrix}}, and its references, such as \code{\link{xtabs}(*, sparse=TRUE)}, or \code{\link{sparse.model.matrix}()}, for constructing sparse matrices. \code{\link{T2graph}} for conversion of \code{"graph"} objects (package \pkg{graph}) to and from sparse matrices. } \note{ In method selection for multiplication operations (i.e. \code{\%*\%} and the two-argument form of \code{\link[base]{crossprod}}) the sparseMatrix class takes precedence in the sense that if one operand is a sparse matrix and the other is any type of dense matrix then the dense matrix is coerced to a \code{dgeMatrix} and the appropriate sparse matrix method is used. } %\author{Martin} \examples{ showClass("sparseMatrix") ## and look at the help() of its subclasses M <- Matrix(0, 10000, 100) M[1,1] <- M[2,3] <- 3.14 M ## show(.) method suppresses printing of the majority of rows data(CAex); dim(CAex) # 72 x 72 matrix determinant(CAex) # works via sparse lu(.) ## factor -> t( ) : (fact <- gl(5, 3, 30, labels = LETTERS[1:5])) (Xt <- as(fact, "sparseMatrix")) # indicator rows ## missing values --> all-0 columns: f.mis <- fact i.mis <- c(3:5, 17) is.na(f.mis) <- i.mis Xt != (X. <- as(f.mis, "sparseMatrix")) # differ only in columns 3:5,17 stopifnot(all(X.[,i.mis] == 0), all(Xt[,-i.mis] == X.[,-i.mis])) } \keyword{classes} Matrix/man/ndenseMatrix-class.Rd0000644000176200001440000000521712622367447016346 0ustar liggesusers\name{ndenseMatrix-class} \docType{class} \alias{ndenseMatrix-class} \alias{!,ndenseMatrix-method} \alias{Ops,ndenseMatrix,ndenseMatrix-method} \alias{Summary,ndenseMatrix-method} \alias{as.logical,ndenseMatrix-method} \alias{coerce,matrix,ndenseMatrix-method} \alias{coerce,ndenseMatrix,matrix-method} \alias{coerce,ndenseMatrix,CsparseMatrix-method} \alias{coerce,ndenseMatrix,TsparseMatrix-method} \alias{coerce,ndenseMatrix,ldenseMatrix-method} \alias{coerce,ndenseMatrix,sparseMatrix-method} \alias{coerce,ndenseMatrix,nsparseMatrix-method} \alias{coerce,ngeMatrix,lgeMatrix-method} \alias{coerce,nspMatrix,lspMatrix-method} \alias{coerce,nsyMatrix,lsyMatrix-method} \alias{coerce,ntpMatrix,ltpMatrix-method} \alias{coerce,ntrMatrix,ltrMatrix-method} \alias{as.vector,ndenseMatrix-method} \alias{diag,ndenseMatrix-method} \alias{norm,ndenseMatrix,character-method} \alias{which,ndenseMatrix-method} % \title{Virtual Class "ndenseMatrix" of Dense Logical Matrices} \description{ \code{ndenseMatrix} is the virtual class of all dense \bold{l}ogical (S4) matrices. It extends both \code{\linkS4class{denseMatrix}} and \code{\linkS4class{lMatrix}} directly. } \section{Slots}{ \describe{ \item{\code{x}:}{logical vector containing the entries of the matrix.} \item{\code{Dim}, \code{Dimnames}:}{see \code{\linkS4class{Matrix}}.} } } \section{Extends}{ Class \code{"nMatrix"}, directly. Class \code{"denseMatrix"}, directly. Class \code{"Matrix"}, by class \code{"nMatrix"}. Class \code{"Matrix"}, by class \code{"denseMatrix"}. } \section{Methods}{ \describe{ \item{\%*\%}{\code{signature(x = "nsparseMatrix", y = "ndenseMatrix")}: ... } \item{\%*\%}{\code{signature(x = "ndenseMatrix", y = "nsparseMatrix")}: ... } \item{coerce}{\code{signature(from = "matrix", to = "ndenseMatrix")}: ... } \item{coerce}{\code{signature(from = "ndenseMatrix", to = "matrix")}: ... } \item{crossprod}{\code{signature(x = "nsparseMatrix", y = "ndenseMatrix")}: ... } \item{crossprod}{\code{signature(x = "ndenseMatrix", y = "nsparseMatrix")}: ... } \item{as.vector}{\code{signature(x = "ndenseMatrix", mode = "missing")}: ...} \item{diag}{\code{signature(x = "ndenseMatrix")}: extracts the diagonal as for all matrices, see the generic \code{\link{diag}()}.} \item{which}{\code{signature(x = "ndenseMatrix")}, semantically equivalent to \pkg{base} function \code{\link{which}(x, arr.ind)}; for details, see the \code{\linkS4class{lMatrix}} class documentation.} } } \seealso{ Class \code{\linkS4class{ngeMatrix}} and the other subclasses. } \examples{ showClass("ndenseMatrix") as(diag(3) > 0, "ndenseMatrix")# -> "nge" } \keyword{classes} Matrix/man/indMatrix-class.Rd0000644000176200001440000001730413775317466015652 0ustar liggesusers\name{indMatrix-class} \title{Index Matrices} \docType{class} \alias{indMatrix-class} \alias{-,indMatrix,missing-method} \alias{coerce,integer,indMatrix-method} \alias{coerce,numeric,indMatrix-method} \alias{coerce,list,indMatrix-method} \alias{coerce,matrix,indMatrix-method} \alias{coerce,sparseMatrix,indMatrix-method} \alias{coerce,indMatrix,matrix-method} \alias{coerce,indMatrix,ngeMatrix-method} \alias{coerce,indMatrix,ngTMatrix-method} \alias{coerce,indMatrix,dMatrix-method} \alias{coerce,indMatrix,lMatrix-method} \alias{coerce,indMatrix,nMatrix-method} \alias{coerce,indMatrix,CsparseMatrix-method} \alias{coerce,indMatrix,TsparseMatrix-method} \alias{coerce,indMatrix,dsparseMatrix-method} \alias{coerce,indMatrix,lsparseMatrix-method} \alias{coerce,indMatrix,nsparseMatrix-method} \alias{coerce,nMatrix,indMatrix-method} \alias{determinant,indMatrix,logical-method} \alias{isSymmetric,indMatrix-method} \alias{Summary,indMatrix-method} %-- see also ./matrix-products.Rd, kronecker-methods.Rd, is.na-methods.Rd, ... \alias{rbind2,indMatrix,indMatrix-method} \alias{t,indMatrix-method} \alias{colSums,indMatrix-method} \alias{colMeans,indMatrix-method} \alias{rowSums,indMatrix-method} \alias{rowMeans,indMatrix-method} % \description{The \code{"indMatrix"} class is the class of index matrices, stored as 1-based integer index vectors. An index matrix is a matrix with exactly one non-zero entry per row. Index matrices are useful for mapping observations to unique covariate values, for example. Matrix (vector) multiplication with index matrices is equivalent to replicating and permuting rows, or \dQuote{sampling rows with replacement}, and is implemented that way in the \pkg{Matrix} package, see the \sQuote{Details} below. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("indMatrix", ...)} or by coercion from an integer index vector, see below. } \section{Slots}{ \describe{ \item{\code{perm}:}{An integer, 1-based index vector, i.e. an integer vector of length \code{Dim[1]} whose elements are taken from \code{1:Dim[2]}.} \item{\code{Dim}:}{\code{\link{integer}} vector of length two. In some applications, the matrix will be skinny, i.e., with at least as many rows as columns.} \item{\code{Dimnames}:}{a \code{\link{list}} of length two where each component is either \code{\link{NULL}} or a \code{\link{character}} vector of length equal to the corresponding \code{Dim} element.} } } \section{Extends}{ Class \code{"\linkS4class{sparseMatrix}"} and \code{"\linkS4class{generalMatrix}"}, directly. } \section{Methods}{ \describe{ \item{\%*\%}{\code{signature(x = "matrix", y = "indMatrix")} and other signatures (use \code{showMethods("\%*\%", class="indMatrix")}): ... } \item{coerce}{\code{signature(from = "integer", to = "indMatrix")}: This enables typical \code{"indMatrix"} construction, given an index vector from elements in \code{1:Dim[2]}, see the first example.} \item{coerce}{\code{signature(from = "numeric", to = "indMatrix")}: a user convenience, to allow \code{as(perm, "indMatrix")} for numeric \code{perm} with integer values.} \item{coerce}{\code{signature(from = "list", to = "indMatrix")}: The list must have two (integer-valued) entries: the first giving the index vector with elements in \code{1:Dim[2]}, the second giving \code{Dim[2]}. This allows \code{"indMatrix"} construction for cases in which the values represented by the rightmost column(s) are not associated with any observations, i.e., in which the index does not contain values \code{Dim[2], Dim[2]-1, Dim[2]-2, ...}} \item{coerce}{\code{signature(from = "indMatrix", to = "matrix")}: coercion to a traditional FALSE/TRUE \code{\link{matrix}} of \code{\link{mode}} \code{logical}.} \item{coerce}{\code{signature(from = "indMatrix", to = "ngTMatrix")}: coercion to sparse logical matrix of class \code{\linkS4class{ngTMatrix}}.} \item{t}{\code{signature(x = "indMatrix")}: return the transpose of the index matrix (which is no longer an \code{indMatrix}, but of class \code{\linkS4class{ngTMatrix}}.} \item{colSums, colMeans, rowSums, rowMeans}{\code{signature(x = "indMatrix")}: return the column or row sums or means.} \item{rbind2}{\code{signature(x = "indMatrix", y = "indMatrix")}: a fast method for rowwise catenation of two index matrices (with the same number of columns).} \item{kronecker}{\code{signature(X = "indMatrix", Y = "indMatrix")}: return the kronecker product of two index matrices, which corresponds to the index matrix of the interaction of the two.} } } \author{Fabian Scheipl, Uni Muenchen, building on existing \code{"\linkS4class{pMatrix}"}, after a nice hike's conversation with Martin Maechler; diverse tweaks by the latter. The \code{\link{crossprod}(x,y)} and \code{\link{kronecker}(x,y)} methods when both arguments are \code{"indMatrix"} have been made considerably faster thanks to a suggestion by Boris Vaillant. } \details{ Matrix (vector) multiplication with index matrices from the left is equivalent to replicating and permuting rows of the matrix on the right hand side. (Similarly, matrix multiplication with the transpose of an index matrix from the right corresponds to selecting \emph{columns}.) The crossproduct of an index matrix \eqn{M} with itself is a diagonal matrix with the number of entries in each column of \eqn{M} on the diagonal, i.e., \eqn{M'M=}\code{Diagonal(x=table(M@perm))}. Permutation matrices (of class \code{\linkS4class{pMatrix}}) are special cases of index matrices: They are square, of dimension, say, \eqn{n \times n}{n * n}, and their index vectors contain exactly all of \code{1:n}. While \dQuote{row-indexing} (of more than one row \emph{or} using \code{drop=FALSE}) stays within the \code{"indMatrix"} class, all other subsetting/indexing operations (\dQuote{column-indexing}, including, \code{\link{diag}}) on \code{"indMatrix"} objects treats them as nonzero-pattern matrices (\code{"\linkS4class{ngTMatrix}"} specifically), such that non-matrix subsetting results in \code{\link{logical}} vectors. Sub-assignment (\code{M[i,j] <- v}) is not sensible and hence an error for these matrices. } \seealso{ The permutation matrices \code{\linkS4class{pMatrix}} are special index matrices. The \dQuote{pattern} matrices, \code{\linkS4class{nMatrix}} and its subclasses. } \examples{ p1 <- as(c(2,3,1), "pMatrix") (sm1 <- as(rep(c(2,3,1), e=3), "indMatrix")) stopifnot(all(sm1 == p1[rep(1:3, each=3),])) ## row-indexing of a turns it into an : class(p1[rep(1:3, each=3),]) set.seed(12) # so we know '10' is in sample ## random index matrix for 30 observations and 10 unique values: (s10 <- as(sample(10, 30, replace=TRUE),"indMatrix")) ## Sample rows of a numeric matrix : (mm <- matrix(1:10, nrow=10, ncol=3)) s10 \%*\% mm set.seed(27) IM1 <- as(sample(1:20, 100, replace=TRUE), "indMatrix") IM2 <- as(sample(1:18, 100, replace=TRUE), "indMatrix") (c12 <- crossprod(IM1,IM2)) ## same as cross-tabulation of the two index vectors: stopifnot(all(c12 - unclass(table(IM1@perm, IM2@perm)) == 0)) # 3 observations, 4 implied values, first does not occur in sample: as(2:4, "indMatrix") # 3 observations, 5 values, first and last do not occur in sample: as(list(2:4, 5), "indMatrix") as(sm1, "ngTMatrix") s10[1:7, 1:4] # gives an "ngTMatrix" (most economic!) s10[1:4, ] # preserves "indMatrix"-class I1 <- as(c(5:1,6:4,7:3), "indMatrix") I2 <- as(7:1, "pMatrix") (I12 <- rbind(I1, I2)) stopifnot(is(I12, "indMatrix"), identical(I12, rbind(I1, I2)), colSums(I12) == c(2L,2:4,4:2)) } \keyword{classes} Matrix/man/dgRMatrix-class.Rd0000644000176200001440000000424411705754605015602 0ustar liggesusers\name{dgRMatrix-class} \docType{class} \title{Sparse Compressed, Row-oriented Numeric Matrices} \alias{dgRMatrix-class} % all alias{coerce,...} are currently in ./RsparseMatrix-class.Rd \alias{diag,dgRMatrix-method} \alias{dim,dgRMatrix-method} \alias{t,dgRMatrix-method} \description{The \code{dgRMatrix} class is a class of sparse numeric matrices in the compressed, sparse, row-oriented format. In this implementation the non-zero elements in the rows are sorted into increasing column order. \bold{Note:} The column-oriented sparse classes, e.g., \code{\linkS4class{dgCMatrix}}, are preferred and better supported in the \pkg{Matrix} package. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("dgRMatrix", ...)}. } \section{Slots}{ \describe{ \item{\code{j}:}{Object of class \code{"integer"} of length nnzero (number of non-zero elements). These are the column numbers for each non-zero element in the matrix.} \item{\code{p}:}{Object of class \code{"integer"} of pointers, one for each row, to the initial (zero-based) index of elements in the row.} \item{\code{x}:}{Object of class \code{"numeric"} - the non-zero elements of the matrix.} \item{\code{Dim}:}{Object of class \code{"integer"} - the dimensions of the matrix.} } } \section{Methods}{ \describe{ \item{coerce}{\code{signature(from = "matrix", to = "dgRMatrix")}} \item{coerce}{\code{signature(from = "dgRMatrix", to = "matrix")}} \item{coerce}{\code{signature(from = "dgRMatrix", to = "dgTMatrix")}} \item{diag}{\code{signature(x = "dgRMatrix")}: returns the diagonal of \code{x}} \item{dim}{\code{signature(x = "dgRMatrix")}: returns the dimensions of \code{x}} \item{image}{\code{signature(x = "dgRMatrix")}: plots an image of \code{x} using the \code{\link[lattice]{levelplot}} function} } } \seealso{ the \code{\linkS4class{RsparseMatrix}} class, the virtual class of all sparse compressed \bold{r}ow-oriented matrices, with its methods. The \code{\linkS4class{dgCMatrix}} class (\bold{c}olumn compressed sparse) is really preferred. } \keyword{classes} \keyword{algebra} Matrix/man/CHMfactor-class.Rd0000644000176200001440000002332512322331041015465 0ustar liggesusers\name{CHMfactor-class} \title{CHOLMOD-based Cholesky Factorizations} \docType{class} \alias{CHMfactor-class}% "mother" virtual \alias{CHMsimpl-class}% virtual \alias{CHMsuper-class}% virtual \alias{dCHMsimpl-class} \alias{nCHMsimpl-class} \alias{dCHMsuper-class} \alias{nCHMsuper-class} \alias{isLDL} % \alias{coerce,CHMfactor,Matrix-method} \alias{coerce,CHMfactor,sparseMatrix-method} \alias{coerce,CHMfactor,triangularMatrix-method} \alias{coerce,CHMfactor,pMatrix-method} \alias{expand,CHMfactor-method} %\alias{solve,CHMfactor,...}%--> solve-methods.Rd \alias{determinant,CHMfactor,missing-method} \alias{determinant,CHMfactor,logical-method} \alias{update,CHMfactor-method} \alias{.updateCHMfactor} % \description{The virtual class \code{"CHMfactor"} is a class of CHOLMOD-based Cholesky factorizations of symmetric, sparse, compressed, column-oriented matrices. Such a factorization is simplicial (virtual class \code{"CHMsimpl"}) or supernodal (virtual class \code{"CHMsuper"}). Objects that inherit from these classes are either numeric factorizations (classes \code{"dCHMsimpl"} and \code{"dCHMsuper"}) or symbolic factorizations (classes \code{"nCHMsimpl"} and \code{"nCHMsuper"}). } \usage{% want usage for the update method which has "surprising arguments" isLDL(x) \S4method{update}{CHMfactor}(object, parent, mult = 0, \dots) .updateCHMfactor(object, parent, mult)% otherwise don't mention; for experts ## and many more methods, notably, ## solve(a, b, system = c("A","LDLt","LD","DLt","L","Lt","D","P","Pt"), ...) ## ----- see below } \arguments{ \item{x,object,a}{a \code{"CHMfactor"} object (almost always the result of \code{\link{Cholesky}()}).} \item{parent}{a \code{"\linkS4class{dsCMatrix}"} or \code{"\linkS4class{dgCMatrix}"} matrix object with the same nonzero pattern as the matrix that generated \code{object}. If \code{parent} is symmetric, of class \code{"\linkS4class{dsCMatrix}"}, then \code{object} should be a decomposition of a matrix with the same nonzero pattern as \code{parent}. If \code{parent} is not symmetric then \code{object} should be the decomposition of a matrix with the same nonzero pattern as \code{tcrossprod(parent)}. Since Matrix version 1.0-8, other \code{"\linkS4class{sparseMatrix}"} matrices are coerced to \code{\linkS4class{dsparseMatrix}} and \code{\linkS4class{CsparseMatrix}} if needed.} \item{mult}{a numeric scalar (default 0). \code{mult} times the identity matrix is (implicitly) added to \code{parent} or \code{tcrossprod(parent)} before updating the decomposition \code{object}.} \item{\dots}{potentially further arguments to the methods.} } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("dCHMsuper", ...)} but are more commonly created via \code{\link{Cholesky}()}, applied to \code{\linkS4class{dsCMatrix}} or \code{\linkS4class{lsCMatrix}} objects. For an introduction, it may be helpful to look at the \code{expand()} method and examples below. } \section{Slots}{ of \code{"CHMfactor"} and all classes inheriting from it: \describe{ \item{\code{perm}:}{An integer vector giving the 0-based permutation of the rows and columns chosen to reduce fill-in and for post-ordering.} \item{\code{colcount}:}{Object of class \code{"integer"} .... }%% FIXME \item{\code{type}:}{Object of class \code{"integer"} .... } } Slots of the non virtual classes \dQuote{[dl]CHM(super|simpl)}: \describe{ \item{\code{p}:}{Object of class \code{"integer"} of pointers, one for each column, to the initial (zero-based) index of elements in the column. Only present in classes that contain \code{"CHMsimpl"}.} \item{\code{i}:}{Object of class \code{"integer"} of length nnzero (number of non-zero elements). These are the row numbers for each non-zero element in the matrix. Only present in classes that contain \code{"CHMsimpl"}.} \item{\code{x}:}{For the \code{"d*"} classes: \code{"numeric"} - the non-zero elements of the matrix.} } } \section{Methods}{ \describe{ \item{isLDL}{\code{(x)} returns a \code{\link{logical}} indicating if \code{x} is an \eqn{LDL'} decomposition or (when \code{FALSE}) an \eqn{LL'} one.} \item{coerce}{\code{signature(from = "CHMfactor", to = "sparseMatrix")} (or equivalently, \code{to = "Matrix"} or \code{to = "triangularMatrix"}) \code{as(*, "sparseMatrix")} returns the lower triangular factor \eqn{L} from the \eqn{LL'} form of the Cholesky factorization. Note that (currently) the factor from the \eqn{LL'} form is always returned, even if the \code{"CHMfactor"} object represents an \eqn{LDL'} decomposition. Furthermore, this is the factor after any fill-reducing permutation has been applied. See the \code{expand} method for obtaining both the permutation matrix, \eqn{P}, and the lower Cholesky factor, \eqn{L}.} \item{coerce}{\code{signature(from = "CHMfactor", to = "pMatrix")} returns the permutation matrix \eqn{P}, representing the fill-reducing permutation used in the decomposition.} \item{expand}{\code{signature(x = "CHMfactor")} returns a list with components \code{P}, the matrix representing the fill-reducing permutation, and \code{L}, the lower triangular Cholesky factor. The original positive-definite matrix \eqn{A} corresponds to the product \eqn{A = P'LL'P}. Because of fill-in during the decomposition the product may apparently have more non-zeros than the original matrix, even after applying \code{\link{drop0}} to it. However, the extra "non-zeros" should be very small in magnitude.} \item{image}{\code{signature(x = "CHMfactor"):} Plot the image of the lower triangular factor, \eqn{L}, from the decomposition. This method is equivalent to \code{image(as(x, "sparseMatrix"))} so the comments in the above description of the \code{coerce} method apply here too.} \item{solve}{\code{signature(a = "CHMfactor", b = "ddenseMatrix"), system= *}: %% This is copy-paste from solve-methods.Rd {FIXME ?} The \code{solve} methods for a \code{"CHMfactor"} object take an optional third argument \code{system} whose value can be one of the character strings \code{"A"}, \code{"LDLt"}, \code{"LD"}, \code{"DLt"}, \code{"L"}, \code{"Lt"}, \code{"D"}, \code{"P"} or \code{"Pt"}. This argument describes the system to be solved. The default, \code{"A"}, is to solve \eqn{Ax = b} for \eqn{x} where \code{A} is the sparse, positive-definite matrix that was factored to produce \code{a}. Analogously, \code{system = "L"} returns the solution \eqn{x}, of \eqn{Lx = b}. Similarly, for all system codes \bold{but} \code{"P"} and \code{"Pt"} where, e.g., \code{x <- solve(a, b, system="P")} is equivalent to \code{x <- P \%*\% b}. See also \code{\link{solve-methods}}. } \item{determinant}{\code{signature(x = "CHMfactor", logarithm = "logical")} returns the determinant (or the logarithm of the determinant, if \code{logarithm = TRUE}, the default) of the factor \eqn{L} from the \eqn{LL'} decomposition (even if the decomposition represented by \code{x} is of the \eqn{LDL'} form (!)). This is the square root of the determinant (half the logarithm of the determinant when \code{logarithm = TRUE}) of the positive-definite matrix that was decomposed.} %% since 0.999375-8 (2008-03-25): \item{update}{\code{signature(object = "CHMfactor"), parent}. The \code{\link{update}} method requires an additional argument \code{parent}, which is \emph{either} a \code{"\linkS4class{dsCMatrix}"} object, say \eqn{A}, (with the same structure of nonzeros as the matrix that was decomposed to produce \code{object}) or a general \code{"\linkS4class{dgCMatrix}"}, say \eqn{M}, where \eqn{A := M M'} (\code{== tcrossprod(parent)}) is used for \eqn{A}. Further it provides an optional argument \code{mult}, a numeric scalar. This method updates the numeric values in \code{object} to the decomposition of \eqn{A+mI} where \eqn{A} is the matrix above (either the \code{parent} or \eqn{M M'}) and \eqn{m} is the scalar \code{mult}. Because only the numeric values are updated this method should be faster than creating and decomposing \eqn{A+mI}. It is not uncommon to want, say, the determinant of \eqn{A+mI} for many different values of \eqn{m}. This method would be the preferred approach in such cases.} } } %\references{} %\author{} %\note{} \seealso{ \code{\link{Cholesky}}, also for examples; class \code{\linkS4class{dgCMatrix}}. } \examples{% most are in ./Cholesky.Rd ## An example for the expand() method n <- 1000; m <- 200; nnz <- 2000 set.seed(1) M1 <- spMatrix(n, m, i = sample(n, nnz, replace = TRUE), j = sample(m, nnz, replace = TRUE), x = round(rnorm(nnz),1)) XX <- crossprod(M1) ## = M1'M1 = M M' where M <- t(M1) CX <- Cholesky(XX) isLDL(CX) str(CX) ## a "dCHMsimpl" object r <- expand(CX) L.P <- with(r, crossprod(L,P)) ## == L'P PLLP <- crossprod(L.P) ## == (L'P)' L'P == P'LL'P = XX = M M' b <- sample(m) stopifnot(all.equal(PLLP, XX), % not needed: factorsCheck is off: check.attributes=FALSE), all(as.vector(solve(CX, b, system="P" )) == r$P \%*\% b), all(as.vector(solve(CX, b, system="Pt")) == t(r$P) \%*\% b) ) u1 <- update(CX, XX, mult=pi) u2 <- update(CX, t(M1), mult=pi) # with the original M, where XX = M M' stopifnot(all.equal(u1,u2, tol=1e-14)) ## [ See help(Cholesky) for more examples ] ## ------------- } \keyword{classes} \keyword{algebra} Matrix/man/graph2T.Rd0000644000176200001440000000735612622365126014107 0ustar liggesusers\name{graph-sparseMatrix} \title{Conversions "graph" <--> (sparse) Matrix} \alias{graph2T} \alias{T2graph} % graph stuff \alias{coerce,graph,Matrix-method} \alias{coerce,graph,sparseMatrix-method} \alias{coerce,graph,CsparseMatrix-method} \alias{coerce,graphAM,sparseMatrix-method} \alias{coerce,graphNEL,CsparseMatrix-method} \alias{coerce,graphNEL,TsparseMatrix-method} \alias{coerce,sparseMatrix,graph-method} \alias{coerce,sparseMatrix,graphNEL-method} \alias{coerce,TsparseMatrix,graphNEL-method} \alias{coerce,dgTMatrix,graphNEL-method} \description{ The \pkg{Matrix} package has supported conversion from and to \code{"\link[graph:graph-class]{graph}"} objects from (Bioconductor) package \pkg{graph} since summer 2005, via the usual \code{\link{as}(., "")} coercion, \preformatted{ as(from, Class) }%pre Since 2013, this functionality is further exposed as the \code{graph2T()} and \code{T2graph()} functions (with further arguments than just \code{from}), which convert graphs to and from the triplet form of sparse matrices (of class \code{"\linkS4class{TsparseMatrix}"}) . } \usage{ graph2T(from, use.weights = ) T2graph(from, need.uniq = is_not_uniqT(from), edgemode = NULL) } \arguments{ \item{from}{for \code{graph2T()}, an \R object of class \code{"graph"}; \cr for \code{T2graph()}, a sparse matrix inheriting from \code{"\linkS4class{TsparseMatrix}"}.} \item{use.weights}{logical indicating if weights should be used, i.e., equivalently the result will be numeric, i.e. of class \code{\linkS4class{dgTMatrix}}; otherwise the result will be \code{\linkS4class{ngTMatrix}} or \code{\linkS4class{nsTMatrix}}, the latter if the graph is undirected. The default looks if there are weights in the graph, and if any differ from \code{1}, weights are used.} \item{need.uniq}{a logical indicating if \code{from} may need to be internally \dQuote{uniqified}; do not set this and hence rather use the default, unless you know what you are doing!} \item{edgemode}{one of \code{NULL}, \code{"directed"}, or \code{"undirected"}. The default \code{NULL} looks if the matrix is symmetric and assumes \code{"undirected"} in that case.} } \value{ For \code{graph2T()}, a sparse matrix inheriting from \code{"\linkS4class{TsparseMatrix}"}. For \code{T2graph()} an \R object of class \code{"graph"}. } \seealso{ Note that the CRAN package \pkg{igraph} also provides conversions from and to sparse matrices (of package \pkg{Matrix}) via its \code{\link[igraph]{graph.adjacency}()} and \code{\link[igraph]{get.adjacency}()}. } \examples{ if(isTRUE(try(require(graph)))) { ## super careful .. for "checking reasons" n4 <- LETTERS[1:4]; dns <- list(n4,n4) show(a1 <- sparseMatrix(i= c(1:4), j=c(2:4,1), x = 2, dimnames=dns)) show(g1 <- as(a1, "graph")) # directed unlist(edgeWeights(g1)) # all '2' show(a2 <- sparseMatrix(i= c(1:4,4), j=c(2:4,1:2), x = TRUE, dimnames=dns)) show(g2 <- as(a2, "graph")) # directed # now if you want it undirected: show(g3 <- T2graph(as(a2,"TsparseMatrix"), edgemode="undirected")) show(m3 <- as(g3,"Matrix")) show( graph2T(g3) ) # a "pattern Matrix" (nsTMatrix) \dontshow{ stopifnot( identical(as(g3,"Matrix"), as(as(a2 + t(a2), "nMatrix"),"symmetricMatrix")) , identical(tg3 <- graph2T(g3), graph2T(g3, use.weights=FALSE)) , identical(as(m3,"TsparseMatrix"), uniqTsparse(tg3)) ) } a. <- sparseMatrix(i= 4:1, j=1:4, dimnames=list(n4,n4), giveC=FALSE) # no 'x' show(a.) # "ngTMatrix" show(g. <- as(a., "graph")) \dontshow{ stopifnot(edgemode(g.) == "undirected", numEdges(g.) == 2, all.equal(as(g., "TsparseMatrix"), as(a., "symmetricMatrix")) ) } }% only if( graph ) } \keyword{graph} \keyword{utilities} Matrix/man/sparse.model.matrix.Rd0000644000176200001440000001460413711014657016471 0ustar liggesusers\name{sparse.model.matrix} \title{Construct Sparse Design / Model Matrices} \alias{sparse.model.matrix} \alias{fac2sparse} \alias{fac2Sparse} \description{Construct a sparse model or \dQuote{design} matrix, from a formula and data frame (\code{sparse.model.matrix}) or a single factor (\code{fac2sparse}). The \code{fac2[Ss]parse()} functions are utilities, also used internally in the principal user level function \code{sparse.model.matrix()}. } \usage{ sparse.model.matrix(object, data = environment(object), contrasts.arg = NULL, xlev = NULL, transpose = FALSE, drop.unused.levels = FALSE, row.names = TRUE, sep = "", verbose = FALSE, \dots) fac2sparse(from, to = c("d", "i", "l", "n", "z"), drop.unused.levels = TRUE, repr = c("C","T","R"), giveCsparse) fac2Sparse(from, to = c("d", "i", "l", "n", "z"), drop.unused.levels = TRUE, repr = c("C","T","R"), giveCsparse, factorPatt12, contrasts.arg = NULL) } \arguments{ \item{object}{an object of an appropriate class. For the default method, a model formula or terms object.} \item{data}{a data frame created with \code{\link{model.frame}}. If another sort of object, \code{model.frame} is called first.} \item{contrasts.arg}{\describe{ \item{for \code{sparse.model.matrix()}:}{A list, whose entries are contrasts suitable for input to the \code{\link{contrasts}} replacement function and whose names are the names of columns of \code{data} containing \code{\link{factor}}s.} \item{for \code{fac2Sparse()}:}{character string or \code{NULL} or (coercable to) \code{"\linkS4class{sparseMatrix}"}, specifying the contrasts to be applied to the factor levels.} }} \item{xlev}{to be used as argument of \code{\link{model.frame}} if \code{data} has no \code{"terms"} attribute.} \item{transpose}{logical indicating if the \emph{transpose} should be returned; if the transposed is used anyway, setting \code{transpose = TRUE} is more efficient.} \item{drop.unused.levels}{should factors have unused levels dropped? The default for \code{sparse.model.matrix} has been changed to \code{FALSE}, 2010-07, for compatibility with \R's standard (dense) \code{\link{model.matrix}()}.} \item{row.names}{logical indicating if row names should be used.} \item{sep}{\code{\link{character}} string passed to \code{\link{paste}()} when constructing column names from the variable name and its levels.} \item{verbose}{logical or integer indicating if (and how much) progress output should be printed.} \item{\dots}{further arguments passed to or from other methods.} \item{from}{(for \code{fac2sparse()}:) a \code{\link{factor}}.} \item{to}{a character indicating the \dQuote{kind} of sparse matrix to be returned. The default, \code{"d"} is for \code{\link{double}}.} \item{giveCsparse}{\bold{deprecated}, replaced with \code{repr}; logical indicating if the result must be a \code{\linkS4class{CsparseMatrix}}.} \item{repr}{\code{\link{character}} string, one of \code{"C"}, \code{"T"}, or \code{"R"}, specifying the sparse \emph{repr}esentation to be used for the result, i.e., one from the super classes \code{\linkS4class{CsparseMatrix}}, \code{\linkS4class{TsparseMatrix}}, or \code{\linkS4class{RsparseMatrix}}.} \item{factorPatt12}{logical vector, say \code{fp}, of length two; when \code{fp[1]} is true, return \dQuote{contrasted} \code{t(X)}; when \code{fp[2]} is true, the original (\dQuote{dummy}) \code{t(X)}, i.e, the result of \code{\link{fac2sparse}()}.} } \value{ a sparse matrix, extending \code{\linkS4class{CsparseMatrix}} (for \code{fac2sparse()} if \code{repr = "C"} as per default; a \code{\linkS4class{TsparseMatrix}} or \code{\linkS4class{RsparseMatrix}}, otherwise). For \code{fac2Sparse()}, a \code{\link{list}} of length two, both components with the corresponding transposed model matrix, where the corresponding \code{factorPatt12} is true. Note that \code{\link[MatrixModels]{model.Matrix}(*, sparse=TRUE)} from package \pkg{MatrixModels} may be often be preferable to \code{sparse.model.matrix()} nowadays, as \code{model.Matrix()} returns \code{\link[MatrixModels:modelMatrix-class]{modelMatrix}} objects with additional slots \code{assign} and \code{contrasts} which relate back to the variables used. \code{fac2sparse()}, the basic workhorse of \code{sparse.model.matrix()}, returns the \emph{transpose} (\code{\link{t}}) of the model matrix. } \author{Doug Bates and Martin Maechler, with initial suggestions from Tim Hesterberg. } \seealso{ \code{\link{model.matrix}} in standard \R's package \pkg{stats}.\cr \code{\link[MatrixModels]{model.Matrix}} which calls \code{sparse.model.matrix} or \code{model.matrix} depending on its \code{sparse} argument may be preferred to \code{sparse.model.matrix}. \code{as(f, "sparseMatrix")} (see \code{coerce(from = "factor", ..)} in the class doc \linkS4class{sparseMatrix}) produces the \emph{transposed} sparse model matrix for a single factor \code{f} (and \emph{no} contrasts). } \examples{ dd <- data.frame(a = gl(3,4), b = gl(4,1,12))# balanced 2-way options("contrasts") # the default: "contr.treatment" sparse.model.matrix(~ a + b, dd) sparse.model.matrix(~ -1+ a + b, dd)# no intercept --> even sparser sparse.model.matrix(~ a + b, dd, contrasts = list(a="contr.sum")) sparse.model.matrix(~ a + b, dd, contrasts = list(b="contr.SAS")) ## Sparse method is equivalent to the traditional one : stopifnot(all(sparse.model.matrix(~ a + b, dd) == Matrix(model.matrix(~ a + b, dd), sparse=TRUE)), all(sparse.model.matrix(~ 0+ a + b, dd) == Matrix(model.matrix(~ 0+ a + b, dd), sparse=TRUE))) %% many more and tougher examples ---> ../tests/spModel.matrix.R (ff <- gl(3,4,, c("X","Y", "Z"))) fac2sparse(ff) # 3 x 12 sparse Matrix of class "dgCMatrix" ## ## X 1 1 1 1 . . . . . . . . ## Y . . . . 1 1 1 1 . . . . ## Z . . . . . . . . 1 1 1 1 ## can also be computed via sparse.model.matrix(): f30 <- gl(3,0 ) f12 <- gl(3,0, 12) stopifnot( all.equal(t( fac2sparse(ff) ), sparse.model.matrix(~ 0+ff), tolerance = 0, check.attributes=FALSE), is(M <- fac2sparse(f30, drop= TRUE),"CsparseMatrix"), dim(M) == c(0, 0), is(M <- fac2sparse(f30, drop=FALSE),"CsparseMatrix"), dim(M) == c(3, 0), is(M <- fac2sparse(f12, drop= TRUE),"CsparseMatrix"), dim(M) == c(0,12), is(M <- fac2sparse(f12, drop=FALSE),"CsparseMatrix"), dim(M) == c(3,12) ) } \keyword{models} Matrix/man/dgTMatrix-class.Rd0000644000176200001440000001046013711014657015574 0ustar liggesusers\name{dgTMatrix-class} \title{Sparse matrices in triplet form} \docType{class} \alias{dgTMatrix-class} \alias{+,dgTMatrix,dgTMatrix-method} \alias{coerce,dgTMatrix,dgCMatrix-method} \alias{coerce,dgTMatrix,dgeMatrix-method} \alias{coerce,dgTMatrix,matrix-method} \alias{coerce,dgTMatrix,dtCMatrix-method} \alias{coerce,dgTMatrix,dsTMatrix-method} \alias{coerce,dgTMatrix,dtTMatrix-method} \alias{coerce,dgTMatrix,symmetricMatrix-method} \alias{coerce,dgTMatrix,triangularMatrix-method} \alias{coerce,dgeMatrix,dgTMatrix-method} \alias{coerce,matrix,dgTMatrix-method} \description{The \code{"dgTMatrix"} class is the class of sparse matrices stored as (possibly redundant) triplets. The internal representation is not at all unique, contrary to the one for class \code{\linkS4class{dgCMatrix}}. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("dgTMatrix", ...)}, but more typically via \code{as(*, "dgTMatrix")}, \code{\link{spMatrix}()}, or \code{\link{sparseMatrix}(*, repr = "T")}. } \section{Slots}{ \describe{ \item{\code{i}:}{\code{\link{integer}} row indices of non-zero entries \emph{in 0-base}, i.e., must be in \code{0:(nrow(.)-1)}.} \item{\code{j}:}{\code{\link{integer}} column indices of non-zero entries. Must be the same length as slot \code{i} and \emph{0-based} as well, i.e., in \code{0:(ncol(.)-1)}.} \item{\code{x}:}{\code{\link{numeric}} vector - the (non-zero) entry at position \code{(i,j)}. Must be the same length as slot \code{i}. If an index pair occurs more than once, the corresponding values of slot \code{x} are added to form the element of the matrix.} \item{\code{Dim}:}{Object of class \code{"integer"} of length 2 - the dimensions of the matrix.} } } \section{Methods}{ \describe{ \item{+}{\code{signature(e1 = "dgTMatrix", e2 = "dgTMatrix")}} \item{coerce}{\code{signature(from = "dgTMatrix", to = "dgCMatrix")}} \item{coerce}{\code{signature(from = "dgTMatrix", to = "dgeMatrix")}} \item{coerce}{\code{signature(from = "dgTMatrix", to = "matrix")}, and typically coercion methods for more specific signatures, we are not mentioning here. Note that these are not guaranteed to continue to exist, but rather you should use calls like \code{as(x, "CsparseMatrix")}, \code{as(x, "generalMatrix")}, \code{as(x, "dMatrix")}, i.e. coercion to higher level virtual classes.} \item{coerce}{\code{signature(from = "matrix", to = "dgTMatrix")}, (direct coercion from tradition matrix).} \item{image}{\code{signature(x = "dgTMatrix")}: plots an image of \code{x} using the \code{\link[lattice]{levelplot}} function} \item{t}{\code{signature(x = "dgTMatrix")}: returns the transpose of \code{x}} } } %\references{} %\author{} \note{Triplet matrices are a convenient form in which to construct sparse matrices after which they can be coerced to \code{\linkS4class{dgCMatrix}} objects. Note that both \code{new(.)} and \code{\link{spMatrix}} constructors for \code{"dgTMatrix"} (and other \code{"\linkS4class{TsparseMatrix}"} classes) implicitly add \eqn{x_k}'s that belong to identical \eqn{(i_k, j_k)} pairs. However this means that a matrix typically can be stored in more than one possible \code{"\linkS4class{TsparseMatrix}"} representations. Use \code{\link{uniqTsparse}()} in order to ensure uniqueness of the internal representation of such a matrix. } \seealso{ Class \code{\linkS4class{dgCMatrix}} or the superclasses \code{\linkS4class{dsparseMatrix}} and \code{\linkS4class{TsparseMatrix}}; \code{\link{uniqTsparse}}. } \examples{ m <- Matrix(0+1:28, nrow = 4) m[-3,c(2,4:5,7)] <- m[ 3, 1:4] <- m[1:3, 6] <- 0 (mT <- as(m, "dgTMatrix")) str(mT) mT[1,] mT[4, drop = FALSE] stopifnot(identical(mT[lower.tri(mT)], m [lower.tri(m) ])) mT[lower.tri(mT,diag=TRUE)] <- 0 mT ## Triplet representation with repeated (i,j) entries ## *adds* the corresponding x's: T2 <- new("dgTMatrix", i = as.integer(c(1,1,0,3,3)), j = as.integer(c(2,2,4,0,0)), x=10*1:5, Dim=4:5) str(T2) # contains (i,j,x) slots exactly as above, but T2 ## has only three non-zero entries, as for repeated (i,j)'s, ## the corresponding x's are "implicitly" added stopifnot(nnzero(T2) == 3) } \keyword{classes} \keyword{algebra} Matrix/man/diagonalMatrix-class.Rd0000644000176200001440000002705513556074411016645 0ustar liggesusers\name{diagonalMatrix-class} \title{Class "diagonalMatrix" of Diagonal Matrices} \docType{class} \alias{diagonalMatrix-class} % \alias{as.vector,diagonalMatrix-method} \alias{coerce,matrix,diagonalMatrix-method} \alias{coerce,diagonalMatrix,denseMatrix-method} \alias{coerce,diagonalMatrix,generalMatrix-method} \alias{coerce,diagonalMatrix,matrix-method} \alias{coerce,diagonalMatrix,nMatrix-method} \alias{coerce,diagonalMatrix,nsparseMatrix-method} \alias{coerce,Matrix,diagonalMatrix-method} \alias{cbind2,sparseMatrix,diagonalMatrix-method} \alias{cbind2,diagonalMatrix,sparseMatrix-method} \alias{rbind2,sparseMatrix,diagonalMatrix-method} \alias{rbind2,diagonalMatrix,sparseMatrix-method} \alias{determinant,diagonalMatrix,logical-method} \alias{norm,diagonalMatrix,character-method} % \alias{coerce,ddiMatrix,matrix-method} \alias{coerce,ddiMatrix,dgeMatrix-method} \alias{coerce,ddiMatrix,ddenseMatrix-method} \alias{coerce,ldiMatrix,ldenseMatrix-method} % Mainly against ambiguity warnings: % Horrible-Hack: currently define for "all subclasses of diagonalMatrix" % ------------- in ../R/diagMatrix.R \alias{coerce,ddiMatrix,symmetricMatrix-method} \alias{coerce,ldiMatrix,symmetricMatrix-method} \alias{coerce,ddiMatrix,triangularMatrix-method} \alias{coerce,ldiMatrix,triangularMatrix-method} %_no_longer_ \alias{coerce,ddiMatrix,sparseMatrix-method} %_no_longer_ \alias{coerce,ldiMatrix,sparseMatrix-method} \alias{coerce,ddiMatrix,CsparseMatrix-method} \alias{coerce,ldiMatrix,CsparseMatrix-method} \alias{coerce,ddiMatrix,TsparseMatrix-method} \alias{coerce,ddiMatrix,dsparseMatrix-method} \alias{coerce,ldiMatrix,TsparseMatrix-method} \alias{coerce,ldiMatrix,lsparseMatrix-method} % \alias{cbind2,ddiMatrix,matrix-method} \alias{cbind2,ldiMatrix,matrix-method} \alias{cbind2,matrix,ddiMatrix-method} \alias{cbind2,matrix,ldiMatrix-method} \alias{rbind2,ddiMatrix,matrix-method} \alias{rbind2,ldiMatrix,matrix-method} \alias{rbind2,matrix,ddiMatrix-method} \alias{rbind2,matrix,ldiMatrix-method} % \alias{cbind2,ddiMatrix,atomicVector-method} \alias{cbind2,ldiMatrix,atomicVector-method} \alias{cbind2,atomicVector,ddiMatrix-method} \alias{cbind2,atomicVector,ldiMatrix-method} \alias{rbind2,ddiMatrix,atomicVector-method} \alias{rbind2,ldiMatrix,atomicVector-method} \alias{rbind2,atomicVector,ddiMatrix-method} \alias{rbind2,atomicVector,ldiMatrix-method} \alias{diag,diagonalMatrix-method} % \alias{diag,ddiMatrix-method} % \alias{diag,ldiMatrix-method} \alias{which,ldiMatrix-method} % \alias{Math,diagonalMatrix-method}% Math2: handled via "dMatrix" class \alias{log,diagonalMatrix-method} \alias{Ops,diagonalMatrix,triangularMatrix-method} \alias{Ops,ddiMatrix,sparseMatrix-method} \alias{Ops,sparseMatrix,ddiMatrix-method} \alias{Ops,ldiMatrix,sparseMatrix-method} \alias{Ops,sparseMatrix,ldiMatrix-method} \alias{Ops,ddiMatrix,numeric-method} \alias{Ops,numeric,ddiMatrix-method} \alias{Ops,ldiMatrix,numeric-method} \alias{Ops,numeric,ldiMatrix-method} \alias{Ops,ddiMatrix,logical-method} \alias{Ops,logical,ddiMatrix-method} \alias{Ops,ldiMatrix,logical-method} \alias{Ops,logical,ldiMatrix-method} % \alias{Ops,ddiMatrix,ANY-method} \alias{Ops,ANY,ddiMatrix-method} \alias{Ops,ldiMatrix,ANY-method} \alias{Ops,ANY,ldiMatrix-method} \alias{Ops,ddiMatrix,Matrix-method} \alias{Ops,Matrix,ddiMatrix-method} \alias{Ops,ldiMatrix,Matrix-method} \alias{Ops,Matrix,ldiMatrix-method} \alias{Ops,ddiMatrix,dMatrix-method} \alias{Ops,dMatrix,ddiMatrix-method} \alias{Ops,ldiMatrix,dMatrix-method} \alias{Ops,dMatrix,ldiMatrix-method} % \alias{Ops,ddiMatrix,ddiMatrix-method} \alias{Ops,ddiMatrix,ldiMatrix-method} \alias{Ops,ldiMatrix,ddiMatrix-method} \alias{Ops,ldiMatrix,ldiMatrix-method} \alias{Arith,triangularMatrix,diagonalMatrix-method} \alias{Compare,triangularMatrix,diagonalMatrix-method} \alias{Logic,triangularMatrix,diagonalMatrix-method} \alias{Arith,numeric,ddiMatrix-method} \alias{Arith,numeric,ldiMatrix-method} \alias{Arith,ddiMatrix,numeric-method} \alias{Arith,ldiMatrix,numeric-method} \alias{Arith,logical,ddiMatrix-method} \alias{Arith,logical,ldiMatrix-method} \alias{Arith,ddiMatrix,logical-method} \alias{Arith,ldiMatrix,logical-method} \alias{-,ddiMatrix,missing-method} \alias{-,ldiMatrix,missing-method} \alias{all,ddiMatrix-method} \alias{all,ldiMatrix-method} \alias{any,ddiMatrix-method} \alias{any,ldiMatrix-method} \alias{prod,ddiMatrix-method} \alias{prod,ldiMatrix-method} \alias{sum,ddiMatrix-method} \alias{sum,ldiMatrix-method} %%--"hack"-- for all these signatures explicitly (in loop in ../R/diagMatrix.R ): %% <[dln]denseMatrix o [dl]diMatrix : \alias{^,ddenseMatrix,ddiMatrix-method} \alias{^,ddenseMatrix,ldiMatrix-method} \alias{^,ddiMatrix,ddenseMatrix-method} \alias{^,ddiMatrix,ldenseMatrix-method} \alias{^,ddiMatrix,ndenseMatrix-method} \alias{^,ldenseMatrix,ddiMatrix-method} \alias{^,ldenseMatrix,ldiMatrix-method} \alias{^,ldiMatrix,ddenseMatrix-method} \alias{^,ldiMatrix,ldenseMatrix-method} \alias{^,ldiMatrix,ndenseMatrix-method} \alias{^,ndenseMatrix,ddiMatrix-method} \alias{^,ndenseMatrix,ldiMatrix-method} \alias{/,ddiMatrix,ddenseMatrix-method} \alias{/,ddiMatrix,ldenseMatrix-method} \alias{/,ddiMatrix,ndenseMatrix-method} \alias{/,ldiMatrix,ddenseMatrix-method} \alias{/,ldiMatrix,ldenseMatrix-method} \alias{/,ldiMatrix,ndenseMatrix-method} \alias{*,ddenseMatrix,ddiMatrix-method} \alias{*,ddenseMatrix,ldiMatrix-method} \alias{*,ddiMatrix,ddenseMatrix-method} \alias{*,ddiMatrix,ldenseMatrix-method} \alias{*,ddiMatrix,ndenseMatrix-method} \alias{*,ldenseMatrix,ddiMatrix-method} \alias{*,ldenseMatrix,ldiMatrix-method} \alias{*,ldiMatrix,ddenseMatrix-method} \alias{*,ldiMatrix,ldenseMatrix-method} \alias{*,ldiMatrix,ndenseMatrix-method} \alias{*,ndenseMatrix,ddiMatrix-method} \alias{*,ndenseMatrix,ldiMatrix-method} \alias{&,ddenseMatrix,ddiMatrix-method} \alias{&,ddenseMatrix,ldiMatrix-method} \alias{&,ddiMatrix,ddenseMatrix-method} \alias{&,ddiMatrix,ldenseMatrix-method} \alias{&,ddiMatrix,ndenseMatrix-method} \alias{&,ldenseMatrix,ddiMatrix-method} \alias{&,ldenseMatrix,ldiMatrix-method} \alias{&,ldiMatrix,ddenseMatrix-method} \alias{&,ldiMatrix,ldenseMatrix-method} \alias{&,ldiMatrix,ndenseMatrix-method} \alias{&,ndenseMatrix,ddiMatrix-method} \alias{&,ndenseMatrix,ldiMatrix-method} \alias{\%/\%,ddiMatrix,ddenseMatrix-method} \alias{\%/\%,ddiMatrix,ldenseMatrix-method} \alias{\%/\%,ddiMatrix,ndenseMatrix-method} \alias{\%/\%,ldiMatrix,ddenseMatrix-method} \alias{\%/\%,ldiMatrix,ldenseMatrix-method} \alias{\%/\%,ldiMatrix,ndenseMatrix-method} \alias{\%\%,ddiMatrix,ddenseMatrix-method} \alias{\%\%,ddiMatrix,ldenseMatrix-method} \alias{\%\%,ddiMatrix,ndenseMatrix-method} \alias{\%\%,ldiMatrix,ddenseMatrix-method} \alias{\%\%,ldiMatrix,ldenseMatrix-method} \alias{\%\%,ldiMatrix,ndenseMatrix-method} %% Matrix o [dl]diMatrix : \alias{^,Matrix,ddiMatrix-method} \alias{^,Matrix,ldiMatrix-method} \alias{^,ddiMatrix,Matrix-method} \alias{^,ldiMatrix,Matrix-method} \alias{/,ddiMatrix,Matrix-method} \alias{/,ldiMatrix,Matrix-method} \alias{*,Matrix,ddiMatrix-method} \alias{*,Matrix,ldiMatrix-method} \alias{*,ddiMatrix,Matrix-method} \alias{*,ldiMatrix,Matrix-method} \alias{&,Matrix,ddiMatrix-method} \alias{&,Matrix,ldiMatrix-method} \alias{&,ddiMatrix,Matrix-method} \alias{&,ldiMatrix,Matrix-method} \alias{\%/\%,ddiMatrix,Matrix-method} \alias{\%/\%,ldiMatrix,Matrix-method} \alias{\%\%,ddiMatrix,Matrix-method} \alias{\%\%,ldiMatrix,Matrix-method} %> %-end{H.Hack} \alias{Ops,diagonalMatrix,diagonalMatrix-method} \alias{Ops,diagonalMatrix,ddiMatrix-method} \alias{Ops,ddiMatrix,diagonalMatrix-method} \alias{Summary,ddiMatrix-method} \alias{Summary,ldiMatrix-method} % \alias{chol2inv,diagonalMatrix-method} \alias{t,diagonalMatrix-method} \alias{print,diagonalMatrix-method} \alias{show,diagonalMatrix-method} %\alias{solve,...} --> solve-methods.Rd %\alias{\%*%,... } --> matrix-products.Rd \alias{summary,diagonalMatrix-method} \description{ Class "diagonalMatrix" is the virtual class of all diagonal matrices. } \section{Objects from the Class}{A virtual Class: No objects may be created from it.} \section{Slots}{ \describe{ \item{\code{diag}:}{code{"character"} string, either \code{"U"} or \code{"N"}, where \code{"U"} means \sQuote{unit-diagonal}.} \item{\code{Dim}:}{matrix dimension, and} \item{\code{Dimnames}:}{the \code{\link{dimnames}}, a \code{\link{list}}, see the \code{\linkS4class{Matrix}} class description. Typically \code{list(NULL,NULL)} for diagonal matrices.} } } \section{Extends}{ Class \code{"\linkS4class{sparseMatrix}"}, directly. } \section{Methods}{ These are just a subset of the signature for which defined methods. Currently, there are (too) many explicit methods defined in order to ensure efficient methods for diagonal matrices. \describe{ \item{coerce}{\code{signature(from = "matrix", to = "diagonalMatrix")}: ... } \item{coerce}{\code{signature(from = "Matrix", to = "diagonalMatrix")}: ... } \item{coerce}{\code{signature(from = "diagonalMatrix", to = "generalMatrix")}: ... } \item{coerce}{\code{signature(from = "diagonalMatrix", to = "triangularMatrix")}: ... } \item{coerce}{\code{signature(from = "diagonalMatrix", to = "nMatrix")}: ... } \item{coerce}{\code{signature(from = "diagonalMatrix", to = "matrix")}: ... } \item{coerce}{\code{signature(from = "diagonalMatrix", to = "sparseVector")}: ... } \item{t}{\code{signature(x = "diagonalMatrix")}: ... } \cr and many more methods \item{solve}{\code{signature(a = "diagonalMatrix", b, ...)}: is trivially implemented, of course; see also \code{\link{solve-methods}}.} \item{which}{\code{signature(x = "nMatrix")}, semantically equivalent to \pkg{base} function \code{\link{which}(x, arr.ind)}.} \item{"Math"}{\code{signature(x = "diagonalMatrix")}: all these group methods return a \code{"diagonalMatrix"}, apart from \code{\link{cumsum}()} etc which return a \emph{vector} also for \pkg{base} \code{\link{matrix}}.} \item{*}{\code{signature(e1 = "ddiMatrix", e2="denseMatrix")}: arithmetic and other operators from the \code{\link[=S4groupGeneric]{Ops}} group have a few dozen explicit method definitions, in order to keep the results \emph{diagonal} in many cases, including the following:} \item{/}{\code{signature(e1 = "ddiMatrix", e2="denseMatrix")}: the result is from class \code{\linkS4class{ddiMatrix}} which is typically very desirable. Note that when \code{e2} contains off-diagonal zeros or \code{\link{NA}}s, we implicitly use \eqn{0 / x = 0}, hence differing from traditional \R arithmetic (where \eqn{0 / 0 \mapsto \mbox{NaN}}{0/0 |-> NaN}), in order to preserve sparsity.} \item{summary}{\code{(object = "diagonalMatrix")}: Returns an object of S3 class \code{"diagSummary"} which is the summary of the vector \code{object@x} plus a simple heading, and an appropriate \code{\link{print}} method.} } } \seealso{ \code{\link{Diagonal}()} as constructor of these matrices, and \code{\link{isDiagonal}}. \code{\linkS4class{ddiMatrix}} and \code{\linkS4class{ldiMatrix}} are \dQuote{actual} classes extending \code{"diagonalMatrix"}. } \examples{ I5 <- Diagonal(5) D5 <- Diagonal(x = 10*(1:5)) ## trivial (but explicitly defined) methods: stopifnot(identical(crossprod(I5), I5), identical(tcrossprod(I5), I5), identical(crossprod(I5, D5), D5), identical(tcrossprod(D5, I5), D5), identical(solve(D5), solve(D5, I5)), all.equal(D5, solve(solve(D5)), tolerance = 1e-12) ) solve(D5)# efficient as is diagonal # an unusual way to construct a band matrix: rbind2(cbind2(I5, D5), cbind2(D5, I5)) } \keyword{classes} Matrix/man/dgeMatrix-class.Rd0000644000176200001440000001157413556074411015625 0ustar liggesusers\name{dgeMatrix-class} \title{Class "dgeMatrix" of Dense Numeric (S4 Class) Matrices} \docType{class} \alias{dgeMatrix-class} % METHODS: %\alias{solve,....-method}--> solve-methods.Rd %\alias{\%*\%,....-method} --> matrix-products.Rd %\alias{crossprod,...-method}--> matrix-products.Rd %\alias{tcrossprod,..-method}--> " " % Group ones \alias{Arith,dgeMatrix,dgeMatrix-method} \alias{Arith,dgeMatrix,logical-method} \alias{Arith,dgeMatrix,numeric-method} \alias{Arith,logical,dgeMatrix-method} \alias{Arith,numeric,dgeMatrix-method} \alias{Math,dgeMatrix-method} \alias{log,dgeMatrix-method} %\alias{Math2,dgeMatrix,numeric-method} % Others % \alias{as.vector,dgeMatrix-method} \alias{coerce,dgeMatrix,matrix-method} \alias{coerce,dgeMatrix,triangularMatrix-method} \alias{coerce,dgeMatrix,lgeMatrix-method} \alias{coerce,numLike,dgeMatrix-method} \alias{coerce,matrix,dgeMatrix-method} \alias{colMeans,dgeMatrix-method} \alias{colSums,dgeMatrix-method} \alias{determinant,dgeMatrix,logical-method} \alias{determinant,dgeMatrix,missing-method} \alias{diag,dgeMatrix-method} \alias{diag<-,dgeMatrix-method} \alias{dim,dgeMatrix-method} \alias{dimnames,dgeMatrix-method} \alias{eigen,dgeMatrix,missing-method} \alias{eigen,dgeMatrix,logical-method} \alias{eigen,Matrix,ANY,missing-method}% only if(.Matrix.avoiding.as.matrix) \alias{eigen,Matrix,ANY,logical-method}% only if(.Matrix.avoiding.as.matrix) \alias{norm,dgeMatrix,missing-method} \alias{norm,dgeMatrix,character-method} \alias{rcond,dgeMatrix,missing-method} \alias{rcond,dgeMatrix,character-method} \alias{rowMeans,dgeMatrix-method} \alias{rowSums,dgeMatrix-method} \alias{t,dgeMatrix-method} % \description{A general numeric dense matrix in the S4 Matrix representation. \code{dgeMatrix} is the \emph{\dQuote{standard}} class for dense numeric matrices in the \pkg{Matrix} package. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("dgeMatrix", ...)} or, more commonly, by coercion from the \code{Matrix} class (see \linkS4class{Matrix}) or by \code{\link{Matrix}(..)}. } \section{Slots}{ \describe{ \item{\code{x}:}{Object of class \code{"numeric"} - the numeric values contained in the matrix, in column-major order.} \item{\code{Dim}:}{Object of class \code{"integer"} - the dimensions of the matrix - must be an integer vector with exactly two non-negative values.} \item{\code{Dimnames}:}{a list of length two - inherited from class \code{\linkS4class{Matrix}}.} \item{\code{factors}:}{Object of class \code{"list"} - a list of factorizations of the matrix.} } } \section{Methods}{ The are group methods (see, e.g., \code{\link{Arith}}) \describe{ \item{Arith}{\code{signature(e1 = "dgeMatrix", e2 = "dgeMatrix")}: ... } \item{Arith}{\code{signature(e1 = "dgeMatrix", e2 = "numeric")}: ... } \item{Arith}{\code{signature(e1 = "numeric", e2 = "dgeMatrix")}: ... } \item{Math}{\code{signature(x = "dgeMatrix")}: ... } \item{Math2}{\code{signature(x = "dgeMatrix", digits = "numeric")}: ...} } matrix products \code{\link[=crossprod-methods]{\%*\%}}, \code{\link[=crossprod-methods]{crossprod}()} and \code{tcrossprod()}, several \code{\link{solve}} methods, and other matrix methods available: \describe{ \item{Schur}{\code{signature(x = "dgeMatrix", vectors = "logical")}: ... } \item{Schur}{\code{signature(x = "dgeMatrix", vectors = "missing")}: ... } \item{chol}{\code{signature(x = "dgeMatrix")}: see \code{\link{chol}}.} \item{coerce}{\code{signature(from = "dgeMatrix", to = "lgeMatrix")}: ... } \item{coerce}{\code{signature(from = "dgeMatrix", to = "matrix")}: ... } \item{coerce}{\code{signature(from = "matrix", to = "dgeMatrix")}: ... } \item{colMeans}{\code{signature(x = "dgeMatrix")}: columnwise means (averages)} \item{colSums}{\code{signature(x = "dgeMatrix")}: columnwise sums} \item{diag}{\code{signature(x = "dgeMatrix")}: ... } \item{dim}{\code{signature(x = "dgeMatrix")}: ... } \item{dimnames}{\code{signature(x = "dgeMatrix")}: ... } \item{eigen}{\code{signature(x = "dgeMatrix", only.values= "logical")}: ...} \item{eigen}{\code{signature(x = "dgeMatrix", only.values= "missing")}: ...} \item{norm}{\code{signature(x = "dgeMatrix", type = "character")}: ... } \item{norm}{\code{signature(x = "dgeMatrix", type = "missing")}: ... } \item{rcond}{\code{signature(x = "dgeMatrix", norm = "character")} or \code{norm = "missing"}: the reciprocal condition number, \code{\link{rcond}()}.} \item{rowMeans}{\code{signature(x = "dgeMatrix")}: rowwise means (averages)} \item{rowSums}{\code{signature(x = "dgeMatrix")}: rowwise sums} \item{t}{\code{signature(x = "dgeMatrix")}: matrix transpose} } } \seealso{ Classes \code{\linkS4class{Matrix}}, \code{\linkS4class{dtrMatrix}}, and \code{\linkS4class{dsyMatrix}}. } %\examples{} \keyword{classes} \keyword{algebra} Matrix/man/dpoMatrix-class.Rd0000644000176200001440000001325213253312013015626 0ustar liggesusers\name{dpoMatrix-class} \title{Positive Semi-definite Dense (Packed | Non-packed) Numeric Matrices} \docType{class} \alias{dpoMatrix-class} \alias{dppMatrix-class} \alias{corMatrix-class} % --- \alias{coerce,dpoMatrix,corMatrix-method} \alias{coerce,dpoMatrix,dppMatrix-method} \alias{coerce,dpoMatrix,lMatrix-method} \alias{coerce,dpoMatrix,nMatrix-method} \alias{coerce,dppMatrix,lMatrix-method} \alias{coerce,dppMatrix,nMatrix-method} \alias{coerce,dppMatrix,sparseMatrix-method} \alias{coerce,dppMatrix,CsparseMatrix-method} \alias{coerce,dppMatrix,dpoMatrix-method} \alias{coerce,dspMatrix,dpoMatrix-method} \alias{coerce,dspMatrix,dppMatrix-method} \alias{coerce,matrix,corMatrix-method} \alias{coerce,Matrix,corMatrix-method} \alias{coerce,matrix,dpoMatrix-method} \alias{coerce,Matrix,dpoMatrix-method} \alias{coerce,matrix,dppMatrix-method} \alias{coerce,Matrix,dppMatrix-method} %\alias{coerce,corMatrix,lMatrix-method} \alias{Ops,dpoMatrix,logical-method} \alias{Ops,dpoMatrix,numeric-method} \alias{Ops,dppMatrix,logical-method} \alias{Ops,dppMatrix,numeric-method} \alias{Ops,logical,dpoMatrix-method} \alias{Ops,logical,dppMatrix-method} \alias{Ops,numeric,dpoMatrix-method} \alias{Ops,numeric,dppMatrix-method} \alias{Arith,dpoMatrix,logical-method} \alias{Arith,dpoMatrix,numeric-method} \alias{Arith,dppMatrix,logical-method} \alias{Arith,dppMatrix,numeric-method} \alias{Arith,logical,dpoMatrix-method} \alias{Arith,logical,dppMatrix-method} \alias{Arith,numeric,dpoMatrix-method} \alias{Arith,numeric,dppMatrix-method} % \alias{rcond,dpoMatrix,character-method} \alias{rcond,dppMatrix,character-method} \alias{rcond,dpoMatrix,missing-method} \alias{rcond,dppMatrix,missing-method} \alias{determinant,dpoMatrix,logical-method} \alias{determinant,dppMatrix,logical-method} \alias{determinant,dpoMatrix,missing-method} \alias{determinant,dppMatrix,missing-method} %\alias{solve,dpoMatrix,...-method}--> solve-methods.Rd \alias{t,dppMatrix-method} \description{ \itemize{ \item{The \code{"dpoMatrix"} class is the class of positive-semidefinite symmetric matrices in nonpacked storage.} \item{The \code{"dppMatrix"} class is the same except in packed storage. Only the upper triangle or the lower triangle is required to be available.} \item{The \code{"corMatrix"} class of correlation matrices extends \code{"dpoMatrix"} with a slot \code{sd}, which allows to restore the original covariance matrix.} } } \section{Objects from the Class}{Objects can be created by calls of the form \code{new("dpoMatrix", ...)} or from \code{crossprod} applied to an \code{"dgeMatrix"} object.} \section{Slots}{ \describe{ \item{\code{uplo}:}{Object of class \code{"character"}. Must be either "U", for upper triangular, and "L", for lower triangular.} \item{\code{x}:}{Object of class \code{"numeric"}. The numeric values that constitute the matrix, stored in column-major order.} \item{\code{Dim}:}{Object of class \code{"integer"}. The dimensions of the matrix which must be a two-element vector of non-negative integers.} \item{\code{Dimnames}:}{inherited from class \code{"Matrix"}} \item{\code{factors}:}{Object of class \code{"list"}. A named list of factorizations that have been computed for the matrix.} \item{\code{sd}:}{(for \code{"corMatrix"}) a \code{\link{numeric}} vector of length \code{n} containing the (original) \eqn{\sqrt{var(.)}}{sqrt(var(.))} entries which allow reconstruction of a covariance matrix from the correlation matrix.} } } \section{Extends}{ Class \code{"dsyMatrix"}, directly.\cr Classes \code{"dgeMatrix"}, \code{"symmetricMatrix"}, and many more by class \code{"dsyMatrix"}. } \section{Methods}{ \describe{ \item{chol}{\code{signature(x = "dpoMatrix")}: Returns (and stores) the Cholesky decomposition of \code{x}, see \code{\link{chol}}.} \item{determinant}{\code{signature(x = "dpoMatrix")}: Returns the \code{\link{determinant}} of \code{x}, via \code{chol(x)}, see above.} \item{rcond}{\code{signature(x = "dpoMatrix", norm = "character")}: Returns (and stores) the reciprocal of the condition number of \code{x}. The \code{norm} can be \code{"O"} for the one-norm (the default) or \code{"I"} for the infinity-norm. For symmetric matrices the result does not depend on the norm.} \item{solve}{\code{signature(a = "dpoMatrix", b = "....")}}{, and} \item{solve}{\code{signature(a = "dppMatrix", b = "....")}}{work via the Cholesky composition, see also the Matrix \code{\link{solve-methods}}.} \item{Arith}{\code{signature(e1 = "dpoMatrix", e2 = "numeric")} (and quite a few other signatures): The result of (\dQuote{elementwise} defined) arithmetic operations is typically \emph{not} positive-definite anymore. The only exceptions, currently, are multiplications, divisions or additions with \emph{positive} \code{length(.) == 1} numbers (or \code{\link{logical}}s).} } } %\references{} %\author{} \seealso{ Classes \code{\linkS4class{dsyMatrix}} and \code{\linkS4class{dgeMatrix}}; further, \code{\link{Matrix}}, \code{\link{rcond}}, \code{\link[base]{chol}}, \code{\link[base]{solve}}, \code{\link{crossprod}}. } \examples{ h6 <- Hilbert(6) rcond(h6) str(h6) h6 * 27720 # is ``integer'' solve(h6) str(hp6 <- as(h6, "dppMatrix")) ### Note that as(*, "corMatrix") *scales* the matrix (ch6 <- as(h6, "corMatrix")) stopifnot(all.equal(h6 * 27720, round(27720 * h6), tolerance = 1e-14), all.equal(ch6@sd^(-2), 2*(1:6)-1, tolerance= 1e-12)) chch <- chol(ch6) stopifnot(identical(chch, ch6@factors$Cholesky), all(abs(crossprod(chch) - ch6) < 1e-10)) } \keyword{classes} \keyword{algebra} Matrix/man/abIndex-class.Rd0000644000176200001440000001074212622367447015256 0ustar liggesusers\name{abIndex-class} \title{Class "abIndex" of Abstract Index Vectors} \Rdversion{1.1} \docType{class} % \alias{abIndex-class} % \alias{seqMat-class}% unexported for now % hence, we do not yet mention these further below: \alias{coerce,abIndex,seqMat-method} \alias{coerce,numeric,seqMat-method} \alias{coerce,seqMat,abIndex-method} \alias{coerce,seqMat,numeric-method} % \alias{as.integer,abIndex-method} \alias{as.numeric,abIndex-method} \alias{as.vector,abIndex-method} \alias{[,abIndex,index,ANY,ANY-method} \alias{coerce,logical,abIndex-method} \alias{coerce,numeric,abIndex-method} \alias{coerce,abIndex,integer-method} \alias{coerce,abIndex,numeric-method} \alias{coerce,abIndex,vector-method} \alias{drop,abIndex-method}% not mentioned below {experimental} \alias{length,abIndex-method} \alias{show,abIndex-method} \alias{is.na,abIndex-method} \alias{is.finite,abIndex-method}% not yet mentioned \alias{is.infinite,abIndex-method} % \alias{Ops,numeric,abIndex-method} \alias{Ops,abIndex,abIndex-method} \alias{Ops,abIndex,numeric-method} \alias{Ops,abIndex,ANY-method} \alias{Ops,ANY,abIndex-method} \alias{Arith,abIndex,abIndex-method} \alias{Arith,abIndex,numLike-method}% \alias{Arith,abIndex,numeric-method} \alias{Arith,numLike,abIndex-method}% \alias{Arith,numeric,abIndex-method} % \alias{Summary,abIndex-method} % \description{ The \code{"abIndex"} \code{\link{class}}, short for \dQuote{Abstract Index Vector}, is used for dealing with large index vectors more efficiently, than using integer (or \code{\link{numeric}}) vectors of the kind \code{2:1000000} or \code{c(0:1e5, 1000:1e6)}. Note that the current implementation details are subject to change, and if you consider working with these classes, please contact the package maintainers (\code{packageDescription("Matrix")$Maintainer}). } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("abIndex", ...)}, but more easily and typically either by \code{as(x, "abIndex")} where \code{x} is an integer (valued) vector, or directly by \code{\link{abIseq}()} and combination \code{\link{c}(...)} of such. } \section{Slots}{ \describe{ \item{\code{kind}:}{a \code{\link{character}} string, one of \code{("int32", "double", "rleDiff")}, denoting the internal structure of the abIndex object.} \item{\code{x}:}{Object of class \code{"numLike"}; is used (i.e., not of length \code{0}) only iff the object is \emph{not} compressed, i.e., currently exactly when \code{kind != "rleDiff"}.} \item{\code{rleD}:}{object of class \code{"\linkS4class{rleDiff}"}, used for compression via \code{\link{rle}}.} } } \section{Methods}{ \describe{ \item{as.numeric, as.integer, as.vector}{\code{signature(x = "abIndex")}: ... } \item{[}{\code{signature(x = "abIndex", i = "index", j = "ANY", drop = "ANY")}: ... } \item{coerce}{\code{signature(from = "numeric", to = "abIndex")}: ... } \item{coerce}{\code{signature(from = "abIndex", to = "numeric")}: ... } \item{coerce}{\code{signature(from = "abIndex", to = "integer")}: ... } \item{length}{\code{signature(x = "abIndex")}: ... } \item{Ops}{\code{signature(e1 = "numeric", e2 = "abIndex")}: These and the following arithmetic and logic operations are \bold{not yet implemented}; see \code{\link[methods]{Ops}} for a list of these (S4) group methods.} \item{Ops}{\code{signature(e1 = "abIndex", e2 = "abIndex")}: ... } \item{Ops}{\code{signature(e1 = "abIndex", e2 = "numeric")}: ... } \item{Summary}{\code{signature(x = "abIndex")}: ... } \item{show}{\code{("abIndex")}: simple \code{\link{show}} method, building on \code{show()}.} \item{is.na}{\code{("abIndex")}: works analogously to regular vectors.} \item{is.finite, is.infinite}{\code{("abIndex")}: ditto.} } } \note{ This is currently experimental and not yet used for our own code. Please contact us (\code{packageDescription("Matrix")$Maintainer}), if you plan to make use of this class. Partly builds on ideas and code from Jens Oehlschlaegel, as implemented (around 2008, in the GPL'ed part of) package \pkg{ff}. } %\author{Martin Maechler} \seealso{ \code{\link{rle}} (\pkg{base}) which is used here; \code{\link{numeric}}% ... FIXME } \examples{ showClass("abIndex") ii <- c(-3:40, 20:70) str(ai <- as(ii, "abIndex"))# note ai # -> show() method %% FIXME: add / exchange with ../tests/abIndex-tsts.R stopifnot(identical(-3:20, as(abIseq1(-3,20), "vector"))) } \keyword{classes} Matrix/man/lsparseMatrix-classes.Rd0000644000176200001440000002116313057762217017066 0ustar liggesusers\name{lsparseMatrix-classes} \title{Sparse logical matrices} \docType{class} \alias{lsparseMatrix-class} \alias{lgCMatrix-class} \alias{ltCMatrix-class} \alias{lsCMatrix-class} \alias{lgRMatrix-class} \alias{ltRMatrix-class} \alias{lsRMatrix-class} \alias{lgTMatrix-class} \alias{ltTMatrix-class} \alias{lsTMatrix-class} % Group(like) \alias{Ops,lsparseMatrix,lsparseMatrix-method} \alias{Arith,lsparseMatrix,Matrix-method} \alias{Arith,Matrix,lsparseMatrix-method} \alias{Arith,lgCMatrix,lgCMatrix-method} \alias{Arith,lgTMatrix,lgTMatrix-method} \alias{Compare,lsparseMatrix,lsparseMatrix-method} \alias{Logic,lsparseMatrix,lsparseMatrix-method} \alias{Logic,lgCMatrix,lgCMatrix-method} \alias{Logic,lgTMatrix,lgTMatrix-method} \alias{Logic,lsCMatrix,lsCMatrix-method} \alias{Logic,ltCMatrix,ltCMatrix-method} \alias{-,lsparseMatrix,missing-method} \alias{!,lsparseMatrix-method} % \alias{coerce,lsparseMatrix,matrix-method} \alias{coerce,lsparseMatrix,dsparseMatrix-method} \alias{coerce,lgCMatrix,dgCMatrix-method} \alias{coerce,lgCMatrix,lgTMatrix-method} \alias{coerce,lgCMatrix,lgeMatrix-method} \alias{coerce,lgCMatrix,lsCMatrix-method} \alias{coerce,lgCMatrix,ltCMatrix-method} \alias{coerce,lgCMatrix,matrix-method} \alias{coerce,lgTMatrix,dgTMatrix-method} \alias{coerce,lgTMatrix,lgCMatrix-method} \alias{coerce,lgTMatrix,lgeMatrix-method} \alias{coerce,lgTMatrix,lsCMatrix-method} \alias{coerce,lgTMatrix,triangularMatrix-method} \alias{coerce,lgTMatrix,symmetricMatrix-method} \alias{coerce,lgTMatrix,ltTMatrix-method} \alias{coerce,lgTMatrix,matrix-method} \alias{coerce,lsCMatrix,dgTMatrix-method} \alias{coerce,lsCMatrix,dsCMatrix-method} \alias{coerce,lsCMatrix,generalMatrix-method} \alias{coerce,lsCMatrix,lgCMatrix-method} \alias{coerce,lsCMatrix,lgTMatrix-method} \alias{coerce,lsCMatrix,lsTMatrix-method} \alias{coerce,lsCMatrix,matrix-method} \alias{coerce,lsTMatrix,dsTMatrix-method} \alias{coerce,lsTMatrix,lgCMatrix-method} \alias{coerce,lsTMatrix,lgTMatrix-method} \alias{coerce,lsTMatrix,lsCMatrix-method} \alias{coerce,lsTMatrix,lsyMatrix-method} \alias{coerce,lsTMatrix,matrix-method} \alias{coerce,ltCMatrix,dMatrix-method} \alias{coerce,ltCMatrix,dtCMatrix-method} \alias{coerce,ltCMatrix,lgCMatrix-method} \alias{coerce,ltCMatrix,ltTMatrix-method} \alias{coerce,ltCMatrix,matrix-method} \alias{coerce,ltTMatrix,dtTMatrix-method} \alias{coerce,ltTMatrix,generalMatrix-method} \alias{coerce,ltTMatrix,lgCMatrix-method} \alias{coerce,ltTMatrix,lgTMatrix-method} \alias{coerce,ltTMatrix,ltCMatrix-method} \alias{coerce,ltTMatrix,ltrMatrix-method} \alias{coerce,ltTMatrix,matrix-method} \alias{coerce,matrix,lgCMatrix-method} \alias{coerce,matrix,lgTMatrix-method} \alias{coerce,matrix,lsCMatrix-method} \alias{coerce,matrix,ltCMatrix-method} \alias{coerce,matrix,ltTMatrix-method} % \alias{t,lgCMatrix-method} \alias{t,lgTMatrix-method} \alias{t,lsCMatrix-method} \alias{t,ltCMatrix-method} \alias{t,lsTMatrix-method} \alias{t,ltTMatrix-method} \alias{which,lgTMatrix-method} \alias{which,lsparseMatrix-method} \alias{which,lsTMatrix-method} \alias{which,ltTMatrix-method} % \description{The \code{lsparseMatrix} class is a virtual class of sparse matrices with \code{TRUE}/\code{FALSE} or \code{NA} entries. Only the positions of the elements that are \code{TRUE} are stored. These can be stored in the \dQuote{triplet} form (class \code{\linkS4class{TsparseMatrix}}, subclasses \code{lgTMatrix}, \code{lsTMatrix}, and \code{ltTMatrix}) or in compressed column-oriented form (class \code{\linkS4class{CsparseMatrix}}, subclasses \code{lgCMatrix}, \code{lsCMatrix}, and \code{ltCMatrix}) or--\emph{rarely}--in compressed row-oriented form (class \code{\linkS4class{RsparseMatrix}}, subclasses \code{lgRMatrix}, \code{lsRMatrix}, and \code{ltRMatrix}). The second letter in the name of these non-virtual classes indicates \code{g}eneral, \code{s}ymmetric, or \code{t}riangular. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("lgCMatrix", ...)} and so on. More frequently objects are created by coercion of a numeric sparse matrix to the logical form, e.g. in an expression \code{x != 0}. The logical form is also used in the symbolic analysis phase of an algorithm involving sparse matrices. Such algorithms often involve two phases: a symbolic phase wherein the positions of the non-zeros in the result are determined and a numeric phase wherein the actual results are calculated. During the symbolic phase only the positions of the non-zero elements in any operands are of interest, hence any numeric sparse matrices can be treated as logical sparse matrices. } \details{ Note that triplet stored (\code{\linkS4class{TsparseMatrix}}) matrices such as \code{lgTMatrix} may contain duplicated pairs of indices \eqn{(i,j)} as for the corresponding numeric class \code{\linkS4class{dgTMatrix}} where for such pairs, the corresponding \code{x} slot entries are added. For logical matrices, the \code{x} entries corresponding to duplicated index pairs \eqn{(i,j)} are \dQuote{added} as well if the addition is defined as logical \eqn{or}, i.e., \dQuote{\code{TRUE + TRUE |-> TRUE}} and \dQuote{\code{TRUE + FALSE |-> TRUE}}. Note the use of \code{\link{uniqTsparse}()} for getting an internally unique representation without duplicated \eqn{(i,j)} entries. } \section{Slots}{ \describe{ \item{\code{x}:}{Object of class \code{"logical"}, i.e., either \code{TRUE}, \code{\link{NA}}, or \code{FALSE}.} \item{\code{uplo}:}{Object of class \code{"character"}. Must be either "U", for upper triangular, and "L", for lower triangular. Present in the triangular and symmetric classes but not in the general class.} \item{\code{diag}:}{Object of class \code{"character"}. Must be either \code{"U"}, for unit triangular (diagonal is all ones), or \code{"N"} for non-unit. The implicit diagonal elements are not explicitly stored when \code{diag} is \code{"U"}. Present in the triangular classes only.} \item{\code{p}:}{Object of class \code{"integer"} of pointers, one for each column (row), to the initial (zero-based) index of elements in the column. Present in compressed column-oriented and compressed row-oriented forms only.} \item{\code{i}:}{Object of class \code{"integer"} of length nnzero (number of non-zero elements). These are the row numbers for each TRUE element in the matrix. All other elements are FALSE. Present in triplet and compressed column-oriented forms only.} \item{\code{j}:}{Object of class \code{"integer"} of length nnzero (number of non-zero elements). These are the column numbers for each TRUE element in the matrix. All other elements are FALSE. Present in triplet and compressed row-oriented forms only.} \item{\code{Dim}:}{Object of class \code{"integer"} - the dimensions of the matrix.} } } \section{Methods}{ \describe{ \item{coerce}{\code{signature(from = "dgCMatrix", to = "lgCMatrix")}} \item{t}{\code{signature(x = "lgCMatrix")}: returns the transpose of \code{x}} \item{which}{\code{signature(x = "lsparseMatrix")}, semantically equivalent to \pkg{base} function \code{\link{which}(x, arr.ind)}; for details, see the \code{\linkS4class{lMatrix}} class documentation.} } } \seealso{ the class \code{\linkS4class{dgCMatrix}} and \code{\linkS4class{dgTMatrix}} } \examples{ (m <- Matrix(c(0,0,2:0), 3,5, dimnames=list(LETTERS[1:3],NULL))) (lm <- (m > 1)) # lgC !lm # no longer sparse stopifnot(is(lm,"lsparseMatrix"), identical(!lm, m <= 1)) data(KNex) str(mmG.1 <- (KNex $ mm) > 0.1)# "lgC..." table(mmG.1@x)# however with many ``non-structural zeros'' ## from logical to nz_pattern -- okay when there are no NA's : nmG.1 <- as(mmG.1, "nMatrix") # <<< has "TRUE" also where mmG.1 had FALSE ## from logical to "double" dmG.1 <- as(mmG.1, "dMatrix") # has '0' and back: lmG.1 <- as(dmG.1, "lMatrix") # has no extra FALSE, i.e. drop0() included stopifnot(identical(nmG.1, as((KNex $ mm) != 0,"nMatrix")), validObject(lmG.1), all(lmG.1@x), # same "logical" but lmG.1 has no 'FALSE' in x slot: all(lmG.1 == mmG.1)) class(xnx <- crossprod(nmG.1))# "nsC.." class(xlx <- crossprod(mmG.1))# "dsC.." : numeric is0 <- (xlx == 0) mean(as.vector(is0))# 99.3\% zeros: quite sparse, but table(xlx@x == 0)# more than half of the entries are (non-structural!) 0 stopifnot(isSymmetric(xlx), isSymmetric(xnx), ## compare xnx and xlx : have the *same* non-structural 0s : sapply(slotNames(xnx), function(n) identical(slot(xnx, n), slot(xlx, n)))) } \keyword{classes} \keyword{algebra} Matrix/man/nearPD.Rd0000644000176200001440000002004013506410762013731 0ustar liggesusers\name{nearPD} \alias{nearPD} \title{Nearest Positive Definite Matrix} \description{ Compute the nearest positive definite matrix to an approximate one, typically a correlation or variance-covariance matrix. } \usage{ nearPD(x, corr = FALSE, keepDiag = FALSE, base.matrix = FALSE, do2eigen = TRUE, doSym = FALSE, doDykstra = TRUE, only.values = FALSE, ensureSymmetry = !isSymmetric(x), eig.tol = 1e-06, conv.tol = 1e-07, posd.tol = 1e-08, maxit = 100, conv.norm.type = "I", trace = FALSE) } \arguments{ \item{x}{numeric \eqn{n \times n}{n * n} approximately positive definite matrix, typically an approximation to a correlation or covariance matrix. If \code{x} is not symmetric (and \code{ensureSymmetry} is not false), \code{\link{symmpart}(x)} is used.} \item{corr}{logical indicating if the matrix should be a \emph{correlation} matrix.} \item{keepDiag}{logical, generalizing \code{corr}: if \code{TRUE}, the resulting matrix should have the same diagonal (\code{\link{diag}(x)}) as the input matrix.} \item{base.matrix}{logical indicating if the resulting \code{mat} component should be a \pkg{base} \code{\link{matrix}} or (by default) a \code{\linkS4class{Matrix}} of class \code{\linkS4class{dpoMatrix}}.} \item{do2eigen}{logical indicating if a \code{\link[sfsmisc]{posdefify}()} eigen step should be applied to the result of the Higham algorithm.} \item{doSym}{logical indicating if \code{X <- (X + t(X))/2} should be done, after \code{X <- tcrossprod(Qd, Q)}; some doubt if this is necessary.} \item{doDykstra}{logical indicating if Dykstra's correction should be used; true by default. If false, the algorithm is basically the direct fixpoint iteration \eqn{Y_k = P_U(P_S(Y_{k-1}))}{Y(k) = P_U(P_S(Y(k-1)))}.} \item{only.values}{logical; if \code{TRUE}, the result is just the vector of eigenvalues of the approximating matrix.} \item{ensureSymmetry}{logical; by default, \code{\link{symmpart}(x)} is used whenever \code{\link{isSymmetric}(x)} is not true. The user can explicitly set this to \code{TRUE} or \code{FALSE}, saving the symmetry test. \emph{Beware} however that setting it \code{FALSE} for an \bold{a}symmetric input \code{x}, is typically nonsense!} \item{eig.tol}{defines relative positiveness of eigenvalues compared to largest one, \eqn{\lambda_1}. Eigenvalues \eqn{\lambda_k} are treated as if zero when \eqn{\lambda_k / \lambda_1 \le eig.tol}.} \item{conv.tol}{convergence tolerance for Higham algorithm.} \item{posd.tol}{tolerance for enforcing positive definiteness (in the final \code{posdefify} step when \code{do2eigen} is \code{TRUE}).} \item{maxit}{maximum number of iterations allowed.} \item{conv.norm.type}{convergence norm type (\code{\link{norm}(*, type)}) used for Higham algorithm. The default is \code{"I"} (infinity), for reasons of speed (and back compatibility); using \code{"F"} is more in line with Higham's proposal.} \item{trace}{logical or integer specifying if convergence monitoring should be traced.} } \details{ This implements the algorithm of Higham (2002), and then (if \code{do2eigen} is true) forces positive definiteness using code from \code{\link[sfsmisc]{posdefify}}. The algorithm of Knol and ten Berge (1989) (not implemented here) is more general in that it allows constraints to (1) fix some rows (and columns) of the matrix and (2) force the smallest eigenvalue to have a certain value. Note that setting \code{corr = TRUE} just sets \code{diag(.) <- 1} within the algorithm. Higham (2002) uses Dykstra's correction, but the version by Jens Oehlschlaegel did not use it (accidentally), and still gave reasonable results; this simplification, now only used if \code{doDykstra = FALSE}, was active in \code{nearPD()} up to Matrix version 0.999375-40. } \value{ If \code{only.values = TRUE}, a numeric vector of eigenvalues of the approximating matrix; Otherwise, as by default, an S3 object of \code{\link{class}} \code{"nearPD"}, basically a list with components \item{mat}{a matrix of class \code{\linkS4class{dpoMatrix}}, the computed positive-definite matrix.} \item{eigenvalues}{numeric vector of eigenvalues of \code{mat}.} \item{corr}{logical, just the argument \code{corr}.} \item{normF}{the Frobenius norm (\code{\link{norm}(x-X, "F")}) of the difference between the original and the resulting matrix.} \item{iterations}{number of iterations needed.} \item{converged}{logical indicating if iterations converged.} } \references{%% more in /u/maechler/R/Pkgs/sfsmisc/man/posdefify.Rd Cheng, Sheung Hun and Higham, Nick (1998) A Modified Cholesky Algorithm Based on a Symmetric Indefinite Factorization; \emph{SIAM J. Matrix Anal.\ Appl.}, \bold{19}, 1097--1110. Knol DL, ten Berge JMF (1989) Least-squares approximation of an improper correlation matrix by a proper one. \emph{Psychometrika} \bold{54}, 53--61. Higham, Nick (2002) Computing the nearest correlation matrix - a problem from finance; \emph{IMA Journal of Numerical Analysis} \bold{22}, 329--343. } \author{Jens Oehlschlaegel donated a first version. Subsequent changes by the Matrix package authors. } \seealso{A first version of this (with non-optional \code{corr=TRUE}) has been available as \code{\link[sfsmisc]{nearcor}()}; and more simple versions with a similar purpose \code{\link[sfsmisc]{posdefify}()}, both from package \pkg{sfsmisc}. } \examples{ ## Higham(2002), p.334f - simple example A <- matrix(1, 3,3); A[1,3] <- A[3,1] <- 0 n.A <- nearPD(A, corr=TRUE, do2eigen=FALSE) n.A[c("mat", "normF")] n.A.m <- nearPD(A, corr=TRUE, do2eigen=FALSE, base.matrix=TRUE)$mat stopifnot(exprs = { #=-------------- all.equal(n.A$mat[1,2], 0.760689917) all.equal(n.A$normF, 0.52779033, tolerance=1e-9) all.equal(n.A.m, unname(as.matrix(n.A$mat)), tolerance = 1e-15)# seen rel.d.= 1.46e-16 }) set.seed(27) m <- matrix(round(rnorm(25),2), 5, 5) m <- m + t(m) diag(m) <- pmax(0, diag(m)) + 1 (m <- round(cov2cor(m), 2)) str(near.m <- nearPD(m, trace = TRUE)) round(near.m$mat, 2) norm(m - near.m$mat) # 1.102 / 1.08 if(require("sfsmisc")) { m2 <- posdefify(m) # a simpler approach norm(m - m2) # 1.185, i.e., slightly "less near" } round(nearPD(m, only.values=TRUE), 9) ## A longer example, extended from Jens' original, ## showing the effects of some of the options: pr <- Matrix(c(1, 0.477, 0.644, 0.478, 0.651, 0.826, 0.477, 1, 0.516, 0.233, 0.682, 0.75, 0.644, 0.516, 1, 0.599, 0.581, 0.742, 0.478, 0.233, 0.599, 1, 0.741, 0.8, 0.651, 0.682, 0.581, 0.741, 1, 0.798, 0.826, 0.75, 0.742, 0.8, 0.798, 1), nrow = 6, ncol = 6) nc. <- nearPD(pr, conv.tol = 1e-7) # default nc.$iterations # 2 nc.1 <- nearPD(pr, conv.tol = 1e-7, corr = TRUE) nc.1$iterations # 11 / 12 (!) ncr <- nearPD(pr, conv.tol = 1e-15) str(ncr)# still 2 iterations ncr.1 <- nearPD(pr, conv.tol = 1e-15, corr = TRUE) ncr.1 $ iterations # 27 / 30 ! ncF <- nearPD(pr, conv.tol = 1e-15, conv.norm = "F") stopifnot(all.equal(ncr, ncF))# norm type does not matter at all in this example ## But indeed, the 'corr = TRUE' constraint did ensure a better solution; ## cov2cor() does not just fix it up equivalently : norm(pr - cov2cor(ncr$mat)) # = 0.09994 norm(pr - ncr.1$mat) # = 0.08746 / 0.08805 ### 3) a real data example from a 'systemfit' model (3 eq.): (load(system.file("external", "symW.rda", package="Matrix"))) # "symW" dim(symW) # 24 x 24 class(symW)# "dsCMatrix": sparse symmetric if(dev.interactive()) image(symW) EV <- eigen(symW, only=TRUE)$values summary(EV) ## looking more closely {EV sorted decreasingly}: tail(EV)# all 6 are negative EV2 <- eigen(sWpos <- nearPD(symW)$mat, only=TRUE)$values stopifnot(EV2 > 0) if(require("sfsmisc")) { plot(pmax(1e-3,EV), EV2, type="o", log="xy", xaxt="n",yaxt="n") eaxis(1); eaxis(2) } else plot(pmax(1e-3,EV), EV2, type="o", log="xy") abline(0,1, col="red3",lty=2) } \keyword{algebra} \keyword{array} Matrix/man/unpack.Rd0000644000176200001440000000515311773633512014055 0ustar liggesusers\name{unpack} \title{Representation of Packed and Unpacked (Dense) Matrices} \usage{ pack(x, \dots) \S4method{pack}{matrix}(x, symmetric = NA, upperTri = NA, \dots) unpack(x, \dots) } \alias{pack} \alias{pack,symmetricMatrix-method} \alias{pack,triangularMatrix-method} \alias{pack,matrix-method} \alias{pack,sparseMatrix-method} \alias{unpack} \alias{unpack,dtpMatrix-method} \alias{unpack,dspMatrix-method} \alias{unpack,symmetricMatrix-method} \alias{unpack,triangularMatrix-method} \alias{unpack,sparseMatrix-method} \description{ \dQuote{Packed} matrix storage here applies to dense matrices (\code{\linkS4class{denseMatrix}}) only, and there is available only for symmetric (\code{\linkS4class{symmetricMatrix}}) or triangular (\code{\linkS4class{triangularMatrix}}) matrices, where only one triangle of the matrix needs to be stored. \code{unpack()} unpacks \dQuote{packed} matrices, where \cr \code{pack()} produces \dQuote{packed} matrices. } \arguments{ \item{x}{ \describe{ \item{for \code{unpack()}:}{a matrix stored in packed form, e.g., of class \code{"d?pMatrix"} where "?" is "t" for triangular or "s" for symmetric.} \item{for \code{pack()}:}{a (symmetric or triangular) matrix stored in full storage.} } } \item{symmetric}{logical (including \code{NA}) for optionally specifying if \code{x} is symmetric (or rather triangular).} \item{upperTri}{(for the triangular case only) logical (incl. \code{NA}) indicating if \code{x} is upper (or lower) triangular.} \item{\dots}{further arguments passed to or from other methods.} } \value{ \describe{ \item{for \code{unpack()}:}{A \code{\linkS4class{Matrix}} object containing the full-storage representation of \code{x}.} \item{for \code{pack()}:}{ A packed \code{Matrix} (i.e. of class \code{"..pMatrix"}) representation of \code{x}.} } } \details{ These are generic functions with special methods for different types of packed (or non-packed) symmetric or triangular dense matrices. Use \code{\link{showMethods}("unpack")} to list the methods for \code{unpack()}, and similarly for \code{pack()}. } \examples{ showMethods("unpack") (cp4 <- chol(Hilbert(4))) # is triangular tp4 <- as(cp4,"dtpMatrix")# [t]riangular [p]acked str(tp4) (unpack(tp4)) stopifnot(identical(tp4, pack(unpack(tp4)))) (s <- crossprod(matrix(sample(15), 5,3))) # traditional symmetric matrix (sp <- pack(s)) mt <- as.matrix(tt <- tril(s)) (pt <- pack(mt)) stopifnot(identical(pt, pack(tt)), dim(s ) == dim(sp), all(s == sp), dim(mt) == dim(pt), all(mt == pt), all(mt == tt)) showMethods("pack") } \keyword{array} \keyword{algebra} Matrix/man/symmpart.Rd0000644000176200001440000000461512417245712014447 0ustar liggesusers\name{symmpart} \title{Symmetric Part and Skew(symmetric) Part of a Matrix} %% Hmm, want the generic and methods all in this file ... %% \docType{methods} \alias{symmpart} \alias{skewpart} % \alias{symmpart-methods} \alias{skewpart-methods} \alias{symmpart,Matrix-method} \alias{skewpart,Matrix-method} \alias{symmpart,diagonalMatrix-method} \alias{skewpart,diagonalMatrix-method} \alias{symmpart,ddenseMatrix-method} \alias{skewpart,ddenseMatrix-method} \alias{symmpart,denseMatrix-method} \alias{skewpart,denseMatrix-method} \alias{symmpart,symmetricMatrix-method} \alias{skewpart,symmetricMatrix-method} \alias{symmpart,matrix-method} \alias{skewpart,matrix-method} % \description{ \code{symmpart(x)} computes the symmetric part \code{(x + t(x))/2} and \code{skewpart(x)} the skew symmetric part \code{(x - t(x))/2} of a square matrix \code{x}, more efficiently for specific Matrix classes. Note that \code{x == symmpart(x) + skewpart(x)} for all square matrices -- apart from extraneous \code{\link{NA}} values in the RHS. } \usage{ symmpart(x) skewpart(x) } \arguments{ \item{x}{a \emph{square} matrix; either \dQuote{traditional} of class \code{"matrix"}, or typically, inheriting from the \code{\linkS4class{Matrix}} class.} } \details{ These are generic functions with several methods for different matrix classes, use e.g., \code{\link{showMethods}(symmpart)} to see them. If the row and column names differ, the result will use the column names unless they are (partly) \code{NULL} where the row names are non-\code{NULL} (see also the examples). } \value{ \code{symmpart()} returns a symmetric matrix, inheriting from \code{\linkS4class{symmetricMatrix}} iff \code{x} inherited from \code{Matrix}. \code{skewpart()} returns a skew-symmetric matrix, typically of the same class as \code{x} (or the closest \dQuote{general} one, see \code{\linkS4class{generalMatrix}}). } \seealso{ \code{\link{isSymmetric}}.} \examples{ m <- Matrix(1:4, 2,2) symmpart(m) skewpart(m) stopifnot(all(m == symmpart(m) + skewpart(m))) dn <- dimnames(m) <- list(row = c("r1", "r2"), col = c("var.1", "var.2")) stopifnot(all(m == symmpart(m) + skewpart(m))) colnames(m) <- NULL stopifnot(all(m == symmpart(m) + skewpart(m))) dimnames(m) <- unname(dn) stopifnot(all(m == symmpart(m) + skewpart(m))) ## investigate the current methods: showMethods(skewpart, include = TRUE) } \keyword{array} \keyword{arith} Matrix/man/invPerm.Rd0000644000176200001440000000256412364143216014211 0ustar liggesusers\name{invPerm} \alias{invPerm} \title{Inverse Permutation Vector} \description{ From a permutation vector \code{p}, compute its \emph{inverse} permutation vector. } \usage{ invPerm(p, zero.p = FALSE, zero.res = FALSE) } \arguments{ \item{p}{an integer vector of length, say, \code{n}.} \item{zero.p}{logical indicating if \code{p} contains values \code{0:(n-1)} or rather (by default, \code{zero.p = FALSE}) \code{1:n}.} \item{zero.res}{logical indicating if the result should contain values \code{0:(n-1)} or rather (by default, \code{zero.res = FALSE}) \code{1:n}.} } \value{ an integer vector of the same length (\code{n}) as \code{p}. By default, (\code{zero.p = FALSE, zero.res = FALSE}), \code{invPerm(p)} is the same as \code{\link{order}(p)} or \code{\link{sort.list}(p)} and for that case, the function is equivalent to \code{invPerm. <- function(p) { p[p] <- seq_along(p) ; p }}. } \author{Martin Maechler} \seealso{the class of permutation matrices, \code{\linkS4class{pMatrix}}. } \examples{ p <- sample(10) # a random permutation vector ip <- invPerm(p) p[ip] # == 1:10 ## they are indeed inverse of each other: stopifnot( identical(p[ip], 1:10), identical(ip[p], 1:10), identical(invPerm(ip), p) ) \dontshow{ p3 <- c(3, 1:2) # ('double' instead of integer) stopifnot(identical(invPerm(p3), c(2:3, 1L))) } } \keyword{arithmetic} Matrix/man/dtCMatrix-class.Rd0000644000176200001440000001334613777276322015611 0ustar liggesusers\name{dtCMatrix-class} \title{Triangular, (compressed) sparse column matrices} \docType{class} \alias{dtCMatrix-class}% C and \alias{dtTMatrix-class}% T % \alias{coerce,ddiMatrix,dtCMatrix-method} \alias{coerce,dtCMatrix,dgCMatrix-method} \alias{coerce,dtCMatrix,dgeMatrix-method} \alias{coerce,dtCMatrix,dgTMatrix-method} \alias{coerce,dtCMatrix,dsCMatrix-method} \alias{coerce,dtCMatrix,dtTMatrix-method} \alias{coerce,dtCMatrix,dtrMatrix-method} \alias{coerce,dtCMatrix,ltCMatrix-method} \alias{coerce,dtCMatrix,ntCMatrix-method} \alias{coerce,dtCMatrix,TsparseMatrix-method} \alias{coerce,dtCMatrix,denseMatrix-method} \alias{coerce,dtCMatrix,matrix-method} \alias{coerce,dtTMatrix,dgTMatrix-method} \alias{coerce,dtTMatrix,dgeMatrix-method} \alias{coerce,dtTMatrix,dtCMatrix-method} \alias{coerce,dtTMatrix,dtrMatrix-method} %no longer\alias{coerce,dtTMatrix,ltTMatrix-method} %no longer\alias{coerce,dtTMatrix,ntTMatrix-method} \alias{coerce,dtTMatrix,generalMatrix-method} \alias{coerce,dtTMatrix,matrix-method} \alias{coerce,matrix,dtCMatrix-method} \alias{coerce,matrix,dtTMatrix-method} %% Group methods \alias{Arith,dtCMatrix,dtCMatrix-method} % %\alias{solve,dtCMatrix,...-method}%--> solve-methods.Rd \alias{t,dtCMatrix-method} \alias{t,dtTMatrix-method} \description{The \code{"dtCMatrix"} class is a class of triangular, sparse matrices in the compressed, column-oriented format. In this implementation the non-zero elements in the columns are sorted into increasing row order. The \code{"dtTMatrix"} class is a class of triangular, sparse matrices in triplet format. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("dtCMatrix", ...)} or calls of the form \code{new("dtTMatrix", ...)}, but more typically automatically via \code{\link{Matrix}()} or coercion such as \code{as(x, "triangularMatrix")}, or \code{as(x, "dtCMatrix")}. } \section{Slots}{ \describe{ \item{\code{uplo}:}{Object of class \code{"character"}. Must be either "U", for upper triangular, and "L", for lower triangular.} \item{\code{diag}:}{Object of class \code{"character"}. Must be either \code{"U"}, for unit triangular (diagonal is all ones), or \code{"N"}; see \code{\linkS4class{triangularMatrix}}.} \item{\code{p}:}{(only present in \code{"dtCMatrix"}:) an \code{\link{integer}} vector for providing pointers, one for each column, see the detailed description in \code{\linkS4class{CsparseMatrix}}.} \item{\code{i}:}{Object of class \code{"integer"} of length nnzero (number of non-zero elements). These are the row numbers for each non-zero element in the matrix.} \item{\code{j}:}{Object of class \code{"integer"} of length nnzero (number of non-zero elements). These are the column numbers for each non-zero element in the matrix. (Only present in the \code{dtTMatrix} class.)} \item{\code{x}:}{Object of class \code{"numeric"} - the non-zero elements of the matrix.} \item{\code{Dim},\code{Dimnames}:}{The dimension (a length-2 \code{"integer"}) and corresponding names (or \code{NULL}), inherited from the \code{\linkS4class{Matrix}}, see there.} } } \section{Extends}{ Class \code{"dgCMatrix"}, directly. Class \code{"triangularMatrix"}, directly. Class \code{"dMatrix"}, \code{"sparseMatrix"}, and more by class \code{"dgCMatrix"} etc, see the examples. } \section{Methods}{ \describe{ \item{coerce}{\code{signature(from = "dtCMatrix", to = "dgTMatrix")}} \item{coerce}{\code{signature(from = "dtCMatrix", to = "dgeMatrix")}} \item{coerce}{\code{signature(from = "dtTMatrix", to = "dgeMatrix")}} \item{coerce}{\code{signature(from = "dtTMatrix", to = "dtrMatrix")}} \item{coerce}{\code{signature(from = "dtTMatrix", to = "matrix")}} \item{solve}{\code{signature(a = "dtCMatrix", b = "....")}: sparse triangular solve (aka \dQuote{backsolve} or \dQuote{forwardsolve}), see \code{\link{solve-methods}}.} \item{t}{\code{signature(x = "dtCMatrix")}: returns the transpose of \code{x}} \item{t}{\code{signature(x = "dtTMatrix")}: returns the transpose of \code{x}} } } %\references{} %\author{} %\note{} \seealso{ Classes \code{\linkS4class{dgCMatrix}}, \code{\linkS4class{dgTMatrix}}, \code{\linkS4class{dgeMatrix}}, and \code{\linkS4class{dtrMatrix}}. } \examples{ showClass("dtCMatrix") showClass("dtTMatrix") t1 <- new("dtTMatrix", x= c(3,7), i= 0:1, j=3:2, Dim= as.integer(c(4,4))) t1 ## from 0-diagonal to unit-diagonal {low-level step}: tu <- t1 ; tu@diag <- "U" tu (cu <- as(tu, "dtCMatrix")) str(cu)# only two entries in @i and @x stopifnot(cu@i == 1:0, all(2 * symmpart(cu) == Diagonal(4) + forceSymmetric(cu))) t1[1,2:3] <- -1:-2 diag(t1) <- 10*c(1:2,3:2) t1 # still triangular (it1 <- solve(t1)) t1. <- solve(it1) all(abs(t1 - t1.) < 10 * .Machine$double.eps) ## 2nd example U5 <- new("dtCMatrix", i= c(1L, 0:3), p=c(0L,0L,0:2, 5L), Dim = c(5L, 5L), x = rep(1, 5), diag = "U") U5 (iu <- solve(U5)) # contains one '0' validObject(iu2 <- solve(U5, Diagonal(5)))# failed in earlier versions I5 <- iu \%*\% U5 # should equal the identity matrix i5 <- iu2 \%*\% U5 m53 <- matrix(1:15, 5,3, dimnames=list(NULL,letters[1:3])) asDiag <- function(M) as(drop0(M), "diagonalMatrix") stopifnot( all.equal(Diagonal(5), asDiag(I5), tolerance=1e-14) , all.equal(Diagonal(5), asDiag(i5), tolerance=1e-14) , identical(list(NULL, dimnames(m53)[[2]]), dimnames(solve(U5, m53))) ) \dontshow{% i5. <- I5; colnames(i5.) <- LETTERS[11:15] M53 <- as(m53, "dgeMatrix") stopifnot( identical((dns <- dimnames(solve(i5., M53))), dimnames(solve(as.matrix(i5.), as.matrix(M53)))) , identical(dns, dimnames(solve(i5., as.matrix(M53)))) ) }%dont } \keyword{classes} \keyword{algebra} Matrix/man/abIseq.Rd0000644000176200001440000000360111617257315013774 0ustar liggesusers\name{abIseq} \title{Sequence Generation of "abIndex", Abstract Index Vectors} \Rdversion{1.1} % \alias{abIseq} \alias{abIseq1} \alias{c.abIndex} % \description{ Generation of abstract index vectors, i.e., objects of class \code{"\linkS4class{abIndex}"}. \code{abIseq()} is designed to work entirely like \code{\link{seq}}, but producing \code{"abIndex"} vectors.\cr \code{abIseq1()} is its basic building block, where \code{abIseq1(n,m)} corresponds to \code{n:m}. \code{c(x, ...)} will return an \code{"abIndex"} vector, when \code{x} is one. } \usage{ abIseq1(from = 1, to = 1) abIseq (from = 1, to = 1, by = ((to - from)/(length.out - 1)), length.out = NULL, along.with = NULL) \method{c}{abIndex}(\dots) } \arguments{ \item{from, to}{the starting and (maximal) end value of the sequence.} \item{by}{number: increment of the sequence.} \item{length.out}{desired length of the sequence. A non-negative number, which for \code{seq} and \code{seq.int} will be rounded up if fractional.} \item{along.with}{take the length from the length of this argument.} \item{\dots}{in general an arbitrary number of \R objects; here, when the first is an \code{"\linkS4class{abIndex}"} vector, these arguments will be concatenated to a new \code{"abIndex"} object.} } %\author{Martin Maechler} % \details{ % } \value{ An abstract index vector, i.e., object of class \code{"\linkS4class{abIndex}"}. } % \references{ % %% ~put references to the literature/web site here ~ % } \seealso{ the class \code{\linkS4class{abIndex}} documentation; \code{\link{rep2abI}()} for another constructor; \code{\link{rle}} (\pkg{base}). } \examples{ stopifnot(identical(-3:20, as(abIseq1(-3,20), "vector"))) try( ## (arithmetic) not yet implemented abIseq(1, 50, by = 3) ) %% FIXME: add / exchange with ../tests/abIndex-tsts.R } \keyword{manip} \keyword{classes} Matrix/man/image-methods.Rd0000644000176200001440000001577313764360665015340 0ustar liggesusers\name{image-methods} \title{Methods for image() in Package 'Matrix'} \docType{methods} %\alias{image}% <- needed for \usage{.} \alias{image-methods} \alias{image,ANY-method} \alias{image,CHMfactor-method} \alias{image,Matrix-method} \alias{image,dgRMatrix-method} \alias{image,dgCMatrix-method} \alias{image,dgTMatrix-method} \alias{image,dsparseMatrix-method} \alias{image,lsparseMatrix-method} \alias{image,nsparseMatrix-method} \description{ Methods for function \code{\link[graphics]{image}} in package \pkg{Matrix}. An image of a matrix simply color codes all matrix entries and draws the \eqn{n\times m}{n x m} matrix using an \eqn{n\times m}{n x m} grid of (colored) rectangles. The \pkg{Matrix} package \code{image} methods are based on \code{\link[lattice]{levelplot}()} from package \pkg{lattice}; hence these methods return an \dQuote{object} of class \code{"trellis"}, producing a graphic when (auto-) \code{\link{print}()}ed. } \usage{% want \usage{} since we have many "surprising arguments" \S4method{image}{dgTMatrix}(x, xlim = c(1, di[2]), ylim = c(di[1], 1), aspect = "iso", sub = sprintf("Dimensions: \%d x \%d", di[1], di[2]), xlab = "Column", ylab = "Row", cuts = 15, useRaster = FALSE, useAbs = NULL, colorkey = !useAbs, col.regions = NULL, lwd = NULL, border.col = NULL, \dots) } \arguments{ \item{x}{a Matrix object, i.e., fulfilling \code{\link{is}(x, "Matrix")}.} \item{xlim, ylim}{x- and y-axis limits; may be used to \dQuote{zoom into} matrix. Note that \eqn{x,y} \dQuote{feel reversed}: \code{ylim} is for the rows (= 1st index) and \code{xlim} for the columns (= 2nd index). For convenience, when the limits are integer valued, they are both extended by \code{0.5}; also, \code{ylim} is always used decreasingly.} \item{aspect}{aspect ratio specified as number (y/x) or string; see \code{\link[lattice]{levelplot}}.} \item{sub, xlab, ylab}{axis annotation with sensible defaults; see \code{\link{plot.default}}.} \item{cuts}{number of levels the range of matrix values would be divided into.} \item{useRaster}{logical indicating if raster graphics should be used (instead of the tradition rectangle vector drawing). If true, \code{\link[lattice]{panel.levelplot.raster}} (from \pkg{lattice} package) is used, and the colorkey is also done via rasters, see also \code{\link[lattice]{levelplot}} and possibly \code{\link[grid]{grid.raster}}. Note that using raster graphics may often be faster, but can be slower, depending on the matrix dimensions and the graphics device (dimensions).} \item{useAbs}{logical indicating if \code{\link{abs}(x)} should be shown; if \code{TRUE}, the former (implicit) default, the default \code{col.regions} will be \code{\link{grey}} colors (and no \code{colorkey} drawn). The default is \code{FALSE} unless the matrix has no negative entries.} \item{colorkey}{logical indicating if a color key aka \sQuote{legend} should be produced. Default is to draw one, unless \code{useAbs} is true. You can also specify a \code{\link{list}}, see \code{\link[lattice]{levelplot}}, such as\code{list(raster=TRUE)} in the case of rastering.} \item{col.regions}{vector of gradually varying colors; see \code{\link[lattice]{levelplot}}.} \item{lwd}{(only used when \code{useRaster} is false:) non-negative number or \code{NULL} (default), specifying the line-width of the rectangles of each non-zero matrix entry (drawn by \code{\link[grid]{grid.rect}}). The default depends on the matrix dimension and the device size.} \item{border.col}{color for the border of each rectangle. \code{NA} means no border is drawn. When \code{NULL} as by default, \code{border.col <- if(lwd < .01) NA else NULL} is used. Consider using an opaque color instead of \code{NULL} which corresponds to \code{grid::\link[grid]{get.gpar}("col")}.} \item{\dots}{further arguments passed to methods and \code{\link[lattice]{levelplot}}, notably \code{at} for specifying (possibly non equidistant) cut values for dividing the matrix values (superseding \code{cuts} above).}% FIXME? example *using* at=.. } \section{Methods}{ All methods currently end up calling the method for the \code{\linkS4class{dgTMatrix}} class. Use \code{showMethods(image)} to list them all. } \value{ as all \pkg{lattice} graphics functions, \code{image()} returns a \code{"trellis"} object, effectively the result of \code{\link[lattice]{levelplot}()}. } \seealso{ \code{\link[lattice]{levelplot}}, and \code{\link[lattice]{print.trellis}} from package \pkg{lattice}. } \examples{ showMethods(image) ## If you want to see all the methods' implementations: showMethods(image, incl=TRUE, inherit=FALSE) \dontshow{## warnings should not happen here, notably when print() op <- options(warn = 2) } data(CAex) image(CAex, main = "image(CAex)") image(CAex, useAbs=TRUE, main = "image(CAex, useAbs=TRUE)") cCA <- Cholesky(crossprod(CAex), Imult = .01) ## See ?print.trellis --- place two image() plots side by side: print(image(cCA, main="Cholesky(crossprod(CAex), Imult = .01)"), split=c(x=1,y=1,nx=2, ny=1), more=TRUE) print(image(cCA, useAbs=TRUE), split=c(x=2,y=1,nx=2,ny=1)) data(USCounties) image(USCounties)# huge image(sign(USCounties))## just the pattern # how the result looks, may depend heavily on # the device, screen resolution, antialiasing etc # e.g. x11(type="Xlib") may show very differently than cairo-based ## Drawing borders around each rectangle; # again, viewing depends very much on the device: image(USCounties[1:400,1:200], lwd=.1) ## Using (xlim,ylim) has advantage : matrix dimension and (col/row) indices: image(USCounties, c(1,200), c(1,400), lwd=.1) image(USCounties, c(1,300), c(1,200), lwd=.5 ) image(USCounties, c(1,300), c(1,200), lwd=.01) ## These 3 are all equivalent : (I1 <- image(USCounties, c(1,100), c(1,100), useAbs=FALSE)) I2 <- image(USCounties, c(1,100), c(1,100), useAbs=FALSE, border.col=NA) I3 <- image(USCounties, c(1,100), c(1,100), useAbs=FALSE, lwd=2, border.col=NA) stopifnot(all.equal(I1, I2, check.environment=FALSE), all.equal(I2, I3, check.environment=FALSE)) ## using an opaque border color image(USCounties, c(1,100), c(1,100), useAbs=FALSE, lwd=3, border.col = adjustcolor("skyblue", 1/2)) \dontshow{options(op)} if(doExtras <- interactive() || nzchar(Sys.getenv("R_MATRIX_CHECK_EXTRA")) || identical("true", unname(Sys.getenv("R_PKG_CHECKING_doExtras")))) { ## Using raster graphics: For PDF this would give a 77 MB file, ## however, for such a large matrix, this is typically considerably ## *slower* (than vector graphics rectangles) in most cases : if(doPNG <- !dev.interactive()) png("image-USCounties-raster.png", width=3200, height=3200) image(USCounties, useRaster = TRUE) # should not suffer from anti-aliasing if(doPNG) dev.off() ## and now look at the *.png image in a viewer you can easily zoom in and out }#only if(doExtras) } \keyword{methods} \keyword{hplot} Matrix/man/sparseVector-class.Rd0000644000176200001440000002755313556074411016365 0ustar liggesusers%%----- Docu for *all* sparse vector classes ---------- \name{sparseVector-class} \docType{class} \title{Sparse Vector Classes} \alias{sparseVector-class} % sub classes \alias{dsparseVector-class} \alias{isparseVector-class} \alias{lsparseVector-class} \alias{nsparseVector-class} \alias{zsparseVector-class} \alias{xsparseVector-class}% the class union %% Group methods \alias{Arith,sparseVector,sparseVector-method} \alias{Arith,dsparseVector,dsparseVector-method} \alias{-,dsparseVector,missing-method} \alias{!,sparseVector-method} \alias{Logic,sparseVector,sparseVector-method} \alias{Logic,lsparseVector,lsparseVector-method} \alias{Logic,nsparseVector,nsparseVector-method} \alias{Ops,ANY,sparseVector-method} \alias{Ops,sparseVector,ANY-method} \alias{Ops,sparseVector,sparseVector-method} \alias{Ops,sparseVector,atomicVector-method} \alias{Ops,atomicVector,sparseVector-method} \alias{Ops,Matrix,sparseVector-method} \alias{Ops,sparseVector,Matrix-method} \alias{Arith,ddenseMatrix,sparseVector-method} \alias{Arith,dgeMatrix,sparseVector-method} \alias{Arith,sparseVector,ddenseMatrix-method} \alias{Arith,sparseVector,dgeMatrix-method} \alias{Logic,dMatrix,sparseVector-method} \alias{Logic,lMatrix,sparseVector-method} \alias{Logic,nMatrix,sparseVector-method} \alias{Logic,sparseVector,dMatrix-method} \alias{Logic,sparseVector,lMatrix-method} \alias{Logic,sparseVector,nMatrix-method} \alias{Math,sparseVector-method} \alias{log,sparseVector-method} \alias{Math2,dsparseVector-method}% or (dsparseVector, numeric) & (dsparseVector,missing) ? \alias{Math2,sparseVector-method} \alias{Summary,sparseVector-method} \alias{Summary,nsparseVector-method} %% non-group : %\alias{solve,..} --> solve-methods.Rd %\alias{\%*\%,..} --> matrix-products.Rd \alias{coerce,ANY,sparseVector-method} \alias{coerce,ANY,nsparseVector-method} \alias{coerce,CsparseMatrix,sparseVector-method} \alias{coerce,TsparseMatrix,sparseVector-method} \alias{coerce,sparseMatrix,sparseVector-method} \alias{coerce,diagonalMatrix,sparseVector-method} \alias{coerce,atomicVector,sparseVector-method} \alias{coerce,atomicVector,dsparseVector-method} \alias{coerce,sparseVector,integer-method} \alias{coerce,sparseVector,logical-method} \alias{coerce,sparseVector,numeric-method} \alias{coerce,sparseVector,vector-method} \alias{coerce,sparseVector,Matrix-method} \alias{coerce,sparseVector,sparseMatrix-method} \alias{coerce,sparseVector,CsparseMatrix-method} \alias{coerce,sparseVector,TsparseMatrix-method} \alias{coerce,nsparseVector,lsparseVector-method} \alias{coerce,nsparseVector,dsparseVector-method} \alias{coerce,nsparseVector,isparseVector-method} \alias{coerce,nsparseVector,zsparseVector-method} \alias{coerce,xsparseVector,dsparseVector-method} \alias{coerce,xsparseVector,isparseVector-method} \alias{coerce,xsparseVector,lsparseVector-method} \alias{coerce,xsparseVector,zsparseVector-method} \alias{coerce,xsparseVector,nsparseVector-method} % \alias{as.logical,sparseVector-method} \alias{as.numeric,sparseVector-method} \alias{as.vector,sparseVector-method} \alias{c.sparseVector}% S3 *and* exported functions \alias{dim<-,sparseVector-method} \alias{is.na,nsparseVector-method} \alias{is.na,sparseVector-method} \alias{is.finite,nsparseVector-method} \alias{is.finite,sparseVector-method} \alias{is.infinite,nsparseVector-method} \alias{is.infinite,sparseVector-method} \alias{length,sparseVector-method} \alias{mean,sparseVector-method} \alias{rep,sparseVector-method} \alias{show,sparseVector-method} \alias{t,sparseVector-method} \alias{toeplitz,sparseVector-method} % \alias{head,sparseVector-method} \alias{tail,sparseVector-method} \alias{which,nsparseVector-method} \alias{which,lsparseVector-method} \alias{[,sparseVector,index,ANY,ANY-method} \alias{[,sparseVector,lsparseVector,ANY,ANY-method} \alias{[,sparseVector,nsparseVector,ANY,ANY-method} \alias{[<-,sparseVector,index,missing,replValueSp-method} \alias{[<-,sparseVector,sparseVector,missing,replValueSp-method} % also indexing in "traditional" vectors: %R_FIXME \alias{[<-,atomicVector,sparseVector,missing,replValue-method} %R_FIXME \alias{[,atomicVector,lsparseVector,ANY,ANY-method} %R_FIXME \alias{[,atomicVector,nsparseVector,ANY,ANY-method} % \description{Sparse Vector Classes: The virtual mother class \code{"sparseVector"} has the five actual daughter classes \code{"dsparseVector"}, \code{"isparseVector"}, \code{"lsparseVector"}, \code{"nsparseVector"}, and \code{"zsparseVector"}, where we've mainly implemented methods for the \code{d*}, \code{l*} and \code{n*} ones. } \section{Slots}{ \describe{ \item{\code{length}:}{class \code{"numeric"} - the \code{\link{length}} of the sparse vector. Note that \code{"numeric"} can be considerably larger than the maximal \code{"integer"}, \code{\link{.Machine}$integer.max}, on purpose.} \item{\code{i}:}{class \code{"numeric"} - the (1-based) indices of the non-zero entries. Must \emph{not} be \code{NA} and strictly sorted increasingly. Note that \code{"integer"} is \dQuote{part of} \code{"numeric"}, and can (and often will) be used for non-huge sparseVectors.} \item{\code{x}:}{(for all but \code{"nsparseVector"}): the non-zero entries. This is of class \code{"numeric"} for class \code{"dsparseVector"}, \code{"logical"} for class \code{"lsparseVector"}, etc. Note that \code{"nsparseVector"}s have no \code{x} slot. Further, mainly for ease of method definitions, we've defined the class union (see \code{\link{setClassUnion}}) of all sparse vector classes which \emph{have} an \code{x} slot, as class \code{"xsparseVector"}. } } } \section{Methods}{ \describe{ \item{length}{\code{signature(x = "sparseVector")}: simply extracts the \code{length} slot.} \item{show}{\code{signature(object = "sparseVector")}: The \code{\link{show}} method for sparse vectors prints \emph{\dQuote{structural}} zeroes as \code{"."} using the non-exported \code{prSpVector} function which allows further customization such as replacing \code{"."} by \code{" "} (blank). Note that \code{\link{options}(max.print)} will influence how many entries of large sparse vectors are printed at all.} \item{as.vector}{\code{signature(x = "sparseVector", mode = "character")} coerces sparse vectors to \dQuote{regular}, i.e., atomic vectors. This is the same as \code{as(x, "vector")}.} \item{as}{..: see \code{coerce} below} \item{coerce}{\code{signature(from = "sparseVector", to = "sparseMatrix")}, and} \item{coerce}{\code{signature(from = "sparseMatrix", to = "sparseVector")}, etc: coercions to and from sparse matrices (\code{\linkS4class{sparseMatrix}}) are provided and work analogously as in standard \R, i.e., a vector is coerced to a 1-column matrix.} \item{dim<-}{\code{signature(x = "sparseVector", value = "integer")} coerces a sparse vector to a sparse Matrix, i.e., an object inheriting from \code{\linkS4class{sparseMatrix}}, of the appropriate dimension.} \item{head}{\code{signature(x = "sparseVector")}: as with \R's (package \pkg{util}) \code{\link{head}}, \code{head(x,n)} (for \eqn{n >= 1}) is equivalent to \code{x[1:n]}, but here can be much more efficient, see the example.} \item{tail}{\code{signature(x = "sparseVector")}: analogous to \code{\link{head}}, see above.} \item{toeplitz}{\code{signature(x = "sparseVector")}: as \code{\link[stats]{toeplitz}(x)}, produce the \eqn{n \times n} Toeplitz matrix from \code{x}, where \code{n = length(x)}.} \item{rep}{\code{signature(x = "sparseVector")} repeat \code{x}, with the same argument list \code{(x, times, length.out, each, ...)} as the default method for rep().} \item{which}{\code{signature(x = "nsparseVector")} and} \item{which}{\code{signature(x = "lsparseVector")} return the indices of the non-zero entries (which is trivial for sparse vectors).} \item{Ops}{\code{signature(e1 = "sparseVector", e2 = "*")}: define arithmetic, compare and logic operations, (see \code{\link[=S4groupGeneric]{Ops}}).} \item{Summary}{\code{signature(x = "sparseVector")}: define all the \code{\link[=S4groupGeneric]{Summary}} methods.} \item{[}{\code{signature(x = "atomicVector", i = ...)}: not only can you subset (aka \emph{\dQuote{index into}}) sparseVectors \code{x[i]} using sparseVectors \code{i}, but we also support efficient subsetting of traditional vectors \code{x} by logical sparse vectors (i.e., \code{i} of class \code{"nsparseVector"} or \code{"lsparseVector"}).} \item{is.na, is.finite, is.infinite}{\code{(x = "sparseVector")}, and} \item{is.na, is.finite, is.infinite}{\code{(x = "nsparseVector")}: return \code{\link{logical}} or \code{"nsparseVector"} of the same length as \code{x}, indicating if/where \code{x} is \code{\link{NA}} (or \code{NaN}), finite or infinite, entirely analogously to the corresponding base \R functions.} } \code{c.sparseVector()} is an S3 method for all \code{"sparseVector"}s, but automatic dispatch only happens for the first argument, so it is useful also as regular \R function, see the examples. } \seealso{ \code{\link{sparseVector}()} for friendly construction of sparse vectors (apart from \code{as(*, "sparseVector")}). } %\author{Martin} \examples{ getClass("sparseVector") getClass("dsparseVector") getClass("xsparseVector")# those with an 'x' slot sx <- c(0,0,3, 3.2, 0,0,0,-3:1,0,0,2,0,0,5,0,0) (ss <- as(sx, "sparseVector")) ix <- as.integer(round(sx)) (is <- as(ix, "sparseVector")) ## an "isparseVector" (!) (ns <- sparseVector(i= c(7, 3, 2), length = 10)) # "nsparseVector" ## rep() works too: (ri <- rep(is, length.out= 25)) ## Using `dim<-` as in base R : r <- ss dim(r) <- c(4,5) # becomes a sparse Matrix: r ## or coercion (as as.matrix() in base R): as(ss, "Matrix") stopifnot(all(ss == print(as(ss, "CsparseMatrix")))) ## currently has "non-structural" FALSE -- printing as ":" (lis <- is & FALSE) (nn <- is[is == 0]) # all "structural" FALSE ## NA-case sN <- sx; sN[4] <- NA (svN <- as(sN, "sparseVector")) v <- as(c(0,0,3, 3.2, rep(0,9),-3,0,-1, rep(0,20),5,0), "sparseVector") v <- rep(rep(v, 50), 5000) set.seed(1); v[sample(v@i, 1e6)] <- 0 str(v) % Formal class 'dsparseVector' [package "Matrix"] with 3 slots % ..@ x : num [1:250000] 3.2 -1 -3 3 5 3.2 -3 3 -1 5 ... % ..@ length: int 9500000 % ..@ i : int [1:250000] 4 16 52 155 189 194 204 231 244 265 ... system.time(for(i in 1:4) hv <- head(v, 1e6)) ## user system elapsed ## 0.033 0.000 0.032 system.time(for(i in 1:4) h2 <- v[1:1e6]) ## user system elapsed ## 1.317 0.000 1.319 stopifnot(identical(hv, h2), identical(is | FALSE, is != 0), validObject(svN), validObject(lis), as.logical(is.na(svN[4])), identical(is^2 > 0, is & TRUE), all(!lis), !any(lis), length(nn@i) == 0, !any(nn), all(!nn), sum(lis) == 0, !prod(lis), range(lis) == c(0,0)) ## create and use the t(.) method: t(x20 <- sparseVector(c(9,3:1), i=c(1:2,4,7), length=20)) (T20 <- toeplitz(x20)) stopifnot(is(T20, "symmetricMatrix"), is(T20, "sparseMatrix"), identical(unname(as.matrix(T20)), toeplitz(as.vector(x20)))) ## c() method for "sparseVector" - also available as regular function (c1 <- c(x20, 0,0,0, -10*x20)) (c2 <- c(ns, is, FALSE)) (c3 <- c(ns, !ns, TRUE, NA, FALSE)) (c4 <- c(ns, rev(ns))) ## here, c() would produce a list {not dispatching to c.sparseVector()} (c5 <- c.sparseVector(0,0, x20)) ## checking (consistency) .v <- as.vector .s <- function(v) as(v, "sparseVector") stopifnot( all.equal(c1, .s(c(.v(x20), 0,0,0, -10*.v(x20))), tol=0), all.equal(c2, .s(c(.v(ns), .v(is), FALSE)), tol=0), all.equal(c3, .s(c(.v(ns), !.v(ns), TRUE, NA, FALSE)), tol=0), all.equal(c4, .s(c(.v(ns), rev(.v(ns)))), tol=0), all.equal(c5, .s(c(0,0, .v(x20))), tol=0) ) } \keyword{classes} Matrix/man/dgCMatrix-class.Rd0000644000176200001440000000707213560531002015546 0ustar liggesusers\name{dgCMatrix-class} \docType{class} \title{Compressed, sparse, column-oriented numeric matrices} \alias{dgCMatrix-class} \alias{as.vector,dgCMatrix-method} \alias{coerce,matrix,dgCMatrix-method} \alias{coerce,ddiMatrix,dgCMatrix-method} \alias{coerce,dgeMatrix,dgCMatrix-method} \alias{coerce,dgCMatrix,dgTMatrix-method} \alias{coerce,dgCMatrix,dsCMatrix-method}% deprecated \alias{coerce,dgCMatrix,dtCMatrix-method} \alias{coerce,dgCMatrix,lgCMatrix-method} \alias{coerce,dgCMatrix,ngCMatrix-method} \alias{coerce,dgCMatrix,dgeMatrix-method} \alias{coerce,dgCMatrix,matrix-method} \alias{coerce,dgCMatrix,vector-method} \alias{coerce,factor,dgCMatrix-method} \alias{diag,dgCMatrix-method} \alias{dim,dgCMatrix-method} %\alias{lu,dgCMatrix-method}-> ./lu.Rd \alias{isSymmetric,dgCMatrix-method} \alias{t,dgCMatrix-method} %\alias{solve,dgCMatrix,matrix-method}--> solve-methods.Rd %% Group methods --------- FIXME: These are not tested yet (or documented) \alias{Arith,logical,dgCMatrix-method} \alias{Arith,numeric,dgCMatrix-method} \alias{Arith,dgCMatrix,logical-method} \alias{Arith,dgCMatrix,numeric-method} \alias{Arith,dgCMatrix,dgCMatrix-method} % for silly reasons, need these 2+3 as well: \alias{round,dgCMatrix,numeric-method} \alias{signif,dgCMatrix,numeric-method} \alias{log,dgCMatrix-method} \alias{gamma,dgCMatrix-method} \alias{lgamma,dgCMatrix-method} % \description{The \code{dgCMatrix} class is a class of sparse numeric matrices in the compressed, sparse, column-oriented format. In this implementation the non-zero elements in the columns are sorted into increasing row order. \code{dgCMatrix} is the \emph{\dQuote{standard}} class for sparse numeric matrices in the \pkg{Matrix} package. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("dgCMatrix", ...)}, more typically via \code{as(*, "CsparseMatrix")} or similar. Often however, more easily via \code{\link{Matrix}(*, sparse = TRUE)}, or most efficiently via \code{\link{sparseMatrix}()}. } \section{Slots}{ \describe{ \item{\code{x}:}{Object of class \code{"numeric"} - the non-zero elements of the matrix.} \item{\dots}{all other slots are inherited from the superclass \code{"\linkS4class{CsparseMatrix}"}. } } } \section{Methods}{ Matrix products (e.g., \link{crossprod-methods}), and (among other) \describe{ \item{coerce}{\code{signature(from = "matrix", to = "dgCMatrix")}} \item{coerce}{\code{signature(from = "dgCMatrix", to = "matrix")}} \item{coerce}{\code{signature(from = "dgCMatrix", to = "dgTMatrix")}} \item{diag}{\code{signature(x = "dgCMatrix")}: returns the diagonal of \code{x}} \item{dim}{\code{signature(x = "dgCMatrix")}: returns the dimensions of \code{x}} \item{image}{\code{signature(x = "dgCMatrix")}: plots an image of \code{x} using the \code{\link[lattice]{levelplot}} function} \item{solve}{\code{signature(a = "dgCMatrix", b = "...")}: see \code{\link{solve-methods}}, notably the extra argument \code{sparse}.} \item{lu}{\code{signature(x = "dgCMatrix")}: computes the LU decomposition of a square \code{dgCMatrix} object} } } %\references{} %\author{} %\note{} \seealso{ Classes \code{\linkS4class{dsCMatrix}}, \code{\linkS4class{dtCMatrix}}, \code{\link{lu}} } \examples{ (m <- Matrix(c(0,0,2:0), 3,5)) str(m) m[,1] \dontshow{## regression test: this must give a validity-check error: stopifnot(inherits(try(new("dgCMatrix", i = 0:1, p = 0:2, x = c(2,3), Dim = 3:4)), "try-error")) } } \keyword{classes} \keyword{algebra} Matrix/man/dsparseMatrix-class.Rd0000644000176200001440000000241112271746775016531 0ustar liggesusers\name{dsparseMatrix-class} \docType{class} \alias{dsparseMatrix-class} % Group \alias{Summary,dsparseMatrix-method} \alias{Arith,dsparseMatrix,logical-method} \alias{Arith,dsparseMatrix,numeric-method} \alias{Arith,logical,dsparseMatrix-method} \alias{Arith,numeric,dsparseMatrix-method} % \alias{lu,dsparseMatrix-method} % \title{Virtual Class "dsparseMatrix" of Numeric Sparse Matrices} \description{The Class \code{"dsparseMatrix"} is the virtual (super) class of all numeric sparse matrices. } \section{Slots}{ \describe{ \item{\code{Dim}:}{the matrix dimension, see class \code{"\linkS4class{Matrix}"}.} \item{\code{Dimnames}:}{see the \code{"Matrix"} class.} \item{\code{x}:}{a \code{\link{numeric}} vector containing the (non-zero) matrix entries.} } } \section{Extends}{ Class \code{"dMatrix"} and \code{"sparseMatrix"}, directly.\cr Class \code{"Matrix"}, by the above classes. } % \section{Methods}{ % No methods defined with class "dsparseMatrix" in the signature. % } %%\author{Martin} \seealso{ the documentation of the (non virtual) sub classes, see \code{showClass("dsparseMatrix")}; in particular, \linkS4class{dgTMatrix}, \linkS4class{dgCMatrix}, and \linkS4class{dgRMatrix}. } \examples{ showClass("dsparseMatrix") } \keyword{classes} Matrix/man/chol.Rd0000644000176200001440000001224214041756722013516 0ustar liggesusers\name{chol} \title{Choleski Decomposition - 'Matrix' S4 Generic and Methods} \alias{chol} \alias{chol-methods} \alias{chol,Matrix-method} % dense methods \alias{chol,ddenseMatrix-method} \alias{chol,dgeMatrix-method} \alias{chol,dpoMatrix-method} \alias{chol,dppMatrix-method} % diagonal \alias{chol,ddiMatrix-method} \alias{chol,ldiMatrix-method} % sparse methods \alias{chol,dsparseMatrix-method} \alias{chol,dsCMatrix-method} \alias{chol,lsCMatrix-method} \alias{chol,nsCMatrix-method} \alias{chol,dtCMatrix-method} \alias{chol,dtRMatrix-method} \alias{chol,dtTMatrix-method} % \description{ Compute the Choleski factorization of a real symmetric positive-definite square matrix. } \usage{ chol(x, \dots) \S4method{chol}{dsCMatrix}(x, pivot = FALSE, \dots) \S4method{chol}{dsparseMatrix}(x, pivot = FALSE, cache = TRUE, \dots) } \arguments{ \item{x}{a (sparse or dense) square matrix, here inheriting from class \code{\linkS4class{Matrix}}; if \code{x} is not positive definite, an error is signalled.} \item{pivot}{logical indicating if pivoting is to be used. Currently, this is \emph{not} made use of for dense matrices.} \item{cache}{logical indicating if the result should be cached in \code{x@factors}; note that this argument is experimental and only available for some sparse matrices.} \item{\dots}{potentially further arguments passed to methods.} } \details{ Note that these Cholesky factorizations are typically \emph{cached} with \code{x} currently, and these caches are available in \code{x@factors}, which may be useful for the sparse case when \code{pivot = TRUE}, where the permutation can be retrieved; see also the examples. However, this should not be considered part of the API and made use of. Rather consider \code{\link{Cholesky}()} in such situations, since \code{chol(x, pivot=TRUE)} uses the same algorithm (but not the same return value!) as \code{\link{Cholesky}(x, LDL=FALSE)} and \code{chol(x)} corresponds to \code{\link{Cholesky}(x, perm=FALSE, LDL=FALSE)}. } \section{Methods}{ Use \code{\link{showMethods}(chol)} to see all; some are worth mentioning here: \describe{ \item{chol}{\code{signature(x = "dgeMatrix")}: works via \code{"dpoMatrix"}, see class \code{\linkS4class{dpoMatrix}}.} \item{chol}{\code{signature(x = "dpoMatrix")}: Returns (and stores) the Cholesky decomposition of \code{x}, via LAPACK routines \code{dlacpy} and \code{dpotrf}.} \item{chol}{\code{signature(x = "dppMatrix")}: Returns (and stores) the Cholesky decomposition via LAPACK routine \code{dpptrf}.} \item{chol}{\code{signature(x = "dsCMatrix", pivot = "logical")}: Returns (and stores) the Cholesky decomposition of \code{x}. If \code{pivot} is true, the Approximate Minimal Degree (AMD) algorithm is used to create a reordering of the rows and columns of \code{x} so as to reduce fill-in.} } } \value{ a matrix of class \code{\linkS4class{Cholesky}}, i.e., upper triangular: \eqn{R} such that \eqn{R'R = x} (if \code{pivot=FALSE}) \emph{or} \eqn{P' R'R P = x} (if \code{pivot=TRUE} and \eqn{P} is the corresponding permutation matrix). } \references{ Timothy A. Davis (2006) \emph{Direct Methods for Sparse Linear Systems}, SIAM Series \dQuote{Fundamentals of Algorithms}. Tim Davis (1996), An approximate minimal degree ordering algorithm, \emph{SIAM J. Matrix Analysis and Applications}, \bold{17}, 4, 886--905. } \seealso{The default from \pkg{base}, \code{\link[base]{chol}}; for more flexibility (but not returning a matrix!) \code{\link{Cholesky}}. } \examples{ showMethods(chol, inherited = FALSE) # show different methods sy2 <- new("dsyMatrix", Dim = as.integer(c(2,2)), x = c(14, NA,32,77)) (c2 <- chol(sy2))#-> "Cholesky" matrix stopifnot(all.equal(c2, chol(as(sy2, "dpoMatrix")), tolerance= 1e-13)) str(c2) ## An example where chol() can't work (sy3 <- new("dsyMatrix", Dim = as.integer(c(2,2)), x = c(14, -1, 2, -7))) try(chol(sy3)) # error, since it is not positive definite ## A sparse example --- exemplifying 'pivot' (mm <- toeplitz(as(c(10, 0, 1, 0, 3), "sparseVector"))) # 5 x 5 (R <- chol(mm)) ## default: pivot = FALSE R2 <- chol(mm, pivot=FALSE) stopifnot( identical(R, R2), all.equal(crossprod(R), mm) ) (R. <- chol(mm, pivot=TRUE))# nice band structure, ## but of course crossprod(R.) is *NOT* equal to mm ## --> see Cholesky() and its examples, for the pivot structure & factorization stopifnot(all.equal(sqrt(det(mm)), det(R)), all.equal(prod(diag(R)), det(R)), all.equal(prod(diag(R.)), det(R))) ## a second, even sparser example: (M2 <- toeplitz(as(c(1,.5, rep(0,12), -.1), "sparseVector"))) c2 <- chol(M2) C2 <- chol(M2, pivot=TRUE) ## For the experts, check the caching of the factorizations: ff <- M2@factors[["spdCholesky"]] FF <- M2@factors[["sPdCholesky"]] L1 <- as(ff, "Matrix")# pivot=FALSE: no perm. L2 <- as(FF, "Matrix"); P2 <- as(FF, "pMatrix") stopifnot(identical(t(L1), c2), all.equal(t(L2), C2, tolerance=0),#-- why not identical()? all.equal(M2, tcrossprod(L1)), # M = LL' all.equal(M2, crossprod(crossprod(L2, P2)))# M = P'L L'P ) } \keyword{algebra} \keyword{array} Matrix/man/MatrixClass.Rd0000644000176200001440000000220612571665074015027 0ustar liggesusers\name{MatrixClass} \title{The Matrix (Super-) Class of a Class} \alias{MatrixClass} \description{ Return the (maybe super-)\code{\link{class}} of class \code{cl} from package \pkg{Matrix}, returning \code{\link{character}(0)} if there is none. } \usage{ MatrixClass(cl, cld = getClassDef(cl), ...Matrix = TRUE, dropVirtual = TRUE, ...) } \arguments{ \item{cl}{string, class name} \item{cld}{its class definition} \item{...Matrix}{\code{\link{logical}} indicating if the result must be of pattern \code{"[dlniz]..Matrix"} where the first letter "[dlniz]" denotes the content kind.} \item{dropVirtual}{\code{\link{logical}} indicating if virtual classes are included or not.}% ?? (FIXME) -- example \item{\dots}{further arguments are passed to \code{\link{.selectSuperClasses}()}.} } \value{ a \code{\link{character}} string } \author{Martin Maechler, 24 Mar 2009} %% \details{ %% } \seealso{ \code{\linkS4class{Matrix}}, the mother of all \pkg{Matrix} classes. } \examples{ mkA <- setClass("A", contains="dgCMatrix") (A <- mkA()) stopifnot(identical( MatrixClass("A"), "dgCMatrix")) } \keyword{classes} Matrix/man/rcond.Rd0000644000176200001440000001177012322330663013673 0ustar liggesusers\name{rcond} \title{Estimate the Reciprocal Condition Number} \alias{rcond} % most methods are "documented" in Matrix-class.Rd \alias{rcond,ANY,missing-method} \alias{rcond,Matrix,character-method} \alias{rcond,ldenseMatrix,character-method} \alias{rcond,ndenseMatrix,character-method} \alias{rcond,sparseMatrix,character-method} % \usage{ rcond(x, norm, \dots) \S4method{rcond}{sparseMatrix,character}(x, norm, useInv=FALSE, \dots) } \description{ Estimate the reciprocal of the condition number of a matrix. This is a generic function with several methods, as seen by \code{\link{showMethods}(rcond)}. } \arguments{ \item{x}{an \R object that inherits from the \code{Matrix} class.} \item{norm}{character string indicating the type of norm to be used in the estimate. The default is \code{"O"} for the 1-norm (\code{"O"} is equivalent to \code{"1"}). For sparse matrices, when \code{useInv=TRUE}, \code{norm} can be any of the \code{kind}s allowed for \code{\link{norm}}; otherwise, the other possible value is \code{"I"} for the infinity norm, see also \code{\link{norm}}. } \item{useInv}{logical (or \code{"Matrix"} containing \code{\link{solve}(x)}). If not false, compute the reciprocal condition number as \eqn{1/(\|x\| \cdot \|x^{-1}\|)}{1/(||x|| * ||x^(-1)||)}, where \eqn{x^{-1}}{x^(-1)} is the inverse of \eqn{x}, \code{solve(x)}. This may be an efficient alternative (only) in situations where \code{solve(x)} is fast (or known), e.g., for (very) sparse or triangular matrices. Note that the \emph{result} may differ depending on \code{useInv}, as per default, when it is false, an \emph{approximation} is computed. } \item{\dots}{further arguments passed to or from other methods.} } \value{ An estimate of the reciprocal condition number of \code{x}. } \section{BACKGROUND}{ The condition number of a regular (square) matrix is the product of the \code{\link{norm}} of the matrix and the norm of its inverse (or pseudo-inverse). More generally, the condition number is defined (also for non-square matrices \eqn{A}) as \deqn{\kappa(A) = \frac{\max_{\|v\| = 1} \|A v\|}{\min_{\|v\| = 1} \|A v\|}.}{% kappa(A) = (max_(||v|| = 1; || Av ||)) /(min_(||v|| = 1; || Av ||)).} Whenever \code{x} is \emph{not} a square matrix, in our method definitions, this is typically computed via \code{rcond(qr.R(qr(X)), ...)} where \code{X} is \code{x} or \code{t(x)}. The condition number takes on values between 1 and infinity, inclusive, and can be viewed as a factor by which errors in solving linear systems with this matrix as coefficient matrix could be magnified. \code{rcond()} computes the \emph{reciprocal} condition number \eqn{1/\kappa} with values in \eqn{[0,1]} and can be viewed as a scaled measure of how close a matrix is to being rank deficient (aka \dQuote{singular}). Condition numbers are usually estimated, since exact computation is costly in terms of floating-point operations. An (over) estimate of reciprocal condition number is given, since by doing so overflow is avoided. Matrices are well-conditioned if the reciprocal condition number is near 1 and ill-conditioned if it is near zero. } \seealso{ \code{\link{norm}}, \code{\link[base]{kappa}()} from package \pkg{base} computes an \emph{approximate} condition number of a \dQuote{traditional} matrix, even non-square ones, with respect to the \eqn{p=2} (Euclidean) \code{\link{norm}}. \code{\link[base]{solve}}. \code{\link{condest}}, a newer \emph{approximate} estimate of the (1-norm) condition number, particularly efficient for large sparse matrices. } \references{ Golub, G., and Van Loan, C. F. (1989). \emph{Matrix Computations,} 2nd edition, Johns Hopkins, Baltimore. } \examples{ x <- Matrix(rnorm(9), 3, 3) rcond(x) ## typically "the same" (with more computational effort): 1 / (norm(x) * norm(solve(x))) rcond(Hilbert(9)) # should be about 9.1e-13 ## For non-square matrices: rcond(x1 <- cbind(1,1:10))# 0.05278 rcond(x2 <- cbind(x1, 2:11))# practically 0, since x2 does not have full rank ## sparse (S1 <- Matrix(rbind(0:1,0, diag(3:-2)))) rcond(S1) m1 <- as(S1, "denseMatrix") all.equal(rcond(S1), rcond(m1)) ## wide and sparse rcond(Matrix(cbind(0, diag(2:-1)))) ## Large sparse example ---------- m <- Matrix(c(3,0:2), 2,2) M <- bdiag(kronecker(Diagonal(2), m), kronecker(m,m)) 36*(iM <- solve(M)) # still sparse MM <- kronecker(Diagonal(10), kronecker(Diagonal(5),kronecker(m,M))) dim(M3 <- kronecker(bdiag(M,M),MM)) # 12'800 ^ 2 if(interactive()) ## takes about 2 seconds if you have >= 8 GB RAM system.time(r <- rcond(M3)) ## whereas this is *fast* even though it computes solve(M3) system.time(r. <- rcond(M3, useInv=TRUE)) if(interactive()) ## the values are not the same c(r, r.) # 0.05555 0.013888 ## for all 4 norms available for sparseMatrix : cbind(rr <- sapply(c("1","I","F","M"), function(N) rcond(M3, norm=N, useInv=TRUE))) \dontshow{stopifnot(all.equal(r., 1/72, tolerance=1e-12))} } \keyword{array} \keyword{algebra} Matrix/man/Diagonal.Rd0000644000176200001440000001017313764360665014320 0ustar liggesusers\name{Diagonal} \title{Create Diagonal Matrix Object} \alias{Diagonal} \alias{.sparseDiagonal} \alias{.symDiagonal} \alias{.trDiagonal} \description{ Create a diagonal matrix object, i.e., an object inheriting from \code{\linkS4class{diagonalMatrix}} (or a \dQuote{standard} \code{\linkS4class{CsparseMatrix}} diagonal matrix in cases that is prefered). } \usage{ Diagonal(n, x = NULL) .symDiagonal(n, x = rep.int(1,n), uplo = "U", kind) .trDiagonal(n, x = 1, uplo = "U", unitri=TRUE, kind) .sparseDiagonal(n, x = 1, uplo = "U", shape = if(missing(cols)) "t" else "g", unitri, kind, cols = if(n) 0:(n - 1L) else integer(0)) } \arguments{ \item{n}{integer specifying the dimension of the (square) matrix. If missing, \code{length(x)} is used.} \item{x}{numeric or logical; if missing, a \emph{unit} diagonal \eqn{n \times n}{n x n} matrix is created.} \item{uplo}{for \code{.symDiagonal} (\code{.trDiagonal}), the resulting sparse \code{\linkS4class{symmetricMatrix}} (or \code{\linkS4class{triangularMatrix}}) will have slot \code{uplo} set from this argument, either \code{"U"} or \code{"L"}. Only rarely will it make sense to change this from the default.} \item{shape}{string of 1 character, one of \code{c("t","s","g")}, to choose a triangular, symmetric or general result matrix.} \item{unitri}{optional logical indicating if a triangular result should be \dQuote{unit-triangular}, i.e., with \code{diag = "U"} slot, if possible. The default, \code{\link{missing}}, is the same as \code{\link{TRUE}}.} \item{kind}{string of 1 character, one of \code{c("d","l","n")}, to choose the storage mode of the result, from classes \code{\linkS4class{dsparseMatrix}}, \code{\linkS4class{lsparseMatrix}}, or \code{\linkS4class{nsparseMatrix}}, respectively.} \item{cols}{integer vector with values from \code{0:(n-1)}, denoting the \emph{columns} to subselect conceptually, i.e., get the equivalent of \code{Diagonal(n,*)[, cols + 1]}.} } \value{ \code{Diagonal()} returns an object of class \code{\linkS4class{ddiMatrix}} or \code{\linkS4class{ldiMatrix}} (with \dQuote{superclass} \code{\linkS4class{diagonalMatrix}}). \code{.symDiagonal()} returns an object of class \code{\linkS4class{dsCMatrix}} or \code{\linkS4class{lsCMatrix}}, i.e., a \emph{sparse} \emph{symmetric} matrix. Analogously, \code{.triDiagonal} gives a sparse \code{\linkS4class{triangularMatrix}}. This can be more efficient than \code{Diagonal(n)} when the result is combined with further symmetric (sparse) matrices, e.g., in \code{\link{kronecker}}, however \emph{not} for matrix multiplications where \code{Diagonal()} is clearly preferred. \code{.sparseDiagonal()}, the workhorse of \code{.symDiagonal} and \code{.trDiagonal} returns a \code{\linkS4class{CsparseMatrix}} (the resulting class depending on \code{shape} and \code{kind}) representation of \code{Diagonal(n)}, or, when \code{cols} are specified, of \code{Diagonal(n)[, cols+1]}. } \author{Martin Maechler} \seealso{the generic function \code{\link{diag}} for \emph{extraction} of the diagonal from a matrix works for all \dQuote{Matrices}. \code{\link{bandSparse}} constructs a \emph{banded} sparse matrix from its non-zero sub-/super - diagonals. \code{\link{band}(A)} returns a band matrix containing some sub-/super - diagonals of \code{A}. \code{\link{Matrix}} for general matrix construction; further, class \code{\linkS4class{diagonalMatrix}}. } \examples{ Diagonal(3) Diagonal(x = 10^(3:1)) Diagonal(x = (1:4) >= 2)#-> "ldiMatrix" ## Use Diagonal() + kronecker() for "repeated-block" matrices: M1 <- Matrix(0+0:5, 2,3) (M <- kronecker(Diagonal(3), M1)) (S <- crossprod(Matrix(rbinom(60, size=1, prob=0.1), 10,6))) (SI <- S + 10*.symDiagonal(6)) # sparse symmetric still stopifnot(is(SI, "dsCMatrix")) (I4 <- .sparseDiagonal(4, shape="t"))# now (2012-10) unitriangular stopifnot(I4@diag == "U", all(I4 == diag(4))) \dontshow{% checking some "unit-diagonality": L <- Diagonal(5, TRUE) stopifnot(L@diag == "U", identical(L, Diagonal(5) > 0)) } } \keyword{array} \keyword{algebra} Matrix/TODO0000644000176200001440000005460714103006124012211 0ustar liggesusers##-*- mode: org -*- * Very *Urgent* ** DONE 0-dim sparseMatrices fail for all "Ops" --> ~/R/MM/Pkg-ex/Matrix/bug-0-length-Ops.R ** DONE as(m, "sparseMatrix") must work when length(m) > max.int for 'matrix' m --> see SM (3e6 x 1023) ex. in tests/Simple.R ** TODO Matrix-Bugs [#6729] 2021-06 ./tests/AAA_latest.R: provide .KhatriRao() for "general" (notably dense,complex,..) matrices ** TODO Using "long vectors" (i.e. 64 bit indices vectors) in CHOLMOD --> cholmod_l_*() *** e.g. segfault in crossprod() Csparse_crossprod -> cholmod_att() ** TODO 'symmetricMatrix' objects with *A*symmetric @Dimnames are formally "valid", but really are not, see FIXME in symmetricMatrix_validate() in src/dsyMatrix.c ---> see TODO below: `forceCspSymmetric()` * *Urgent* in some sense --------------------------------------------------- ** TODO `unique()` and `duplicated()` methods for "sparseVector" & "(sparse)Matrix"; have "*.matrix" S3 methods ** TODO (partly DONE via workaround "round up" to 100): print() / show() for small options(max.print=): --> tests/Simple.R {'max.print'} ** TODO API change: Should Matrix(diag(2), sparse=TRUE, doDiag=TRUE) not rather give "ddiMatrix" ?? Why change? Originally "ddiMatrix" etc extended denseMatrix but now sparseMatrix Currently 'doDiag's documentation starts as 'doDiag: only when ‘sparse = FALSE’, ....' This would change, and doDiag would be active *also* for 'sparse = TRUE' ** TODO Do section in ./vignettes/Design-issues.Rnw (& man/symmetricMatrix-class.Rd ?) about *dimnames* ** also mentioning forceSymmetric(); maybe that wd "inherit" arg. 'symDimnames' in {T,F,NA} from forceCspSymmetric(). ** TODO sparse2int() using a X[...] * Y[...] construct which is too large --> Matrix bug #1330: *** See FIXME in ./R/spModels.R and https://r-forge.r-project.org/tracker/index.php?func=detail&aid=1330&group_id=61&atid=294 ** TODO S[sel,] and S[,sel] <- value should work for sparse S and NA-containing sel. ** TODO nnzero() is too slow for a large CsparseMatrix ** TODO sparse.model.matrix(.) bug with NA's & na.action = "na.pass" => ~/R/MM/Pkg-ex/Matrix/sparse.model-bugs_EB.R ** TODO sparse.model.matrix(~ poly(x,3)) gives wrong column names => ~/R/MM/Pkg-ex/Matrix/sparse.model-bugs_EB.R ** TODO lu() should preserve dimnames in a way such that lu(A) ~= PLU =.= A can rebuild A. R/ ** TODO M[] indexing should work (but with a warning: use *dense*!) ** TODO doxygen (seed inst/Doxyfile and ../../www/doxygen/UPDATE_me.sh) now _fails_ partly, e.g., for ------- e.g., for src/Csparse.c, Csp_dense_products(...) around lines 600 ** TODO src/CHOLMOD/MatrixOps/cholmod_symmetry.c is "cool" and fast; Definitely should use it for solve() {it seems MATLAB does}; alternatively also is_sym() [in src/cs_utils.c], see below. ** TODO diagonalMatrix inherits from sparseMatrix, *BUT* "ddiMatrix" does not inherit from "dsparseMatrix", nor does "ldiMatrix" from "lparseMatrix". Seems an undesirable inconsistency. Try changing setClass("ddiMatrix", contains = c("diagonalMatrix", "dMatrix")) to setClass("ddiMatrix", contains = c("diagonalMatrix", "dsparseMatrix")) ** TODO Look at Paul Bailey's problem -- CHOLMOD error (even seg.fault for him) --> ~/R/MM/Pkg-ex/Matrix/sparseOrderedLogit.R ** TODO Schur() should also get a "matrix" method, so people like RP may stop whining about its non-availability in "base R" (2015-07-09) ** TODO BunchKaufman()'s result is not really useful yet, but it is used on C level e.g. for solve(). NB: is a generalized LDL' [with pivoting!]. Should define expand() method or similar, see man/BunchKaufman-methods.Rd and R/dsyMatrix.R (at end). ** TODO src/cs_utils.c : I think is_sym() [only used in Matrix_cs_to_SEXP()] can be made sped up: leave the for loops, as soon as is_lower == is_upper == 0. ** TODO kronecker(, ) should return symmetricMatrix, notably when one of the arguments is diagonal ** DONE as(, "CsparseMatrix") -> dense_to_Csparse() is inefficient: it first *copies* the matrix to a dgeMatrix {re-allocating!}, then goes to sparse via cholmod_(l_)dense_to_sparse. ==> *** DONE Do this directly in C (also working around "too long // segfault problem we have there): matrix_to_Csparse() plus .m2dgC() etc R short cuts ** TODO extend C's matrix_to_Csparse() to optionally check for diagonal, (upper or lower) triangular, and/or symmetric case ** DONE %*% , crossprod() & tcrossprod() often return a pattern, i.e., nsparseMatrix as well *because* cholmod_ssmult() just does that even if only *one* of the two matrices is a pattern matrix. The latter case is really wrong. The above behavior seems many years old.. and sometimes is interesting and good, using Boolean arithmetic: T+T := T|T = T For 1.2-0, changed the result to return *numeric* when *one* of the two matrices is not nsparse. ==> Provide the previous functionality via a Matrix package R function: ==> We've introduced '%&%' for Matrix 1.2-0 and 'boolArith = TRUE' for crossprod/tcrossprod. ** TODO (%*% (t)crossprod, see above) Should we always return *numeric*, i.e., behave the same as for 'ndenseMatrix' or 'lsparseMatrix' or traditional logical matrices? ** DONE norm(matrix(1:4,2), type="2") should work as in base __AND__ we shold support type="2" (-> svd()) ** DONE [t]crossprod() could/should become more lenient with *vector*s: adapt R-devel (= R 3.2.0)'s rules: see misc/products-Mv.R and *.Rout -- now tests/matprod.R ("3.2.0") *** DONE for sparseVector o (sparse)vector *** DONE consider analagous changes to base-R ** DONE m %*% M (crossprod, ..) with 0-dim. result give garbage ** DONE M[i,j] should *not* drop dimnames (R-forge bug 2556, see ~/R/MM/Pkg-ex/Matrix/dimnames-prod.R) ** DONE "Math"/"Math2" *fail* entirely for sparseVectors ** DONE rbind2(, ) did not work, now is completely wrong !! (e.g. , ) ** DONE qr.coef() has *wrong* (column)names, even in full-rank case: see man/qr-methods.Rd ("FIXME"); maybe related to ** DONE qr.R(), qrR() etc have *wrong* currently *lose* column/row names {compared to base R's qr.R}, see, drop0(R. <- qr.R(qx), tol=1e-15) # columns are int b1 c1 c2 b2 c3 {in man/qr-methods.Rd} ** DONE should as.matrix() eventually become a no-op, as for Rmpfr::"mpfrMatrix" ?? -- *NO!* *** Big advantages: **** 1) Functions such as base::scale.default() will work automagically **** 2) If sM <- as.matrix() .. then identical(as.matrix(sM) , sM) -- not currently !! *** Bigger drawbacks: Really I have to define Matrix methods for base functions that just worked perfectly via as.matrix **** 1a) eigen() base::eigen uses as.matrix() = asRbasematrix(); is not generic; called from nearPD() ==> I've introduced "Matrix" S4 methods (and hence made eigen() S4 generic) **** 1b) svd() same as eigen(); also called from norm(*, "2") {as eigen()} would also need "Matrix" S4 methods **** 1c) qr() needs additional dgeMatrix methods (as base::qr.default uses as.matrix()) and now warns, also, e.g., from rcond() **** 2) base :: lower.tri() and upper.tri() also use as.matrix() but are not generic => would need to make them S4 genric ***** for now: just redefinition in inst/test-tools-Matrix.R notably for CheckMatrix(), but also for use in diverse ./tests/*.R. ***** For R-devel (-> 3.5.0 in April 2018): lower.tri() / upper.tri() do *not* use as.matrix() **** 3) Documented in more than one place that base functions work thanks to as.matrix() *** How to go there: For a while as.matrix() should give deprecation warning: use as(*,"matrix") and ---- give substitute .asmatrix(), but that's not faster; simply calls as(*,"matrix") **** In R/Auxiliaries.R .Matrix.avoiding.as.matrix <- TRUE -- for experiments only **** turn off warning via options(Matrix.quiet.as.matrix = TRUE) ** DONE BunchKaufman() got a "matrix" method. * New smallish ideas, relatively urgent for MM ----------------------------- ** TODO qr1() as non-pivoting rank-correcting -- .Call(lapack_qr, ..) in src/dense.c ** DONE generalize new "indMatrix" class, to allow 0 repetitions of some samples, i.e., columns of all 0 s. It's mathematically more natural --> typically will be useful. ** DONE polnish translation (e-mail!) ** DONE FIXME(2) and (3) in R/products.R: t(.Call(Csparse_dense_*)) ** TODO cor() and cov() at least for y=NULL ("no y"). -> ~/R/MM/Pkg-ex/Matrix/cor_sparse-propos.R <- http://stackoverflow.com/questions/5888287/ -> ~/R/MM/Pkg-ex/Matrix/cor_cos.R and ~/R/MM/Pkg-ex/Matrix/cor_cos_testing Provide cor.sparse() and other association measures for sparse matrices. ** TODO Add larger collection of *random matrix generator* functions, typically *sparse* ones: Have rsparseMatrix() [exported] already; then rspMat(), rUnitTri(), mkLDL() [!] in inst/test-tools-Matrix.R ; then, e.g., rBlockTri() in man/bdiag.Rd. (man/* ?; tests/* ) ** TODO port isSeq() to C [ R/Auxiliaries.R ] ** TODO Investigate the "band changing (and getting) ideas 'band<-' etc, from Jeremy D Silver, per posts to R-devel on Aug.26,2011 {MM: ~/R/MM/Pkg-ex/Matrix/bands-Jeremy_Silver-ex.R } *** TODO Similarly (maybe covered by his suggestion?): provide *inverse* of bandSparse() in the sense that if 'dg.mat' is a ("LINPACK/EISPACK"-format) dense (n x K) matrix containing K diagonals, and BS <- bandSparse(.., diagonals=dg.mat); dg.m <- getbands(BS,..) would exactly return the 'dg.mat' matrix. ** TODO finalize and activate the _unused_ code in src/t_sparseVector.c ** TODO cbind2() / rbind2() for sparseMatrices: dimnames propagation should happen in C, see R/bind2.R and src/Csparse.c (Csparse_horzcat etc). ** TODO use getOption("Matrix.quiet") in more places [--> less messages/warnings] ** DONE Check for DimNames propagation in coercion and other operations. *** DONE for (%*%, crossprod, tcrossprod), now systematically checked in tests/matprod.R *** DONE For colSums(), rowSums() [R-forge bug # 6018] --> 'FIXME' in R/colSums.R ** TODO Report the problem in the Linux ldexp manual page. The second and third calls in the Synopsis should be to ldexpf and ldexpl. ** TODO provide methods for "dspMatrix" and "dppMatrix"! 2012-07: DONE with Ops, etc, also pack() / unpack(); not yet: "Math" ** TODO "corMatrix" extends "dpoMatrix".. -- but we miss a *packed* corMatrix: "copMatrix" or "crpMatrix" (well, this is "related to" the fact that we do not have too many packed matrix methods). ** TODO combine the C functions for multiplication by special forms and solution wrt special forms by using a 'right' argument and a 'classed' argument. [done with dgeMatrix_matrix_mm(); not yet for other classes; and for _crossprod()] ** DONE Cache '@factors' components also from R, e.g., for "Tsparse.." via .set.factors() ** TODO chol() and Cholesky() caching unfinished: the *name* [Ss][Pp][Dd]Cholesky depends on (perm, LDL, super) arguments: *** DONE .chkName.CHM(name, perm, LDL, super) and .CHM.factor.name() *** TODO use the above ** TODO partly DONE; new arg 'cache=FALSE': allow cache=FALSE to disable the caching ** TODO 0-based vs 1-based indexing: grep -nHE -e '[01]-(orig|ind|base)' *.R Can I find a *uniform* language '1-based indexing' or '0-origin indexing' ? *** More systemtic possible via new argumnet 'orig_1' in m_encodeInd(), m_encodeInd2() -> src/Mutils.c * Generalization of Existing Classes and Methods --------------------------- ** DONE "Math2" , "Math", "Summary": keep diagonal, triangular and symmetric Matrices when appropriate: particularly desirable for "Math2": round(), signif() ** TODO "Arith" (and Ops ?): keep diagonal, triangular and symmetric Matrices where appropr. ** TODO For triangular matrices, ensure the four rules of "triangular matrix algebra" (Golub+Van Loan 1996, 3.1.8, p.93)" *** DONE since 2008-03-06 for Csparse *** DONE since 2010-07-23 for %*% *** TODO e.g. for %*% ** TODO "d" <-> "l" coercion for all "[TCR]" sparse matrices is really trivial: "d" -> "l" : drops the 'x' slot "l" -> "d" : construct an 'x' slot of all '1' We currently have many of these conversions explicitly, e.g. setAs("dsTMatrix", "lsTMatrix", function(from) new("lsTMatrix", i = from@i, j = from@j, uplo = from@uplo, Dim = from@Dim, Dimnames = from@Dimnames)) but I would rather want to automatically construct all these coercion methods at once by a ``method constructor'', i.e., for all "dsparse*" -> "lsparse*" and vice versa. How can one do this {in a documented way} ? ** TODO Think of constructing setAs(...) calls automatically in order to basically enable all ``sensible'' as(fromMatrix, toMatrix) calls, possibly using canCoerce(.) ** TODO When we have a packed matrix, it's a waste to go through "full" to "sparse": ==> implement setAs("dspMatrix", "sparseMatrix") setAs("dppMatrix", "sparseMatrix") setAs("dtpMatrix", "sparseMatrix") and the same for "lsp" , "ltp" and "nsp" , "ntp" ! ** TODO tcrossprod(x, y) : do provide methods for y != NULL calling Lapack's DGEMM for "dense" [2005-12-xx: done for dgeMatrix at least] ** TODO Factorizations: LU done; also Schur() for *sparse* Matrices. ** TODO use .Call(Csparse_drop, M, tol) in more places, both with 'tol = 0.' to drop "values that happen to be 0" and for zapsmall() methods for Csparse* ** TODO implement .Call(Csparse_scale, ....) interfacing to cholmod_scale() in src/CHOLMOD/Include/cholmod_matrixops.h : for another function specifically for multiplying a cholmod_sparse object by a diagonal matrix. Use it in %*% and [t]crossprod methods. ** TODO make sure *all* group methods have (maybe "bail-out") setMethod for "Matrix". e.g. zapsmall() fails "badly" ** TODO %*% {also in crossprod/tcrossprod} currently always returns , since --> Csparse_dense_prod --> cholmod_sdmult and that does only return dense. When the sparse matrix is very sparse, i.e. has many rows with only zero entries, it would make much sense to return sparse. ** TODO ! loses symmetry, both for dense and sparse matrices. !M where M is "sparseMatrix", currently always gives dense. This only makes sense when M is ``really sparse''. ** TODO diag(m) <- val currently automatically works via m[cbind(i,i)] <- val This (`[<-` method) is now "smart" for diagonalMatrix, but needs also to be for triangularMatrix, and probably also "dense*general*Matrix" since the above currently goes via "matrix" and back instead of using the 'x' slot directly; in particular, the triangular* "class property" is lost! [current ??] ** TODO "[<-" now uses src/t_Csparse_subassign.c (no memory explosion). *However* it's still too slow when the replacement region is large, or also when do many millions of one-element assignments (say in a 100'000^2 Matrix). * Cholesky(), chol() etc --------------------------------------------------- ** chol() should ``work'': proper result or "good" error message. (mostly done ?) ** example(Cholesky, echo=FALSE) ; cm <- chol(mtm); str(cm); str(mtm) shows that chol() does not seem to make use of an already present factorization and rather uses one with more '0' in x slot. ** examples for solve( Cholesky(.), b, system = c("A", "LDLt"....)) probably rather in man/CHMfactor-class.Rd than man/Cholesky.Rd ** LDL() looks relatively easy; via "tCsparse_diag()" {diagonal entries of *triangular* Csparse} --> see comment in determinant() in R/dsCMatrix.R, will give faster determinant ** Allow Cholesky(A,..) when A is not symmetric *AND* we really _mean_ to factorize AA' ( + beta * I) ** update(Cholesky(..), *): make *also* use of the possibility to update with non-symmetric A and then AA' + mult * I is really meant. .updateCHMfactor() ## allows that already(?) ** TODO add examples (and tests!) for update(, ..) and Cholesky(......, Imult), also tests for hidden {hence no examples} ldetL2up() { R/CHMfactor.R }; see ex in man/wrld_1deg.Rd MM: See e.g. ~/R/MM/Pkg-ex/Matrix/CholUpdate.R -- for solve(, ) ** TODO implement fast diag() via calling new src/Csparse.c's diag_tC_ptr() . - diag_tC_ptr() functionality now exported via R/dsCMatrix.R .diag.dsC() : the name is silly, but functionality nice. See (hidden) example in man/Cholesky.Rd ** TODO chol() gives "temporarily disabled" but should give the *symbolic* factorization; similarly Cholesky(.) is not enabled * "Basic" new functionality -- "nice to have" (non-urgent) ----------------- ** TODO tr(A %*% B) {and even tr(A %*% B %*% C) ...} are also needed frequently in some computations {conditional normal distr. ...}. Since this can be done faster than by sum(diag(A %*% B)) even for traditional matrices, e.g. sum(A * t(B)) or {sometimes even faster for "full" mat} crossprod(as.vector(A), as.vector(t(B))) and even more so for, e.g. %*% {used in Soeren's 'gR' computations}, we should also provide a generic and methods. ** TODO diag(A %*% B) might look like a "generalization" of tr(A %*% B), but as the above tricks show, is not really. Still, it's well worth to provide diag.prod(A, B): Well, if A %*% B is square, diag(A %*% B) === colSums(t(A) * B) and we should probably teach people about that ! ** TODO eigen() should become generic, and get a method at least for diagonal, but also for symmetric -> dsyMatrix [LAPACK dsyev() uses UPLO !], but also simply for dgeMatrix (without going via tradition matrices). What about Sparse? There's fill-in, but it may still be sensible, e.g. mlist <- list(1, 2:3, diag(x=5:3), 27, cbind(1,3:6), 100:101) ee <- eigen(tcrossprod(bdiag(lapply(mlist, as.matrix)))) Matrix( signif(ee$vectors, 3) ) * Everything else aka "Miscellaneous" -------------------------------------- ** TODO qr.R(qr(x)) may differ for the "same" matrix, depending on it being sparse or dense: "qr.R() may differ from qr.R() because of permutations" *** TODO column names are *not* produced, whereas dense qr.R(.) *has* column names. *** DONE We provide `qrR()` .. but not entirely happily: Users are still a bit frustrated and it currently influences rcond() as well. ** TODO rcond() for square currently goes via *dense* -- BAD -- can we go via qr() in any case? In some cases, e.g. lmer()'s "Lambda" (block triangular, small blocks) rcond(L) := 1 / (norm(L) * norm(solve(L))) is simple {and remains sparse, as solve(L) is still block triangular} ** facmul() has no single method defined; it looks like a good idea though (instead of the infamous qr.qy, qr.qty,.... functions) ** TODO symmpart() and skewpart() for *sparse* matrices still use (x +/- t(x))/2 and could be made more efficient. Consider going via asTuniq() or something very close to .Arith.Csparse() in R/Ops.R For a traditional "matrix" object, we should speedup, using C code .. ** TODO many setAs(*, "[dl]..Matrix") are still needed, as long as e.g. replCmat() uses as_CspClass() and drop0(.) which itself call as_CspClass() quite a bit. --> try to replace these by as(*, "CsparseMatrix"); forceSymmetric, etc. ** writeMM(obj, file=stdout()) creates file "1" since file is silently assumed to be a string, i.e. cannot be a connection. An R (instead of C) version should be pretty simple, and would work with connections automatically ["lsparse" become either "real" or "pattern", "depending if they have NAs or not]. ** o still works via sparse in some cases, but could return in the same cases where o does. ** look at solve.QP.compact() in \pkg{quadprog} and how to do that using our sparse matrices. Maybe this needs to be re-implemented using CHOLMOD routines. ** We allow "over-allocated" (i,x)-slots for CsparseMatrix objects, as per Csparse_validate() and the tests in tests/validObj.R. This is as in CHOLMOD/CSparse, where nzmax (>= .@p[n]) corresponds to length(.@i), and makes sense e.g. for M[.,.] <- v assignments which could allocate in chunks and would not need to re-allocate anything in many cases. HOWEVER, replCmat() in R/Csparse.R is still far from making use of that. ** DONE Thanks to base::rbind, cbind now doing S4 dispatch on C level ** TODO In all(M1 == M2) for sparse large matrices M1, M2 (e.g. M2 <- M1 !), the intermediate 'M1 == M2' typically is dense, hence potentially using humongous amount of memory. We should/could devise something like allCompare(M1, M2, `==`) which would remain sparse in all its computations. -------- ** Reconsider the linkages in the include files for the SuiteSparse packages. It may be better simply to add all the src//Include directories to the include path for all compilations. I don't think there is a big overhead. Right now we need to modify the include file src/SPQR/Include/SuiteSparseQR_C.h so that it does not expect to have src/UFsparse and src/CHOLMOD/Include on the include path. Maybe just those two should be added to the include path. ** (systematically check that LAPACK-calling functions check for 0-dimensional input themselves; LAPACK gives an integer error code) ** the f[,5762] <- thisCol now go via Csparse_subassign() call ... [ in tests/indexing.R ]. Still would be nice to be able to use abIndex (see replTmat in R/Tsparse.R) ** {IS THIS CURRENT?} Sept. 2009: Subject: chol2inv() |-> solve() when testing and documenting chol2inv(), I found that it's pretty simple to also define a method for "CHMfactor" objects, namely simply the solve(*, Diagonal(.) "A") method. This is not particularly exciting, and also does *not*, I think help for defining a chol2inv() method for *sparse* (upper) triangular matrices. ** sort(, partial=..), needed, for mean(*, trim = .) or median(). Note that defining xtfrm() does not "help" (as sort() then goes via dense index). See "mean" in R/Matrix.R ** TODO How can we ensure that inst/include/cholmod.h remains correct and equivalent to src/CHOLMOD/Include/cholmod_core.h and siblings ??? {currently need to do this manually (Emacs M-x compare-windows) for the typedefs} ** DONE SMALL_4_Alloca := 10000; check all uses of alloca()/Alloca() in src/*.[ch] ensuring that the *size* allocated cannot grow with the vector/matrix/nnzero sizes of the input. [see the change needed in svn r2770 in src/dtCMatrix.c !] Matrix/DESCRIPTION0000644000176200001440000000511714154217452013235 0ustar liggesusersPackage: Matrix Version: 1.4-0 Date: 2021-12-08 Priority: recommended Title: Sparse and Dense Matrix Classes and Methods Contact: Doug and Martin Maintainer: Martin Maechler Authors@R: c(person("Douglas","Bates", role="aut") , person("Martin","Maechler", role = c("aut","cre"), email="mmaechler+Matrix@gmail.com", comment = c(ORCID = "0000-0002-8685-9910")) , person("Timothy A.", "Davis", role="ctb", comment = c("SuiteSparse and 'cs' C libraries, notably CHOLMOD, AMD; collaborators listed in dir(pattern = '^[A-Z]+[.]txt$', full.names=TRUE, system.file('doc', 'SuiteSparse', package='Matrix'))")) , person("Jens", "Oehlschlägel", role="ctb", comment="initial nearPD()") , person("Jason", "Riedy", role="ctb", comment = c("condest() and onenormest() for octave", "Copyright: Regents of the University of California")) , person("R Core Team", role = "ctb", comment="base R matrix implementation") ) Description: A rich hierarchy of matrix classes, including triangular, symmetric, and diagonal matrices, both dense and sparse and with pattern, logical and numeric entries. Numerous methods for and operations on these matrices, using 'LAPACK' and 'SuiteSparse' libraries. Depends: R (>= 3.5.0) Imports: methods, graphics, grid, stats, utils, lattice Suggests: expm, MASS Enhances: MatrixModels, graph, SparseM, sfsmisc, igraph, maptools, sp, spdep EnhancesNote: line 2: for "Rd xrefs" Encoding: UTF-8 LazyData: no LazyDataNote: not possible, since we use data/*.R *and* our classes BuildResaveData: no License: GPL (>= 2) | file LICENCE URL: https://Matrix.R-forge.R-project.org/, https://Matrix.R-forge.R-project.org/doxygen/ BugReports: https://R-forge.R-project.org/tracker/?atid=294?group_id=61 Author: Douglas Bates [aut], Martin Maechler [aut, cre] (), Timothy A. Davis [ctb] (SuiteSparse and 'cs' C libraries, notably CHOLMOD, AMD; collaborators listed in dir(pattern = '^[A-Z]+[.]txt$', full.names=TRUE, system.file('doc', 'SuiteSparse', package='Matrix'))), Jens Oehlschlägel [ctb] (initial nearPD()), Jason Riedy [ctb] (condest() and onenormest() for octave, Copyright: Regents of the University of California), R Core Team [ctb] (base R matrix implementation) Repository: CRAN Repository/R-Forge/Project: matrix Repository/R-Forge/Revision: 3419 Repository/R-Forge/DateTimeStamp: 2021-12-08 17:23:53 Date/Publication: 2021-12-08 21:10:02 UTC NeedsCompilation: yes Packaged: 2021-12-08 17:30:00 UTC; rforge Matrix/build/0000755000176200001440000000000014154165627012630 5ustar liggesusersMatrix/build/vignette.rds0000644000176200001440000000057414154165627015175 0ustar liggesusersRAK0κnt2^ b5o3%5I߂3kTQ}y}_׻>B(@a+@A[#uA!_DPə߰"tN/L >%<-E9Rw0)dV|Hǂ8!YRdd ×>L6pNd<_SxR\W\T?g qDiy~̟s Ƽ}g0{ZP^JV޲Y]Р(qC5#ʼk7̓;uddUn?O=!Ω:UT*ՙLuvx9E8;8;DZwq*۝TS\mqI|ܓ'`\1ב: <x_itҔﯚZ6 M{^?\nan5e-S+N.׾!M\\(7 珉q7J|sgW/V)AYy?!jz0[q\+3wJ㹍Q*ޛLLj33Ӆk˚9Tg6Wlݷ>uoIͨGjf"~QGS=y 4THuW &{}'DRgleUwVTͽJP^+(J+ԟ)JTJ,0Vm(YK]BP37 ߈]KgC͎kE;ŋ*X B~"DJȆlhѩhDZnM7`Gݰañkw,.CDn tH}V@LJt[NpP,P؆fʦ \Ltꭎv^QסTMn;m[6ɴ\h1d6nV0+J+WoV)!:W38t6Dx6S00%Z*8-*°Ѷ]ރ2"R_@Lvj.yێa&+uw^|9AJF/gKz*W,py1ki̯6 He  ֚k>$}6% R3$~!cBқ/XfA; ]-Vru\ΖͭlSg_oi`rCDR-\Zs$;oH1e!hw V2gN63slpŎ̏^")A_\:SR"̫xZ'jQEqExrrjWFlnc wϪfǤ0 Ym0/~zv[0Yc"JEȋ-2+xGQmG>V7 O3zݩTڑ50HrFr4 A^Kz%| :GzT^u/X0?w7"Ťl۪xkm UȪ&ocUf0y;.XEcst[,:9 "\kQ7usT1CPGE)FŭMOҤA.hj/v9ΙEQbLYTûj"[t,(IVP tj]rbeq sJUZ6[Y^^N $[gQY>? 62 /I Dj %>M3 G!+RMfKŸi6G|Ϡ)MTb@"UW^F>|: 4JdpٵXö; VZ6%pACe#se;%uO!'0$S])ƚ j1@&oj4Sg86rvq1w`hBsfܾBo3 /A_Iev j@0j˴wQ6J:#.׷*ptRG@|gpեUb}#(wǤo0Wje>ϸLmuw{O!kQjlàHh+!Jk1QGiI6C=ܪa'kQ& m,'jWʋ˚+i LphںDUbP w[֚m"Ț4{pmaEC۲L%i ﲼ7H8/4=Jk䌋e!?=kgMwHY":+iuMI2 00Jv|*A{xEOC>fJzg mӬk𢼰m<4ꋗKckjum8QBg<~(V磊(~E@Q. QzK S6Q9Ji يOygMSJ64y1ʕA/9"3XCf:L1!އɱolB\/AV nAːƛ-1J C dEF g8yn#R7 11bQ!RmN<9}g;,y?f#+|a4/?YPx˪,sfӪ,﷍6ҽ!cQ`+5Sez@" "Z% ;hcV-Vg+Q"vd +̈́k?ZOBV[,~zXmZH\ rµa- Rjfd1#AFHa@Vh,j힜T@D@DɅ*_0^o,ڇT왐}tDA<Do u}OĮEt w'覹[vQUj$pΰ:lRzaTB~؞:>(?Hc{@Z.@Vא{֌?탄[={ Ai#4;f6IhV{ **3{?‘5[x넪u--XRW"$mԤ~Q@rߟU[30m˟.ťC+ zLfL^/Qf== r Y2Bam辝J=jAx Pһ;'bsx 7#vj^|=+ i۾ayxڪuz-Qނ|VdZ'>x-T({-iג~& ~{gayמΰ^M:Y^ށ \zIîu9GcȏCbVClr空.?kCYɏjsLjH qos7kɆJ<55 |Yi)y$ ~;4 VS<8voeݚH,A*_ #́IrIO=6~]ܥ'!+"+2i=4_5"D2:x/M@ɽ3OX] m$Uu*NCMI&ܩlܝFr1|*A+XJK8zRmM#Yg%u]s@9ΖtW3JǒaKv(-} ћGL #)ߵjOVVϟѣ/X2o>O?T?~i؟4z:aT\i&.UUKt(Z)f2d"X}<$egfS1j7K* 8 9iOMk;f3]@V?=#1-mW:+=L ρ_@VM#H=fO_U /P=SLC5@':KW{ "bVS}tdko uc ƞLqʼn r\ϒ~=!lY`ÜOl.Wl˙DlU&};P|Wzy=A(&u]cORH1i2O`턉 yyp"%d"Q;q u"gYA3-^ t6^OMȱNHh|5'};y[bPF^E +}Dކ[||9NJBRh9ٵgd[Zb|9E>XDƏ.|Dx;rK꺀!_];ǼWޛlF\Jw^JnmHP$MCNYԍg!+MJf:|Y7ӑT)I)Vh|/Q8.Q7LQƒo&sK[M`pRS4HP8f-oAVkOOUJiJ'.wB>0#N^,zQi%9*o߅ytoߑJrW>4)z84 &cjhR,;z"+"Ťq;9}#GvhEJ;DQ3'9~y-4 ӤgC%=JU>Iզ뾚_+8ax)zՄܺ3+>kuɽ[ͩ!ÝZzM/+^#@-Z2ZSf ÜK)f_htGFrwB-i '~nJVf?ϲږn]׌wo5[3YN^+kQx˟KOML T4/ "valeن]fߛ yfZz5mm cI^n_W/YM+Ν%tL /:7'^hvY>u&u]@ovT膀H UQ4prԆU*F g!Ƭ6a kJ:ʰ;[5}\|.ʯe /Ogk>3o3i~>Urr7ܛe&G ڂɉ䝙YgrbeD!K7ݝٕm5p .]쐄3! L% 헜(q~[cۮ[qYxz3[x+)YͧquSEXyڰuS GّXb"F>V" B-0HVYo)i9?أwEDVCl-v1$ɿpKN+يbCQқ?`a}񝝹b*01Kei,nLfZkfJ`Kנ0ހ0=J/6MB8gk˲g>IR<Ҏg ۆ}2|J1yCZ!]zZ5FD#[˺u 0du1[J糇j=^=m*,u*F)Z(<-i[)E!D^Öeҡj&sEE}0 If?G?,D+ <jA6i kDtV IYCod (LA>%˴DB"ZRI>T/"̔uY*iǽc(*0 9"NC~`5E"u3 qTTMy)6 ئ-kÓO*jg8V靮@p)<N^WyeQi>d;GUDÔu$b2|Jj/P_5PX9`Clc(@꺀,T( ؓAJMW޷0<*nd £&ݨRG.@VZ.ېƷX5umXRw bVm޿tֲDo!/@TNKĈGH1< |S}i^ߥj暀HfuJ IQ0Mzfx0( 4eDh8 y=s89#W]"9pAlz=mhYGɶ sxrr§Wd4w|pr 6 f^11 Z΢e}  ǟ:{TqH<<Tb>u鞀\^܆؛ԝ2}I~&s7Vr_~7YzN;DR'{iZ_ RZ˯k"mr6#F7n=eXb[t<*ϳnqGJu7)]\3ʆ^;uMiyEP#dYlI*ZH)25z> yP8%+f^FC|ym{n#(db3̡Ml ּz7!+tj6 d'pVV8a*n rEw?i6nW/ LxA IFV93lп'8pU5>U [rym86/lvpW Hg-2@ؙ9ɹ UR<ܯ$GL&6٠JIҶ^I7I%[Iy4pҚKCC{u(͋$;-|728ƞNZ,-=Ϩ! sJcfKod߀auӥ]z[vۿ6{oo3QNt{cu >,Q NوͩdJbHd O8U16MM׋ǖUa-o2m%wf{C5T?TE^L1q8`$ &Ө-,]ë2LM?FZ&gsty;dT vyƳRHyL e#/X!_>,*kY{{o\Mo \M~嚡.ϯ{fMNL`{{Пg'&ar_gM2.lf1i@Ԝ܌xan+.PTf @~;#4??>/`2}Sx=K/ m+[tӣ O׮:<.$8fYf" -x/VL@$9|8OrKrԎכ%&PYwXh$aޛn޹{};(ƺl 뀊LPc u3d#3L*b < ^X@!n;juCתlɒakZ78S~> A~;7 )`Dxa۸4D^zşDR:}PmmGүS6㐏'V){ר_ZiK-IOQUIIʟ&OB>Z!DR+:saYJ)4qzXa Qڻ&vCG3ؓ=n_տhcVkv GY9آizim# n7}]oМg7 i.k%R(myčbN66ćN뢅wpDss?sn#yRJaH' /V1/+0=p6qRj,pie/I)=^ ۞^/vU|6oswmzۚ]f]˭~8.GxaZa}k݁[S &I]mnn&ϤCu}+44P%ܫI Ri>ۦ=Mu8εdh[=aʛ[|CƦ;_y*2Ŀк>h<#Kb1k M+8Aqd=܄Yʼn,]ObP):ώg4 {FzM ѭ|q~7ύU4ǽNMMNMw5[a丿/ h4q\+3wJ9 w&&xpݮ|`+ꑖwȰUNɢ -kk[_CVrAT^yU[׿2zA=h~>z?~駏)p\by+kQD}f3Ow:&)l xRUԋ,$rx ?wgۖ1nCC73y/!YL/ H$-?Ǥ8] mŅo0ZA 9;6A&•AR@V*P*z;!`BH1:Sf<YQVaV7Ts8R? RBU2ou{-$R~avz^rSL׺& z>HDRSq}} `q Fzס/C^|%v V)Ύ> L|BO Ƒ`5ǟ"o<&cO]"K]x'5k}ٺ> Z.fՙQaÉUS}: B[1ckKߍ>h"!O"9 /Oc,Dv{;N1q7"o}זs/s/#2ؕ/HJ5- G[_T[hiyJq k/1zƉϱ"f׹9zlCۗ݊[?{Zr?(FM@޴6l]{-` |Vg$F.\}3~U`P޼SҜs%~zt/6ߵ-qT;[g :P;͔¥v>eSۇL1=Ѳ胂ey #;'LkP5n\W9=|Pr!J")Q'J'r^.P}F~b}.$QY.˳ ;YMcE\H2`r1QVtI c=e0Wz_5z 1mښEi[o&0ѝuRKˉj nm-3lG醴OYia&SuYL63PPAz*)/آUY*64Z*˫9LzlOBJgwh;%ckQvJ{?E2A򎉞/i<719e;[;LBoa7KBoBwXll0*ƣ^6&i:/n %20s: ", .dq(n), .dq(m))) tt <- try(as(x, m), silent = TRUE) if(inherits(tt, "try-error")) { cat("\t *ERROR* !!\n") } else { cat("as() ok; validObject: ") vo <- validObject(tt, test = TRUE) cat(if(isTRUE(vo)) "ok" else paste("OOOOOOPS:", vo), "\n") } } } cat("---\n") } } cat('Time elapsed: ', proc.time(),'\n') # for the above "part I" if(doExtras && !interactive()) { # don't want to see on source() cat("All classes in the 'Matrix' package:\n") for(cln in allCl) { cat("\n-----\n\nClass", dQuote(cln),":\n ", paste(rep("~",nchar(cln)),collapse=''),"\n") ## A smarter version would use getClass() instead of showClass(), ## build the "graph" and only then display. ## showClass(cln) } cat("\n \n") ## One could extend the `display' by using (something smarter than) ## are the "coerce" methods showing more than the 'Extends' output above? cat("All (S4) methods in the 'Matrix' package:\n") showMethods(where="package:Matrix") } # end{non-interactive} ## 1-indexing instead of 0-indexing for direct "dgT" should give error: ii <- as.integer(c(1,2,2)) jj <- as.integer(c(1,1,3)) assertError(new("dgTMatrix", i=ii, j=jj, x= 10*(1:3), Dim=2:3)) assertError(new("dgTMatrix", i=ii, j=jj - 1:1, x= 10*(1:3), Dim=2:3)) assertError(new("dgTMatrix", i=ii - 1:1, j=jj, x= 10*(1:3), Dim=2:3)) (mm <- new("dgTMatrix", i=ii - 1:1, j=jj - 1:1, x= 10*(1:3), Dim=2:3)) validObject(mm) ### Sparse Logical: m <- Matrix(c(0,0,2:0), 3,5) mT <- as(mC <- as(m, "CsparseMatrix"), "TsparseMatrix") stopifnot(identical(as(mT,"CsparseMatrix"), mC)) (mC. <- as(mT[1:2, 2:3], "CsparseMatrix")) (mlC <- as(mC. , "lMatrix")) as(mlC,"ltCMatrix") if(!doExtras && !interactive()) q("no") ## (saving testing time) ### Test all classes: validObject(new( * )) should be fulfilled ----------- ## need stoplist for now: Rcl.struc <- c("gR", "sR", "tR") (dR.classes <- paste0(paste0("d", Rcl.struc[Rcl.struc != "gR"]), "Matrix")) (.R.classes <- paste0(sort(outer(c("l", "n"), Rcl.struc, paste0)), "Matrix")) # have only stub implementation Mat.MatFact <- c("Cholesky", "pCholesky", "BunchKaufman", "pBunchKaufman")##, "LDL" ##FIXME maybe move to ../../MatrixModels/tests/ : ## (modmat.classes <- .subclasses("modelMatrix")) no.t.etc <- c(.R.classes, dR.classes, Mat.MatFact)#, modmat.classes) no.t.classes <- c(no.t.etc) # no t() available no.norm.classes <- no.t.classes not.Ops <- NULL # "Ops", e.g. "+" fails not.coerce1 <- no.t.etc # not coercable from "dgeMatrix" not.coerce2 <- no.t.etc # not coercable from "matrix" tstMatrixClass <- function(cl, mM = Matrix(c(2,1,1,2) + 0, 2,2, dimnames=rep( list(c("A","B")), 2)), # dimnames: *symmetric* mm = as(mM, "matrix"), recursive = TRUE, offset = 0) { ## Purpose: Test 'Matrix' class {and do this for all of them} ## ---------------------------------------------------------------------- ## Arguments: cl: class object of a class that extends "Matrix" ## mM: a "Matrix"-matrix which will be coerced to class 'cl' ## mm: a S3-matrix which will be coerced to class 'cl' ## ---------------------------------------------------------------------- ## Author: Martin Maechler ## from pkg sfsmisc : bl.string <- function(no) sprintf("%*s", no, "") ## Compute a few things only once : mM <- as(mM, "dgeMatrix") trm <- mm; trm[lower.tri(mm)] <- 0 ## not yet used: ## summList <- lapply(getGroupMembers("Summary"), get, ## envir = asNamespace("Matrix")) if(recursive) cList <- character(0) extraValid <- function(m, cl = class(m)) { sN <- slotNames(cl) sN <- sN[sN != "factors"] for(nm in sN) if(!is.null(a <- attributes(slot(m, nm)))) stop(sprintf("slot '%s' with %d attributes, named: ", nm, length(a)), paste(names(a), collapse=", ")) invisible(TRUE) } ## This is the recursive function dotestMat <- function(cl, offset) { cat. <- function(...) cat(bl.string(offset), ...) clNam <- cl@subClass cat("\n==>") cat.(clNam) ##--------- clD <- getClassDef(clNam) if(isVirtualClass(clD)) { cat(" - is virtual\n") if(recursive) { cat.("----- begin{class :", clNam, "}----new subclasses----\n") for(ccl in clD@subclasses) { cclN <- ccl@subClass if(cclN %in% cList) cat.(cclN,": see above\n") else { cList <<- c(cList, cclN) dotestMat(ccl, offset = offset + 3) } } cat.("----- end{class :", clNam, "}---------------------\n") } } else { ## --- actual class --- genC <- extends(clD, "generalMatrix") symC <- extends(clD, "symmetricMatrix") triC <- extends(clD, "triangularMatrix") diaC <- extends(clD, "diagonalMatrix") if(!(genC || symC || triC || diaC)) stop("does not extend one of 'general', 'symmetric', 'triangular', or 'diagonal'") sparseC <- extends(clD, "sparseMatrix") denseC <- extends(clD, "denseMatrix") if(!(sparseC || denseC)) stop("does not extend either 'sparse' or 'dense'") cat("; new(*): ") m <- new(clNam) ; cat("ok; ") m0 <- matrix(,0,0) if(canCoerce(m0, clNam)) { cat("; canCoerce(matrix(,0,0), *) => as(m0, <.>): ") stopifnot(Qidentical(m, as(m0, clNam))); cat("ok; ") } is_p <- extends(clD, "indMatrix") is_cor <- extends(clD, "corMatrix") # has diagonal divided out if(canCoerce(mm, clNam)) { ## replace 'm' by `non-empty' version cat("canCoerce(mm, *) ") m0 <- { if(triC) trm else if(is_p) mm == 1 # logical *and* "true" permutation else mm } if(extends(clD, "lMatrix") || extends(clD, "nMatrix")) storage.mode(m0) <- "logical" else if(extends(clD, "zMatrix")) storage.mode(m0) <- "complex" validObject(m) ## validity of trivial 'm' before replacing m <- as(m0, clNam) if(is_cor) m0 <- cov2cor(m0) } else { m0 <- vector(Matrix:::.type.kind[Matrix:::.M.kindC(clNam)]) dim(m0) <- c(0L,0L) } ## m0 is the 'matrix' version of our 'Matrix' m m. <- m0 ##m. <- if(is_p) as.integer(m0) else m0 EQ <- if(is_cor) all.equal else identical stopifnot(EQ(m0[FALSE], m[FALSE]) , EQ(m.[TRUE], m[TRUE]) , if(length(m) >= 2) EQ(m.[2:1], m[2:1]) else TRUE) if(all(dim(m) > 0)) { ## matrix(0,0,0)[FALSE,] is invalid too m00 <- m[FALSE,FALSE] m.. <- m[TRUE , TRUE] stopifnot(dim(m00) == c(0L,0L), dim(m..) == dim(m)) ## not yet , class(m00) == clNam , identical(m.. , m) } cat("valid: ", validObject(m), extraValid(m, clNam),"\n") ## This can only work as long as 'm' has no NAs : ## not yet -- have version in not.Ops below ## once we have is.na(): ## stopifnot(all(m == m | is.na(m))) ## check all() and "==" [Compare] ## if(any(m != m && !is.na(m))) show(m) ## coerce to 'matrix' m.m <- as(m, "matrix") ##=========## checkMatrix(m, m.m, ##=========## do.t= !(clNam %in% no.t.classes), doNorm= !(clNam %in% no.norm.classes), doOps = all(clNam != not.Ops), doCoerce = all(clNam != not.coerce1), catFUN = cat.) ### FIXME: organize differently : ### 1) produce 'mM' and 'mm' for the other cases, ### 2) use identical code for all cases if(is(m, "dMatrix") && is(m, "compMatrix")) { if(any(clNam == not.coerce1)) cat.("not coercable_1\n") else if(canCoerce(mM, clNam)) { m2 <- as(mM, clNam) cat("valid:", validObject(m2), "\n") if(!is_cor) ## as.vector() stopifnot(as.vector(m2) == as.vector(mM)) cat.("[cr]bind2():"); mm2 <- cbind2(m2,m2) stopifnot(dim(rbind2(m2,m2)) == 2:1 * dim(mM)); cat(" ok") if(genC && class(mm2) == clNam) ## non-square matrix when "allowed" m2 <- mm2 dd <- diag(m2) cat("; `diag<-` ") diag(m2) <- 10*dd stopifnot(is_cor || identical(dd, diag(mM)), identical(10*dd, diag(m2))); cat("ok ") } ## if(all(clNam != not.coerce2)) { if(canCoerce("matrix", clNam)) { cat.("as(matrix, ): ") m3 <- as(mm, clNam) cat("valid:", validObject(m3), "\n") } else cat.(" not coerceable from \"matrix\"\n") ## } } ## else { ... no happens in tstMatrix() above .. } ## if(is(m, "denseMatrix")) { ## ## ......... ## cat.("as dsparse* ") ## msp <- as(m, "dsparseMatrix") ## cat.("; valid coercion: ", validObject(msp), "\n") ## } else if(is(m, "sparseMatrix")) { ## } else cat.("-- not dense nor sparse -- should not happen(!?)\n") if(is(m, "dsparseMatrix")) { if(any(clNam == not.coerce1)) cat.("not coercable_1\n") else { ## make sure we can coerce to dgT* -- needed, e.g. for "image" ## change: use Tsparse instead of dgT, unless it *is* Tsparse: isT <- is(m, "TsparseMatrix") prefix <- if(isT) "dgT" else "Tsparse" Tcl <- paste(prefix, "Matrix", sep='') cat.(sprintf("as %s* ", prefix)) mgT <- as(m, Tcl) cat(sprintf("; valid %s* coercion: %s\n", prefix, validObject(mgT))) } } } } # end{dotestMat} for(scl in getClass(cl)@subclasses) dotestMat(scl, offset + 1) } ## in case we want to make progress: ## codetools::checkUsage(tstMatrixClass, all=TRUE) tstMatrixClass("Matrix") if(FALSE)## or just a sub class tstMatrixClass("triangularMatrix") cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' if(!interactive()) warnings() Matrix/tests/dtpMatrix.R0000644000176200001440000000420013436004512014751 0ustar liggesusers### triangular packed library(Matrix) source(system.file("test-tools.R", package = "Matrix"))# identical3() etc cp6 <- chol(H6 <- Hilbert(6)) tp6 <- as(cp6,"dtpMatrix") round(tp6, 3)## round() is "Math2" group method 1/tp6 ## "Arith" group : gives 'dgeMatrix' str(tp6) ## arithmetic with a mix of dimnames / no dimnames tp <- tp6; dimnames(tp) <- list(LETTERS[1:6], letters[11:16]) ## as.matrix() --> "logical" matrix stopifnot(as.matrix(tp - tp6 == tp6 - tp), as.matrix(0 == tp - tp6), identical(as(tp6,"CsparseMatrix"), as(cp6,"CsparseMatrix"))) stopifnot(validObject(tp6), all.equal(tp6 %*% diag(6), as(tp6, "dgeMatrix")), validObject(tp6. <- diag(6) %*% tp6), class((tt6 <- t(tp6))) == "dtpMatrix", identical(t(tt6), tp6), tp6@uplo == "U" && tt6@uplo == "L") all.equal(as(tp6.,"matrix"), as(tp6, "matrix"), tolerance= 1e-15) (tr6 <- as(tp6, "dtrMatrix")) dH6 <- determinant(H6) D. <- determinant(tp6) rc <- rcond(tp6) stopifnot(all.equal(dH6$modulus, determinant(as.matrix(H6))$modulus), is.all.equal3(c(D.$modulus), c(dH6$modulus) / 2, -19.883103353), all.equal(rc, 1.791511257e-4), all.equal(norm(tp6, "I") , 2.45), all.equal(norm(tp6, "1") , 1), all.equal(norm(tp6, "F") , 1.37047826623) ) object.size(tp6) object.size(as(tp6, "dtrMatrix")) object.size(as(tp6, "matrix")) D6 <- as(diag(6), "dgeMatrix") ge6 <- as(tp6, "dgeMatrix") stopifnot(all.equal(D6 %*% tp6, ge6), all.equal(tp6 %*% D6, ge6)) ## larger case RNGversion("3.6.0")# future proof set.seed(123) rl <- new("dtpMatrix", uplo="L", diag="N", Dim = c(1000L, 1000L), x = rnorm(500*1001)) validObject(rl) str(rl) sapply(c("I", "1", "F"), function(type) norm(rl, type=type)) rcond(rl)# 0 ! stopifnot(all.equal(as(rl %*% diag(1000),"matrix"), as(rl, "matrix"))) object.size(rl) ## 4 MB object.size(as(rl, "dtrMatrix"))# 8 MB object.size(as(rl, "matrix"))# ditto print(drl <- determinant(rl), digits = 12) stopifnot(all.equal(c(drl$modulus), -638.257312422)) cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' Matrix/tests/dpo-test.R0000644000176200001440000001430713506410762014553 0ustar liggesusers### Testing positive definite matrices library(Matrix) source(system.file("test-tools.R", package = "Matrix"))# identical3() etc cat("doExtras:",doExtras,"\n") h9 <- Hilbert(9) stopifnot(c(0,0) == dim(Hilbert(0)), c(9,9) == dim(h9), identical(h9@factors, list())) str(h9)# no 'factors' 32b: -96.73694669 2.08e-8 assert.EQ.(c(determinant(h9)$modulus), -96.7369487, tol = 8e-8) ## 64b: -96.73695078 2.15e-8 then 6.469e-8 ## determinant() now working via chol(): ==> h9 now has factorization stopifnot(names(h9@factors) == "Cholesky", identical(ch9 <- chol(h9), h9@factors$Cholesky)) round(ch9, 3) ## round() preserves 'triangular' ! str(f9 <- as(ch9, "dtrMatrix")) stopifnot(all.equal(rcond(h9), 9.0938e-13), all.equal(rcond(f9), 9.1272e-7, tolerance = 1e-6))# more precision fails options(digits=4) (cf9 <- crossprod(f9))# looks the same as h9 : assert.EQ.mat(h9, as(cf9,"matrix"), tol=1e-15) h9. <- round(h9, 2)# actually loses pos.def. "slightly" # ==> the above may be invalid in the future h9p <- as(h9, "dppMatrix") h9.p <- as(h9., "dppMatrix") ch9p <- chol(h9p) stopifnot(identical(ch9p, h9p@factors$pCholesky), identical(names(h9p@factors), c("Cholesky", "pCholesky"))) h4 <- h9.[1:4, 1:4] # this and the next h9.[1,1] <- 10 # had failed in 0.995-14 h9p[1,1] <- 10 stopifnotValid(h9., "symmetricMatrix") stopifnotValid(h9p, "symmetricMatrix") stopifnotValid(h4, "symmetricMatrix") h9p[1,2] <- 99 stopifnot(class(h9p) == "dgeMatrix", h9p[1,1:2] == c(10,99)) str(h9p <- as(h9, "dppMatrix"))# {again} h6 <- h9[1:6,1:6] stopifnot(all(h6 == Hilbert(6)), length(h6@factors) == 0) stopifnotValid(th9p <- t(h9p), "dppMatrix") stopifnotValid(h9p@factors$Cholesky,"Cholesky") H6 <- as(h6, "dspMatrix") pp6 <- as(H6, "dppMatrix") po6 <- as(pp6,"dpoMatrix") hs <- as(h9p, "dspMatrix") stopifnot(names(H6@factors) == "pCholesky", names(pp6@factors) == "pCholesky", names(hs@factors) == "Cholesky") # for now chol(hs) # and that is cached in 'hs' too : stopifnot(names(hs@factors) %in% c("Cholesky","pCholesky"), all.equal(h9, crossprod(hs@factors$pCholesky), tolerance =1e-13), all.equal(h9, crossprod(hs@factors$ Cholesky), tolerance =1e-13)) hs@x <- 1/h9p@x # is not pos.def. anymore validObject(hs) # "but" this does not check stopifnot(diag(hs) == seq(1, by = 2, length = 9)) s9 <- solve(h9p, seq(nrow(h9p))) signif(t(s9)/10000, 4)# only rounded numbers are platform-independent (I9 <- h9p %*% s9) m9 <- matrix(1:9, dimnames = list(NULL,NULL)) stopifnot(all.equal(m9, .asmatrix(I9), tolerance = 2e-9)) ### Testing nearPD() --- this is partly in ../man/nearPD.Rd : pr <- Matrix(c(1, 0.477, 0.644, 0.478, 0.651, 0.826, 0.477, 1, 0.516, 0.233, 0.682, 0.75, 0.644, 0.516, 1, 0.599, 0.581, 0.742, 0.478, 0.233, 0.599, 1, 0.741, 0.8, 0.651, 0.682, 0.581, 0.741, 1, 0.798, 0.826, 0.75, 0.742, 0.8, 0.798, 1), nrow = 6, ncol = 6) nL <- list(r = nearPD(pr, conv.tol = 1e-7), # default r.1 = nearPD(pr, conv.tol = 1e-7, corr = TRUE), rs = nearPD(pr, conv.tol = 1e-7, doDyk=FALSE), rs1 = nearPD(pr, conv.tol = 1e-7, doDyk=FALSE, corr = TRUE), rH = nearPD(pr, conv.tol = 1e-15), rH.1= nearPD(pr, conv.tol = 1e-15, corr = TRUE)) sapply(nL, `[`, c("iterations", "normF")) allnorms <- function(d) vapply(c("1","I","F","M","2"), norm, x = d, double(1)) ## "F" and "M" distances are larger for the (corr=TRUE) constrained: 100 * sapply(nL, function(rr) allnorms((pr - rr $ mat))) ## But indeed, the 'corr = TRUE' constraint yield a better solution, ## if you need the constraint : cov2cor() does not just fix it up : 100 * (nn <- sapply(nL, function(rr) allnorms((pr - cov2cor(rr $ mat))))) stopifnot( all.equal(nn["1",], c(r =0.0999444286984696, r.1= 0.0880468666522317, rs=0.0999444286984702, rs1= 0.0874614179943388, rH=0.0999444286984696, rH.1=0.0880468927726625), tolerance=1e-9)) nr <- nL $rH.1 $mat stopifnot( all.equal(nr[lower.tri(nr)], c(0.4877861230299, 0.6429309061748, 0.4904554299278, 0.6447150779852, 0.8082100656035, 0.514511537243, 0.2503412693503, 0.673249718642, 0.7252316891977, 0.5972811755863, 0.5818673040157, 0.7444549621769, 0.7308954865819, 0.7713984381710, 0.8124321235679), tolerance = 1e-9)) showProc.time() suppressWarnings(RNGversion("3.5.0")); set.seed(27) m9 <- h9 + rnorm(9^2)/1000 ; m9 <- (m9 + t(m9))/2 nm9 <- nearPD(m9) showProc.time() nRep <- if(doExtras) 50 else 4 CPU <- 0 for(M in c(5, 12)) for(i in 1:nRep) { m <- matrix(round(rnorm(M^2),2), M, M) m <- m + t(m) diag(m) <- pmax(0, diag(m)) + 1 m <- cov2cor(m) CPU <- CPU + system.time(n.m <- nearPD(m, base.matrix=TRUE))[1] X <- n.m$mat stopifnot(all.equal(X, (X + t(X))/2, tolerance = 8*.Machine$double.eps), all.equal(eigen(n.m$mat, only.values=TRUE)$values, n.m$eigenvalues, tolerance = 4e-8)) } cat('Time elapsed for ',nRep, 'nearPD(): ', CPU,'\n') showProc.time() ## cov2cor() m <- diag(6:1) %*% as(pr,"matrix") %*% diag(6:1) # so we can "vector-index" m[upper.tri(m)] <- 0 ltm <- which(lower.tri(m)) ne <- length(ltm) set.seed(17) m[ltm[sample(ne, 3/4*ne)]] <- 0 m <- (m + t(m))/2 # now is a covariance matrix with many 0 entries (spr <- Matrix(m)) cspr <- cov2cor(spr) ev <- eigen(cspr, only.v = TRUE)$values stopifnot(is(spr, "dsCMatrix"), is(cspr,"dsCMatrix"), all.equal(ev, c(1.5901626099, 1.1902658504, 1, 1, 0.80973414959, 0.40983739006), tolerance=1e-10)) x <- c(2,1,1,2) mM <- Matrix(x, 2,2, dimnames=rep( list(c("A","B")), 2))# dsy mM stopifnot(length(mM@factors)== 0) (po <- as(mM, "dpoMatrix")) # still has dimnames mm <- as(mM, "matrix") msy <- as(mm, "dsyMatrix") stopifnot(Qidentical(mM, msy), length(mM @factors)== 1, length(msy@factors)== 0) c1 <- as(mm, "corMatrix") c2 <- as(mM, "corMatrix") c3 <- as(po, "corMatrix") (co.x <- matrix(x/2, 2,2)) checkMatrix(c1) assert.EQ.mat(c1, co.x) assert.EQ.mat(c2, co.x) # failed in Matrix 0.999375-9, because of ## the wrong automatic "dsyMatrix" -> "corMatrix" coerce method stopifnot(identical(dimnames(c1), dimnames(mM)), all.equal(c1, c3, tolerance =1e-15)) showProc.time() Matrix/tests/Simple.R0000644000176200001440000013641314154106403014242 0ustar liggesusers#### Currently a collection of simple tests ## (since 'Matrix' takes long to load, rather have fewer source files!) ##-------- *BEFORE* attaching Matrix: -------------------------------- str(Matrix::Matrix)# -> load the namespace T <- new("ngTMatrix", i=0L, j=2L, Dim = c(2L,6L)) T as(T, "CsparseMatrix") ## gave Error in asMethod(object) : could not find function ".M.classEnv" ## from 0.999375-23 to *-25 ## another even shorter version of this: n <- new("dgCMatrix") n ## this: m <- Matrix::Matrix(cbind(1,0,diag(x=2:4))) m mt <- m + table(gl(3,5), gl(5,3))# failed in Matrix <= 1.2.9 mt stopifnot(is(mt, "sparseMatrix")) ##-------------------------------------------------------------------- library(Matrix) source(system.file("test-tools.R", package = "Matrix"))# identical3() etc if(interactive()) { options(error = recover, Matrix.verbose = TRUE, warn = 1) } else options( Matrix.verbose = TRUE, warn = 1) # ^^^^^^ to show Matrix.msg()s ### Matrix() ''smartness'' (d40 <- Matrix( diag(4))) (z4 <- Matrix(0*diag(4))) (o4 <- Matrix(1+diag(4))) (tr <- Matrix(cbind(1,0:1))) (M4 <- Matrix(m4 <- cbind(0,rbind(6*diag(3),0)))) dM4 <- Matrix(M4, sparse = FALSE) d4. <- diag(4); dimnames(d4.) <- dns <- rep(list(LETTERS[1:4]), 2) d4a <- diag(4); dimnames(d4a) <- dna <- list(LETTERS[1:4], letters[1:4])# "a"symmetric m1a <- matrix(0, dimnames=list("A","b"))# "a"symmetric d4di<- as(d4., "diagonalMatrix") d4da<- as(d4a, "diagonalMatrix") d4d <- as(d4., "denseMatrix") d4aS <- Matrix(d4a, sparse=TRUE, doDiag=FALSE) d1aS <- Matrix(m1a, sparse=TRUE, doDiag=FALSE) stopifnot(exprs = { identical(d4di@x, numeric()) # was "named" unnecessarily identical(dimnames(d4 <- Matrix(d4.)), dns) identical4(d40, Matrix(diag(4)), unname(d4), unname(d4da)) identical3(d4, as(d4., "Matrix"), as(d4., "diagonalMatrix")) is(d4aS, "dtCMatrix") # not "dsC*", as asymmetric dimnames is(d4d, "denseMatrix") identical(dimnames(d4T <- as(d4., "TsparseMatrix")), dns) # failed till 2019-09-xx identical(d4T, as(d4., "dgTMatrix")) }) class(mN <- Matrix(NA, 3,4)) # NA *is* logical validObject(Matrix(NA)) bd4 <- bdiag(M4,dM4,M4) stopifnotValid(o4, "dsyMatrix") stopifnotValid(M4, "dtCMatrix") stopifnot(validObject(dM4), validObject(mN), identical(bdiag(M4), bdiag(dM4)), identical(bd4@p, c(0L,0:3,3:6,6:9)), identical(bd4@i, c(0:2, 4:6, 8:10)), bd4@x == 6 ) assert.EQ.mat(dM4, m4) assert.EQ.mat(M4^M4, m4^m4) assert.EQ.mat(mN, matrix(NA, 3,4)) assert.EQ.mat(bdiag(diag(4)), diag(4)) sL <- Matrix(, 3,4, sparse=TRUE)# -> "lgC" trS <- Matrix(tr, sparse=TRUE)# failed in 0.9975-11 stopifnotValid(d4, "diagonalMatrix"); stopifnotValid(z4, "diagonalMatrix") stopifnotValid(tr, "triangularMatrix"); stopifnotValid(trS, "triangularMatrix") stopifnot(all(is.na(sL@x)), ## not yet: all(is.na(sL)), !any(sL, na.rm=TRUE), all(!sL, na.rm=TRUE), validObject(Matrix(c(NA,0), 4, 3, byrow = TRUE)), validObject(Matrix(c(NA,0), 4, 4))) stopifnotValid(Matrix(c(NA,0,0,0), 4, 4), "sparseMatrix") I <- i1 <- I1 <- Diagonal(1) ## TODO? stopifnot(identical(I, Matrix(1, sparse=TRUE))) # doDiag=TRUE default I1[1,1] <- i1[1, ] <- I [ ,1] <- NA stopifnot(identical3(I,i1,I1)) image(d4) # gave infinite recursion ## Steve Walker, Mar 12, 2014: n <- 7 (M <- triu(Matrix(seq_len(n^2), n, sparse=TRUE))) im <- image(M) # should be an n-by-n image plot, but is not stopifnot(n == diff(sort(im$y.limits))) ## ylimits were too small (by 1 on each side) assertError( Matrix(factor(letters)) ) n.lsec <- length(.leap.seconds)# 27 (2017-07) mlp <- matrix(.leap.seconds)## 27 x 1 numeric matrix Mlp <- Matrix(.leap.seconds) stopifnot(identical(dim(Mlp), c(n.lsec, 1L))) assert.EQ.mat(Mlp, mlp) .Leap.seconds <- as.POSIXlt(.leap.seconds) if(FALSE) { ## TODO -- once R itself does better ... mLp <- matrix(.Leap.seconds)## 11 x 1 list of (Numeric,Int.,Char.) each of length 27 -- yuck!!! MLp <- Matrix(.Leap.seconds)## --> error (for now) } E <- rep(c(TRUE,NA,TRUE), length=8) F <- new("nsparseVector", length = 8L, i = c(2L, 5L, 8L)) e <- as(E, "sparseVector"); f <- as(F,"lsparseVector") Fv <- as.vector(F, "any") # failed in Matrix <= 1.2.0, and base::as.vector(.) failed too: stopifnot(E | as.vector(F), identical(E | F, F | E), all(e | f), all(E | F), # <- failed Ops.spv.spv identical(Fv, base::as.vector(F)), is.logical(Fv), which(Fv) == c(2,5,8)) F[-8:-1] # was partly "illegal" (length = 0 is ok; nnz '3' is not) F.ineg <- lapply(1:8, function(k) F[-8:-k]) F.pos <- lapply(1:8, function(k) F[seq_len(k-1)]) F.vec <- lapply(1:8, function(k) Fv[seq_len(k-1)]) str(F.vec, vec=8) (nT <- vapply(F.vec, sum, 1L)) # == 0 0 1 1 1 2 2 2 str(whichT <- lapply(F.vec, which)) i.lengths <- function(L) vapply(L, function(.) length(.@i), 1L) stopifnot(identical(lengths(F.vec), 0:7) , identical(lengths(F.ineg), 0:7) , identical(lengths(F.pos), 0:7) , identical(i.lengths(F.pos), nT) , identical(i.lengths(F.ineg), nT) # failed before 2018-03-19 , identical(lapply(F.pos, slot, "i"), whichT) , identical(lapply(F.ineg, slot, "i"), whichT) # failed before 2018-03-19 ) ## Here, sparseVector '[' is really wrong: SV <- new("nsparseVector", length = 30L, i = c(1L, 8L, 9L, 12L, 13L, 18L, 21L, 22L)) NI <- -c(1:5, 7:10, 12:16, 18:27, 29,30) sv <- SV[1:14]; ni <- -(1:14)[-c(6,11)] # smaller example selectMethod("[", c("nsparseVector","index","missing","missing"))# the culprit if(FALSE) trace("[", browser, signature=c("nsparseVector","index","missing","missing")) stopifnot( SV[NI] == as.vector(SV)[NI] ## badly failed before 2018-03-19 , sv[ni] == as.vector(sv)[ni] ## ditto ) if(FALSE) untrace("[", signature=c("nsparseVector","index","missing","missing")) dT <- new("dgTMatrix", i = c(1:2,1:2), j=rep(1:2, each=2), Dim = c(4L, 4L), x = c(1, 1, NA, 2)) dt <- new("dtTMatrix", i = 0:3, j = 0:3, Dim = c(4L, 4L), x = c(1,0,0,0), uplo = "U", diag = "N") c1 <- as(dT, "CsparseMatrix") c2 <- as(dt, "CsparseMatrix") isValid(lc <- c1 > c2,"lgCMatrix") isValid(lt <- dT > dt,"lgCMatrix") stopifnot(identical(lc,lt)) ## Versions of Diagonal() dD <- Diagonal(x = 5:1) sD <- .symDiagonal(5, 5:1) tD <- .trDiagonal (5, 5:1) # x= had failed for both stopifnot(all(sD == dD) , all(tD == dD) , identical(sD, .symDiagonal(x = 5:1)) , identical(tD, .sparseDiagonal(x=5:1)) , identical(tD, .trDiagonal (x = 5:1)))# 'n' now has default M <- Diagonal(4); M[1,2] <- 2 ; M cM <- crossprod(M) # >> as_cholmod_l_triplet(): could not reallocate for internal diagU2N() stopifnot(identical(cM, tcrossprod(t(M)))) S.na <- spMatrix(3, 4, c(1,2,3), c(2,3,3), c(NA,1,0)) (S.na <- S.na - 2 * S.na) (L <- S.na != 0) (Ln0 <- S.na != rep(0, prod(dim(L)))) .Lm0 <- S.na != Matrix(0, 3, 4) stopifnot(Q.eq(L, Ln0), identical(Ln0, .Lm0)); rm(Ln0, .Lm0) ### Unit-diagonal and unitriangular {methods need diagU2N() or similar} I <- Diagonal(3) (T <- as(I,"TsparseMatrix")) # unitriangular (C <- as(I,"CsparseMatrix")) # (ditto) lT <- as(T,"lMatrix") lC <- as(C,"lMatrix") stopifnot( identical((n0 <- I != 0), Diagonal(3, TRUE)), I@diag == "U", identical(n0, I & TRUE), identical(n0, I | FALSE), identical(n0, TRUE & I), identical(n0, FALSE | I), all(n0 == !(I == 0)), all(I == n0), identical(n0 == I, I == n0) , identical4(lT, as(Diagonal(3, x=TRUE),"TsparseMatrix"), T & TRUE, TRUE & T), identical4(lC, as(Diagonal(3, x=TRUE),"CsparseMatrix"), C & TRUE, TRUE & C), identical3(lT, T | FALSE, FALSE | T), identical3(lC, C | FALSE, FALSE | C), TRUE) I[,1] <- NA; I[2,2] <- NA ; I[3,] <- NaN stopifnotValid(I, "sparseMatrix") I # gave error in printSpMatrix() - because of R bug in format.info() L <- spMatrix(9, 30, i = rep(1:9, 3), 1:27, (1:27) %% 4 != 1) M <- drop0(crossprod(L)) diag(M) <- diag(M) + 5 # to make it pos.def. M. <- M[1:12,1:12] # small ex N3 <- as(Matrix(upper.tri(diag(3))), "nMatrix") stopifnotValid(bdN <- bdiag(N3, N3),"nsparseMatrix") stopifnot(identical(L, L == TRUE), ## used to give infinite recursion all(drop0((0 - L) != 0) == drop0(L))) L[sample(length(L), 10)] <- NA ll <- as(L,"logical") stopifnot(all.equal(mean(L, na.rm=TRUE), mean(ll, na.rm=TRUE), tol= 1e-14), all.equal(mean(L, na.rm=TRUE, trim=1/4),# <- with a warning mean(ll, na.rm=TRUE, trim=1/4), tol= 1e-14)) ## Examples where is.na(.) was wrong: validObject(sc <- new("dsCMatrix", i=as.integer(c(0,0:1,1:2,0:1,3)), Dim=c(4L,4L), p = c(0L,1L,3L,5L,8L), x = c(0,NA,NA,0:1,0,NA,1))) validObject(gc <- as(sc, "generalMatrix")) stopifnot(isSymmetric(M), isSymmetric(M.), is(bdiag(M., M.),"symmetricMatrix"), is(bdN, "triangularMatrix"), all(sc == gc | (is.na(sc) & is.na(gc))), all.equal(N3,N3), tail(all.equal(N3, t(N3)), 1) == all.equal(1,-1),# ~= "Mean relative difference: 2" all((bdN != t(bdN)) == (bdN + t(bdN))), # != failed to work... !any((0+bdN) > bdN), # o !any(bdN != (0+bdN)), # o length(grep("Length", all.equal(M., (vM <- as.vector(M.))))) > 0, identical(M., (M2 <- Matrix(vM, 12,12))), all.equal(M., M2, tolerance =0) ) Filter(function(.) inherits(get(.), "symmetricMatrix"), ls()) ## [1] "cM" "M" "M." "M2" "o4" "sc" tt <- as(kronecker(cM, Diagonal(x = c(10,1))), "symmetricMatrix") dimnames(tt) <- list(NULL, cn <- letters[1:ncol(tt)]) stopifnotValid(tt, "dsTMatrix") (cc <- as(tt, "CsparseMatrix")) # shows *symmetric* dimnames stopifnot(identical3( cc @Dimnames, tt @Dimnames, list(NULL, cn)), identical3(t(cc)@Dimnames, t(tt)@Dimnames, list(cn, NULL)), identical3(dimnames(cc), dimnames(tt), list(cn, cn)))# now symmetric ! stopifnot(identical3(dimnames(cc), dimnames(as(cc, "generalMatrix")), ## should fixup dimnames to *symmetric* dimnames(as(tt, "generalMatrix")))) ## --> .Call(Csparse_symmetric_to_general, from) mat <- as(cc, "matrix") ## --> should fixup dimnames to *symmetric* mat # should print *symmetric* dimnames stopifnot(identical3(dimnames(cc), dimnames(mat), dimnames(as(tt, "matrix")))) selectMethod(coerce, c("dsCMatrix", "denseMatrix")) dmat <- as(cc, "denseMatrix") ## --> gave Error (!!) in Matrix 1.1-5 stopifnot(identical3(tt@Dimnames, dmat@Dimnames, list(NULL, cn))) dmat # should print *symmetric* dimnames (not modifying dmat as it did intermittently) stopifnot(identical(dmat@Dimnames, list(NULL, cn))) ttdm <- as(tt, "denseMatrix") stopifnot(all.equal(dmat, ttdm), ## ^^^^^^ not identical(): 'x' slot differs, as only "U" is needed identical(as(dmat, "dspMatrix"), as(ttdm, "dspMatrix")), identical(dimnames(cc), dimnames(dmat)), ## coercing back should give original : identical(cc, as(dmat, "sparseMatrix")), identical(uniqTsparse(tt), as(ttdm, "TsparseMatrix"))) ## MM: now *if* cc is "truly symmetric", these dimnames should be, too: d5 <- cn[1:5]; dnm5 <- list(d5,d5) stopifnot(identical(dimnames( cc [1:5, 1:5]), dnm5), identical(dimnames(t(cc)[1:5, 1:5]), dnm5)) ## large sparse ones: these now directly "go sparse": str(m0 <- Matrix(0, nrow=100, ncol = 1000)) str(l0 <- Matrix(FALSE, nrow=100, ncol = 200)) stopifnot(all(!l0), identical(FALSE, any(l0))) if(!interactive()) warnings() ## really large {length() is beyond R's limits}: op <- options(warn = 2) # warnings (e.g. integer overflow!) become errors: n <- 50000L stopifnot(n^2 > .Machine$integer.max) ## had integer overflow in index constructions: x <- 1:n D <- Diagonal(n, x=x[n:1]) summary(D)# special method summary(D != 0) stopifnot(identical(x*D, (Dx <- D*x)), identical(D != 0, as(D, "lMatrix")), identical(Dx, local({d <- D; d@x <- d@x * x; d}))) Lrg <- new("dgTMatrix", Dim = c(n,n)) l0 <- as(as(Lrg, "lMatrix"), "lgCMatrix") d0 <- as(l0, "dgCMatrix") if(FALSE) { #_____________________ FIXME: Should use cholmod_l_*() everywhere (?)____ ## problem in Csparse_to_dense : dl0 <- as(l0, "denseMatrix") dd0 <- as(d0, "denseMatrix") ## currently, both give --- Error in asMethod(object) : ## Cholmod error 'problem too large' at file ../Core/cholmod_dense.c, line 105 ##--> And there it is 'Int_max' ==> ../src/CHOLMOD/Include/cholmod_internal.h ## defines 'Int_max' and does that depending of "mode", and ## MM thinks we should use the "DLONG" mode now -- for 64-bit integers! ## ==> Then Int_max := SuiteSparse_long_max := LONG_MAX ## (the latter from ../src/SuiteSparse_config/SuiteSparse_config.h ) ## ==> use cholmod_l_ instead of cholmod_ in *many places* ## ## check they are ok stopifnot(identical(dim(dl0), c(n,n)), identical(dim(dd0), c(n,n)), !any(dl0), all(dd0 == 0)) rm(dl0, dd0)# too large to keep in memory and pass to checkMatrix() } diag(Lrg[2:9,1:8]) <- 1:8 ## ==: Lrg[2:9,1:8] <- `diag<-`(Lrg[2:9,1:8], 1:8) e1 <- try(Lrg == Lrg) # ==> Cholmod error 'problem too large' at file ../Core/cholmod_dense.c, line 105 ## (error message almost ok) (memGB <- Sys.memGB("MemFree")) # from test-tools-1.R, only works with /proc/* system.time( # ~10 sec. __vv__ e2 <- if(doExtras && is.finite(memGB) && memGB > 30) { # need around 18 GB try(!Lrg) # now *works* on 64-bit machines with enough RAM ## and immediately errors if LONG_VECTORs are not available }) str(e2) # error, NULL or "worked" (=> 50000 x 50000 lgeMatrix) ina <- is.na(Lrg)# "all FALSE" stopifnot(grep("too large", e1) == 1, if(inherits(e2, "try-error")) grep("too large", e2) == 1 else is.null(e2) || length(e2@x) == n^2, !any(ina))# <- gave warning previously stopifnot(suppressWarnings(any(Lrg)))# (double -> logical warning) rm(e2)# too large... RNGversion("3.6.0")# future proof if(doExtras && is.finite(memGB) && memGB > 49) withAutoprint({ cat("computing SM .. \n") showSys.time(m <- matrix(0, 3e6, 1024)) ## user system elapsed ## 2.475 10.688 13.196 (faster in past ??) set.seed(1); inot0 <- unique(sort(c(1, length(m), sample(length(m), 20)))) ai0 <- arrayInd(inot0, .dim=dim(m), useNames=FALSE) showSys.time(m[inot0] <- 1:22) ## user system elapsed ## 5.931 11.184 17.162 showSys.time(SM <- as(m, "sparseMatrix")) # ~ 8 sec ## gave 'Error in asMethod(object) : negative length vectors are not allowed' ## now works - via C matrix_to_Csparse() showSys.time(n0.m <- c(m) != 0) # logical (full, base R) matrix, 12 GB ## user system elapsed ## 14.901 10.789 25.776 try( ## _FIXME_ in R: Error ... long vectors not supported yet in0.m <- which(n0.m) ) ## DONE: now very fast! [previously did coerce the whole matrix to dense first !] subS <- SM[inot0] selectMethod("[", c("dgCMatrix","numeric","missing","missing"))# -> .M.vectorSub(x,i) ## Directly via arrayInd(), is *FAST*: subSij <- SM[ai0] stopifnot(subS == 1:22, identical(subS, subSij)) cat(" [Ok]\n") rm(m) str(SM) ## checking SM: TM <- as(SM, "TsparseMatrix") stopifnot(as.matrix(summary(TM)) == cbind(ai0, 1:22)) ## cleanup: rm(SM, TM) }) ## Constructing *packed* dense symmetric (dsp*) | triangular (dtp*) Matrices: if(doExtras && is.finite(memGB) && memGB > 35) withAutoprint({ m <- as.integer(2^16) ## = 65536 showSys.time(x <- rep(as.numeric(1:100), length.out=m*(m+1)/2)) ## user system elapsed ## 6.028 8.964 15.074 gc() object.size(x) # 17'180'131'368 bytes: ~ 17 GB mat <- new("dspMatrix", x = x, Dim = c(m, m)) # failed with ## long vectors not supported yet: ../../src/include/Rinlinedfuns.h:... validObject(mat) mat <- new("dtpMatrix", x = x, Dim = c(m, m)) # failed ....... validObject(mat) ## cleanup rm(mat) }) ## with dimnames: v <- c(a=1, b=2:3) m <- as.matrix(v) M <- as(v, "dgeMatrix") stopifnot(identical(dimnames(m), list(c("a", "b1", "b2"), NULL)), identical(M, as(m, "dgeMatrix")), identical(dimnames(M), dimnames(m))) ## dimnames(.) of symmpart() / skewpart() : ns <- c("symmpart", "skewpart", "forceSymmetric") symFUNs <- setNames(lapply(ns, get), ns); rm(ns) chkSS <- function(m) { r <- lapply(symFUNs, function(fn) fn(m)) m0 <- as(m, "matrix") r0 <- lapply(symFUNs, function(fn) fn(m0)) stopifnotValid(fS <- r [["forceSymmetric"]], "symmetricMatrix") stopifnotValid(fS0 <- r0[["forceSymmetric"]], "symmetricMatrix") dnms <- dimnames(m) d.sy <- dimnames(r[["symmpart"]]) id <- if(is.null(dnms[[2]]) && !is.null(dnms[[1]])) 1 else 2 stopifnot(identical(d.sy, dnms[c(id,id)]), identical(d.sy, dimnames(r [["skewpart"]])), identical(d.sy, dimnames(r0[["skewpart"]])), all(m == with(r, symmpart + skewpart)), all(m0 == with(r0, symmpart + skewpart)), identical(dS <- dimnames(fS), dimnames(fS0)), identical(dS[1], dS[2])) } cat(sprintf("chkSS() {valid %s} for a list of matrices:\n", paste(paste0(names(symFUNs), "()"), collapse=", "))) for(m in list(Matrix(1:4, 2,2), Matrix(c(0, rep(1:0, 3),0:1), 3,3))) { cat("\n---\nm:\n"); show(m) chkSS(m) dn <- list(row = paste0("r", 1:nrow(m)), col = paste0("var.", 1:ncol(m))) dimnames(m) <- dn ; chkSS(m) colnames(m) <- NULL ; chkSS(m) dimnames(m) <- unname(dn) ; chkSS(m) } m. <- matrix(c(0, 0, 2:0), 3, 5) dimnames(m.) <- list(LETTERS[1:3], letters[1:5]) (m0 <- m <- Matrix(m.)) m@Dimnames[[2]] <- m@Dimnames[[1]] ## not valid anymore: (val <- validObject(m, test=TRUE)); stopifnot(is.character(val)) dm <- as(m0, "denseMatrix"); rm(m) stopifnot(all.equal(rcond(dm), rcond(m.), tolerance = 1e-14), ##^^^^^^^ dm and m. are both dense, interestingly small differences ## show in at least one case of optimized BLAS all.equal(rcond(dm), 0.4899474520656), ## show() had revealed a bug in C: identical(capture.output(show(as(m0, "RsparseMatrix")))[-(1:2)], gsub("0", ".", capture.output(show(m.))[-1]))) m.1 <- m.; dimnames(m.1) <- list(row=NULL, col=NULL) M.1 <- Matrix(m.1, sparse=TRUE) show(M.1)# had bug in .formatSparseSimple() ###-- Sparse Triangular : g5 <- new("dgCMatrix", Dim = c(5L, 5L), x = c(10, 1, 3, 10, 1, 10, 1, 10, 10), i = c(0L,2L,4L, 1L, 3L,2L,4L, 3L, 4L), p = c(0L, 3L, 5L, 7:9)) t5 <- as(g5, "triangularMatrix") # fine stopifnot(class(t5) == "dtCMatrix", identical(t5, tril(g5))) ## This is really a regression test for 'methods::selectMethod()' ## Maybe move to R once 'Matrix' is recommended sm <- selectMethod(coerce, c("dgCMatrix", "triangularMatrix"), verbose=TRUE) stopifnot(identical(sm(g5), t5)) dimnames(t5) <- list(row=paste0("r",1:5), col=paste0("C.",1:5)) s5 <- symmpart(t5) # gave an error (t1 <- new("dtTMatrix", x= c(3,7), i= 0:1, j=3:2, Dim= as.integer(c(4,4)))) ## Diagonal o Sparse I4 <- Diagonal(4) D4 <- Diagonal(4, x=1:4) validObject(t1) validObject(t2 <- t1 + I4) validObject(tt2 <- t(t1) + I4) validObject(t1c <- as(t1, "CsparseMatrix")) validObject(t2c <- as(t2, "CsparseMatrix")) stopifnotValid(2 * I4, "diagonalMatrix") stopifnotValid(D4 * 3, "diagonalMatrix") stopifnotValid(I4 / 5, "diagonalMatrix") stopifnotValid(D4 / 2, "diagonalMatrix") stopifnotValid(t1c + I4,"triangularMatrix") stopifnotValid(t2c + I4,"triangularMatrix") stopifnot(identical(t1, t(t(t1))), identical(t1c, t(t(t1c))), c(class(t2), class(t1c), class(t2c), class(tt2)) == "dtCMatrix", identical(t(tt2), t2)) assert.EQ.mat(t1, as(t1c, "matrix")) D4. <- D4 * (A4 <- Matrix(1:4, 4,4)) D4p <- A4 + D4 Lg1 <- D4 > 0 & D4 > 1 nLg <- !Lg1 nnLg <- !nLg D4m <- D4 * 4:1 assert.EQ.mat(D4., diag(x= (1:4)^2)) assert.EQ.mat(D4p, diag(x= (1:4)) + (1:4)) assert.EQ.mat(D4m, diag(x=c(4,6,6,4))) assert.EQ.mat(Lg1, diag(x= c(FALSE, rep(TRUE,3)))) stopifnot(is(Lg1, "diagonalMatrix"), is(D4m, "diagonalMatrix"), is(D4., "diagonalMatrix"), is(nLg, "symmetricMatrix"), is(nnLg, "symmetricMatrix"), identical3(Lg1, Matrix(nnLg), as(nnLg, "diagonalMatrix")), all(Lg1 != (!Lg1))) ## tri[lu]() td3 <- triu(diag(3)); stopifnot(is(td3, "triangularMatrix"), td3@uplo == "U") Ld3 <- tril(diag(3)); stopifnot(is(Ld3, "triangularMatrix"), Ld3@uplo == "L") ## the latter did fail till 2014-12-20 D3 <- Diagonal(3) stopifnot(identical3(D3, tril(D3), triu(D3))) ## methods were missing ## as(, ) : str(cls <- names(getClass("Matrix")@subclasses))# all Matrix classes for(cl in cls) if(canCoerce(I4, cl)) { cat(cl,":") M <- as(I4, cl) M. <- as(D4, cl) stopifnot(diag(4) == as(M,"matrix"), if(is(cl,"dMatrix")) diag(x=1:4) == as(M.,"matrix") else TRUE) cat(" [Ok]\n") } s4 <- as(D4,"sparseMatrix") v <- c(11,2,2,12); s4[2:3,2:3] <- v; validObject(s4) s4. <- D4; s4.[2:3,2:3] <- v; validObject(s4.) stopifnot(all(s4 == s4.)) ## now assign symmetrically to symmetricMatrix s4 <- as(as(D4,"sparseMatrix"),"symmetricMatrix") s4[2:3,2:3] <- v validObject(s4) stopifnot(is(s4,"symmetricMatrix")) assert.EQ.mat(s4, as(s4.,"matrix"),tol=0) ## lower-triangular unit-diagonal L <- new("dtCMatrix", i = 1L, p = c(0:1, 1L), Dim = c(2L, 2L), x = 0.5, uplo = "L", diag = "U") stopifnot(range(L) == 0:1, all.equal(mean(L), 5/8)) ## from 0-diagonal to unit-diagonal triangular {low-level step}: tu <- t1 ; tu@diag <- "U" tu validObject(cu <- as(tu, "dtCMatrix")) validObject(cnu <- diagU2N(cu))# <- testing diagU2N validObject(tu. <- as(cu, "dtTMatrix")) validObject(tt <- as(cu, "TsparseMatrix")) stopifnot(## NOT: identical(tu, tu.), # since T* is not unique! identical(cu, as(tu., "dtCMatrix")), length(cnu@i) == length(cu@i) + nrow(cu), identical(cu, diagN2U(cnu)),# <- testing diagN2U all(cu >= 0, na.rm = TRUE), all(cu >= 0), any(cu >= 7)) validObject(tcu <- t(cu)) validObject(ttu <- t(tu)) validObject(ltu <- as(ttu, "lMatrix")) validObject(ldtu <- as(ltu, "denseMatrix")) validObject(Cltu <- as(ltu, "CsparseMatrix")) stopifnot(identical(asCsp(ttu > 0), asCsp(ltu)), all(ltu == as(ttu > 0,"denseMatrix"))) ltu - (ttu > 0) # failed assert.EQ.mat(cu, as(tu,"matrix"), tol=0) assert.EQ.mat(cnu, as(tu,"matrix"), tol=0) C <- suppressWarnings(Matrix(c(0,1,0,0), 5,5)) + Diagonal(5) (tU <- diagN2U(tril(C))) # dtC Unitriangular ntU <- as(tU, "nMatrix") nT <- as(ntU, "TsparseMatrix") R <- as(tU, "RsparseMatrix") Tt <- diagU2N(R) # used to accidentally drop the diag. stopifnot(R@x == c(1,1,1), diag(Tt) == 1) lcu <- new("ltCMatrix", Dim = c(4L, 4L), i = c(0:1, 0L), p = c(0L, 0:3), x = c(TRUE, FALSE, FALSE), uplo = "U", diag = "U") (lTu <- as(lcu,"TsparseMatrix"))# prints wrongly (in Matrix 0.999375-31) stopifnot(identical3(rowSums(lcu), rowSums(lTu), rowSums(drop0(lcu)))) (ncu <- as(lcu, "nMatrix"))# -- gives the "pattern" of lcu, i.e. FALSE are *there* ncn <- diagU2N(ncu) (cncn <- crossprod(ncn))# works -> "nsCMatrix" stopifnot(identical(ncu, as(lcu,"nsparseMatrix")), identical(rowSums(ncu), c(3:1, 1L)), Q.eq(ncn, ncu), Q.eq(crossprod(drop0(lcu)), crossprod(lcu)),# crossprod works -> "dsCMatrix" identical(crossprod(ncu), cncn), Q.eq(cncn, t(ncu) %*% ncu)) #used to seg.fault U <- new("dtCMatrix", Dim = c(6L, 6L), i = c(0:1, 0L, 2:3, 1L, 4L), p = c(0L,0L,0L, 2:3, 5L, 7L), x = rep.int(-0.5, 7), diag = "U") validObject(U) U. <- solve(iU <- solve(U))#-> gave segmentation fault stopifnot(validObject(U), ## had a case where solve(U) modified U ! validObject(iU), validObject(U.), ## no rounding error, since have iU@x * 8 is integer : identical(U, diagN2U(drop0(U.)))) ## o (of length > 1): stopifnotValid(tm <- tu * 1:8, "sparseMatrix") stopifnot(identical4(tm, cu * 1:8, 1:8 * cu, 1:8 * tu)) cu[1,2] <- tu[1,2] <- NA mu <- as(tu,"matrix") stopifnotValid(cu, "CsparseMatrix"); stopifnotValid(cu, "triangularMatrix") stopifnotValid(tu, "TsparseMatrix"); stopifnotValid(tu, "triangularMatrix") stopifnot(identical(cu * 1:8, tu * 1:8), # but are no longer triangular identical(cu > .1, as(tu > .1, "CsparseMatrix")), all(cu >= 0, na.rm=TRUE), !all(cu >= 1), is.na(all(tu >= 0)), ## Csparse_drop: preserves triangularity incl diag="U" identical(cu, .Call(Matrix:::Csparse_drop, cu, 0.)) ) assert.EQ.mat(cu * 1:8, mu * 1:8) ina <- is.na(as(cu,"matrix")) ## These 3 were each different (2008-03) !! stopifnot(all(ina == is.na(cu)), all(ina == is.na(as(cu,"generalMatrix"))), all(ina == as(is.na(as(cu,"matrix")),"nMatrix"))) set.seed(7) xx <- rpois(10, 50) Samp <- function(n,size) sample(n, size, replace=TRUE) Tn <- sparseMatrix(i=Samp(8, 50), j=Samp(9,50), x=xx, repr = "T") Tn stopifnot(xx == Tn@x, max(xx) < max(Tn), 0 == min(Tn), (sT <- sum(Tn)) == sum(colSums(Tn)), sT == sum(Tn@x), range(Tn) == range(as(Tn, "CsparseMatrix"))) ## tu. is diag "U", but tu2 not: tu2 <- as(as(tu., "generalMatrix"), "triangularMatrix") assert.EQ.mat(cu, mu, tol=0) stopifnot(identical3(cu[cu > 1], tu [tu > 1], mu [mu > 1]), identical3(cu <= 1, tu <= 1, as(mu <= 1, "lMatrix")),# all lgeMatrix identical3(cu[cu <= 1], tu[tu <= 1], mu[mu <= 1]), identical3(cu , triu(cu ), t(t(cu))), identical3(tu , triu(tu ), t(t(tu))), identical3(tu., triu(tu.), t(t(tu.))), identical(tu2, triu(tu2)), identical(tcu , tril(tcu)), identical(ttu , tril(ttu)), identical(t(tu), tril(t(tu))) ) assert.EQ.mat(triu(cu), .asmatrix(triu(.asmatrix(cu)))) for(k in -1:1) assert.EQ.mat(tril(cu,k), .asmatrix(tril(.asmatrix(cu),k))) (dtr <- Matrix(local({m <- diag(2); m[1,2] <- 3;m}))) identical(dtr, triu(dtr)) assert.EQ.mat(tril(dtr), diag(2)) (t4 <- new("dgTMatrix", i = 3:0, j = 0:3, x = rep(1,4), Dim = as.integer(c(4,4)))) c4 <- as(t4, "CsparseMatrix") ## the same but "dsT" (symmetric) suppressWarnings(M <- Matrix(c(0, rep(c(0,0:1),4)), 4,4))# warning:.. length [13] is not ..multiple tt <- as(M, "TsparseMatrix") stopifnot(all.equal(triu(t4) + tril(t4), c4), all.equal(triu(tt) + tril(tt), c4)) ###-- Numeric Dense: Crossprod & Solve set.seed(123) mm. <- mm <- Matrix(rnorm(500 * 150), nc = 150) stopifnot(validObject(mm)) xpx <- crossprod(mm) stopifnot(identical(mm, mm.))# once upon a time, mm was altered by crossprod() stopifnotValid(xpx, "dpoMatrix") str(mm) # 'dge*" str(xpx)# 'dpo*" xpy <- crossprod(mm, rnorm(500)) res <- solve(xpx, xpy) str(xpx)# now with Cholesky factor stopifnot(validObject(xpx), validObject(xpy), validObject(res)) stopifnot(all.equal(xpx %*% res, xpy, tolerance = 1e-12)) lp <- xpx >= 1 slp <- as(lp, "sparseMatrix") ltlp <- lp[ lower.tri(lp) ] sltlp <- slp[ lower.tri(slp) ] dim(ij <- which(lower.tri(lp), arr.ind = TRUE)) ss <- slp[ij] # now fast (!) stopifnot(identical4(lp[ij], ltlp, sltlp, as(lp, "matrix")[ij]), identical(ss, sltlp), isValid(lp, "lsyMatrix"), lp@uplo == "U") ###-- more solve() methods {was ./solve.R } ## first for "dgeMatrix" and all kinds of RHS : (m6 <- 1 + as(diag(0:5), "dgeMatrix")) rcond(m6) I6 <- as(diag(6), "dgeMatrix") stopifnot(all.equal(I6, m6 %*% solve(m6)), all.equal(I6, solve(m6) %*% m6) ) (i6 <- solve(m6, Matrix(1:6))) stopifnot(identical(i6, as(cbind(c(-4, rep(1,5))), "dgeMatrix")), identical(i6, solve(m6, 1:6)), identical(i6, solve(m6, matrix(1:6))), identical(i6, solve(m6, matrix(c(1,2,3,4,5,6)))) ) ## solve() (m <- t1+ t(t1) + Diagonal(4)) i.m <- solve(as.mat(m)) I1 <- m %*% i.m o4 <- diag(I1) im <- solve(m)# is now sparse {not yet} (I2 <- m %*% im) (ms <- as(m, "symmetricMatrix")) ## solve(, ): s.mm <- solve(m,m) s.mms <- solve(m, ms) ## these now work "fully-sparse" s.ms2 <- solve(ms, ms) s.msm <- solve(ms, m) I4c <- as(Matrix(diag(4),sparse=TRUE), "generalMatrix") stopifnot(isValid(im, "Matrix"), isValid(I2, "Matrix"), class(I4c) == "dgCMatrix", all.equal(I1, as(I2,"dgeMatrix"), tolerance = 1e-14), all.equal(diag(4), as.mat(I2), tolerance = 1e-12), all.equal(s.mm, I2, tolerance = 1e-14), all.equal(s.mms, I2, tolerance = 1e-14), all.equal(s.ms2, s.msm, tolerance = 4e-15), all.equal(s.ms2, I4c , tolerance = 4e-15), abs(o4 - 1) < 1e-14) image(T125 <- kronecker(kronecker(t5,t5),t5), main = paste("T125:",class(T125))) dim(T3k <- kronecker(t5,kronecker(T125, t5))) system.time(IT3 <- solve(T3k))# incredibly fast I. <- drop0(zapsmall(IT3 %*% T3k)) I.. <- diagN2U(I.) I <- Diagonal(5^5) stopifnotValid(IT3, "dtCMatrix") stopifnot(## something like the equivalent of all(I. == Diagonal(3125)) : identical(as(I., "diagonalMatrix"), I), identical(as(I..,"diagonalMatrix"), I) ) ## printSpMatrix() ; "suppressing (columns | rows) .." {and do it correctly!} IT3 op0 <- options(width = 70, max.print = 1000) T125[-(1:50),] ## suppression ... is it correctly done? ## Still buggy -- FIXME: see ../TODO --- even if we'd require max.print >= 5 or so for(mm in 1:21) { options(max.print=mm) cat("----------\n\nmax.print=",mm,":\n", sep="") cat("\n>> U: ") ; show(U) cat("\n>> slp: ") ; show(slp) } options(op0)# revert to max.print = 1000 ###-- row- and column operations {was ./rowcolOps.R } set.seed(321) (m1 <- round(Matrix(rnorm(25), 5), 2)) m1k <- Matrix(round(rnorm(1000), 2), 50, 20) m.m <- as(m1k, "matrix") stopifnot(all.equal(colMeans(m1k), colMeans(m.m)), all.equal(colSums (m1k), colSums (m.m)), all.equal(rowMeans(m1k), rowMeans(m.m)), all.equal(rowSums (m1k), rowSums (m.m)), all.equal(colMeans(m1k, na.rm=TRUE), colMeans(m.m, na.rm=TRUE)), all.equal(colSums (m1k, na.rm=TRUE), colSums (m.m, na.rm=TRUE)), all.equal(rowMeans(m1k, na.rm=TRUE), rowMeans(m.m, na.rm=TRUE)), all.equal(rowSums (m1k, na.rm=TRUE), rowSums (m.m, na.rm=TRUE)) ) ###-- kronecker for nonsparse uses Matrix(.): stopifnotValid(kr <- kronecker(m1, m6), "Matrix") assert.EQ.mat(kr, kronecker(as(m1, "matrix"), as(m6, "matrix")), tol = 0) ## sparse: (kt1 <- kronecker(t1, tu)) kt2 <- kronecker(t1c, cu) stopifnot(identical(Matrix:::uniq(kt1), Matrix:::uniq(kt2))) ## but kt1 and kt2, both "dgT" are different since entries are not ordered! ktf <- kronecker(.asmatrix(t1), .asmatrix(tu)) if(FALSE) # FIXME? our kronecker treats "0 * NA" as "0" for structural-0 assert.EQ.mat(kt2, ktf, tol= 0) (cs1 <- colSums(kt1)) NA.or.True <- function(x) is.na(x) | x eq <- (cs1 == colSums(as(kt1, "matrix"))) stopifnot(NA.or.True(eq), identical(is.na(eq), is.na(cs1))) nt1 <- as(kt1, "nMatrix") # no NA's anymore (ng1 <- as(as(nt1, "generalMatrix"),"CsparseMatrix")) # ngC dg1 <- as(ng1, "dMatrix")# dgC lt1 <- kt1 > 5 nt1 <- as(lt1, "nMatrix") (colSums(nt1, sparseResult = TRUE)) (colSums(kt1, sparseResult = TRUE)) # dsparse, with NA (colSums(lt1, sparseResult = TRUE)) # isparse, with NA (colSums(lt1, sparseResult = TRUE, na.rm = TRUE)) (colSums(nt1, sparseResult = TRUE)) # isparse, no NA ## check correct sparseness of both: for(M in list(kt1, nt1, ng1, dg1, lt1, nt1)) { m <- as(M, "matrix") for(na.rm in c(FALSE,TRUE)) { cs <- colSums(M, na.rm = na.rm) cs. <- colSums(M, na.rm = na.rm, sparseResult = TRUE) rs <- rowSums(M, na.rm = na.rm) rs. <- rowSums(M, na.rm = na.rm, sparseResult = TRUE) stopifnotValid(cs., "sparseVector") stopifnotValid(rs., "sparseVector") stopifnot(identical(cs, as(cs., "vector")), identical(rs, as(rs., "vector")), {eq <- cs == colSums(m, na.rm = na.rm) ; ineq <- is.na(eq) all(ineq | eq) && identical(ineq, is.na(cs)) }, {eq <- rs == rowSums(m, na.rm = na.rm) ; ineq <- is.na(eq) all(ineq | eq) && identical(ineq, is.na(rs)) } ) } } i1 <- cs. == 1 cs2 <- cs. cs2[i1] <- 0 # failed in *-31 !! ## now *index* with a NA-sparseVector : i2 <- i1 ; i2[3] <- NA ; li2 <- as.logical(i2) cs3 <- cs. ; cs3 [i2] <- 0 v3 <- as(cs.,"vector"); v3[li2] <- 0 cs4 <- cs. ; cs4[li2] <- 0 stopifnot(length(i1@x) == 2, identical(li2, as(i2,"vector")), identical(cs3, cs4), cs3 == v3, all(as(v3, "sparseVector") == cs3) ## indexing simple "numeric" with sparseVector: ## see 'R_FIXME' in ../R/sparseVector.R ## , identical(v3[i2], v3[li2]) ## TODO: ## sub-assigning into simple "numeric" with sparseVector index: ) M <- Matrix(c(2:0,1),2); M. <- as(M, "sparseMatrix") (N <- as(crossprod(kronecker(diag(2), M)) > 0, "nMatrix")) (L. <- as(N,"lMatrix")) stopifnot(identical(N, as(L.,"nMatrix")), identical(kronecker( c(1,0), M), kronecker(cbind(1:0), M))) assert.EQ.mat(kronecker(M, c(1,0,0)), kronecker(.asmatrix(M), c(1,0,0))) ## coercion from "dpo" or "dsy" xx <- as(xpx, "dsyMatrix") stopifnot(isSymmetric(xxS <- as(xx, "sparseMatrix")), isSymmetric(xpxS <- as(xpx, "sparseMatrix"))) tm <- matrix(0, 8,8) tm[cbind(c(1,1,2,7,8), c(3,6,4,8,8))] <- c(2,-30,15,20,80) (tM <- Matrix(tm)) ## dtC (mM <- Matrix(m <- (tm + t(tm)))) ## dsC mT <- as(mM, "dsTMatrix") gC <- as(as(mT, "dgTMatrix"), "dgCMatrix") lT <- as(Matrix(TRUE, 2,2),"TsparseMatrix") ## Check that mT, lT, and gC print properly : pr.mT <- capture.output(mT) pr.lT <- capture.output(lT)[-(1:2)] nn <- unlist(strsplit(gsub(" +\\.", "", sub("^....", "", pr.mT[-(1:2)])), " ")) stopifnot(as.numeric(nn[nn != ""]) == m[m != 0], identical(1:2, grep("|", pr.lT, fixed=TRUE)), identical(pr.lT, capture.output(as(lT, "nMatrix"))[-(1:2)]), capture.output(gC)[-1] == pr.mT[-1]) assert.EQ.mat(tM, tm, tol=0) assert.EQ.mat(gC, m, tol=0) assert.EQ.mat(mT, m, tol=0) stopifnotValid(mM, "dsCMatrix") stopifnotValid(tM, "dtCMatrix") stopifnot(identical(mT, as(mM, "TsparseMatrix")) , identical(gC, as(mM, "generalMatrix")) ## coercions general <-> symmetric , identical(as(as(mM, "generalMatrix"), "symmetricMatrix"), mM) , identical(as(as(mM, "dgTMatrix"), "symmetricMatrix"), mT) , identical(as(as(tM, "generalMatrix"),"triangularMatrix"), tM) , identical(tM + Diagonal(8), tMD <- Diagonal(8) + tM) ) stopifnotValid(tMD, "dtCMatrix") eM <- eigen(mM) # works thanks to base::as.matrix hack in ../R/zzz.R stopifnot(all.equal(eM$values, { v <- c(162.462112512353, 30.0665927567458) c(v, 15, 0, 0, 160-v[1], -15, -v[2])}, tol=1e-14)) ##--- symmetric -> pos.def. needs valid test: m5 <- Matrix(diag(5) - 1) assertError(as(m5, "dpoMatrix"))# not pos.definite! pm5 <- as(m5, "dspMatrix") # packed assertError(as(pm5, "dppMatrix"))# not pos.definite! sm <- as(Matrix(diag(5) + 1),"dspMatrix") pm <- as(sm,"dpoMatrix")## gave infinite recursion (for a day or so) pp <- as(pm,"dppMatrix") x <- round(100 * crossprod(Matrix(runif(25),5))) D <- Diagonal(5, round(1000*runif(5))) px <- pack(x) stopifnot(is(x, "dpoMatrix"), is(px,"dppMatrix"), is(D, "ddiMatrix")) class(x+D)#--> now "dsyMatrix" stopifnot(is(x+D, "symmetricMatrix"), is(D+px, "dspMatrix"), identical(x+D, D+x), identical(px+D, D+px), identical(pack(x-D), px-D)) tx <- tril(x) ptx <- pack(tx) stopifnot(is(tx, "dtrMatrix"), is(ptx, "dtpMatrix"), is(t(tx), "dtrMatrix"), is(t(ptx), "dtpMatrix"), is(D + tx, "dtrMatrix"), is(tx + D, "dtrMatrix"), is(ptx + D, "dtpMatrix"), is(D + ptx, "dtpMatrix")) ###-- dense nonzero pattern: class(m <- Matrix(TRUE,2,2)) # lsy isValid(n <- as(m, "nMatrix"), "nsyMatrix") ## 1) as(n,"CsparseMatrix") # used to give CHOLMOD error: invalid xtype... ls2 <- as(m, "CsparseMatrix") # works fine ## and really 'm' and 'n' are interally slot identical (!!!) as(n,"sparseMatrix") as(m,"sparseMatrix") ### -- now when starting with nsparse : nT <- new("ngTMatrix", i = as.integer(c(0, 1, 0)), j = as.integer(c(0, 0, 1)), Dim = as.integer(c(2,2))) (nC <- as(nT, "ngCMatrix")) str(nC)# of course, no 'x' slot tt <- as(nT,"denseMatrix") # nge (was lge "wrongly") stopifnot(is(tt,"ngeMatrix"), identical(as(tt, "lMatrix"), as(as(nT, "lMatrix"), "denseMatrix"))) tt as(nC,"denseMatrix") ###-- sparse nonzero pattern : ---------- (nkt <- as(as(as(kt1, "generalMatrix"), "CsparseMatrix"), "ngCMatrix"))# ok dkt <- as(nkt, "denseMatrix") (clt <- crossprod(nkt)) stopifnotValid(nkt, "ngCMatrix") stopifnotValid(clt, "nsCMatrix") suppressWarnings(crossprod(clt)) ## warning "crossprod() of symmetric ..." ## a Csparse with *repeated* entry is not valid! assertError(new("ngCMatrix", p = c(0L,2L), i = c(0L,0L), Dim = 2:1)) ### "d" <-> "l" for (symmetric) sparse : --------------------------------------- suppressWarnings( data(KNex) ) ## may warn, as 'Matrix' is recommended ## and exist more than once at check-time mm <- KNex$mm xpx <- crossprod(mm) ## extract nonzero pattern nxpx <- as(xpx, "nsCMatrix") show(nxpx) ## now ok, since subsetting works r <- nxpx[1:2,] lmm <- as(mm, "lgCMatrix") nmm <- as(lmm, "nMatrix") xlx <- crossprod(lmm) x.x <- crossprod(nmm) ## now A = lxpx and B = xlx should be close, but not quite the same ## since = 0 is well possible when x!=0 and y!=0 . ## However, A[i,j] != 0 ==> B[i,j] != 0: A <- as(as(nxpx, "lMatrix"), "TsparseMatrix") B <- as(as(xlx, "lMatrix"), "TsparseMatrix") ij <- function(a) a@i + ncol(a) * a@j stopifnot(all(ij(A) %in% ij(B))) l3 <- upper.tri(matrix(,3,3)) validObject(c3 <- as(l3, "CsparseMatrix")) stopifnotValid(c3, "lMatrix")# lgC (M <- Matrix(l3)) stopifnotValid(M, "ltCMatrix") stopifnotValid(M2 <- M %x% M, "triangularMatrix") # is "dtT" (why not "dtC" ?) stopifnot(dim(M2) == c(9,9), identical(M2, kronecker(M,M))) M3 <- M %x% M2 #ok (cM3 <- colSums(M3, sparse=TRUE)) identical(as.vector(cM3), as(rev(rowSums(M3, sparse=TRUE)), "vector")) M. <- M2 %x% M # gave infinite recursion ## diagonal, sparse & interactions stopifnotValid(as(Diagonal(3), "TsparseMatrix"), "TsparseMatrix") stopifnotValid(X <- Diagonal(7) + 1.5 * tM[1:7,1:7], "sparseMatrix") stopifnotValid(X, "triangularMatrix") stopifnotValid(XX <- X - chol(crossprod(X)), "triangularMatrix") X XX XX <- as(drop0(XX), "dsCMatrix") stopifnot(identical(XX, Matrix(0, nrow(X), ncol(X), doDiag=FALSE))) M <- Matrix(m., sparse = FALSE) (sM <- Matrix(m.)) class(dlM <- M >= 1) stopifnot(identical(dlM, !(M < 1))) stopifnotValid(sM, "sparseMatrix") stopifnotValid(dlM, "denseMatrix") (lM <- as(dlM, "sparseMatrix")) lM2 <- as(dlM, "CsparseMatrix") #-> now ok lM0 <- Matrix:::as_Csparse(dlM) stopifnot(identical3(lM, lM2, lM0)) selectMethod("coerce", c("lgeMatrix", "CsparseMatrix"), useInherited = c(from = TRUE, to = FALSE)) ms0 <- Matrix(c(0,1,1,0), 2,2) ms <- as(ms0, "TsparseMatrix") cs <- as(ms, "CsparseMatrix") ll <- as(ms, "lMatrix") lt <- as(ll, "lgTMatrix") nn <- as(cs, "nsparseMatrix") l2 <- as(cs, "lsparseMatrix") nt <- triu(nn) n3 <- as(nt, "lsparseMatrix") da <- nt + t(nt) dm <- nt * t(nt) + da ## mnt <- as(nt, "matrix") m <- rbind(v <- 2:3) assert.EQ.mat(nt %*% v, mnt %*% v) assert.EQ.mat(v %*% nt, v %*% mnt) assert.EQ.mat( crossprod(nt, v), crossprod(mnt,v)) assert.EQ.mat( crossprod(v, nt), crossprod(v,mnt)) assert.EQ.mat(tcrossprod(v, nt), tcrossprod(v,mnt)) assert.EQ.mat(tcrossprod(nt, m), tcrossprod(mnt, m)) ## stopifnotValid(ms, "dsTMatrix") stopifnot(as(ms0,"matrix") == as(ll, "matrix"), # coercing num |-> log as(lt, "matrix") == as(ll, "matrix"), identical(ms, as(ll, "dMatrix")), identical4(as(ll, "CsparseMatrix"), as(cs, "lMatrix"),# lsC* as(nn, "lsparseMatrix"), l2), identical3(da, dm, as(cs, "generalMatrix")), # dgC* identical(as(da, "lMatrix"), as(lt, "CsparseMatrix")) # lgC* ) ## Dense *packed* ones: s4 <- as(D4, "symmetricMatrix") sp <- as(as(as(D4, "symmetricMatrix"),"denseMatrix"),"dspMatrix") tp <- as(triu(sp),"dtpMatrix") tpL <- as(tril(sp),"dtpMatrix") (spL <- t(sp)) stopifnot(sp @uplo=="U", tp @uplo=="U", spL@uplo=="L", tpL@uplo=="L") ## band(): n <- 4 ; m <- 6 r1 <- Matrix(1:24, n,m) validObject(M1 <- band(r1, 0,0)) (M1 <- as(M1, "sparseMatrix")) r2 <- Matrix(1:18, 3, 6) stopifnot(identical(M1, bandSparse(n,m, k=0, diag = list(diag(r1)))), identical(band(r2, 0,4), band(r2, 0,3) + band(r2, 4,4))) s1 <- as(r1, "sparseMatrix") # such that band(s1) is sparse, too for(k1 in (-n):m) for(k2 in k1:m) { stopifnotValid(br1 <- band(r1, k1,k2), "ddenseMatrix") stopifnotValid(bs1 <- band(s1, k1,k2), "CsparseMatrix") stopifnot(all(r1 == s1)) } ## large dimensions -- gave integer overflow ## R-forge bug 6743 by Ariel Paulson ## https://r-forge.r-project.org/tracker/?func=detail&atid=294&aid=6743&group_id=61 n <- 47000 stopifnotValid(Mn <- sparseMatrix(i = rep(1:6, 2), dims = c(n,n), j = c(1L,4L, 6:8, 10:12, 16:19)), "nsparseMatrix") stopifnotValid(M <- as(Mn, "dMatrix"), "dgCMatrix") dim(M) # 47000 47000 i <- 46341 stopifnotValid(bM <- band(M, i, i ), "dtCMatrix") ## gave Error in if (sqr && k1 * k2 >= 0) .... ## In addition: Warning message: ## In k1 * k2 : NAs produced by integer overflow x <- 1:999 bM2 <- bandSparse(n, k=i+(0:3), diagonals = list(x,10*x,32*x,5*x), symmetric=TRUE) stopifnotValid(bM2, "dsCMatrix") stopifnotValid(bb2 <- band(bM2, k1=i-2, k2=i+5), "dtCMatrix") stopifnotValid(b0 <- band(bM2, -1000, 1000), "dsCMatrix") stopifnotValid(b0a <- band(bM2, -1000, 1001), "dgCMatrix") (id <- nrow(M)-i)# 659 colN <- colSums(bM2 != 0) stopifnot(exprs = { identical(bb2, triu(bM2)) identical(b0 @x, numeric(0)) identical(b0a@x, numeric(0)) identical(bM2, band(bM2, -(i+3), i+3)) assert.EQ(as(bM2, "generalMatrix"), band(bM2, -(i+3), i+11), showOnly = TRUE) colN == { cN <- c(1:3, rep(4L, id-3)); c(rev(cN), rep(0L, i-id), cN)} }) ## some of these failed before Matrix 1.4.0 (Oct.7, 2021) D. <- Diagonal(x= c(-2,3:4)); D.[lower.tri(D.)] <- 1:3 ; D. D0 <- Diagonal(x= 0:3); D0[upper.tri(D0)] <- 1:6 ; D0 stopifnot(all.equal(list(modulus = structure(24, logarithm = FALSE), sign = -1L), unclass(determinant(D.,FALSE)), tol=1e-15), det(Matrix(0,1)) == 0, all.equal(list(modulus = structure(0, logarithm = FALSE), sign = 1L), unclass(determinant(D0,FALSE)), tol=0) ) ### More sparseVector checks: ------------------------------- validObject(new("isparseVector")) R <- sv <- as(D4, "sparseVector") ## dim() <- (n1,n2) --> sparse Matrix : dim(R) <- dim(D4) stopifnotValid(sv,"sparseVector") stopifnotValid(R, "sparseMatrix") stopifnot(identical(D4, as(R, "diagonalMatrix"))) iv <- c(rep(0, 5), 3, 0,0,7,0,0,0) sv <- as(iv, "sparseVector") sv. <- as(as.integer(iv), "sparseVector") ## Note: Method with signature "numeric#sparseVector" chosen ... (sv2 <- as(sv, "isparseVector")) ## gave error as(sv, "zsparseVector") stopifnot(identical(sv., sv2), identical( Matrix(sv, 3,4, byrow=TRUE), t(Matrix(sv, 4,3)))) options(warn = 0)# no longer error ## "Large" sparse: n <- 100000 m <- 50000 ; nnz <- 47 M <- spMatrix(n, m, i = sample(n, nnz, replace = TRUE), j = sample(m, nnz, replace = TRUE), x = round(rnorm(nnz),1)) validObject(Mv <- as(M, "sparseVector")) validObject(Dv <- as(Diagonal(60000), "sparseVector")) validObject(LD <- Diagonal(60000, TRUE)) validObject(Lv <- as(LD, "sparseVector")) Dm <- Dv; dim(Dm) <- c(180000L, 20000L) stopifnot(!doExtras || isValid(Md <- M * rowSums(M, sparseResult=TRUE), "sparseMatrix"), LD@diag == "U", isValid(Dm, "sparseMatrix"), identical(Dv, as(Dm, "sparseVector"))) p. <- new("dtCMatrix", i = c(2:3, 2L), p = c(0L, 2:3, 3L, 3L), Dim = c(4L, 4L), x = rep(-0.5, 3), uplo = "L", diag = "U") assert.EQ.mat(solve(solve(p.)), as(p., "matrix")) dimnames(p.)[[1]] <- paste(1:4) ii <- is.na(p.) stopifnot(all(!ii), !any(as(ii, "denseMatrix")))# used to fail lst <- ls() table(istri <- sapply(lst, function(.) is(get(.),"triangularMatrix"))) table(triC <- sapply(lst[istri], function(.) class(get(.)))) table(uniC <- sapply(lst[istri], function(.) get(.)@diag == "U")) lsUtr <- lst[istri][uniC] (di <- sapply(lsUtr, function(.) dim(get(.)))) ## TODO: use %*%, crossprod(), .. on all those 4 x 4 -- and check "triangular rules" r <- tryCatch(chol2inv(Diagonal(x=1:10), pi=pi), warning=identity) stopifnot(grepl("extra argument pi .*chol2inv\\(Diagonal", r$message)) assertError(new("ltrMatrix", Dim = c(2L,2L), x=TRUE))# gave "illegal" object w/o error assertError(new("ntrMatrix", Dim = c(2L,2L)))# dito cat('Time elapsed: ', (.pt <- proc.time()),'\n') # "stats" cat("doExtras:",doExtras,"\n") if(doExtras) { cat("checkMatrix() of all: \n---------\n") Sys.setlocale("LC_COLLATE", "C") # to keep ls() reproducible for(nm in ls()) if(is(.m <- get(nm), "Matrix")) { cat("\n", rep("-",nchar(nm)),"\n",nm, ":\n", sep='') checkMatrix(.m) } cat('Time elapsed: ', proc.time() - .pt,'\n') # "stats" } ## in any case, test d4d.2 <- Matrix:::.dense2C(!!d4da) ## <<- did wrongly make dimnames symmetric l4da <- as(d4da, "lMatrix") assert.EQ.Mat(l4da, as(l4da,"CsparseMatrix")) dtr <- tr4 <- triu(Matrix(1:16, 4,4)) dtr@x[Matrix:::indTri(4, upper=FALSE, diag=FALSE)] <- 100*(-3:2) stopifnot(all.equal(dtr, tr4), # because are same *as* simple matrices dtr@x[1:4] == c(1, -(3:1)*100), range(tr4) == c(0,16), range(dtr) == c(0,16)) # <- failed ## new("nsyMatrix") + new("lgeMatrix") # failed cln <- sort(outer(c("l","n"), paste0(c("ge","sy"), "Matrix"), paste0)) dim(c.c <- as.matrix(expand.grid(cln, cln, KEEP.OUT.ATTRS=FALSE))) # 16 x 2 ## clTry <- function(expr) class(tryCatch(expr, error=identity))[[1]] ## '+' [Arith] failed -- now fixed cbind(c.c, Res = apply(c.c, 1, function(x) class(new(x[1]) + new(x[2])))) ## '<' [Compare] works fine cbind(c.c, Res = apply(c.c, 1, function(x) class(new(x[1]) < new(x[2])))) if(!interactive()) warnings() ## R-forge matrix-Bugs [#6708] (2021-02-25, by David Cortes): sVec <- sparseVector(c(1,exp(1),pi), c(1,3,7), length=9) vec <- c(1, 0, exp(1), 0, 0, 0, pi, 0, 0) stopifnot(identical(as.matrix(sVec), as.matrix(vec)), identical(as.array (sVec), as.array (vec))) ## R-forge matrix-Bugs [#6656] (2020-02-05, by Chun Fung (Jackson) Kwok (kcf.jackson) ## (*is* a bug, but not in kronecker etc, but rather in Arith / Ops) dC <- sparseMatrix(i=1:4, j=1:4, x=5:2, triangular = TRUE) (dT <- as(dC, "TsparseMatrix")) stopifnot(identical(--dC, dC), identical(--dT, dT) ) ## both - gave : Error .... 'factors’ is not a slot in class “dtTMatrix” ## R PR#18250 - by Mikael Jagan nm2 <- c("a","b") x <- new("dspMatrix", x = c(3,2,1), Dim = c(2L,2L), Dimnames = list(nm2, NULL)) dn <- list(nm2,nm2) stopifnotValid(x. <- unpack(x), "dsyMatrix") validObject( y <- as(x , "generalMatrix") ) validObject( y. <- as(x., "generalMatrix") ) stopifnotValid( l <- x > 0, "lspMatrix") stopifnotValid( l. <- unpack(l), "lsyMatrix") stopifnotValid( lg <- as(l, "generalMatrix"), "lgeMatrix") stopifnotValid( lg2<- as(l.,"generalMatrix"), "lgeMatrix") stopifnot(exprs = { identical(dimnames(x ), dn) identical(dimnames(x.), dn) identical(dimnames(y ), dn) # was wrong identical(dimnames(y.), dn) # was wrong identical(dimnames(l ), dn) identical(dimnames(l.), dn) identical(dimnames(lg), dn) # was wrong identical(lg, lg2) ## even more cases (?) }) dn4 <- list(letters[1:4], LETTERS[1:4]) (D4n <- `dimnames<-`(D4, dn4)) m4 <- as(D4n, "matrix") stopifnot(identical(dimnames(m4), dn4), Q.eq(D4n, m4, superclasses = "mMatrix")) ## as(, "matrix") had lost dimnames before ## Platform - and other such info -- so we find it in old saved outputs .libPaths() SysI <- Sys.info() structure(Sys.info()[c(4,5,1:3)], class="simple.list") sessionInfo() c(Matrix = packageDescription("Matrix")$Built) if(SysI[["sysname"]] == "Linux" && require("sfsmisc")) local({ nn <- names(.Sc <- sfsmisc::Sys.cpuinfo()) nn <- names(.Sc <- .Sc[!grepl("^flags", nn)]) print(.Sc[ grep("\\.[0-9]+$", nn, invert=TRUE) ]) }) Matrix/tests/indexing.R0000644000176200001440000013340214147653617014631 0ustar liggesusers#### For both 'Extract' ("[") and 'Replace' ("[<-") Method testing #### aka subsetting and subassignment #### ~~~~~~~~~~ ~~~~~~~~~~~~~ if(interactive()) { options(error = recover, warn = 1) } else if(FALSE) { ## MM / developer testing *manually* : options(error = recover, Matrix.verbose = 2, warn = 1) } else { options( Matrix.verbose = 2, warn = 1) } ## Matrix.verbose = .. (*before* loading 'Matrix' pkg) ## ==> will also show method dispath ambiguity messages: getOption("ambiguousMethodSelection") #### suppressPackageStartupMessages(...) as we have an *.Rout.save to Rdiff against stopifnot(suppressPackageStartupMessages(require(Matrix))) source(system.file("test-tools.R", package = "Matrix"), keep.source = FALSE) ##-> identical3() etc cat("doExtras:",doExtras,"\n") ### Dense Matrices m <- Matrix(1:28 +0, nrow = 7) validObject(m) stopifnot(identical(m, m[]), identical(m[2, 3], 16), # simple number identical(m[2, 3:4], c(16,23)), # simple numeric of length 2 identical(m[NA,NA], as(Matrix(NA, 7,4), "dMatrix"))) m[2, 3:4, drop=FALSE] # sub matrix of class 'dgeMatrix' m[-(4:7), 3:4] # ditto; the upper right corner of 'm' ## rows or columns only: m[1,] # first row, as simple numeric vector m[,2] # 2nd column m[,1:2] # sub matrix of first two columns m[-(1:6),, drop=FALSE] # not the first 6 rows, i.e. only the 7th m[integer(0),] #-> 0 x 4 Matrix m[2:4, numeric(0)] #-> 3 x 0 Matrix ## logical indexing stopifnot(identical(m[2,3], m[(1:nrow(m)) == 2, (1:ncol(m)) == 3]), identical(m[2,], m[(1:nrow(m)) == 2, ]), identical(m[,3:4], m[, (1:4) >= 3])) ## dimnames indexing: mn <- m dimnames(mn) <- list(paste("r",letters[1:nrow(mn)],sep=""), LETTERS[1:ncol(mn)]) checkMatrix(mn) mn["rd", "D"] msr <- ms <- as(mn,"sparseMatrix") mnr <- mn v <- rev(as(ms, "vector")) mnr[] <- v msr[] <- v # [<- "sparse" -- not very sensical; did fail w/o a message z <- msr; z[] <- 0 zz <- as(array(0, dim(z)), "sparseMatrix") a.m <- as(mnr,"matrix") stopifnot(identical(mn["rc", "D"], mn[3,4]), mn[3,4] == 24, identical(mn[, "A"], mn[,1]), mn[,1] == 1:7, identical(mn[c("re", "rb"), "B"], mn[c(5,2), 2]), identical(ms["rc", "D"], ms[3,4]), ms[3,4] == 24, identical(ms[, "A"], ms[,1]), ms[,1] == 1:7, identical(ms[ci <- c("re", "rb"), "B"], ms[c(5,2), 2]), identical(rownames(mn[ci, ]), ci), identical(rownames(ms[ci, ]), ci), identical(colnames(mn[,cj <- c("B","D")]), cj), identical(colnames(ms[,cj]), cj), identical(a.m, as(msr,"matrix")), identical(unname(z), zz), identical(a.m, array(v, dim=dim(mn), dimnames=dimnames(mn))) ) showProc.time() ## Bug found thanks to Timothy Mak, Feb 3, 2017: ## sparseMatrix logical indexing with (partial) NA: a.m <- as(mn,"matrix") assert.EQ(as(ms,"matrix"), a.m) # incl. dimnames iN4 <- c(NA, TRUE, FALSE, TRUE) assert.EQ(as(mn[,iN4],"matrix"), a.m[,iN4]) # (incl. dimnames) ##assert.EQ(as.matrix(ms[,iN4]), a.m[,iN4]) # ms[, ] fails still : _FIXME_ try(ms[,iN4]) try(ms[,iN4] <- 100) ## <- segfaulted in Matrix <= 1.2-8 (!) ## R-forge Matrix bug #2556: Subsetting a sparse matrix did remove names(dimnames(.)) : m44 <- matrix(1:16, 4, 4, dimnames=list(row=c('a','b','c','d'), col=c('x','y','z','w'))) ## Dense matrix: ------------------------------------------ a <- Matrix(m44) identical( dimnames(m44[,FALSE, drop=FALSE]), dimnames( a[,FALSE, drop=FALSE])) chk.ndn <- function(a, a0=m44) stopifnot(identical(names(dimnames(a)), names(dimnames(a0)))) i <- 1:2 chk.ndn(a[i,]); chk.ndn(a[i, i]) ## Sparse matrix: ----------------------------------------- s <- as(a %% 3 == 1, "sparseMatrix") ts <- as(s,"TsparseMatrix") b <- sparseMatrix(i=1:3, j=rep(2,3), dims=c(4,4), dimnames=dimnames(s)) tb <- as(b,"TsparseMatrix") stopifnot(identical5( dimnames(a), dimnames(s), dimnames(ts), dimnames(b), dimnames(tb))) chk.ndn(b [i, i]); chk.ndn(b [i, ]) chk.ndn(s [i, i]); chk.ndn(s [i, ]) chk.ndn(tb[i, i]); chk.ndn(tb[i, ]) chk.ndn(ts[i, i]); chk.ndn(ts[i, ]) chk.ndn( b[ , 1, drop=FALSE]); chk.ndn( s[i, 2, drop=FALSE]) chk.ndn(tb[ , 1, drop=FALSE]); chk.ndn(ts[i, 2, drop=FALSE]) L0 <- logical(0) stopifnot(exprs = { identical(dim(b[,L0]), c(4L, 0L)) identical(dim(b[L0,]), c(0L, 4L)) # failed till 2019-09-x }) ## Printing sparse colnames: ms[sample(28, 20)] <- 0 ms <- t(rbind2(ms, 3*ms)) cnam1 <- capture.output(show(ms))[2] ; op <- options("sparse.colnames" = "abb3") cnam2 <- capture.output(show(ms))[2] ; options(op) # revert stopifnot(## sparse printing grep("^ +$", cnam1) == 1, # cnam1 is empty identical(cnam2, paste(" ", paste(rep(rownames(mn), 2), collapse=" ")))) mo <- m m[2,3] <- 100 m[1:2, 4] <- 200 m[, 1] <- -1 m[1:3,] m. <- .asmatrix(m) ## m[ cbind(i,j) ] indexing: iN <- ij <- cbind(1:6, 2:3) iN[2:3,] <- iN[5,2] <- NA stopifnot(identical(m[ij], m.[ij]), identical(m[iN], m.[iN])) ## testing operations on logical Matrices rather more than indexing: g10 <- m [ m > 10 ] stopifnot(18 == length(g10)) stopifnot(10 == length(m[ m <= 10 ])) sel <- (20 < m) & (m < 150) sel.<- (20 < m.)& (m.< 150) nsel <-(20 >= m) | (m >= 150) (ssel <- as(sel, "sparseMatrix")) stopifnot(is(sel, "lMatrix"), is(ssel, "lsparseMatrix"), identical3(as.mat(sel.), as.mat(sel), as.mat(ssel)), identical3(!sel, !ssel, nsel), # ! is typically dense identical3(m[ sel], m[ ssel], .asmatrix(m)[.asmatrix( ssel)]), identical3(m[!sel], m[!ssel], .asmatrix(m)[.asmatrix(!ssel)]) ) showProc.time() ## more sparse Matrices -------------------------------------- ##' @title Check sparseMatrix sub-assignment m[i,j] <- v ##' @param ms sparse Matrix ##' @param mm its [traditional matrix]-equivalent ##' @param k (approximate) length of index vectors (i,j) ##' @param n.uniq (approximate) number of unique values in i,j ##' @param vRNG function(n) for random 'v' generation ##' @param show logical; if TRUE, it will not stop on error ##' @return ##' @author Martin Maechler chkAssign <- function(ms, mm = as(ms, "matrix"), k = min(20,dim(mm)), n.uniq = k %/% 3, vRNG = { if(is.numeric(mm) || is.complex(mm)) function(n) rpois(n,lambda= 0.75)# <- about 47% zeros else ## logical function(n) runif(n) > 0.8 }, ## 80% zeros showOnly=FALSE) { stopifnot(is(ms,"sparseMatrix")) d <- dim(ms) s1 <- function(n) sample(n, pmin(n, pmax(1, rpois(1, n.uniq)))) i <- sample(s1(d[1]), k/2+ rpois(1, k/2), replace = TRUE) j <- sample(s1(d[2]), k/2+ rpois(1, k/2), replace = TRUE) assert.EQ.mat(ms[i,j], mm[i,j]) ms2 <- ms. <- ms; mm. <- mm # save ## now sub*assign* to these repeated indices, and then compare ----- v <- vRNG(length(i) * length(j)) mm[i,j] <- v ms[i,j] <- v ## useful to see (ii,ij), but confusing R/ESS when additionally debugging: ## if(!showOnly && interactive()) { op <- options(error = recover); on.exit(options(op)) } assert.EQ.mat(ms, mm, show=showOnly) ## vector indexing m[cbind(i,j)] == m[i + N(j-1)] , N = nrow(.) ii <- seq_len(min(length(i), length(j))) i <- i[ii] j <- j[ii] ij <- cbind(i, j) ii <- i + nrow(ms)*(j - 1) ord.i <- order(ii) iio <- ii[ord.i] ui <- unique(iio) # compare these with : neg.ii <- - setdiff(seq_len(prod(d)), ii) stopifnot(identical(mm[ii], mm[ij]), identical(ms.[ui], ms.[neg.ii]), ms.[ij] == mm.[ii], ## M[ cbind(i,j) ] was partly broken; now checking ms.[ii] == mm.[ii]) v <- v[seq_len(length(i))] if(is(ms,"nMatrix")) v <- as.logical(v) # ! mm.[ij] <- v ms.[ii] <- v nodup <- (length(ui) == length(ii)) ## <==> ! anyDuplicated(iio) if(nodup) { cat("[-]") # rare, unfortunately ms2[neg.ii] <- v[ord.i] stopifnot(identical(ms2, ms.)) } assert.EQ.mat(ms., mm., show=showOnly) } ##{chkAssign} ## Get duplicated index {because these are "hard" (and rare) getDuplIndex <- function(n, k) { repeat { i <- sample(n, k, replace=TRUE) # 3 4 6 9 2 9 : 9 is twice if(anyDuplicated(i)) break } i } suppressWarnings(RNGversion("3.5.0")); set.seed(101) m <- 1:800 m[sample(800, 600)] <- 0 m0 <- Matrix(m, nrow = 40) m1 <- add.simpleDimnames(m0) for(kind in c("n", "l", "d")) { for(m in list(m0,m1)) { ## -- with and without dimnames ------------------------- kClass <-paste0(kind, "Matrix" ) Ckind <- paste0(kind, "gCMatrix") Tkind <- paste0(kind, "gTMatrix") str(mC <- as(m, Ckind)) str(mT <- as(as(as(m, kClass), "TsparseMatrix"), Tkind)) mm <- as(mC, "matrix") # also logical or double IDENT <- if(kind == "n") function(x,y) Q.eq2(x,y, tol=0) else identical stopifnot(identical(mT, as(as(mC, "TsparseMatrix"), Tkind)), identical(mC, as(mT, Ckind)), Qidentical(mC[0,0], new(Ckind)), Qidentical(mT[0,0], new(Tkind)), identical(unname(mT[0,]), new(Tkind, Dim = c(0L,ncol(m)))), identical(unname(mT[,0]), new(Tkind, Dim = c(nrow(m),0L))), IDENT(mC[0,], as(mT[FALSE,], Ckind)), IDENT(mC[,0], as(mT[,FALSE], Ckind)), sapply(pmin(min(dim(mC)), c(0:2, 5:10)), function(k) {i <- seq_len(k); all(mC[i,i] == mT[i,i])}), TRUE) cat("ok\n") show(mC[,1]) show(mC[1:2,]) show(mC[7, drop = FALSE]) assert.EQ.mat(mC[1:2,], mm[1:2,]) assert.EQ.mat(mC[0,], mm[0,]) assert.EQ.mat(mC[,FALSE], mm[,FALSE]) ## ## *repeated* (aka 'duplicated') indices - did not work at all ... i <- pmin(nrow(mC), rep(8:10,2)) j <- c(2:4, 4:3) assert.EQ.mat(mC[i,], mm[i,]) assert.EQ.mat(mC[,j], mm[,j]) ## FIXME? assert.EQ.mat(mC[,NA], mm[,NA]) -- mC[,NA] is all 0 "instead" of all NA ## MM currently thinks we should NOT allow [ ] assert.EQ.mat(mC[i, 2:1], mm[i, 2:1]) assert.EQ.mat(mC[c(4,1,2:1), j], mm[c(4,1,2:1), j]) assert.EQ.mat(mC[i,j], mm[i,j]) ## ## set.seed(7) op <- options(Matrix.verbose = FALSE) cat(" for(): ") for(n in 1:(if(doExtras) 50 else 5)) { # (as chkAssign() is random) chkAssign(mC, mm) chkAssign(mC[-3,-2], mm[-3,-2]) cat(".") } options(op) cat(sprintf("\n[Ok]%s\n\n", strrep("-", 64))) } cat(sprintf("\nok( %s )\n== ###%s\n\n", kind, strrep("=", 70))) }## end{for}--------------------------------------------------------------- showProc.time() if(doExtras) {### {was ./AAA_index.R, MM-only} ## an nsparse-example A <- Matrix(c(rep(c(1,0,0),2), rep(c(2,0),7), c(0,0,2), rep(0,4)), 3,9) i <- c(3,1:2) j <- c(3, 5, 9, 5, 9) vv <- logical(length(i)*length(j)); vv[6:9] <- TRUE print(An <- as(A,"nMatrix")); an <- as(An, "matrix") assert.EQ.mat(An, an) An[i, j] <- vv an[i, j] <- vv assert.EQ.mat(An, an)## error if(!all(An == an)) show(drop0(An - an)) ## all are +1 options("Matrix.subassign.verbose" = TRUE)# output from C An <- as(A,"nMatrix"); An[i, j] <- vv ## and compare with this: Al <- as(A,"lMatrix"); Al[i, j] <- vv options("Matrix.subassign.verbose" = FALSE) ##--- An interesting not small not large example for M[i,j] <- v ------------ ## M <- Matrix(c(1, rep(0,7), 1:4), 3,4) N0 <- kronecker(M,M) mkN1 <- function(M) { stopifnot(length(d <- dim(M)) == 2) isC <- is(M,"CsparseMatrix") M[,d[2]] <- c(0,2,0) N <- kronecker(diag(x=1:2), M)## remains sparse if 'M' is if(isC) N <- as(N, "CsparseMatrix") diag(N[-1,]) <- -2 N[9,] <- 1:4 # is recycled N[,12] <- -7:-9 # ditto N } show(N1 <- t(N <- mkN1(N0))) # transpose {for display reasons} C1 <- t(C <- mkN1(as(N0,"CsparseMatrix"))) stopifnot(all(C == N)) assert.EQ.mat(C, mkN1(.asmatrix(N0))) C. <- C1 show(N <- N1) ; n <- .asmatrix(N); str(N) sort(i <- c(6,8,19,11,21,20,10,7,12,9,5,18,17,22,13))## == c(5:13, 17:22)) sort(j <- c(3,8,6,15,10,4,14,13,16,2,11,17,7,5))## == c(2:8, 10:11, 13:17) val <- v.l <- 5*c(0,6,0,7,0,0,8:9, 0,0) show(spv <- as(val, "sparseVector")); str(spv) n [i,j] <- v.l N [i,j] <- val# is recycled, too C.[i,j] <- val assert.EQ.mat(N,n) ; stopifnot(all(C. == N)) ## and the same *again*: n [i,j] <- v.l N [i,j] <- val C.[i,j] <- val assert.EQ.mat(N,n) stopifnot(all(C. == N)) print(load(system.file("external", "symA.rda", package="Matrix"))) # "As" stopifnotValid(As, "dsCMatrix"); stopifnot(identical(As@factors, list())) R. <- drop0(chol(As)) stopifnot(1:32 == sort(diag(R.)), ## ! R.@x == as.integer(R.@x),## so it is an integer-valued chol-decomp ! ## shows that (1) As is *not* singular (2) the matrix is not random all.equal(crossprod(R.), As, tolerance =1e-15)) print(summary(evA <- eigen(As, only.values=TRUE)$val)) print(tail(evA)) ## largest three ~= 10^7, smallest two *negative* print(rcond(As)) # 1.722 e-21 == very bad ! ##-> this *is* a border line case, i.e. very close to singular ! ## and also determinant(.) is rather random here! cc0 <- Cholesky(As)# no problem try({ cc <- Cholesky(As, super=TRUE) ## gives --on 32-bit only-- ## Cholmod error 'matrix not positive definite' at file:../Supernodal/t_cholmod_super_numeric.c, line 613 ecc <- expand(cc) L.P <- with(ecc, crossprod(L,P)) ## == L'P ## crossprod(L.P) == (L'P)' L'P == P'LL'P stopifnot( all.equal(crossprod(L.P), As) ) }) ##---- end{ eigen( As ) ----------- } ## only if(doExtras) ##---- Symmetric indexing of symmetric Matrix ---------- m. <- mC m.[, c(2, 7:12)] <- 0 stopifnotValid(S <- crossprod(add.simpleDimnames(m.) %% 100), "dsCMatrix") ss <- as(S, "matrix") ds <- as(S, "denseMatrix") ## NA-indexing of *dense* Matrices: should work as traditionally assert.EQ.mat(ds[NA,NA], ss[NA,NA]) assert.EQ.mat(ds[NA, ], ss[NA,]) assert.EQ.mat(ds[ ,NA], ss[,NA]) T <- as(S, "TsparseMatrix") stopifnot(identical(ds[2 ,NA], ss[2,NA]), identical(ds[NA, 1], ss[NA, 1]), identical(S, as(T, "CsparseMatrix")) ) ## non-repeated indices: i <- c(7:5, 2:4);assert.EQ.mat(T[i,i], ss[i,i]) ## NA in indices -- check that we get a helpful error message: i[2] <- NA er <- tryCatch(T[i,i], error = function(e)e) stopifnot(as.logical(grep("indices.*sparse Matrices", er$message))) N <- nrow(T) set.seed(11) for(n in 1:(if(doExtras) 50 else 3)) { i <- sample(N, max(2, sample(N,1)), replace = FALSE) validObject(Tii <- T[i,i]) ; tTi <- t(T)[i,i] stopifnot(is(Tii, "dsTMatrix"), # remained symmetric Tsparse is(tTi, "dsTMatrix"), # may not be identical when *sorted* differently identical(as(t(Tii),"CsparseMatrix"), as(tTi,"CsparseMatrix"))) assert.EQ.mat(Tii, ss[i,i]) } b <- diag(1:2)[,c(1,1,2,2)] cb <- crossprod(b) cB <- crossprod(Matrix(b, sparse=TRUE)) a <- matrix(0, 6, 6) a[1:4, 1:4] <- cb A1 <- A2 <- Matrix(0, 6, 6)#-> ddiMatrix A1[1:4, 1:4] <- cb A2[1:4, 1:4] <- cB assert.EQ.mat(A1, a)# indeed ## "must": symmetric and sparse, i.e., ds*Matrix: stopifnot(identical(A1, A2), is(A1, "dsCMatrix")) ## repeated ones ``the challenge'' (to do smartly): j <- c(4, 4, 9, 12, 9, 4, 17, 3, 18, 4, 12, 18, 4, 9) assert.EQ.mat(T[j,j], ss[j,j]) ## and another two sets (a, A) & (a., A.) : a <- matrix(0, 6,6) a[upper.tri(a)] <- (utr <- c(2, 0,-1, 0,0,5, 7,0,0,0, 0,0,-2,0,8)) ta <- t(a); ta[upper.tri(a)] <- utr; a <- t(ta) diag(a) <- c(0,3,0,4,6,0) A <- as(Matrix(a), "TsparseMatrix") A. <- A diag(A.) <- 10 * (1:6) a. <- as(A., "matrix") ## More testing {this was not working for a long time..} set.seed(1) for(n in 1:(if(doExtras) 100 else 6)) { i <- sample(1:nrow(A), 3+2*rpois(1, lam=3), replace=TRUE) Aii <- A[i,i] A.ii <- A.[i,i] stopifnot(class(Aii) == class(A), class(A.ii) == class(A.)) assert.EQ.mat(Aii , a [i,i]) assert.EQ.mat(A.ii, a.[i,i]) assert.EQ.mat(T[i,i], ss[i,i]) } showProc.time() stopifnot(all.equal(mC[,3], mm[,3]), identical(mC[ij], mC[ij + 0.4]), identical(mC[ij], mm[ij]), identical(mC[iN], mm[iN])) ## out of bound indexing must be detected: assertError(mC[cbind(ij[,1] - 5, ij[,2])]) assertError(mC[cbind(ij[,1], ij[,2] + ncol(mC))]) assert.EQ.mat(mC[7, , drop=FALSE], mm[7, , drop=FALSE]) identical (mC[7, drop=FALSE], mm[7, drop=FALSE]) # *vector* indexing stopifnot(dim(mC[numeric(0), ]) == c(0,20), # used to give warnings dim(mC[, integer(0)]) == c(40,0), identical(mC[, integer(0)], mC[, FALSE])) validObject(print(mT[,c(2,4)])) stopifnot(all.equal(mT[2,], mm[2,]), ## row or column indexing in combination with t() : Q.C.identical(mT[2,], t(mT)[,2]), Q.C.identical(mT[-2,], t(t(mT)[,-2])), Q.C.identical(mT[c(2,5),], t(t(mT)[,c(2,5)])) ) assert.EQ.mat(mT[4,, drop = FALSE], mm[4,, drop = FALSE]) stopifnot(identical3(mm[,1], mC[,1], mT[,1]), identical3(mm[3,], mC[3,], mT[3,]), identical3(mT[2,3], mC[2,3], 0), identical(mT[], mT), identical4( mm[c(3,7), 2:4], as.mat( m[c(3,7), 2:4]), as.mat(mT[c(3,7), 2:4]), as.mat(mC[c(3,7), 2:4])) ) x.x <- crossprod(mC) stopifnot(class(x.x) == "dsCMatrix", class(x.x. <- round(x.x / 10000)) == "dsCMatrix", identical(x.x[cbind(2:6, 2:6)], diag(x.x [2:6, 2:6]))) head(x.x.) # Note the *non*-structural 0's printed as "0" tail(x.x., -3) # all but the first three lines lx.x <- as(x.x, "lsCMatrix") # FALSE only for "structural" 0 (l10 <- lx.x[1:10, 1:10])# "lsC" (l3 <- lx.x[1:3, ]) m.x <- as.mat(x.x) # as.mat() *drops* (NULL,NULL) dimnames stopifnot(class(l10) == "lsCMatrix", # symmetric indexing -> symmetric ! identical(as.mat(lx.x), m.x != 0), identical(as.logical(lx.x), as.logical(m.x)), identical(as.mat(l10), m.x[1:10, 1:10] != 0), identical(as.mat(l3 ), m.x[1:3, ] != 0) ) ##-- Sub*assignment* with repeated / duplicated index: A <- Matrix(0,4,3) ; A[c(1,2,1), 2] <- 1 ; A B <- A; B[c(1,2,1), 2] <- 1:3; B; B. <- B B.[3,] <- rbind(4:2) ## change the diagonal and the upper and lower subdiagonal : diag(B.) <- 10 * diag(B.) diag(B.[,-1]) <- 5* diag(B.[,-1]) diag(B.[-1,]) <- 4* diag(B.[-1,]) ; B. C <- B.; C[,2] <- C[,2]; C[1,] <- C[1,]; C[2:3,2:1] <- C[2:3,2:1] stopifnot(identical(unname(.asmatrix(A)), local({a <- matrix(0,4,3); a[c(1,2,1), 2] <- 1 ; a})), identical(unname(.asmatrix(B)), local({a <- matrix(0,4,3); a[c(1,2,1), 2] <- 1:3; a})), identical(C, drop0(B.))) ## [] <- v failed in the past T <- as(C,"TsparseMatrix"); C. <- C T[T>0] <- 21 C[C>0] <- 21 a. <- local({a <- .asmatrix(C.); a[a>0] <- 21; a}) assert.EQ.mat(C, a.) stopifnot(identical(C, as(T, "CsparseMatrix"))) ## used to fail n <- 5 ## or much larger sm <- new("dsTMatrix", i=1L, j=1L, Dim=as.integer(c(n,n)), x = 1) (cm <- as(sm, "CsparseMatrix")) sm[2,] stopifnot(sm[2,] == c(0:1, rep.int(0,ncol(sm)-2)), sm[2,] == cm[2,], sm[,3] == sm[3,], all(sm[,-(1:3)] == t(sm[-(1:3),])), # all() all(sm[,-(1:3)] == 0) ) showProc.time() ##--- "nsparse*" sub-assignment :---------- M <- Matrix(c(1, rep(0,7), 1:4), 3,4) N0 <- kronecker(M,M) Nn <- as(N0, "nMatrix"); nn <- as(Nn,"matrix") (Nn00 <- Nn0 <- Nn); nn00 <- nn0 <- nn set.seed(1) Nn0 <- Nn00; nn0 <- nn00 for(i in 1:(if(doExtras) 200 else 25)) { Nn <- Nn0 nn <- nn0 i. <- getDuplIndex(nrow(N0), 6) j. <- getDuplIndex(ncol(N0), 4) vv <- sample(c(FALSE,TRUE), length(i.)*length(j.), replace=TRUE) cat(",") Nn[i., j.] <- vv nn[i., j.] <- vv assert.EQ.mat(Nn, nn) if(!all(Nn == nn)) { cat("i=",i,":\n i. <- "); dput(i.) cat("j. <- "); dput(j.) cat("which(vv): "); dput(which(vv)) cat("Difference matrix:\n") show(drop0(Nn - nn)) } cat("k") ## sub-assign double precision to logical sparseMatrices: now *with* warning: ## {earlier: gave *no* warning}: assertWarning(Nn[1:2,] <- -pi) assertWarning(Nn[, 5] <- -pi) assertWarning(Nn[2:4, 5:8] <- -pi) stopifnotValid(Nn,"nsparseMatrix") ## cat(".") if(i %% 10 == 0) cat("\n") if(i == 100) { Nn0 <- as(Nn0, "CsparseMatrix") cat("Now: class", class(Nn0)," :\n~~~~~~~~~~~~~~~~~\n") } } showProc.time() Nn <- Nn0 ## Check that NA is interpreted as TRUE (with a warning), for "nsparseMatrix": assertWarning(Nn[ii <- 3 ] <- NA); stopifnot(isValid(Nn,"nsparseMatrix"), Nn[ii]) assertWarning(Nn[ii <- 22:24] <- NA); stopifnot(isValid(Nn,"nsparseMatrix"), Nn[ii]) assertWarning(Nn[ii <- -(1:99)] <- NA); stopifnot(isValid(Nn,"nsparseMatrix"), Nn[ii]) assertWarning(Nn[ii <- 3:4 ] <- c(0,NA)) stopifnot(isValid(Nn,"nsparseMatrix"), Nn[ii] == 0:1) assertWarning(Nn[ii <- 25:27] <- c(0,1,NA)) stopifnot(isValid(Nn,"nsparseMatrix"), Nn[ii] == c(FALSE,TRUE,TRUE)) m0 <- Diagonal(5) stopifnot(identical(m0[2,], m0[,2]), identical(m0[,1], c(1,0,0,0,0))) ### Diagonal -- Sparse: (m1 <- as(m0, "TsparseMatrix")) # dtTMatrix unitriangular (m2 <- as(m0, "CsparseMatrix")) # dtCMatrix unitriangular m1g <- as(m1, "generalMatrix") tr1 <- as(m1, "denseMatrix") # dtrMatrix unitriangular stopifnotValid(m1g, "dgTMatrix") diag(tr1) <- 100 stopifnot(diag(tr1) == 100)# failed when 'diag<-' did not recycle assert.EQ.mat(m2[1:3,], diag(5)[1:3,]) assert.EQ.mat(m2[,c(4,1)], diag(5)[,c(4,1)]) stopifnot(identical(m2[1:3,], as(m1[1:3,], "CsparseMatrix")), identical(uniqTsparse(m1[, c(4,2)]), uniqTsparse(as(m2[, c(4,2)], "TsparseMatrix"))) )## failed in 0.9975-11 ## 0-dimensional diagonal - subsetting ---------------------------- ## before that diagU2N() etc for 0-dim. dtC*: m0. <- m00 <- matrix(numeric(),0,0) dimnames(m0.) <- list(NULL, NULL) tC0.<- new("dtCMatrix") tC0 <- new("dtCMatrix", diag="U") (gC0 <- new("dgCMatrix")) # 0 x 0 D0 <- Diagonal(0) stopifnot(exprs = { identical(m0., as(tC0, "matrix")) # failed: Cholmod error 'invalid xtype' .. identical(numeric(), as(tC0, "numeric"))# " identical(numeric(), tC0[ 0 ])# --> .M.vectorSub(x, i) failed in as(., "matrix") identical(m00[TRUE ], tC0[TRUE ])# (worked already) identical(m00[FALSE], tC0[FALSE])# ditto ## identical(D0, D0[0,0]) # used to fail --> subCsp_ij (..) identical(D0, D0[ ,0]) # (ditto) --> subCsp_cols(..) identical(D0, D0[0, ]) # " --> subCsp_rows(..) identical(D0, D0[,]) # (worked already) identical(m00[ 0 ], D0[ 0 ] )# ditto identical(m00[TRUE ], D0[TRUE ])# " identical(m00[FALSE], D0[FALSE])# " ## identical(tC0.,tC0[0,0]) # failed --> subCsp_ij (..) identical(gC0, tC0[ ,0]) # " --> subCsp_cols(..) identical(gC0, tC0[0, ]) # " --> subCsp_rows(..) identical(tC0, tC0[,]) # (worked already) ## vector indexing }) expr <- quote({ ## FIXME -- both 'TRUE' and 'FALSE' should fail "out of bound",etc D0[TRUE, TRUE ] D0[ , TRUE ] D0[TRUE, ] # worked but should *NOT* tC0[TRUE, TRUE ] tC0[ , TRUE ] tC0[TRUE, ] # worked but should *NOT* ## D0[FALSE,FALSE] # fails --> subCsp_ij(..) -> intI() D0[ ,FALSE] # ditto ............ D0[FALSE, ] # ditto tC0[FALSE,FALSE] # " tC0[FALSE, ] # " tC0[ ,FALSE] # " }) EE <- lapply(expr[-1], function(e) list(expr = e, r = tryCatch(eval(e), error = identity))) exR <- lapply(EE, `[[`, "r") stopifnot(exprs = { vapply(exR, inherits, logical(1), what = "error") unique( vapply(exR, `[[`, "", "message") ) == "logical subscript too long (1, should be 0)" }) (uTr <- new("dtTMatrix", Dim = c(3L,3L), diag="U")) uTr[1,] <- 0 assert.EQ.mat(uTr, cbind(0, rbind(0,diag(2)))) M <- m0; M[1,] <- 0 Z <- m0; Z[] <- 0; z <- array(0, dim(M)) stopifnot(identical(M, Diagonal(x=c(0, rep(1,4)))), all(Z == 0), Qidentical(as(Z, "matrix"), z)) M <- m0; M[,3] <- 3 ; M ; stopifnot(is(M, "sparseMatrix"), M[,3] == 3) checkMatrix(M) M <- m0; M[1:3, 3] <- 0 ;M T <- m0; T[1:3, 3] <- 10 stopifnot(identical(M, Diagonal(x=c(1,1, 0, 1,1))), isValid(T, "triangularMatrix"), identical(T[,3], c(10,10,10,0,0))) M <- m1; M[1,] <- 0 ; M ; assert.EQ.mat(M, diag(c(0,rep(1,4))), tol=0) M <- m1; M[,3] <- 3 ; stopifnot(is(M,"sparseMatrix"), M[,3] == 3) Z <- m1; Z[] <- 0 checkMatrix(M) M <- m1; M[1:3, 3] <- 0 ;M assert.EQ.mat(M, diag(c(1,1, 0, 1,1)), tol=0) T <- m1; T[1:3, 3] <- 10; checkMatrix(T) stopifnot(is(T, "triangularMatrix"), identical(T[,3], c(10,10,10,0,0)), Qidentical(as(Z, "matrix"), z)) M <- m2; M[1,] <- 0 ; M ; assert.EQ.mat(M, diag(c(0,rep(1,4))), tol=0) M <- m2; M[,3] <- 3 ; stopifnot(is(M,"sparseMatrix"), M[,3] == 3) checkMatrix(M) Z <- m2; Z[] <- 0 M <- m2; M[1:3, 3] <- 0 ;M assert.EQ.mat(M, diag(c(1,1, 0, 1,1)), tol=0) T <- m2; T[1:3, 3] <- 10; checkMatrix(T) stopifnot(is(T, "dtCMatrix"), identical(T[,3], c(10,10,10,0,0)), Qidentical(as(Z, "matrix"), z)) showProc.time() ## "Vector indices" ------------------- asLogical <- function(x) { stopifnot(is.atomic(x)) storage.mode(x) <- "logical" x } .iniDiag.example <- expression({ D <- Diagonal(6) M <- as(D,"dgeMatrix") m <- as(D,"matrix") s <- as(D,"TsparseMatrix"); N <- as(s,"nMatrix") S <- as(s,"CsparseMatrix"); C <- as(S,"nMatrix") }) eval(.iniDiag.example) i <- c(3,1,6); v <- c(10,15,20) ## (logical,value) which both are recycled: L <- c(TRUE, rep(FALSE,8)) ; z <- c(50,99) ## vector subassignment, both with integer & logical ## these now work correctly {though not very efficiently; hence warnings} m[i] <- v # the role model: only first column is affected M[i] <- v; assert.EQ.mat(M,m) # dge D[i] <- v; assert.EQ.mat(D,m) # ddi -> dtC (new! 2019-07; was dgT) s[i] <- v; assert.EQ.mat(s,m) # dtT -> dgT S[i] <- v; assert.EQ.mat(S,m); S # dtC -> dtT -> dgT -> dgC m.L <- asLogical(m) ; assertWarning( C[i] <- v, verbose=TRUE) # warning: C is nMatrix, v not T/F assert.EQ.mat(C,m.L); validObject(C); assertWarning( N[i] <- v, verbose=TRUE) assert.EQ.mat(N,m.L); validObject(N) stopifnot(identical(D, as(as(s, "triangularMatrix"), "CsparseMatrix"))) ## logical *vector* indexing eval(.iniDiag.example) m[L] <- z; m.L <- asLogical(m) M[L] <- z; assert.EQ.mat(M,m) D[L] <- z; assert.EQ.mat(D,m) s[L] <- z; assert.EQ.mat(s,m) S[L] <- z; assert.EQ.mat(S,m) ; S ; assertWarning( C[L] <- z, verbose=TRUE); assert.EQ.mat(C,m.L) ; assertWarning( N[L] <- z, verbose=TRUE); assert.EQ.mat(N,m.L) ## indexing [i] vs [i,] --- now ok eval(.iniDiag.example) stopifnot(identical5(m[i], M[i], D[i], s[i], S[i]), identical3(as.logical(m[i]), C[i], N[i]), identical5(m[L], M[L], D[L], s[L], S[L]), identical3(as.logical(m[L]), C[L], N[L])) ## bordercase ' drop = .' *vector* indexing {failed till 2009-04-..) stopifnot(identical5(m[i,drop=FALSE], M[i,drop=FALSE], D[i,drop=FALSE], s[i,drop=FALSE], S[i,drop=FALSE]), identical3(as.logical(m[i,drop=FALSE]), C[i,drop=FALSE], N[i,drop=FALSE])) stopifnot(identical5(m[L,drop=FALSE], M[L,drop=FALSE], D[L,drop=FALSE], s[L,drop=FALSE], S[L,drop=FALSE]), identical3(as.logical(m[L,drop=FALSE]), C[L,drop=FALSE], N[L,drop=FALSE])) ## using L for row-indexing should give an error assertError(m[L,]); assertError(m[L,, drop=FALSE]) ## these did not signal an error, upto (including) 0.999375-30: assertError(s[L,]); assertError(s[L,, drop=FALSE]) assertError(S[L,]); assertError(S[L,, drop=FALSE]) assertError(N[L,]); assertError(N[L,, drop=FALSE]) ## row indexing: assert.EQ.mat(D[i,], m[i,]) assert.EQ.mat(M[i,], m[i,]) assert.EQ.mat(s[i,], m[i,]) assert.EQ.mat(S[i,], m[i,]) assert.EQ.mat(C[i,], asLogical(m[i,])) assert.EQ.mat(N[i,], asLogical(m[i,])) ## column indexing: assert.EQ.mat(D[,i], m[,i]) assert.EQ.mat(M[,i], m[,i]) assert.EQ.mat(s[,i], m[,i]) assert.EQ.mat(S[,i], m[,i]) assert.EQ.mat(C[,i], asLogical(m[,i])) assert.EQ.mat(N[,i], asLogical(m[,i])) ### --- negative indices ---------- ## 1) negative *vector* indexing eval(.iniDiag.example) i <- -(2:30) stopifnot(identical5(m[i], M[i], D[i], s[i], S[i]), identical3(as.logical(m[i]), C[i], N[i])) ## negative vector subassignment : v <- seq_along(m[i]) m[i] <- v; m.L <- asLogical(m) M[i] <- v; assert.EQ.mat(M,m) # dge D[i] <- v; assert.EQ.mat(D,m) # ddi -> dtT -> dgT s[i] <- v; assert.EQ.mat(s,m) # dtT -> dgT S[i] <- v; assert.EQ.mat(S,m); S ; assertWarning( # dtC -> dtT -> dgT -> dgC N[i] <- v, verbose=TRUE) assert.EQ.mat(N,m.L); N ; assertWarning( C[i] <- v, verbose=TRUE) assert.EQ.mat(C,m.L); C # options(warn = 2) #---------------------# NO WARNINGS from here ----------------- # ===================== ## 2) negative [i,j] indices mc <- mC[1:5, 1:7] mt <- mT[1:5, 1:7] ## sub matrix assert.EQ.mat(mC[1:2, 0:3], mm[1:2, 0:3]) # test 0-index stopifnot(identical(mc[-(3:5), 0:2], mC[1:2, 0:2]), identical(mt[-(3:5), 0:2], mT[1:2, 0:2]), identical(mC[2:3, 4], mm[2:3, 4])) assert.EQ.mat(mC[1:2,], mm[1:2,]) ## sub vector stopifnot(identical4(mc[-(1:4), ], mC[5, 1:7], mt[-(1:4), ], mT[5, 1:7])) stopifnot(identical4(mc[-(1:4), -(2:4)], mC[5, c(1,5:7)], mt[-(1:4), -(2:4)], mT[5, c(1,5:7)])) ## mixing of negative and positive must give error assertError(mT[-1:1,]) showProc.time() ## Sub *Assignment* ---- now works (partially): mt0 <- mt nt <- as(mt, "nMatrix") mt[1, 4] <- -99 mt[2:3, 1:6] <- 0 mt m2 <- mt+mt m2[1,4] <- -200 m2[c(1,3), c(5:6,2)] <- 1:6 stopifnot(m2[1,4] == -200, as.vector(m2[c(1,3), c(5:6,2)]) == 1:6) mt[,3] <- 30 mt[2:3,] <- 250 mt[1:5 %% 2 == 1, 3] <- 0 mt[3:1, 1:7 > 5] <- 0 mt tt <- as(mt,"matrix") ii <- c(0,2,5) jj <- c(2:3,5) tt[ii, jj] <- 1:6 # 0 is just "dropped" mt[ii, jj] <- 1:6 assert.EQ.mat(mt, tt) mt[1:5, 2:6] as((mt0 - mt)[1:5,], "dsparseMatrix")# [1,5] and lines 2:3 mt[c(2,4), ] <- 0; stopifnot(as(mt[c(2,4), ],"matrix") == 0) mt[2:3, 4:7] <- 33 checkMatrix(mt) mt mc[1,4] <- -99 ; stopifnot(mc[1,4] == -99) mc[1,4] <- 00 ; stopifnot(mc[1,4] == 00) mc[1,4] <- -99 ; stopifnot(mc[1,4] == -99) mc[1:2,4:3] <- 4:1; stopifnot(.asmatrix(mc[1:2,4:3]) == 4:1) mc[-1, 3] <- -2:1 # 0 should not be entered; 'value' recycled mt[-1, 3] <- -2:1 stopifnot(mc@x != 0, mt@x != 0, mc[-1,3] == -2:1, mt[-1,3] == -2:1) ## failed earlier mc0 <- mc mt0 <- as(mc0, "TsparseMatrix") m0 <- as(mc0, "matrix") set.seed(1); options(Matrix.verbose = FALSE) for(i in 1:(if(doExtras) 50 else 4)) { mc <- mc0; mt <- mt0 ; m <- m0 ev <- 1:5 %% 2 == round(runif(1))# 0 or 1 j <- sample(ncol(mc), 1 + round(runif(1))) nv <- rpois(sum(ev) * length(j), lambda = 1) mc[ev, j] <- nv m[ev, j] <- nv mt[ev, j] <- nv if(i %% 10 == 1) print(mc[ev,j, drop = FALSE]) stopifnot(as.vector(mc[ev, j]) == nv, ## failed earlier... as.vector(mt[ev, j]) == nv) validObject(mc) ; assert.EQ.mat(mc, m) validObject(mt) ; assert.EQ.mat(mt, m) } showProc.time() options(Matrix.verbose = TRUE) mc # no longer has non-structural zeros mc[ii, jj] <- 1:6 mc[c(2,5), c(3,5)] <- 3.2 checkMatrix(mc) m. <- mc mc[4,] <- 0 mc S <- as(Diagonal(5),"TsparseMatrix") H <- Hilbert(9) Hc <- as(round(H, 3), "dsCMatrix")# a sparse matrix with no 0 ... (trH <- tril(Hc[1:5, 1:5])) stopifnot(is(trH, "triangularMatrix"), trH@uplo == "L", is(S, "triangularMatrix")) ## triangular assignment ## the slick (but inefficient in case of sparse!) way to assign sub-diagonals: ## equivalent to tmp <- `diag<-`(S[,-1], -2:1); S[,-1] <- tmp ## which dispatches to (x="TsparseMatrix", i="missing",j="index", value="replValue") diag(S[,-1]) <- -2:1 # used to give a wrong warning S <- as(S,"triangularMatrix") assert.EQ.mat(S, local({s <- diag(5); diag(s[,-1]) <- -2:1; s})) trH[c(1:2,4), c(2:3,5)] <- 0 # gave an *error* upto Jan.2008 trH[ lower.tri(trH) ] <- 0 # ditto, because of callNextMethod() m <- Matrix(0+1:28, nrow = 4) m[-3,c(2,4:5,7)] <- m[ 3, 1:4] <- m[1:3, 6] <- 0 mT <- as(m, "dgTMatrix") stopifnot(identical(mT[lower.tri(mT)], m [lower.tri(m) ])) lM <- upper.tri(mT, diag=TRUE) mT[lM] <- 0 m[lM] <- 0 assert.EQ.mat(mT, as(m,"matrix")) mT[lM] <- -1:0 m[lM] <- -1:0 assert.EQ.mat(mT, as(m,"matrix")) (mT <- drop0(mT)) i <- c(1:2, 4, 6:7); j <- c(2:4,6) H[i,j] <- 0 (H. <- round(as(H, "sparseMatrix"), 3)[ , 2:7]) Hc. <- Hc Hc.[i,j] <- 0 ## now "works", but setting "non-structural" 0s stopifnot(.asmatrix(Hc.[i,j]) == 0) Hc.[, 1:6] ## an example that failed for a long time sy3 <- new("dsyMatrix", Dim = as.integer(c(2, 2)), x = c(14, -1, 2, -7)) checkMatrix(dm <- kronecker(Diagonal(2), sy3))# now sparse with new kronecker dm <- Matrix(.asmatrix(dm))# -> "dsyMatrix" (s2 <- as(dm, "sparseMatrix")) checkMatrix(st <- as(s2, "TsparseMatrix")) stopifnot(is(s2, "symmetricMatrix"), is(st, "symmetricMatrix")) checkMatrix(s.32 <- st[1:3,1:2]) ## 3 x 2 - and *not* dsTMatrix checkMatrix(s2.32 <- s2[1:3,1:2]) I <- c(1,4:3) stopifnot(is(s2.32, "generalMatrix"), is(s.32, "generalMatrix"), identical(as.mat(s.32), as.mat(s2.32)), identical3(dm[1:3,-1], asD(s2[1:3,-1]), asD(st[1:3,-1])), identical4(2, dm[4,3], s2[4,3], st[4,3]), identical3(diag(dm), diag(s2), diag(st)), is((cI <- s2[I,I]), "dsCMatrix"), is((tI <- st[I,I]), "dsTMatrix"), identical4(as.mat(dm)[I,I], as.mat(dm[I,I]), as.mat(tI), as.mat(cI)) ) ## now sub-assign and check for consistency ## symmetric subassign should keep symmetry st[I,I] <- 0; checkMatrix(st); stopifnot(is(st,"symmetricMatrix")) s2[I,I] <- 0; checkMatrix(s2); stopifnot(is(s2,"symmetricMatrix")) ## m <- as.mat(st) m[2:1,2:1] <- 4:1 st[2:1,2:1] <- 4:1 s2[2:1,2:1] <- 4:1 stopifnot(identical(m, as.mat(st)), 1:4 == as.vector(s2[1:2,1:2]), identical(m, as.mat(s2))) ## now a slightly different situation for 's2' (had bug) s2 <- as(dm, "sparseMatrix") s2[I,I] <- 0; diag(s2)[2:3] <- -(1:2) stopifnot(is(s2,"symmetricMatrix"), diag(s2) == c(0:-2,0)) t2 <- as(s2, "TsparseMatrix") m <- as.mat(s2) s2[2:1,2:1] <- 4:1 t2[2:1,2:1] <- 4:1 m[2:1,2:1] <- 4:1 assert.EQ.mat(t2, m) assert.EQ.mat(s2, m) ## and the same (for a different s2 !) s2[2:1,2:1] <- 4:1 t2[2:1,2:1] <- 4:1 assert.EQ.mat(t2, m)# ok assert.EQ.mat(s2, m)# failed in 0.9975-8 showProc.time() ## sub-assign RsparseMatrix -- Matrix bug [#6709] by David Cortes ## https://r-forge.r-project.org/tracker/?func=detail&atid=294&aid=6709&group_id=61 ## simplified by MM X <- new("dgCMatrix", i = c(0L,3L), p = c(0L,2L,2L,2L), x = c(100, -20), Dim = c(12L,3L)) R <- as(X, "RsparseMatrix") T <- as(R, "TsparseMatrix") T[, 2] <- 22 # works fine R[, 2] <- 22 # failed, as it called replTmat() giving narg() == 3 ## now R is Tsparse (as documented on ../man/RsparseMatrix-class.Rd), identical(R, T) ## but as this may change, rather R & T should have the same *content* assert.EQ.Mat(R, T) ## m[cbind(i,j)] <- value: (2-column matrix subassignment): ------------------------- m.[ cbind(3:5, 1:3) ] <- 1:3 stopifnot(m.[3,1] == 1, m.[4,2] == 2) nt. <- nt ; nt[rbind(2:3, 3:4, c(3,3))] <- FALSE s. <- m. ; m.[cbind(3,4:6)] <- 0 ## assigning 0 where there *is* 0 .. stopifnot(identical(nt.,nt), ## should not have changed identical(s., m.)) x.x[ cbind(2:6, 2:6)] <- 12:16 stopifnot(isValid(x.x, "dsCMatrix"), 12:16 == as.mat(x.x)[cbind(2:6, 2:6)]) (ne1 <- (mc - m.) != 0) stopifnot(identical(ne1, 0 != abs(mc - m.))) (ge <- m. >= mc) # contains "=" -> result is dense ne. <- mc != m. # was wrong (+ warning) stopifnot(identical(!(m. < mc), m. >= mc), identical(m. < mc, as(!ge, "sparseMatrix")), identical(ne., drop0(ne1))) d6 <- Diagonal(6) ii <- c(1:2, 4:5) d6[cbind(ii,ii)] <- 7*ii stopifnot(is(d6, "ddiMatrix"), identical(d6, Diagonal(x=c(7*1:2,1,7*4:5,1)))) sclass <- function(obj) as.vector(class(obj)) # as.v*(): drop attr(*,"package") show2cls <- function(C,D, chr = "") cat(sprintf("%s & %s%s: %s %s\n", deparse(substitute(C)), deparse(substitute(D)), chr, sclass(C), sclass(D))) for(j in 2:6) { ## even and odd j used to behave differently cat("j = ", j, ":\n-------\n") M <- Matrix(0, j,j); m <- matrix(0, j,j) T <- as(M, "TsparseMatrix") TG <- as(T, "generalMatrix") G <- as(M, "generalMatrix"); show2cls(TG, G) stopifnot(is(TG, "TsparseMatrix"), is(G, "CsparseMatrix")) id <- cbind(1:j,1:j) i2 <- cbind(1:j,j:1) m[id] <- 1:j M[id] <- 1:j T[id] <- 1:j ; show2cls(M, T,' ("diag")') stopifnot(is(M, "diagonalMatrix"), # since 2019-07 // FIXME (?!) for j=1 is(T,"triangularMatrix"), isDiagonal(T)) # was "symmetricMatrix" G[id] <- 1:j TG[id]<- 1:j m[i2] <- 10 M[i2] <- 10 T[i2] <- 10 ; show2cls(M, T,' ("symm")') G[i2] <- 10 TG[i2]<- 10 ## assert.EQ.mat(M, m) assert.EQ.mat(T, m) assert.EQ.mat(G, m) assert.EQ.mat(TG,m) } ## drop, triangular, ... (M3 <- Matrix(upper.tri(matrix(, 3, 3)))) # ltC; indexing used to fail T3 <- as(M3, "TsparseMatrix") stopifnot(identical(drop(M3), M3), identical4(drop(M3[,2, drop = FALSE]), M3[,2, drop = TRUE], drop(T3[,2, drop = FALSE]), T3[,2, drop = TRUE]), is(T3, "triangularMatrix"), !is(T3[,2, drop=FALSE], "triangularMatrix") ) (T6 <- as(as(kronecker(Matrix(c(0,0,1,0),2,2), t(T3)), "lMatrix"), "triangularMatrix")) T6[1:4, -(1:3)] # failed (trying to coerce back to ltTMatrix) stopifnot(identical(T6[1:4, -(1:3)][2:3, -3], spMatrix(2,2, i=c(1,2,2), j=c(1,1,2), x=rep(TRUE,3)))) M <- Diagonal(4); M[1,2] <- 2 M. <- as(M, "CsparseMatrix") (R <- as(M., "RsparseMatrix")) (Ms <- symmpart(M.)) Rs <- as(Ms, "RsparseMatrix") stopifnot(isValid(M, "triangularMatrix"), isValid(M.,"triangularMatrix"), isValid(Ms, "dsCMatrix"), isValid(R, "dtRMatrix"), isValid(Rs, "dsRMatrix") ) stopifnot(dim(M[2:3, FALSE]) == c(2,0), dim(R[2:3, FALSE]) == c(2,0), identical(M [2:3,TRUE], M [2:3,]), identical(M.[2:3,TRUE], M.[2:3,]), identical(R [2:3,TRUE], R [2:3,]), dim(R[FALSE, FALSE]) == c(0,0)) n <- 50000L Lrg <- new("dgTMatrix", Dim = c(n,n)) diag(Lrg) <- 1:n dLrg <- as(Lrg, "diagonalMatrix") stopifnot(identical(Diagonal(x = 1:n), dLrg)) diag(dLrg) <- 1 + diag(dLrg) Clrg <- as(Lrg,"CsparseMatrix") Ctrg <- as(Clrg, "triangularMatrix") diag(Ctrg) <- 1 + diag(Ctrg) stopifnot(identical(Diagonal(x = 1+ 1:n), dLrg), identical(Ctrg, as(dLrg,"CsparseMatrix"))) cc <- capture.output(show(dLrg))# show() used to error for large n showProc.time() ## FIXME: "dspMatrix" (symmetric *packed*) not going via "matrix" ## Large Matrix indexing / subassignment ## ------------------------------------- (from ex. by Imran Rashid) n <- 7000000 m <- 100000 nnz <- 20000 op <- options(Matrix.verbose = 2, warn = 1) set.seed(12) f <- sparseMatrix(i = sample(n, size=nnz, replace=TRUE), j = sample(m, size=nnz, replace=TRUE)) str(f) dim(f) # 6999863 x 99992 prod(dim(f)) # 699930301096 == 699'930'301'096 (~ 700'000 millions) str(thisCol <- f[,5000])# logi [~ 7 mio....] sv <- as(thisCol, "sparseVector") str(sv) ## "empty" ! validObject(spCol <- f[,5000, drop=FALSE]) # "empty" [n x 1] ngCmatrix ## ## *not* identical(): as(spCol, "sparseVector")@length is "double"prec: stopifnot(all.equal(as(spCol, "sparseVector"), as(sv, "nsparseVector"), tolerance=0)) if(interactive()) selectMethod("[<-", c("ngCMatrix", "missing","numeric", "logical")) # -> replCmat() in ../R/Csparse.R f[,5762] <- thisCol # now "fine" and fast thanks to replCmat() --> replCmat4() fx <- sparseMatrix(i = sample(n, size=nnz, replace=TRUE), j = sample(m, size=nnz, replace=TRUE), x = round(10*rnorm(nnz))) class(fx)## dgCMatrix fx[,6000] <- (tC <- rep(thisCol, length=nrow(fx)))# fine thCol <- fx[,2000] fx[,5762] <- thCol# fine stopifnot(is(f, "ngCMatrix"), is(fx, "dgCMatrix"), identical(thisCol, f[,5762]),# perfect identical(as.logical(fx[,6000]), tC), identical(thCol, fx[,5762])) showProc.time() options(op)# revert ## if(doExtras) {#----------------------------------------------------------------- cat("checkMatrix() of all: \n---------\n") Sys.setlocale("LC_COLLATE", "C")# to keep ls() reproducible for(nm in ls()) if(is(.m <- get(nm), "Matrix")) { cat(nm, "\n") checkMatrix(.m, verbose = FALSE , doDet = nm != "As" ## <- "As" almost singular <=> det() "ill posed" ) } showProc.time() }#--------------end if(doExtras) ----------------------------------------------- ## Bugs found by Peter Ralph n <- 17 x <- Matrix(0, n,n) ## x must have at least three nonzero entries x[1,1] <- x[2,1:2] <- 1. x0 <- x <- as(x,"dgTMatrix") # if x is dgCMatrix, no error ## z <- matrix(x) # <== not the "Matrix way": a (n, 1) matrix z[1] <- 0 x[1:n, 1:n] <- as(z, "sparseVector") ## gave Error: ... invalid subscript type 'S4' x2 <- x dim(zC <- as(z, "dgCMatrix")) x <- x0 x[] <- zC # did fail, then gave warning. x1 <- x ## x <- x0 x[] <- as(zC, "sparseVector") # did fail, too x2 <- x stopifnot(identical(x1,x2)) x <- as(x0, "matrix") x[] <- z assert.EQ.mat(x1, x) i <- 4:7 x1 <- x0; x1[cbind(i, i+10)] <- i^2 x2 <- x0; x2[cbind(i, i+10)] <- .asmatrix(i^2) ## failed: nargs() = 4 ... please report stopifnot(isValid(x1, "dgTMatrix"), identical(x1, x2)) showProc.time() ## check valid indexing (using *random* indices, often duplicated): chk_dsp_ind <- function(sv, n=512, negI = FALSE, verbose=FALSE) { stopifnot(inherits(sv, "dsparseVector"), n >= 1) d <- length(sv) ## lambda=2 ==> aiming for short 'i' {easier to work with} P <- rpois(n, lambda = if(negI) 5 else 2) for(i in seq_len(n)) { I <- if(negI) { # negative indices: 2 are, 4 neither ... always "valid" !! k <- max(4L, d - max(1L, P[i])) if(verbose) cat(sprintf("size=k = %2d: ", k)) - sort(sample.int(d, size=k))# replace=FALSE } else sample.int(d, size=1L+P[i], replace=TRUE) ## validObject(ss <- sv[I]) # Error if not true } invisible() } s <- as(c(3,5,6), "sparseVector") set.seed(11); chk_dsp_ind(s) set.seed(3) (s2 <- as(rsparsematrix(ncol=1, nrow=37, density=1/4),"sparseVector")) (s3 <- as(rsparsematrix(ncol=1, nrow=64, density=1/4),"sparseVector")) set.seed(1) chk_dsp_ind(s2) chk_dsp_ind(s3) ## set.seed(47) ## system.time(e.N2 <- chk_dsp_ind(s2, negI=TRUE, verbose=TRUE)) chk_dsp_ind(s2, negI=TRUE) chk_dsp_ind(s3, negI=TRUE) iv <- c(rep(0,100), 3, 0,0,7,0,0,0) sv0 <- sv <- as(iv, "sparseVector") sv.0 <- sv. <- as(as.integer(iv), "sparseVector") stopifnot(canCoerce("integer", "sparseVector")) sv2 <- as(sv, "isparseVector") stopifnot(validObject(sv), validObject(sv2), identical(sv., sv2), sv == sv.) n0 <- sv. != 0 # -> is "lsparseV.." if(FALSE) debug(Matrix:::replSPvec) ## --> ../R/sparseVector.R : replSPvec() ## sv [n0] <- sv [n0] sv.[n0] <- sv.[n0] # gave error stopifnot(identical(sv , sv0), identical(sv., sv.0)) sv [3:7] <- 0 sv.[3:7] <- 0L stopifnot(identical(sv , sv0), identical(sv., sv.0)) sv [2:4] <- 2:4 sv.[2:4] <- 2:4 stopifnot(which(sv != 0) == (which(sv. != 0) -> in0), in0 == c(2:4, 101L, 104L)) sv [2:6] <- 0L sv.[2:6] <- 0L stopifnot(identical(sv , sv0), identical(sv., sv.0)) ## the next six *all* gave an error -- but should be no-op's: for(vv in list(sv, sv.0)) for(ind in list(0, FALSE, logical(length(vv)))) vv[ind] <- NA stopifnot(identical(sv , sv0), identical(sv., sv.0)) ## [i] <- val -- failed to resort @i sometimes: (R-forge Matrix bug #6659) y1 <- sparseVector(1:3, 13:15, 16) y2 <- sparseVector(1:6, c(5, 6, 7, 9, 14, 15), 16) i <- 1:16*12 # 12 24 36 ... 192 x <- sparseVector(numeric(1), 1, length=200) x[i] <- y1 ; validObject(x[i]) # TRUE N <- x[i] + y2 ; validObject( N ) # TRUE x[i] <- N ## <== bug was here .. validObject(x) ## gave 'Error' invalid ..“dsparseVector”.. 'i' must be sorted strictly increasingly stopifnot(all.equal(x[i] , y1+y2, tolerance=0), x[i] == y1+y2) showProc.time() if(!interactive()) warnings() ## [matrix-Bugs][#6720] Subsetting with empty indices does not drop -- 17 Apr 2021, by David Cortes ## https://r-forge.r-project.org/tracker/?func=detail&atid=294&aid=6720&group_id=61 ## extended by MM to all versions of "empty" : x <- c(1,8) (m1 <- rbind(x)) m1[] # remains matrix m1[,,drop=FALSE] # ditto m1[,] # [1] 1 2 -- drops (as default drop=TRUE !) ## Sparse Matrix and actually *any* Matrix-extending class did not work (M1 <- as(m1, "denseMatrix")) # "dgeMatrix" S1 <- as(m1, "CsparseMatrix") R1 <- as(m1, "RsparseMatrix") stopifnot(exprs = { identical(M1[], M1) # remains identical(S1[], S1) # remains identical(R1[], R1) # remains identical(M1[,,drop=FALSE], M1) # ditto identical(S1[,,drop=FALSE], S1) # " identical(R1[,,drop=FALSE], R1) # " ## but drop=TRUE which is the *default* much be obeyed (also for *empty* (i,j): identical(m1[,], x) identical(M1[,], x) # should drop, but did not identical(S1[,], x) # " identical(R1[,], x) # " identical(m1[,,drop=TRUE], x) identical(M1[,,drop=TRUE], x) # should drop, but did not identical(S1[,,drop=TRUE], x) # " identical(R1[,,drop=TRUE], x) # " }) ## [matrix-Bugs][#6721] Assignment to 'dgRMatrix' with missing index takes only first element ## MM: This has been fixed already! X <- rbind(0, 1:3, 0, c(0,1,0)) Rx <- as(X, "RsparseMatrix") Cx <- as(X, "CsparseMatrix") X [2,] <- 0 Cx[2,] <- 0 Rx[2,] <- 0 stopifnot(all(Cx == X), all(Rx == X)) ## [matrix-Bugs][#6745] show() ## NB: is from a bug in head(*); *only* applies to *empty* sparseV: length(x@i) == 0 op <- options(max.print=999) ( s0 <- sparseVector(i=integer(), length=2^33)) # show -> head() failed in Matrix <= 1.3-* (xs0 <- sparseVector(i=integer(), length=2^33, x = numeric()))# ditto options(op); tail(s0) ; tail(xs0) # (always worked) ## *related* bug in `[` --> needed to fix intIv() for such large sparseVectors stopifnot(exprs = { identical(s0[length(s0) - 3:0], # gave Error in if (any(i < 0L)) { : missing value .... new("nsparseVector", i=integer(), length=4L)) identical(xs0[length(s0) - 3:0], # gave Error .. new("dsparseVector", i=integer(), length=4L)) }) Matrix/tests/other-pkgs.R0000644000176200001440000001222113556074233015074 0ustar liggesusers####--------- Test interfaces to other non-standard Packages --------------- library(Matrix) source(system.file("test-tools.R", package = "Matrix"))# identical3() etc MatrixRversion <- pkgRversion("Matrix") ###-- 1) 'graph' (from Bioconductor) --------------------------- ###-- == ======= --------------------------- ## do not run the test "usually" for now [Solaris problem after detach() ..]: if((Sys.getenv("USER")=="maechler" || nzchar(Sys.getenv("R_MATRIX_CHECK_EXTRA"))) && isTRUE(try(require(graph)))) { # may be there and fail (with R-devel) if(packageDescription("graph")$Version <= "1.10.2") { ## graph 1.10.x for x <= 2 had too many problems as(, "matrix") cat("Version of 'graph' is too old --- no tests done here!\n") } else if(pkgRversion("graph") != MatrixRversion) { cat(sprintf("The R version (%s) of 'graph' installation differs from the Matrix one (%s)\n", pkgRversion("graph"), MatrixRversion)) } else { ## do things if(find("which")[[1]] != "package:Matrix") ## horribly, BiocGenerics::which() masks ## *and* kills the correct working of Matrix::which(.) ___ why on earth ?!??!?!! ___ which <- Matrix::which if(!dev.interactive(orNone=TRUE)) pdf("other-pkg-graph.pdf") ## 0) Simplest non-trivial graph: has no weights: g0 <- graphNEL(paste(1:2), edgeL=list("1"="2"), "directed") m0 <- as(g0, "Matrix") stopifnot(is(m0,"ngCMatrix"), dim(m0) == c(2,2), Matrix::which(m0) == 3) g. <- as(m0, "graph") ## failed in Matrix <= 1.1-0 m. <- as(g., "Matrix") stopifnot( identical(m., m0) ) ## but (g0, g.) differ: the latter has '1' weights ## 1) undirected V <- LETTERS[1:4] edL <- vector("list", length=4) names(edL) <- V ## 1a) unweighted for(i in 1:4) edL[[i]] <- list(edges = 5-i) gR <- new("graphNEL", nodes=V, edgeL=edL) str(edges(gR)) sm.g <- as(gR, "sparseMatrix") str(sm.g) ## dgC: TODO: want 'ds.' (symmetric) validObject(sm.g) show( sm.g )## (incl colnames !) ## 1b) weighted set.seed(123) for(i in 1:4) edL[[i]] <- list(edges = 5-i, weights=runif(1)) gRw <- new("graphNEL", nodes=V, edgeL=edL) str(edgeWeights(gRw)) sm.gw <- as(gRw, "sparseMatrix") str(sm.gw) ## *numeric* dgCMatrix validObject(sm.gw) show( sm.gw )## U[0,1] numbers in anti-diagonal ## 2) directed gU <- gR; edgemode(gU) <- "directed" sgU <- as(gU, "sparseMatrix") str(sgU) ## 'dgC' validObject(sgU) show( sgU ) ## Reverse : sparseMatrix -> graph sm.g[1,2] <- 1 gmg <- as(sm.g, "graph") validObject(gmg2 <- as(sm.g, "graphNEL")) gmgw <- as(sm.gw, "graph") validObject(gmgw2 <- as(sm.gw, "graphNEL")) gmgU <- as(sgU, "graph") validObject(gmgU2 <- as(sgU, "graphNEL")) stopifnot(identical(gmg, gmg2), identical(gmgw, gmgw2), identical(gmgU, gmgU2)) data(CAex) cc <- crossprod(CAex) ## work around bug in 'graph': diagonal must be empty: diag(cc) <- 0; cc <- drop0(cc) image(cc) gg <- as(cc, "graph") .r <- require# cheat checks - do *not* want it in DESCRIPTION: if(.r("Rgraphviz")) { plot(gg, "circo") detach("package:Rgraphviz", unload = TRUE) } stopifnot(all.equal(edgeMatrix(gg), rbind(from = c(rep(1:24, each=2), 25:48), to = c(rbind(25:48,49:72), 49:72)))) detach("package:graph", unload = TRUE) dev.off() } # {else} } ## end{graph} ###-- 2) 'SparseM' --------------------------------------------- ###-- == ======== --------------------------------------------- if(isTRUE(try(require(SparseM)))) { # may be there and fail if(pkgRversion("SparseM") != MatrixRversion) { cat(sprintf("The R version (%s) of 'SparseM' installation differs from the Matrix one (%s)\n", pkgRversion("SparseM"), MatrixRversion)) } else { ## do things set.seed(1) a <- round(rnorm(5*4), 2) a[abs(a) < 0.7] <- 0 A <- matrix(a,5,4) print(M <- Matrix(A)) stopifnot( validObject(A.csr <- as.matrix.csr(A)), validObject(At.csr <- as.matrix.csr(t(A))), validObject(A.csc <- as.matrix.csc(A)), identical(At.csr, t(A.csr)), identical(A, as.matrix(A.csr)), identical(A.csr, as(M, "matrix.csr")), identical(A.csc, as(M, "matrix.csc")), identical3(M, as(A.csr, "CsparseMatrix"), as(A.csr, "dgCMatrix")), identical(t(M), as(At.csr, "CsparseMatrix")) ) ## More tests, notably for triplets A.coo <- as.matrix.coo(A) str(T <- as(M, "TsparseMatrix")) # has 'j' sorted str(T. <- as(A.coo, "TsparseMatrix")) # has 'i' sorted T3 <- as(as(T, "matrix.coo"), "Matrix") # dgT M3 <- as(A.csr, "Matrix") # dgC M4 <- as(A.csc, "Matrix") # dgC M5 <- as(as(M, "matrix.coo"), "Matrix") # dgT uniqT <- uniqTsparse stopifnot(identical4(uniqT(T), uniqT(T.), uniqT(T3), uniqT(M5)), identical3(M, M3, M4)) if(FALSE) # detaching the package gives error ".GenericTable" not found detach("package:SparseM") } }## end{SparseM} Matrix/tests/dg_Matrix.R0000644000176200001440000000660513436004512014726 0ustar liggesuserslibrary(Matrix) source(system.file("test-tools.R", package = "Matrix")) data(KNex) ; mm <- KNex$mm stopifnot(##is(mm) == c("dgCMatrix", "dMatrix", "Matrix"), dim(mm) == (dm <- c(1850, 712)), identical(dimnames(mm), list(NULL,NULL))) str(mm) tmm <- t(mm) str(tmm) str(mTm <- crossprod(mm)) mmT <- crossprod(tmm) mmT. <- tcrossprod(mm) stopifnot(all.equal(mmT, mmT.)) ## Previously these were not the same ## Should be the same but not quite: even length( * @ x ) differs! ##str(mmT, max=2)# much larger than mTm (i.e less sparse) ##str(mmT., max=2)# x slot is currently slightly larger --> improve tcrossprod()? ##system.time(ae <- all.equal(as(mmT.,"matrix"), as(mmT,"matrix"), tolerance = 1e-14)) ## 4-5 seconds on a 850 MHz, P III ##stopifnot(ae) stopifnot(validObject(tmm), dim(tmm) == dm[2:1], validObject(mTm), dim(mTm) == dm[c(2,2)], validObject(mmT), dim(mmT) == dm[c(1,1)], identical(as(tmm, "matrix"), t(as(mm, "matrix")))) ## from a bug report by Guissepe Ragusa RNGversion("3.6.0")# future proof set.seed(101) for(i in 1:10) { A <- matrix(rnorm(400), nrow = 100, ncol = 4) A[A < +1] <- 0 ; Am <- A Acsc <- as(Am, "dgCMatrix") A <- as(Am, "dgeMatrix") b <- matrix(rnorm(400), nrow = 4, ncol = 100) B <- as(b, "dgeMatrix") assert.EQ.mat(A %*% B, Am %*% b) assert.EQ.mat(B %*% A, b %*% Am) stopifnot(identical(A, as(Acsc, "dgeMatrix")), identical(Acsc, as(A, "dgCMatrix")), is.all.equal4(A %*% B, Acsc %*% B, A %*% b, Acsc %*% b), is.all.equal4(b %*% A, b %*% Acsc, B %*% A, B %*% Acsc)) } ###--- dgTMatrix {was ./dgTMatrix.R } ------- ### Use ``non-unique'' versions of dgTMatrix objects N <- 200 set.seed(1) i <- as.integer(round(runif (N, 0, 100))) j <- as.integer(3* rpois (N, lam=15)) x <- round(rnorm(N), 2) which(duplicated(cbind(i,j))) # 8 index pairs are duplicated m1 <- new("dgTMatrix", Dim = c(max(i)+1:1, max(j)+1:1), i = i, j = j, x = x) mc <- as(m1, "dgCMatrix") m2 <- as(mc, "dgTMatrix")## the same as 'm1' but without duplicates stopifnot(!isTRUE(all.equal.default(m1, m2)), all.equal(as(m1,"matrix"), as(m2,"matrix"), tolerance =1e-15), all.equal(crossprod(m1), crossprod(m2), tolerance =1e-15), identical(mc, as(m2, "dgCMatrix"))) ### -> uniq* functions now in ../R/Auxiliaries.R (t2 <- system.time(um2 <- Matrix:::uniq(m1))) stopifnot(identical(m2,um2)) ### -> error/warning condition for solve() of a singular matrix (Barry Rowlingson) (M <- Matrix(0+ 1:16, nc = 4)) assertError(solve(M), verbose=TRUE)## ".. computationally singular" + warning + caches LU assertError(solve(t(M))) options(warn=2) # no more warnings allowed from here lum <- lu(M, warnSing=FALSE) stopifnot(is(fLU <- M@factors $ LU, "MatrixFactorization"), identical(lum, fLU)) (e.lu <- expand(fLU)) M2 <- with(e.lu, P %*% L %*% U) assert.EQ.mat(M2, as(M, "matrix")) ## now the sparse LU : M. <- as(M,"sparseMatrix") tt <- try(solve(M.)) # less nice: factor is *not* cached ## use a non-singular one: M1 <- M. + 0.5*Diagonal(nrow(M.)) luM1 <- lu(M1) d1 <- determinant(as(M1,"denseMatrix")) stopifnot(identical(luM1, M1@factors$LU), diag(luM1@L) == 1,# L is *unit*-triangular all.equal(log(-prod(diag(luM1@U))), c(d1$modulus))) cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' Matrix/tests/indexing.Rout.save0000644000176200001440000036042214151637577016324 0ustar liggesusers R Under development (unstable) (2021-11-30 r81267) -- "Unsuffered Consequences" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > #### For both 'Extract' ("[") and 'Replace' ("[<-") Method testing > #### aka subsetting and subassignment > #### ~~~~~~~~~~ ~~~~~~~~~~~~~ > > if(interactive()) { + options(error = recover, warn = 1) + } else if(FALSE) { ## MM / developer testing *manually* : + options(error = recover, Matrix.verbose = 2, warn = 1) + } else { + options( Matrix.verbose = 2, warn = 1) + } > ## Matrix.verbose = .. (*before* loading 'Matrix' pkg) > ## ==> will also show method dispath ambiguity messages: getOption("ambiguousMethodSelection") > > #### suppressPackageStartupMessages(...) as we have an *.Rout.save to Rdiff against > stopifnot(suppressPackageStartupMessages(require(Matrix))) > > source(system.file("test-tools.R", package = "Matrix"), keep.source = FALSE) Loading required package: tools > ##-> identical3() etc > cat("doExtras:",doExtras,"\n") doExtras: FALSE > > > ### Dense Matrices > > m <- Matrix(1:28 +0, nrow = 7) > validObject(m) [1] TRUE > stopifnot(identical(m, m[]), + identical(m[2, 3], 16), # simple number + identical(m[2, 3:4], c(16,23)), # simple numeric of length 2 + identical(m[NA,NA], as(Matrix(NA, 7,4), "dMatrix"))) M[m,m,m] : nargs()=2 M[i,i,m] : nargs()=3 M[i,i,m] : nargs()=3 M[i,i,m] : nargs()=3 > > m[2, 3:4, drop=FALSE] # sub matrix of class 'dgeMatrix' 1 x 2 Matrix of class "dgeMatrix" [,1] [,2] [1,] 16 23 > m[-(4:7), 3:4] # ditto; the upper right corner of 'm' M[i,i,m] : nargs()=3 3 x 2 Matrix of class "dgeMatrix" [,1] [,2] [1,] 15 22 [2,] 16 23 [3,] 17 24 > > ## rows or columns only: > m[1,] # first row, as simple numeric vector M[i,m,m] : nargs()=3 [1] 1 8 15 22 > m[,2] # 2nd column M[m,i,m] : nargs()=3 [1] 8 9 10 11 12 13 14 > m[,1:2] # sub matrix of first two columns M[m,i,m] : nargs()=3 7 x 2 Matrix of class "dgeMatrix" [,1] [,2] [1,] 1 8 [2,] 2 9 [3,] 3 10 [4,] 4 11 [5,] 5 12 [6,] 6 13 [7,] 7 14 > m[-(1:6),, drop=FALSE] # not the first 6 rows, i.e. only the 7th 1 x 4 Matrix of class "dgeMatrix" [,1] [,2] [,3] [,4] [1,] 7 14 21 28 > m[integer(0),] #-> 0 x 4 Matrix M[i,m,m] : nargs()=3 0 x 4 Matrix of class "dgeMatrix" [,1] [,2] [,3] [,4] > m[2:4, numeric(0)] #-> 3 x 0 Matrix M[i,i,m] : nargs()=3 3 x 0 Matrix of class "dgeMatrix" [1,] [2,] [3,] > > ## logical indexing > stopifnot(identical(m[2,3], m[(1:nrow(m)) == 2, (1:ncol(m)) == 3]), + identical(m[2,], m[(1:nrow(m)) == 2, ]), + identical(m[,3:4], m[, (1:4) >= 3])) M[i,i,m] : nargs()=3 M[i,i,m] : nargs()=3 M[i,m,m] : nargs()=3 M[logi,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[m,i,m] : nargs()=3 > > ## dimnames indexing: > mn <- m > dimnames(mn) <- list(paste("r",letters[1:nrow(mn)],sep=""), + LETTERS[1:ncol(mn)]) > checkMatrix(mn) M[m,i,m] : nargs()=3 norm(m [7 x 4]) : 1 I F M ok Summary: ok 2*m =?= m+m: identical m >= m for all: ok m < m for none: ok > mn["rd", "D"] M[i,i,m] : nargs()=3 [1] 25 > msr <- ms <- as(mn,"sparseMatrix") > mnr <- mn > v <- rev(as(ms, "vector")) > mnr[] <- v > msr[] <- v # [<- "sparse" -- not very sensical; did fail w/o a message replCmat[x,i,j,.., val] : nargs()=3; missing (i,j) = (0,1) diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) > z <- msr; z[] <- 0 > zz <- as(array(0, dim(z)), "sparseMatrix") > a.m <- as(mnr,"matrix") > stopifnot(identical(mn["rc", "D"], mn[3,4]), mn[3,4] == 24, + identical(mn[, "A"], mn[,1]), mn[,1] == 1:7, + identical(mn[c("re", "rb"), "B"], mn[c(5,2), 2]), + identical(ms["rc", "D"], ms[3,4]), ms[3,4] == 24, + identical(ms[, "A"], ms[,1]), ms[,1] == 1:7, + identical(ms[ci <- c("re", "rb"), "B"], ms[c(5,2), 2]), + identical(rownames(mn[ci, ]), ci), + identical(rownames(ms[ci, ]), ci), + identical(colnames(mn[,cj <- c("B","D")]), cj), + identical(colnames(ms[,cj]), cj), + identical(a.m, as(msr,"matrix")), + identical(unname(z), zz), + identical(a.m, array(v, dim=dim(mn), dimnames=dimnames(mn))) + ) M[i,i,m] : nargs()=3 M[i,i,m] : nargs()=3 M[i,i,m] : nargs()=3 M[m,i,m] : nargs()=3 M[m,i,m] : nargs()=3 M[m,i,m] : nargs()=3 M[i,i,m] : nargs()=3 M[i,i,m] : nargs()=3 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,m,m] : nargs()=3 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 > showProc.time() Time (user system elapsed): 0.361 0.014 0.377 > > ## Bug found thanks to Timothy Mak, Feb 3, 2017: > ## sparseMatrix logical indexing with (partial) NA: > a.m <- as(mn,"matrix") > assert.EQ(as(ms,"matrix"), a.m) # incl. dimnames > iN4 <- c(NA, TRUE, FALSE, TRUE) > assert.EQ(as(mn[,iN4],"matrix"), a.m[,iN4]) # (incl. dimnames) M[m,i,m] : nargs()=3 > ##assert.EQ(as.matrix(ms[,iN4]), a.m[,iN4]) # ms[, ] fails still : _FIXME_ > try(ms[,iN4]) M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 Error in intI(j, n = x@Dim[2], dn[[2]], give.dn = FALSE) : 'NA' indices are not (yet?) supported for sparse Matrices > try(ms[,iN4] <- 100) ## <- segfaulted in Matrix <= 1.2-8 (!) replCmat[x,i,j,.., val] : nargs()=4; missing (i,j) = (1,0) Error in intI(i, n = di[margin], dn = dn[[margin]], give.dn = FALSE) : 'NA' indices are not (yet?) supported for sparse Matrices > > ## R-forge Matrix bug #2556: Subsetting a sparse matrix did remove names(dimnames(.)) : > m44 <- matrix(1:16, 4, 4, dimnames=list(row=c('a','b','c','d'), col=c('x','y','z','w'))) > ## Dense matrix: ------------------------------------------ > a <- Matrix(m44) > identical( + dimnames(m44[,FALSE, drop=FALSE]), + dimnames( a[,FALSE, drop=FALSE])) [1] TRUE > chk.ndn <- function(a, a0=m44) + stopifnot(identical(names(dimnames(a)), names(dimnames(a0)))) > i <- 1:2 > chk.ndn(a[i,]); chk.ndn(a[i, i]) M[i,m,m] : nargs()=3 M[i,i,m] : nargs()=3 > ## Sparse matrix: ----------------------------------------- > s <- as(a %% 3 == 1, "sparseMatrix") > ts <- as(s,"TsparseMatrix") > b <- sparseMatrix(i=1:3, j=rep(2,3), dims=c(4,4), dimnames=dimnames(s)) > tb <- as(b,"TsparseMatrix") > stopifnot(identical5( + dimnames(a), dimnames(s), dimnames(ts), + dimnames(b), dimnames(tb))) > > chk.ndn(b [i, i]); chk.ndn(b [i, ]) M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 > chk.ndn(s [i, i]); chk.ndn(s [i, ]) M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 > chk.ndn(tb[i, i]); chk.ndn(tb[i, ]) M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 > chk.ndn(ts[i, i]); chk.ndn(ts[i, ]) M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 > chk.ndn( b[ , 1, drop=FALSE]); chk.ndn( s[i, 2, drop=FALSE]) Csp[m,i,l] : nargs()=4 Csp[i,i,l] : nargs()=4 > chk.ndn(tb[ , 1, drop=FALSE]); chk.ndn(ts[i, 2, drop=FALSE]) Csp[m,i,l] : nargs()=4 Csp[i,i,l] : nargs()=4 > > L0 <- logical(0) > stopifnot(exprs = { + identical(dim(b[,L0]), c(4L, 0L)) + identical(dim(b[L0,]), c(0L, 4L)) # failed till 2019-09-x + }) M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[logi,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 > > ## Printing sparse colnames: > ms[sample(28, 20)] <- 0 replCmat[x,i,j,.., val] : nargs()=3; missing (i,j) = (0,1) diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) > ms <- t(rbind2(ms, 3*ms)) > cnam1 <- capture.output(show(ms))[2] ; op <- options("sparse.colnames" = "abb3") [[ suppressing 14 column names 'ra', 'rb', 'rc' ... ]] > cnam2 <- capture.output(show(ms))[2] ; options(op) # revert > stopifnot(## sparse printing + grep("^ +$", cnam1) == 1, # cnam1 is empty + identical(cnam2, + paste(" ", paste(rep(rownames(mn), 2), collapse=" ")))) > > mo <- m > m[2,3] <- 100 > m[1:2, 4] <- 200 > m[, 1] <- -1 > m[1:3,] M[i,m,m] : nargs()=3 3 x 4 Matrix of class "dgeMatrix" [,1] [,2] [,3] [,4] [1,] -1 8 15 200 [2,] -1 9 100 200 [3,] -1 10 17 24 > > m. <- .asmatrix(m) > > ## m[ cbind(i,j) ] indexing: > iN <- ij <- cbind(1:6, 2:3) > iN[2:3,] <- iN[5,2] <- NA > stopifnot(identical(m[ij], m.[ij]), + identical(m[iN], m.[iN])) > > ## testing operations on logical Matrices rather more than indexing: > g10 <- m [ m > 10 ] M[logi,m,m] : nargs()=2 > stopifnot(18 == length(g10)) > stopifnot(10 == length(m[ m <= 10 ])) M[logi,m,m] : nargs()=2 > sel <- (20 < m) & (m < 150) > sel.<- (20 < m.)& (m.< 150) > nsel <-(20 >= m) | (m >= 150) > (ssel <- as(sel, "sparseMatrix")) 7 x 4 sparse Matrix of class "lgCMatrix" [1,] . . . . [2,] . . | . [3,] . . . | [4,] . . . | [5,] . . . | [6,] . . . | [7,] . . | | > stopifnot(is(sel, "lMatrix"), is(ssel, "lsparseMatrix"), + identical3(as.mat(sel.), as.mat(sel), as.mat(ssel)), + identical3(!sel, !ssel, nsel), # ! is typically dense + identical3(m[ sel], m[ ssel], .asmatrix(m)[.asmatrix( ssel)]), + identical3(m[!sel], m[!ssel], .asmatrix(m)[.asmatrix(!ssel)]) + ) M[logi,m,m] : nargs()=2 M[logi,m,m] : nargs()=2 M[logi,m,m] : nargs()=2 M[logi,m,m] : nargs()=2 > showProc.time() Time (user system elapsed): 0.121 0.001 0.122 > > ## more sparse Matrices -------------------------------------- > > ##' @title Check sparseMatrix sub-assignment m[i,j] <- v > ##' @param ms sparse Matrix > ##' @param mm its [traditional matrix]-equivalent > ##' @param k (approximate) length of index vectors (i,j) > ##' @param n.uniq (approximate) number of unique values in i,j > ##' @param vRNG function(n) for random 'v' generation > ##' @param show logical; if TRUE, it will not stop on error > ##' @return > ##' @author Martin Maechler > chkAssign <- function(ms, mm = as(ms, "matrix"), + k = min(20,dim(mm)), n.uniq = k %/% 3, + vRNG = { if(is.numeric(mm) || is.complex(mm)) + function(n) rpois(n,lambda= 0.75)# <- about 47% zeros + else ## logical + function(n) runif(n) > 0.8 }, ## 80% zeros + showOnly=FALSE) + { + stopifnot(is(ms,"sparseMatrix")) + d <- dim(ms) + s1 <- function(n) sample(n, pmin(n, pmax(1, rpois(1, n.uniq)))) + i <- sample(s1(d[1]), k/2+ rpois(1, k/2), replace = TRUE) + j <- sample(s1(d[2]), k/2+ rpois(1, k/2), replace = TRUE) + assert.EQ.mat(ms[i,j], mm[i,j]) + ms2 <- ms. <- ms; mm. <- mm # save + ## now sub*assign* to these repeated indices, and then compare ----- + v <- vRNG(length(i) * length(j)) + mm[i,j] <- v + ms[i,j] <- v + ## useful to see (ii,ij), but confusing R/ESS when additionally debugging: + ## if(!showOnly && interactive()) { op <- options(error = recover); on.exit(options(op)) } + assert.EQ.mat(ms, mm, show=showOnly) + ## vector indexing m[cbind(i,j)] == m[i + N(j-1)] , N = nrow(.) + ii <- seq_len(min(length(i), length(j))) + i <- i[ii] + j <- j[ii] + ij <- cbind(i, j) + ii <- i + nrow(ms)*(j - 1) + ord.i <- order(ii) + iio <- ii[ord.i] + ui <- unique(iio) # compare these with : + neg.ii <- - setdiff(seq_len(prod(d)), ii) + stopifnot(identical(mm[ii], mm[ij]), + identical(ms.[ui], ms.[neg.ii]), + ms.[ij] == mm.[ii], ## M[ cbind(i,j) ] was partly broken; now checking + ms.[ii] == mm.[ii]) + v <- v[seq_len(length(i))] + if(is(ms,"nMatrix")) v <- as.logical(v) # ! + mm.[ij] <- v + ms.[ii] <- v + nodup <- (length(ui) == length(ii)) ## <==> ! anyDuplicated(iio) + if(nodup) { cat("[-]") # rare, unfortunately + ms2[neg.ii] <- v[ord.i] + stopifnot(identical(ms2, ms.)) + } + assert.EQ.mat(ms., mm., show=showOnly) + } ##{chkAssign} > > ## Get duplicated index {because these are "hard" (and rare) > getDuplIndex <- function(n, k) { + repeat { + i <- sample(n, k, replace=TRUE) # 3 4 6 9 2 9 : 9 is twice + if(anyDuplicated(i)) break + } + i + } > > suppressWarnings(RNGversion("3.5.0")); set.seed(101) > m <- 1:800 > m[sample(800, 600)] <- 0 > m0 <- Matrix(m, nrow = 40) > m1 <- add.simpleDimnames(m0) > for(kind in c("n", "l", "d")) { + for(m in list(m0,m1)) { ## -- with and without dimnames ------------------------- + kClass <-paste0(kind, "Matrix" ) + Ckind <- paste0(kind, "gCMatrix") + Tkind <- paste0(kind, "gTMatrix") + str(mC <- as(m, Ckind)) + str(mT <- as(as(as(m, kClass), "TsparseMatrix"), Tkind)) + mm <- as(mC, "matrix") # also logical or double + IDENT <- if(kind == "n") function(x,y) Q.eq2(x,y, tol=0) else identical + stopifnot(identical(mT, as(as(mC, "TsparseMatrix"), Tkind)), + identical(mC, as(mT, Ckind)), + Qidentical(mC[0,0], new(Ckind)), + Qidentical(mT[0,0], new(Tkind)), + identical(unname(mT[0,]), new(Tkind, Dim = c(0L,ncol(m)))), + identical(unname(mT[,0]), new(Tkind, Dim = c(nrow(m),0L))), + IDENT(mC[0,], as(mT[FALSE,], Ckind)), + IDENT(mC[,0], as(mT[,FALSE], Ckind)), + sapply(pmin(min(dim(mC)), c(0:2, 5:10)), + function(k) {i <- seq_len(k); all(mC[i,i] == mT[i,i])}), + TRUE) + cat("ok\n") + show(mC[,1]) + show(mC[1:2,]) + show(mC[7, drop = FALSE]) + assert.EQ.mat(mC[1:2,], mm[1:2,]) + assert.EQ.mat(mC[0,], mm[0,]) + assert.EQ.mat(mC[,FALSE], mm[,FALSE]) + ## + ## *repeated* (aka 'duplicated') indices - did not work at all ... + i <- pmin(nrow(mC), rep(8:10,2)) + j <- c(2:4, 4:3) + assert.EQ.mat(mC[i,], mm[i,]) + assert.EQ.mat(mC[,j], mm[,j]) + ## FIXME? assert.EQ.mat(mC[,NA], mm[,NA]) -- mC[,NA] is all 0 "instead" of all NA + ## MM currently thinks we should NOT allow [ ] + assert.EQ.mat(mC[i, 2:1], mm[i, 2:1]) + assert.EQ.mat(mC[c(4,1,2:1), j], mm[c(4,1,2:1), j]) + assert.EQ.mat(mC[i,j], mm[i,j]) + ## + ## set.seed(7) + op <- options(Matrix.verbose = FALSE) + cat(" for(): ") + for(n in 1:(if(doExtras) 50 else 5)) { # (as chkAssign() is random) + chkAssign(mC, mm) + chkAssign(mC[-3,-2], mm[-3,-2]) + cat(".") + } + options(op) + cat(sprintf("\n[Ok]%s\n\n", strrep("-", 64))) + } + cat(sprintf("\nok( %s )\n== ###%s\n\n", kind, strrep("=", 70))) + }## end{for}--------------------------------------------------------------- Formal class 'ngCMatrix' [package "Matrix"] with 5 slots ..@ i : int [1:200] 2 6 11 21 24 29 37 38 1 4 ... ..@ p : int [1:21] 0 8 22 28 37 41 50 63 71 81 ... ..@ Dim : int [1:2] 40 20 ..@ Dimnames:List of 2 .. ..$ : NULL .. ..$ : NULL ..@ factors : list() Formal class 'ngTMatrix' [package "Matrix"] with 5 slots ..@ i : int [1:200] 2 6 11 21 24 29 37 38 1 4 ... ..@ j : int [1:200] 0 0 0 0 0 0 0 0 1 1 ... ..@ Dim : int [1:2] 40 20 ..@ Dimnames:List of 2 .. ..$ : NULL .. ..$ : NULL ..@ factors : list() M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[logi,m,m] : nargs()=3 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 Note: method with signature 'nsparseMatrix#sparseMatrix' chosen for function '==', target signature 'ngCMatrix#ngTMatrix'. "nMatrix#nMatrix", "sparseMatrix#nsparseMatrix" would also be valid M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 ok M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 [1] FALSE FALSE TRUE FALSE FALSE FALSE TRUE FALSE FALSE FALSE FALSE TRUE [13] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE FALSE FALSE [25] TRUE FALSE FALSE FALSE FALSE TRUE FALSE FALSE FALSE FALSE FALSE FALSE [37] FALSE TRUE TRUE FALSE M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 2 x 20 sparse Matrix of class "ngCMatrix" [1,] . . . | . . | . . . . | . . | . | . . . [2,] . | . . . | . . . . . . | | . . . . | . Csp[i,m,l] : nargs()=3 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 [1] TRUE M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 for(): ..... [Ok]---------------------------------------------------------------- Formal class 'ngCMatrix' [package "Matrix"] with 5 slots ..@ i : int [1:200] 2 6 11 21 24 29 37 38 1 4 ... ..@ p : int [1:21] 0 8 22 28 37 41 50 63 71 81 ... ..@ Dim : int [1:2] 40 20 ..@ Dimnames:List of 2 .. ..$ : chr [1:40] "r1" "r2" "r3" "r4" ... .. ..$ : chr [1:20] "c1" "c2" "c3" "c4" ... ..@ factors : list() Formal class 'ngTMatrix' [package "Matrix"] with 5 slots ..@ i : int [1:200] 2 6 11 21 24 29 37 38 1 4 ... ..@ j : int [1:200] 0 0 0 0 0 0 0 0 1 1 ... ..@ Dim : int [1:2] 40 20 ..@ Dimnames:List of 2 .. ..$ : chr [1:40] "r1" "r2" "r3" "r4" ... .. ..$ : chr [1:20] "c1" "c2" "c3" "c4" ... ..@ factors : list() M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[logi,m,m] : nargs()=3 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 ok M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 r1 r2 r3 r4 r5 r6 r7 r8 r9 r10 r11 r12 r13 FALSE FALSE TRUE FALSE FALSE FALSE TRUE FALSE FALSE FALSE FALSE TRUE FALSE r14 r15 r16 r17 r18 r19 r20 r21 r22 r23 r24 r25 r26 FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE FALSE FALSE TRUE FALSE r27 r28 r29 r30 r31 r32 r33 r34 r35 r36 r37 r38 r39 FALSE FALSE FALSE TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE TRUE r40 FALSE M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 2 x 20 sparse Matrix of class "ngCMatrix" [[ suppressing 20 column names 'c1', 'c2', 'c3' ... ]] r1 . . . | . . | . . . . | . . | . | . . . r2 . | . . . | . . . . . . | | . . . . | . Csp[i,m,l] : nargs()=3 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 [1] TRUE M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 for(): ..... [Ok]---------------------------------------------------------------- ok( n ) == ###====================================================================== Formal class 'lgCMatrix' [package "Matrix"] with 6 slots ..@ i : int [1:200] 2 6 11 21 24 29 37 38 1 4 ... ..@ p : int [1:21] 0 8 22 28 37 41 50 63 71 81 ... ..@ Dim : int [1:2] 40 20 ..@ Dimnames:List of 2 .. ..$ : NULL .. ..$ : NULL ..@ x : logi [1:200] TRUE TRUE TRUE TRUE TRUE TRUE ... ..@ factors : list() Formal class 'lgTMatrix' [package "Matrix"] with 6 slots ..@ i : int [1:200] 2 6 11 21 24 29 37 38 1 4 ... ..@ j : int [1:200] 0 0 0 0 0 0 0 0 1 1 ... ..@ Dim : int [1:2] 40 20 ..@ Dimnames:List of 2 .. ..$ : NULL .. ..$ : NULL ..@ x : logi [1:200] TRUE TRUE TRUE TRUE TRUE TRUE ... ..@ factors : list() M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[logi,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 ok M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 [1] FALSE FALSE TRUE FALSE FALSE FALSE TRUE FALSE FALSE FALSE FALSE TRUE [13] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE FALSE FALSE [25] TRUE FALSE FALSE FALSE FALSE TRUE FALSE FALSE FALSE FALSE FALSE FALSE [37] FALSE TRUE TRUE FALSE M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 2 x 20 sparse Matrix of class "lgCMatrix" [1,] . . . | . . | . . . . | . . | . | . . . [2,] . | . . . | . . . . . . | | . . . . | . Csp[i,m,l] : nargs()=3 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 [1] TRUE M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 for(): ..... [Ok]---------------------------------------------------------------- Formal class 'lgCMatrix' [package "Matrix"] with 6 slots ..@ i : int [1:200] 2 6 11 21 24 29 37 38 1 4 ... ..@ p : int [1:21] 0 8 22 28 37 41 50 63 71 81 ... ..@ Dim : int [1:2] 40 20 ..@ Dimnames:List of 2 .. ..$ : chr [1:40] "r1" "r2" "r3" "r4" ... .. ..$ : chr [1:20] "c1" "c2" "c3" "c4" ... ..@ x : logi [1:200] TRUE TRUE TRUE TRUE TRUE TRUE ... ..@ factors : list() Formal class 'lgTMatrix' [package "Matrix"] with 6 slots ..@ i : int [1:200] 2 6 11 21 24 29 37 38 1 4 ... ..@ j : int [1:200] 0 0 0 0 0 0 0 0 1 1 ... ..@ Dim : int [1:2] 40 20 ..@ Dimnames:List of 2 .. ..$ : chr [1:40] "r1" "r2" "r3" "r4" ... .. ..$ : chr [1:20] "c1" "c2" "c3" "c4" ... ..@ x : logi [1:200] TRUE TRUE TRUE TRUE TRUE TRUE ... ..@ factors : list() M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[logi,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 ok M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 r1 r2 r3 r4 r5 r6 r7 r8 r9 r10 r11 r12 r13 FALSE FALSE TRUE FALSE FALSE FALSE TRUE FALSE FALSE FALSE FALSE TRUE FALSE r14 r15 r16 r17 r18 r19 r20 r21 r22 r23 r24 r25 r26 FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE FALSE FALSE TRUE FALSE r27 r28 r29 r30 r31 r32 r33 r34 r35 r36 r37 r38 r39 FALSE FALSE FALSE TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE TRUE r40 FALSE M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 2 x 20 sparse Matrix of class "lgCMatrix" [[ suppressing 20 column names 'c1', 'c2', 'c3' ... ]] r1 . . . | . . | . . . . | . . | . | . . . r2 . | . . . | . . . . . . | | . . . . | . Csp[i,m,l] : nargs()=3 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 [1] TRUE M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 for(): ..... [Ok]---------------------------------------------------------------- ok( l ) == ###====================================================================== Formal class 'dgCMatrix' [package "Matrix"] with 6 slots ..@ i : int [1:200] 2 6 11 21 24 29 37 38 1 4 ... ..@ p : int [1:21] 0 8 22 28 37 41 50 63 71 81 ... ..@ Dim : int [1:2] 40 20 ..@ Dimnames:List of 2 .. ..$ : NULL .. ..$ : NULL ..@ x : num [1:200] 3 7 12 22 25 30 38 39 42 45 ... ..@ factors : list() Formal class 'dgTMatrix' [package "Matrix"] with 6 slots ..@ i : int [1:200] 2 6 11 21 24 29 37 38 1 4 ... ..@ j : int [1:200] 0 0 0 0 0 0 0 0 1 1 ... ..@ Dim : int [1:2] 40 20 ..@ Dimnames:List of 2 .. ..$ : NULL .. ..$ : NULL ..@ x : num [1:200] 3 7 12 22 25 30 38 39 42 45 ... ..@ factors : list() M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[logi,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 ok M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 [1] 0 0 3 0 0 0 7 0 0 0 0 12 0 0 0 0 0 0 0 0 0 22 0 0 25 [26] 0 0 0 0 30 0 0 0 0 0 0 0 38 39 0 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 2 x 20 sparse Matrix of class "dgCMatrix" [1,] . . . 121 . . 241 . . . . 441 . . 561 . 641 . . . [2,] . 42 . . . 202 . . . . . . 482 522 . . . . 722 . Csp[i,m,l] : nargs()=3 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 [1] 7 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 for(): ..... [Ok]---------------------------------------------------------------- Formal class 'dgCMatrix' [package "Matrix"] with 6 slots ..@ i : int [1:200] 2 6 11 21 24 29 37 38 1 4 ... ..@ p : int [1:21] 0 8 22 28 37 41 50 63 71 81 ... ..@ Dim : int [1:2] 40 20 ..@ Dimnames:List of 2 .. ..$ : chr [1:40] "r1" "r2" "r3" "r4" ... .. ..$ : chr [1:20] "c1" "c2" "c3" "c4" ... ..@ x : num [1:200] 3 7 12 22 25 30 38 39 42 45 ... ..@ factors : list() Formal class 'dgTMatrix' [package "Matrix"] with 6 slots ..@ i : int [1:200] 2 6 11 21 24 29 37 38 1 4 ... ..@ j : int [1:200] 0 0 0 0 0 0 0 0 1 1 ... ..@ Dim : int [1:2] 40 20 ..@ Dimnames:List of 2 .. ..$ : chr [1:40] "r1" "r2" "r3" "r4" ... .. ..$ : chr [1:20] "c1" "c2" "c3" "c4" ... ..@ x : num [1:200] 3 7 12 22 25 30 38 39 42 45 ... ..@ factors : list() M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[logi,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 ok M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 r1 r2 r3 r4 r5 r6 r7 r8 r9 r10 r11 r12 r13 r14 r15 r16 r17 r18 r19 r20 0 0 3 0 0 0 7 0 0 0 0 12 0 0 0 0 0 0 0 0 r21 r22 r23 r24 r25 r26 r27 r28 r29 r30 r31 r32 r33 r34 r35 r36 r37 r38 r39 r40 0 22 0 0 25 0 0 0 0 30 0 0 0 0 0 0 0 38 39 0 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 2 x 20 sparse Matrix of class "dgCMatrix" [[ suppressing 20 column names 'c1', 'c2', 'c3' ... ]] r1 . . . 121 . . 241 . . . . 441 . . 561 . 641 . . . r2 . 42 . . . 202 . . . . . . 482 522 . . . . 722 . Csp[i,m,l] : nargs()=3 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 [1] 7 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 for(): ..... [Ok]---------------------------------------------------------------- ok( d ) == ###====================================================================== > showProc.time() Time (user system elapsed): 0.62 0.007 0.629 > > if(doExtras) {### {was ./AAA_index.R, MM-only} + ## an nsparse-example + A <- Matrix(c(rep(c(1,0,0),2), rep(c(2,0),7), c(0,0,2), rep(0,4)), 3,9) + i <- c(3,1:2) + j <- c(3, 5, 9, 5, 9) + vv <- logical(length(i)*length(j)); vv[6:9] <- TRUE + + print(An <- as(A,"nMatrix")); an <- as(An, "matrix") + assert.EQ.mat(An, an) + An[i, j] <- vv + an[i, j] <- vv + assert.EQ.mat(An, an)## error + if(!all(An == an)) show(drop0(An - an)) + ## all are +1 + + options("Matrix.subassign.verbose" = TRUE)# output from C + An <- as(A,"nMatrix"); An[i, j] <- vv + ## and compare with this: + Al <- as(A,"lMatrix"); Al[i, j] <- vv + options("Matrix.subassign.verbose" = FALSE) + + ##--- An interesting not small not large example for M[i,j] <- v ------------ + ## + M <- Matrix(c(1, rep(0,7), 1:4), 3,4) + N0 <- kronecker(M,M) + mkN1 <- function(M) { + stopifnot(length(d <- dim(M)) == 2) + isC <- is(M,"CsparseMatrix") + M[,d[2]] <- c(0,2,0) + N <- kronecker(diag(x=1:2), M)## remains sparse if 'M' is + if(isC) N <- as(N, "CsparseMatrix") + diag(N[-1,]) <- -2 + N[9,] <- 1:4 # is recycled + N[,12] <- -7:-9 # ditto + N + } + + show(N1 <- t(N <- mkN1(N0))) # transpose {for display reasons} + C1 <- t(C <- mkN1(as(N0,"CsparseMatrix"))) + stopifnot(all(C == N)) + assert.EQ.mat(C, mkN1(.asmatrix(N0))) + + C. <- C1 + show(N <- N1) ; n <- .asmatrix(N); str(N) + sort(i <- c(6,8,19,11,21,20,10,7,12,9,5,18,17,22,13))## == c(5:13, 17:22)) + sort(j <- c(3,8,6,15,10,4,14,13,16,2,11,17,7,5))## == c(2:8, 10:11, 13:17) + val <- v.l <- 5*c(0,6,0,7,0,0,8:9, 0,0) + show(spv <- as(val, "sparseVector")); str(spv) + + n [i,j] <- v.l + N [i,j] <- val# is recycled, too + C.[i,j] <- val + assert.EQ.mat(N,n) ; stopifnot(all(C. == N)) + ## and the same *again*: + n [i,j] <- v.l + N [i,j] <- val + C.[i,j] <- val + assert.EQ.mat(N,n) + stopifnot(all(C. == N)) + + print(load(system.file("external", "symA.rda", package="Matrix"))) # "As" + stopifnotValid(As, "dsCMatrix"); stopifnot(identical(As@factors, list())) + R. <- drop0(chol(As)) + stopifnot(1:32 == sort(diag(R.)), ## ! + R.@x == as.integer(R.@x),## so it is an integer-valued chol-decomp ! + ## shows that (1) As is *not* singular (2) the matrix is not random + all.equal(crossprod(R.), As, tolerance =1e-15)) + print(summary(evA <- eigen(As, only.values=TRUE)$val)) + print(tail(evA)) ## largest three ~= 10^7, smallest two *negative* + print(rcond(As)) # 1.722 e-21 == very bad ! + ##-> this *is* a border line case, i.e. very close to singular ! + ## and also determinant(.) is rather random here! + cc0 <- Cholesky(As)# no problem + try({ + cc <- Cholesky(As, super=TRUE) + ## gives --on 32-bit only-- + ## Cholmod error 'matrix not positive definite' at file:../Supernodal/t_cholmod_super_numeric.c, line 613 + ecc <- expand(cc) + L.P <- with(ecc, crossprod(L,P)) ## == L'P + ## crossprod(L.P) == (L'P)' L'P == P'LL'P + stopifnot( all.equal(crossprod(L.P), As) ) + }) + ##---- end{ eigen( As ) ----------- + + } ## only if(doExtras) > > > ##---- Symmetric indexing of symmetric Matrix ---------- > m. <- mC > m.[, c(2, 7:12)] <- 0 replCmat[x,i,j,.., val] : nargs()=4; missing (i,j) = (1,0) > stopifnotValid(S <- crossprod(add.simpleDimnames(m.) %% 100), "dsCMatrix") > ss <- as(S, "matrix") > ds <- as(S, "denseMatrix") > ## NA-indexing of *dense* Matrices: should work as traditionally > assert.EQ.mat(ds[NA,NA], ss[NA,NA]) M[i,i,m] : nargs()=3 M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 > assert.EQ.mat(ds[NA, ], ss[NA,]) M[logi,m,m] : nargs()=3 > assert.EQ.mat(ds[ ,NA], ss[,NA]) M[m,i,m] : nargs()=3 > T <- as(S, "TsparseMatrix") > stopifnot(identical(ds[2 ,NA], ss[2,NA]), + identical(ds[NA, 1], ss[NA, 1]), + identical(S, as(T, "CsparseMatrix")) ) M[i,i,m] : nargs()=3 M[i,i,m] : nargs()=3 > > ## non-repeated indices: > i <- c(7:5, 2:4);assert.EQ.mat(T[i,i], ss[i,i]) M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > ## NA in indices -- check that we get a helpful error message: > i[2] <- NA > er <- tryCatch(T[i,i], error = function(e)e) M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > stopifnot(as.logical(grep("indices.*sparse Matrices", er$message))) > > N <- nrow(T) > set.seed(11) > for(n in 1:(if(doExtras) 50 else 3)) { + i <- sample(N, max(2, sample(N,1)), replace = FALSE) + validObject(Tii <- T[i,i]) ; tTi <- t(T)[i,i] + stopifnot(is(Tii, "dsTMatrix"), # remained symmetric Tsparse + is(tTi, "dsTMatrix"), # may not be identical when *sorted* differently + identical(as(t(Tii),"CsparseMatrix"), as(tTi,"CsparseMatrix"))) + assert.EQ.mat(Tii, ss[i,i]) + } M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > > b <- diag(1:2)[,c(1,1,2,2)] > cb <- crossprod(b) > cB <- crossprod(Matrix(b, sparse=TRUE)) > a <- matrix(0, 6, 6) > a[1:4, 1:4] <- cb > A1 <- A2 <- Matrix(0, 6, 6)#-> ddiMatrix > A1[1:4, 1:4] <- cb replCmat[x,i,j,.., val] : nargs()=4; > A2[1:4, 1:4] <- cB replCmat[x,i,j,.., val] : nargs()=4; > assert.EQ.mat(A1, a)# indeed > ## "must": symmetric and sparse, i.e., ds*Matrix: > stopifnot(identical(A1, A2), is(A1, "dsCMatrix")) > > ## repeated ones ``the challenge'' (to do smartly): > j <- c(4, 4, 9, 12, 9, 4, 17, 3, 18, 4, 12, 18, 4, 9) > assert.EQ.mat(T[j,j], ss[j,j]) M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > ## and another two sets (a, A) & (a., A.) : > a <- matrix(0, 6,6) > a[upper.tri(a)] <- (utr <- c(2, 0,-1, 0,0,5, 7,0,0,0, 0,0,-2,0,8)) > ta <- t(a); ta[upper.tri(a)] <- utr; a <- t(ta) > diag(a) <- c(0,3,0,4,6,0) > A <- as(Matrix(a), "TsparseMatrix") > A. <- A > diag(A.) <- 10 * (1:6) > a. <- as(A., "matrix") > ## More testing {this was not working for a long time..} > set.seed(1) > for(n in 1:(if(doExtras) 100 else 6)) { + i <- sample(1:nrow(A), 3+2*rpois(1, lam=3), replace=TRUE) + Aii <- A[i,i] + A.ii <- A.[i,i] + stopifnot(class(Aii) == class(A), + class(A.ii) == class(A.)) + assert.EQ.mat(Aii , a [i,i]) + assert.EQ.mat(A.ii, a.[i,i]) + assert.EQ.mat(T[i,i], ss[i,i]) + } M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > showProc.time() Time (user system elapsed): 0.172 0.001 0.174 > > stopifnot(all.equal(mC[,3], mm[,3]), + identical(mC[ij], mC[ij + 0.4]), + identical(mC[ij], mm[ij]), + identical(mC[iN], mm[iN])) M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 > ## out of bound indexing must be detected: > assertError(mC[cbind(ij[,1] - 5, ij[,2])]) > assertError(mC[cbind(ij[,1], ij[,2] + ncol(mC))]) > > assert.EQ.mat(mC[7, , drop=FALSE], mm[7, , drop=FALSE]) Csp[i,m,l] : nargs()=4 > identical (mC[7, drop=FALSE], mm[7, drop=FALSE]) # *vector* indexing Csp[i,m,l] : nargs()=3 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 [1] TRUE > > stopifnot(dim(mC[numeric(0), ]) == c(0,20), # used to give warnings + dim(mC[, integer(0)]) == c(40,0), + identical(mC[, integer(0)], mC[, FALSE])) M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 > validObject(print(mT[,c(2,4)])) M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 40 x 2 sparse Matrix of class "dgTMatrix" c2 c4 r1 . 121 r2 42 . r3 . . r4 . . r5 45 . r6 . . r7 . . r8 . 128 r9 . 129 r10 50 . r11 . . r12 52 132 r13 . 133 r14 . . r15 55 . r16 . . r17 . . r18 . 138 r19 . . r20 . . r21 . 141 r22 . 142 r23 63 . r24 . . r25 65 . r26 . . r27 67 . r28 68 . r29 . . r30 . . r31 71 . r32 72 . r33 . . r34 74 . r35 . . r36 76 . r37 . . r38 . . r39 . 159 r40 80 . [1] TRUE > stopifnot(all.equal(mT[2,], mm[2,]), + ## row or column indexing in combination with t() : + Q.C.identical(mT[2,], t(mT)[,2]), + Q.C.identical(mT[-2,], t(t(mT)[,-2])), + Q.C.identical(mT[c(2,5),], t(t(mT)[,c(2,5)])) ) M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 > assert.EQ.mat(mT[4,, drop = FALSE], mm[4,, drop = FALSE]) Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 > stopifnot(identical3(mm[,1], mC[,1], mT[,1]), + identical3(mm[3,], mC[3,], mT[3,]), + identical3(mT[2,3], mC[2,3], 0), + identical(mT[], mT), + identical4( mm[c(3,7), 2:4], as.mat( m[c(3,7), 2:4]), + as.mat(mT[c(3,7), 2:4]), as.mat(mC[c(3,7), 2:4])) + ) M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[m,m,m] : nargs()=2 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > > x.x <- crossprod(mC) > stopifnot(class(x.x) == "dsCMatrix", + class(x.x. <- round(x.x / 10000)) == "dsCMatrix", + identical(x.x[cbind(2:6, 2:6)], + diag(x.x [2:6, 2:6]))) M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > head(x.x.) # Note the *non*-structural 0's printed as "0" Csp[i,m,l] : nargs()=4 6 x 20 sparse Matrix of class "dgCMatrix" [[ suppressing 20 column names 'c1', 'c2', 'c3' ... ]] c1 1 0 . 1 . 1 1 3 . 3 2 1 6 1 . 2 4 6 5 1 c2 0 6 2 1 3 5 7 5 12 14 14 9 11 16 12 13 17 19 19 10 c3 . 2 6 . 4 2 5 3 8 12 5 16 9 11 23 . . 6 7 7 c4 1 1 . 17 . 8 10 13 8 6 18 18 29 35 14 8 25 10 19 21 c5 . 3 4 . 14 4 10 . . 29 8 9 19 11 11 . . 26 26 16 c6 1 5 2 8 4 42 5 19 14 9 8 10 42 56 50 27 29 32 64 16 > tail(x.x., -3) # all but the first three lines Csp[i,m,l] : nargs()=4 17 x 20 sparse Matrix of class "dgCMatrix" [[ suppressing 20 column names 'c1', 'c2', 'c3' ... ]] c4 1 1 . 17 . 8 10 13 8 6 18 18 29 35 14 8 25 10 19 21 c5 . 3 4 . 14 4 10 . . 29 8 9 19 11 11 . . 26 26 16 c6 1 5 2 8 4 42 5 19 14 9 8 10 42 56 50 27 29 32 64 16 c7 1 7 5 10 10 5 87 14 9 31 77 47 79 43 28 17 67 110 36 121 c8 3 5 3 13 . 19 14 70 10 24 37 13 59 62 34 19 58 21 64 44 c9 . 12 8 8 . 14 9 10 116 41 58 33 33 72 78 43 69 72 75 25 c10 3 14 12 6 29 9 31 24 41 167 69 56 99 44 70 24 105 82 85 32 c11 2 14 5 18 8 8 77 37 58 69 267 80 86 139 49 105 194 119 122 129 c12 1 9 16 18 9 10 47 13 33 56 80 194 70 77 81 . 90 32 . 106 c13 6 11 9 29 19 42 79 59 33 99 86 70 324 157 55 . 69 142 144 155 c14 1 16 11 35 11 56 43 62 72 44 139 77 157 375 123 102 145 39 196 81 c15 . 12 23 14 11 50 28 34 78 70 49 81 55 123 368 71 112 41 41 86 c16 2 13 . 8 . 27 17 19 43 24 105 . . 102 71 233 124 44 139 . c17 4 17 . 25 . 29 67 58 69 105 194 90 69 145 112 124 523 141 245 100 c18 6 19 6 10 26 32 110 21 72 82 119 32 142 39 41 44 141 497 104 111 c19 5 19 7 19 26 64 36 64 75 85 122 . 144 196 41 139 245 104 542 55 c20 1 10 7 21 16 16 121 44 25 32 129 106 155 81 86 . 100 111 55 541 > > lx.x <- as(x.x, "lsCMatrix") # FALSE only for "structural" 0 > (l10 <- lx.x[1:10, 1:10])# "lsC" M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 10 x 10 sparse Matrix of class "lsCMatrix" [[ suppressing 10 column names 'c1', 'c2', 'c3' ... ]] c1 | | . | . | | | . | c2 | | | | | | | | | | c3 . | | . | | | | | | c4 | | . | . | | | | | c5 . | | . | | | . . | c6 | | | | | | | | | | c7 | | | | | | | | | | c8 | | | | . | | | | | c9 . | | | . | | | | | c10 | | | | | | | | | | > (l3 <- lx.x[1:3, ]) M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 3 x 20 sparse Matrix of class "lgCMatrix" [[ suppressing 20 column names 'c1', 'c2', 'c3' ... ]] c1 | | . | . | | | . | | | | | . | | | | | c2 | | | | | | | | | | | | | | | | | | | | c3 . | | . | | | | | | | | | | | . . | | | > m.x <- as.mat(x.x) # as.mat() *drops* (NULL,NULL) dimnames > stopifnot(class(l10) == "lsCMatrix", # symmetric indexing -> symmetric ! + identical(as.mat(lx.x), m.x != 0), + identical(as.logical(lx.x), as.logical(m.x)), + identical(as.mat(l10), m.x[1:10, 1:10] != 0), + identical(as.mat(l3 ), m.x[1:3, ] != 0) + ) > > ##-- Sub*assignment* with repeated / duplicated index: > A <- Matrix(0,4,3) ; A[c(1,2,1), 2] <- 1 ; A replCmat[x,i,j,.., val] : nargs()=4; 4 x 3 sparse Matrix of class "dgCMatrix" [1,] . 1 . [2,] . 1 . [3,] . . . [4,] . . . > B <- A; B[c(1,2,1), 2] <- 1:3; B; B. <- B replCmat[x,i,j,.., val] : nargs()=4; 4 x 3 sparse Matrix of class "dgCMatrix" [1,] . 3 . [2,] . 2 . [3,] . . . [4,] . . . > B.[3,] <- rbind(4:2) replCmat[x,i,j,.., val] : nargs()=4; missing (i,j) = (0,1) > ## change the diagonal and the upper and lower subdiagonal : > diag(B.) <- 10 * diag(B.) > diag(B.[,-1]) <- 5* diag(B.[,-1]) M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 replCmat[x,i,j,.., val] : nargs()=4; missing (i,j) = (1,0) > diag(B.[-1,]) <- 4* diag(B.[-1,]) ; B. M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 replCmat[x,i,j,.., val] : nargs()=4; missing (i,j) = (0,1) 4 x 3 sparse Matrix of class "dgCMatrix" [1,] . 15 . [2,] . 20 . [3,] 4 12 20 [4,] . . . > C <- B.; C[,2] <- C[,2]; C[1,] <- C[1,]; C[2:3,2:1] <- C[2:3,2:1] M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 replCmat[x,i,j,.., val] : nargs()=4; missing (i,j) = (1,0) M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 replCmat[x,i,j,.., val] : nargs()=4; missing (i,j) = (0,1) M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 replCmat[x,i,j,.., val] : nargs()=4; > stopifnot(identical(unname(.asmatrix(A)), + local({a <- matrix(0,4,3); a[c(1,2,1), 2] <- 1 ; a})), + identical(unname(.asmatrix(B)), + local({a <- matrix(0,4,3); a[c(1,2,1), 2] <- 1:3; a})), + identical(C, drop0(B.))) > ## [] <- v failed in the past > T <- as(C,"TsparseMatrix"); C. <- C > T[T>0] <- 21 Note: method with signature 'TsparseMatrix#Matrix#missing#replValue' chosen for function '[<-', target signature 'dgTMatrix#lgTMatrix#missing#numeric'. "Matrix#lsparseMatrix#missing#replValue" would also be valid .TM.repl.i.mat(): "lMatrix" case ... diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) > C[C>0] <- 21 Note: method with signature 'CsparseMatrix#Matrix#missing#replValue' chosen for function '[<-', target signature 'dgCMatrix#lgCMatrix#missing#numeric'. "Matrix#lsparseMatrix#missing#replValue" would also be valid .TM.repl.i.mat(): "lMatrix" case ... diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) > a. <- local({a <- .asmatrix(C.); a[a>0] <- 21; a}) > assert.EQ.mat(C, a.) > stopifnot(identical(C, as(T, "CsparseMatrix"))) > > ## used to fail > n <- 5 ## or much larger > sm <- new("dsTMatrix", i=1L, j=1L, Dim=as.integer(c(n,n)), x = 1) > (cm <- as(sm, "CsparseMatrix")) 5 x 5 sparse Matrix of class "dsCMatrix" [1,] . . . . . [2,] . 1 . . . [3,] . . . . . [4,] . . . . . [5,] . . . . . > sm[2,] M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 [1] 0 1 0 0 0 > stopifnot(sm[2,] == c(0:1, rep.int(0,ncol(sm)-2)), + sm[2,] == cm[2,], + sm[,3] == sm[3,], + all(sm[,-(1:3)] == t(sm[-(1:3),])), # all() + all(sm[,-(1:3)] == 0) + ) M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 > showProc.time() Time (user system elapsed): 0.153 0 0.153 > > ##--- "nsparse*" sub-assignment :---------- > M <- Matrix(c(1, rep(0,7), 1:4), 3,4) > N0 <- kronecker(M,M) > Nn <- as(N0, "nMatrix"); nn <- as(Nn,"matrix") > (Nn00 <- Nn0 <- Nn); nn00 <- nn0 <- nn 9 x 16 sparse Matrix of class "ngTMatrix" [1,] | . . | . . . . . . . . | . . | [2,] . . . | . . . . . . . . . . . | [3,] . . | | . . . . . . . . . . | | [4,] . . . . . . . . . . . . | . . | [5,] . . . . . . . . . . . . . . . | [6,] . . . . . . . . . . . . . . | | [7,] . . . . . . . . | . . | | . . | [8,] . . . . . . . . . . . | . . . | [9,] . . . . . . . . . . | | . . | | > > set.seed(1) > Nn0 <- Nn00; nn0 <- nn00 > for(i in 1:(if(doExtras) 200 else 25)) { + Nn <- Nn0 + nn <- nn0 + i. <- getDuplIndex(nrow(N0), 6) + j. <- getDuplIndex(ncol(N0), 4) + vv <- sample(c(FALSE,TRUE), + length(i.)*length(j.), replace=TRUE) + cat(",") + Nn[i., j.] <- vv + nn[i., j.] <- vv + assert.EQ.mat(Nn, nn) + if(!all(Nn == nn)) { + cat("i=",i,":\n i. <- "); dput(i.) + cat("j. <- "); dput(j.) + cat("which(vv): "); dput(which(vv)) + cat("Difference matrix:\n") + show(drop0(Nn - nn)) + } + cat("k") + ## sub-assign double precision to logical sparseMatrices: now *with* warning: + ## {earlier: gave *no* warning}: + assertWarning(Nn[1:2,] <- -pi) + assertWarning(Nn[, 5] <- -pi) + assertWarning(Nn[2:4, 5:8] <- -pi) + stopifnotValid(Nn,"nsparseMatrix") + ## + cat(".") + if(i %% 10 == 0) cat("\n") + if(i == 100) { + Nn0 <- as(Nn0, "CsparseMatrix") + cat("Now: class", class(Nn0)," :\n~~~~~~~~~~~~~~~~~\n") + } + } ,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; . ,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; . ,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .,.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=24; k.. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (0,1) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; missing (i,j) = (1,0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=ngTMatrix; len.(value)=1; .> showProc.time() Time (user system elapsed): 0.146 0.001 0.147 > Nn <- Nn0 > ## Check that NA is interpreted as TRUE (with a warning), for "nsparseMatrix": > assertWarning(Nn[ii <- 3 ] <- NA); stopifnot(isValid(Nn,"nsparseMatrix"), Nn[ii]) diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) M[i,m,m] : nargs()=2 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > assertWarning(Nn[ii <- 22:24] <- NA); stopifnot(isValid(Nn,"nsparseMatrix"), Nn[ii]) diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) M[i,m,m] : nargs()=2 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > assertWarning(Nn[ii <- -(1:99)] <- NA); stopifnot(isValid(Nn,"nsparseMatrix"), Nn[ii]) diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) M[i,m,m] : nargs()=2 > assertWarning(Nn[ii <- 3:4 ] <- c(0,NA)) diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) > stopifnot(isValid(Nn,"nsparseMatrix"), Nn[ii] == 0:1) M[i,m,m] : nargs()=2 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > assertWarning(Nn[ii <- 25:27] <- c(0,1,NA)) diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) > stopifnot(isValid(Nn,"nsparseMatrix"), Nn[ii] == c(FALSE,TRUE,TRUE)) M[i,m,m] : nargs()=2 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > > m0 <- Diagonal(5) > stopifnot(identical(m0[2,], m0[,2]), + identical(m0[,1], c(1,0,0,0,0))) M[i,m,m] : nargs()=3 diag[i,m,l] : nargs()=4 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 > ### Diagonal -- Sparse: > (m1 <- as(m0, "TsparseMatrix")) # dtTMatrix unitriangular 5 x 5 sparse Matrix of class "dtTMatrix" (unitriangular) [1,] I . . . . [2,] . I . . . [3,] . . I . . [4,] . . . I . [5,] . . . . I > (m2 <- as(m0, "CsparseMatrix")) # dtCMatrix unitriangular 5 x 5 sparse Matrix of class "dtCMatrix" (unitriangular) [1,] I . . . . [2,] . I . . . [3,] . . I . . [4,] . . . I . [5,] . . . . I > m1g <- as(m1, "generalMatrix") > tr1 <- as(m1, "denseMatrix") # dtrMatrix unitriangular > stopifnotValid(m1g, "dgTMatrix") > diag(tr1) <- 100 > stopifnot(diag(tr1) == 100)# failed when 'diag<-' did not recycle > assert.EQ.mat(m2[1:3,], diag(5)[1:3,]) M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 > assert.EQ.mat(m2[,c(4,1)], diag(5)[,c(4,1)]) M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 > stopifnot(identical(m2[1:3,], as(m1[1:3,], "CsparseMatrix")), + identical(uniqTsparse(m1[, c(4,2)]), + uniqTsparse(as(m2[, c(4,2)], "TsparseMatrix"))) + )## failed in 0.9975-11 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 > > ## 0-dimensional diagonal - subsetting ---------------------------- > ## before that diagU2N() etc for 0-dim. dtC*: > m0. <- m00 <- matrix(numeric(),0,0) > dimnames(m0.) <- list(NULL, NULL) > tC0.<- new("dtCMatrix") > tC0 <- new("dtCMatrix", diag="U") > (gC0 <- new("dgCMatrix")) # 0 x 0 0 x 0 sparse Matrix of class "dgCMatrix" <0 x 0 matrix> > D0 <- Diagonal(0) > stopifnot(exprs = { + identical(m0., as(tC0, "matrix")) # failed: Cholmod error 'invalid xtype' .. + identical(numeric(), as(tC0, "numeric"))# " + identical(numeric(), tC0[ 0 ])# --> .M.vectorSub(x, i) failed in as(., "matrix") + identical(m00[TRUE ], tC0[TRUE ])# (worked already) + identical(m00[FALSE], tC0[FALSE])# ditto + ## + identical(D0, D0[0,0]) # used to fail --> subCsp_ij (..) + identical(D0, D0[ ,0]) # (ditto) --> subCsp_cols(..) + identical(D0, D0[0, ]) # " --> subCsp_rows(..) + identical(D0, D0[,]) # (worked already) + identical(m00[ 0 ], D0[ 0 ] )# ditto + identical(m00[TRUE ], D0[TRUE ])# " + identical(m00[FALSE], D0[FALSE])# " + ## + identical(tC0.,tC0[0,0]) # failed --> subCsp_ij (..) + identical(gC0, tC0[ ,0]) # " --> subCsp_cols(..) + identical(gC0, tC0[0, ]) # " --> subCsp_rows(..) + identical(tC0, tC0[,]) # (worked already) + ## vector indexing + }) M[i,m,m] : nargs()=2 M[logi,m,m] : nargs()=2 [ ] : .M.sub.i.logical() maybe inefficient M[logi,m,m] : nargs()=2 [ ] : .M.sub.i.logical() maybe inefficient M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,m,m] : nargs()=3 diag[i,m,l] : nargs()=4 Csp[i,m,l] : nargs()=4 M[m,m,m] : nargs()=3 M[m,m, TRUE] : nargs()=4 M[i,m,m] : nargs()=2 M[logi,m,m] : nargs()=2 [ ] : .M.sub.i.logical() maybe inefficient M[logi,m,m] : nargs()=2 [ ] : .M.sub.i.logical() maybe inefficient M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[m,m,m] : nargs()=3 M[m,m, TRUE] : nargs()=4 > > expr <- quote({ ## FIXME -- both 'TRUE' and 'FALSE' should fail "out of bound",etc + D0[TRUE, TRUE ] + D0[ , TRUE ] + D0[TRUE, ] # worked but should *NOT* + tC0[TRUE, TRUE ] + tC0[ , TRUE ] + tC0[TRUE, ] # worked but should *NOT* + ## + D0[FALSE,FALSE] # fails --> subCsp_ij(..) -> intI() + D0[ ,FALSE] # ditto ............ + D0[FALSE, ] # ditto + tC0[FALSE,FALSE] # " + tC0[FALSE, ] # " + tC0[ ,FALSE] # " + }) > EE <- lapply(expr[-1], function(e) + list(expr = e, + r = tryCatch(eval(e), error = identity))) M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[logi,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[logi,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[logi,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[logi,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 > exR <- lapply(EE, `[[`, "r") > stopifnot(exprs = { + vapply(exR, inherits, logical(1), what = "error") + unique( vapply(exR, `[[`, "", "message") + ) == "logical subscript too long (1, should be 0)" + }) > > > (uTr <- new("dtTMatrix", Dim = c(3L,3L), diag="U")) 3 x 3 sparse Matrix of class "dtTMatrix" (unitriangular) [1,] I . . [2,] . I . [3,] . . I > uTr[1,] <- 0 .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=dtTMatrix; len.(value)=1; missing (i,j) = (0,1) > assert.EQ.mat(uTr, cbind(0, rbind(0,diag(2)))) > > M <- m0; M[1,] <- 0 replCmat[x,i,j,.., val] : nargs()=4; missing (i,j) = (0,1) > Z <- m0; Z[] <- 0; z <- array(0, dim(M)) > stopifnot(identical(M, Diagonal(x=c(0, rep(1,4)))), + all(Z == 0), Qidentical(as(Z, "matrix"), z)) > M <- m0; M[,3] <- 3 ; M ; stopifnot(is(M, "sparseMatrix"), M[,3] == 3) replCmat[x,i,j,.., val] : nargs()=4; missing (i,j) = (1,0) 5 x 5 sparse Matrix of class "dgCMatrix" [1,] 1 . 3 . . [2,] . 1 3 . . [3,] . . 3 . . [4,] . . 3 1 . [5,] . . 3 . 1 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 > checkMatrix(M) Note: method with signature 'sparseMatrix#ldiMatrix' chosen for function '==', target signature 'nsCMatrix#ldiMatrix'. "nsparseMatrix#sparseMatrix", "nMatrix#lMatrix" would also be valid M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 Csp[m,i,l] : nargs()=4 Compare -- "dgCMatrix" != "dgCMatrix" : norm(m [5 x 5]) : 1 I F M ok Summary: ok as(., "nMatrix") giving full nonzero-pattern: ok 2*m =?= m+m: identical m >= m for all: ok m < m for none: Compare -- "dgCMatrix" < "dgCMatrix" : ok symmpart(m) + skewpart(m) == m: ok; determinant(): ok > M <- m0; M[1:3, 3] <- 0 ;M replCmat[x,i,j,.., val] : nargs()=4; 5 x 5 diagonal matrix of class "ddiMatrix" [,1] [,2] [,3] [,4] [,5] [1,] 1 . . . . [2,] . 1 . . . [3,] . . 0 . . [4,] . . . 1 . [5,] . . . . 1 > T <- m0; T[1:3, 3] <- 10 replCmat[x,i,j,.., val] : nargs()=4; > stopifnot(identical(M, Diagonal(x=c(1,1, 0, 1,1))), + isValid(T, "triangularMatrix"), identical(T[,3], c(10,10,10,0,0))) M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 > > M <- m1; M[1,] <- 0 ; M ; assert.EQ.mat(M, diag(c(0,rep(1,4))), tol=0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=dtTMatrix; len.(value)=1; missing (i,j) = (0,1) 5 x 5 sparse Matrix of class "dtTMatrix" [1,] . . . . . [2,] . 1 . . . [3,] . . 1 . . [4,] . . . 1 . [5,] . . . . 1 > M <- m1; M[,3] <- 3 ; stopifnot(is(M,"sparseMatrix"), M[,3] == 3) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=dtTMatrix; len.(value)=1; missing (i,j) = (1,0) M[i,j] <- v : coercing symmetric M[] into non-symmetric M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 > Z <- m1; Z[] <- 0 > checkMatrix(M) M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 Csp[m,i,l] : nargs()=4 Compare -- "dgCMatrix" != "dgCMatrix" : norm(m [5 x 5]) : 1 I F M ok Summary: ok as(., "nMatrix") giving full nonzero-pattern: ok 2*m =?= m+m: Note: method with signature 'sparseMatrix#ldiMatrix' chosen for function '&', target signature 'nsCMatrix#ldiMatrix'. "nsparseMatrix#sparseMatrix", "nMatrix#lMatrix" would also be valid ok m >= m for all: ok m < m for none: Compare -- "dgCMatrix" < "dgCMatrix" : ok symmpart(m) + skewpart(m) == m: ok; determinant(): ok > M <- m1; M[1:3, 3] <- 0 ;M .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=dtTMatrix; len.(value)=1; 5 x 5 sparse Matrix of class "dtTMatrix" [1,] 1 . . . . [2,] . 1 . . . [3,] . . . . . [4,] . . . 1 . [5,] . . . . 1 > assert.EQ.mat(M, diag(c(1,1, 0, 1,1)), tol=0) > T <- m1; T[1:3, 3] <- 10; checkMatrix(T) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=dtTMatrix; len.(value)=1; M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 Csp[m,i,l] : nargs()=4 Compare -- "dtCMatrix" != "dtCMatrix" : norm(m [5 x 5]) : 1 I F M ok Summary: ok as(., "nMatrix") giving full nonzero-pattern: ok 2*m =?= m+m: identical m >= m for all: ok m < m for none: Compare -- "dtCMatrix" < "dtCMatrix" : ok symmpart(m) + skewpart(m) == m: ok; determinant(): ok .TM.repl.i.mat(): drop 'matrix' case ... diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) 'sub-optimal sparse 'x[i] <- v' assignment: Coercing class dtTMatrix to dgTMatrix as(, dtTMatrix): valid: TRUE > stopifnot(is(T, "triangularMatrix"), identical(T[,3], c(10,10,10,0,0)), + Qidentical(as(Z, "matrix"), z)) M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 > > M <- m2; M[1,] <- 0 ; M ; assert.EQ.mat(M, diag(c(0,rep(1,4))), tol=0) replCmat[x,i,j,.., val] : nargs()=4; missing (i,j) = (0,1) 5 x 5 sparse Matrix of class "dtCMatrix" [1,] . . . . . [2,] . 1 . . . [3,] . . 1 . . [4,] . . . 1 . [5,] . . . . 1 > M <- m2; M[,3] <- 3 ; stopifnot(is(M,"sparseMatrix"), M[,3] == 3) replCmat[x,i,j,.., val] : nargs()=4; missing (i,j) = (1,0) M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 > checkMatrix(M) M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 Csp[m,i,l] : nargs()=4 Compare -- "dgCMatrix" != "dgCMatrix" : norm(m [5 x 5]) : 1 I F M ok Summary: ok as(., "nMatrix") giving full nonzero-pattern: ok 2*m =?= m+m: identical m >= m for all: ok m < m for none: Compare -- "dgCMatrix" < "dgCMatrix" : ok symmpart(m) + skewpart(m) == m: ok; determinant(): ok > Z <- m2; Z[] <- 0 > M <- m2; M[1:3, 3] <- 0 ;M replCmat[x,i,j,.., val] : nargs()=4; 5 x 5 sparse Matrix of class "dtCMatrix" [1,] 1 . . . . [2,] . 1 . . . [3,] . . . . . [4,] . . . 1 . [5,] . . . . 1 > assert.EQ.mat(M, diag(c(1,1, 0, 1,1)), tol=0) > T <- m2; T[1:3, 3] <- 10; checkMatrix(T) replCmat[x,i,j,.., val] : nargs()=4; M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[i,m,m] : nargs()=3 M[m,i,m] : nargs()=3 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 Csp[m,i,l] : nargs()=4 Compare -- "dtCMatrix" != "dtCMatrix" : norm(m [5 x 5]) : 1 I F M ok Summary: ok as(., "nMatrix") giving full nonzero-pattern: ok 2*m =?= m+m: identical m >= m for all: ok m < m for none: Compare -- "dtCMatrix" < "dtCMatrix" : ok symmpart(m) + skewpart(m) == m: ok; determinant(): ok .TM.repl.i.mat(): drop 'matrix' case ... diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) 'sub-optimal sparse 'x[i] <- v' assignment: Coercing class dtTMatrix to dgTMatrix as(, dtCMatrix): valid: TRUE > stopifnot(is(T, "dtCMatrix"), identical(T[,3], c(10,10,10,0,0)), + Qidentical(as(Z, "matrix"), z)) M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 > showProc.time() Time (user system elapsed): 0.499 0.017 0.518 > > > ## "Vector indices" ------------------- > asLogical <- function(x) { + stopifnot(is.atomic(x)) + storage.mode(x) <- "logical" + x + } > .iniDiag.example <- expression({ + D <- Diagonal(6) + M <- as(D,"dgeMatrix") + m <- as(D,"matrix") + s <- as(D,"TsparseMatrix"); N <- as(s,"nMatrix") + S <- as(s,"CsparseMatrix"); C <- as(S,"nMatrix") + }) > eval(.iniDiag.example) > i <- c(3,1,6); v <- c(10,15,20) > ## (logical,value) which both are recycled: > L <- c(TRUE, rep(FALSE,8)) ; z <- c(50,99) > > ## vector subassignment, both with integer & logical > ## these now work correctly {though not very efficiently; hence warnings} > m[i] <- v # the role model: only first column is affected > M[i] <- v; assert.EQ.mat(M,m) # dge > D[i] <- v; assert.EQ.mat(D,m) # ddi -> dtC (new! 2019-07; was dgT) replCmat[x,i,j,.., val] : nargs()=3; missing (i,j) = (0,1) diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) 'sub-optimal sparse 'x[i] <- v' assignment: Coercing class dtTMatrix to dgTMatrix > s[i] <- v; assert.EQ.mat(s,m) # dtT -> dgT diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) 'sub-optimal sparse 'x[i] <- v' assignment: Coercing class dtTMatrix to dgTMatrix > S[i] <- v; assert.EQ.mat(S,m); S # dtC -> dtT -> dgT -> dgC replCmat[x,i,j,.., val] : nargs()=3; missing (i,j) = (0,1) diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) 'sub-optimal sparse 'x[i] <- v' assignment: Coercing class dtTMatrix to dgTMatrix 6 x 6 sparse Matrix of class "dgCMatrix" [1,] 15 . . . . . [2,] . 1 . . . . [3,] 10 . 1 . . . [4,] . . . 1 . . [5,] . . . . 1 . [6,] 20 . . . . 1 > m.L <- asLogical(m) ; assertWarning( + C[i] <- v, verbose=TRUE) # warning: C is nMatrix, v not T/F replCmat[x,i,j,.., val] : nargs()=3; missing (i,j) = (0,1) diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) 'sub-optimal sparse 'x[i] <- v' assignment: Coercing class ntTMatrix to ngTMatrix Asserted warning: x[.] <- val: x is "ngTMatrix", val not in {TRUE, FALSE} is coerced. > assert.EQ.mat(C,m.L); validObject(C); assertWarning( [1] TRUE + N[i] <- v, verbose=TRUE) diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) 'sub-optimal sparse 'x[i] <- v' assignment: Coercing class ntTMatrix to ngTMatrix Asserted warning: x[.] <- val: x is "ngTMatrix", val not in {TRUE, FALSE} is coerced. > assert.EQ.mat(N,m.L); validObject(N) [1] TRUE > stopifnot(identical(D, as(as(s, "triangularMatrix"), "CsparseMatrix"))) > ## logical *vector* indexing > eval(.iniDiag.example) > m[L] <- z; m.L <- asLogical(m) > M[L] <- z; assert.EQ.mat(M,m) > D[L] <- z; assert.EQ.mat(D,m) replCmat[x,i,j,.., val] : nargs()=3; missing (i,j) = (0,1) diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) 'sub-optimal sparse 'x[i] <- v' assignment: Coercing class dtTMatrix to dgTMatrix > s[L] <- z; assert.EQ.mat(s,m) diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) 'sub-optimal sparse 'x[i] <- v' assignment: Coercing class dtTMatrix to dgTMatrix > S[L] <- z; assert.EQ.mat(S,m) ; S ; assertWarning( replCmat[x,i,j,.., val] : nargs()=3; missing (i,j) = (0,1) diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) 'sub-optimal sparse 'x[i] <- v' assignment: Coercing class dtTMatrix to dgTMatrix 6 x 6 sparse Matrix of class "dgCMatrix" [1,] 50 . . 50 . . [2,] . 1 . . . . [3,] . . 1 . . . [4,] . 99 . 1 99 . [5,] . . . . 1 . [6,] . . . . . 1 + C[L] <- z, verbose=TRUE); assert.EQ.mat(C,m.L) ; assertWarning( replCmat[x,i,j,.., val] : nargs()=3; missing (i,j) = (0,1) diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) 'sub-optimal sparse 'x[i] <- v' assignment: Coercing class ntTMatrix to ngTMatrix Asserted warning: x[.] <- val: x is "ngTMatrix", val not in {TRUE, FALSE} is coerced. + N[L] <- z, verbose=TRUE); assert.EQ.mat(N,m.L) diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) 'sub-optimal sparse 'x[i] <- v' assignment: Coercing class ntTMatrix to ngTMatrix Asserted warning: x[.] <- val: x is "ngTMatrix", val not in {TRUE, FALSE} is coerced. > > > ## indexing [i] vs [i,] --- now ok > eval(.iniDiag.example) > stopifnot(identical5(m[i], M[i], D[i], s[i], S[i]), identical3(as.logical(m[i]), C[i], N[i]), + identical5(m[L], M[L], D[L], s[L], S[L]), identical3(as.logical(m[L]), C[L], N[L])) M[i,m,m] : nargs()=2 M[i,m,m] : nargs()=2 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,m,m] : nargs()=2 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,m,m] : nargs()=2 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,m,m] : nargs()=2 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,m,m] : nargs()=2 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[logi,m,m] : nargs()=2 M[logi,m,m] : nargs()=2 [ ] : .M.sub.i.logical() maybe inefficient M[logi,m,m] : nargs()=2 [ ] : .M.sub.i.logical() maybe inefficient M[logi,m,m] : nargs()=2 [ ] : .M.sub.i.logical() maybe inefficient M[logi,m,m] : nargs()=2 [ ] : .M.sub.i.logical() maybe inefficient M[logi,m,m] : nargs()=2 [ ] : .M.sub.i.logical() maybe inefficient > ## bordercase ' drop = .' *vector* indexing {failed till 2009-04-..) > stopifnot(identical5(m[i,drop=FALSE], M[i,drop=FALSE], D[i,drop=FALSE], + s[i,drop=FALSE], S[i,drop=FALSE]), + identical3(as.logical(m[i,drop=FALSE]), + C[i,drop=FALSE], N[i,drop=FALSE])) diag[i,m,l] : nargs()=3 Csp[i,m,l] : nargs()=3 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 Tsp[i,m,l]: nargs()=3 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 Csp[i,m,l] : nargs()=3 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 Csp[i,m,l] : nargs()=3 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 Tsp[i,m,l]: nargs()=3 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > stopifnot(identical5(m[L,drop=FALSE], M[L,drop=FALSE], D[L,drop=FALSE], + s[L,drop=FALSE], S[L,drop=FALSE]), + identical3(as.logical(m[L,drop=FALSE]), + C[L,drop=FALSE], N[L,drop=FALSE])) diag[i,m,l] : nargs()=3 Csp[i,m,l] : nargs()=3 Tsp[i,m,l]: nargs()=3 Csp[i,m,l] : nargs()=3 Csp[i,m,l] : nargs()=3 Tsp[i,m,l]: nargs()=3 > ## using L for row-indexing should give an error > assertError(m[L,]); assertError(m[L,, drop=FALSE]) > ## these did not signal an error, upto (including) 0.999375-30: > assertError(s[L,]); assertError(s[L,, drop=FALSE]) M[logi,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 > assertError(S[L,]); assertError(S[L,, drop=FALSE]) M[logi,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 Csp[i,m,l] : nargs()=4 > assertError(N[L,]); assertError(N[L,, drop=FALSE]) M[logi,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 > > ## row indexing: > assert.EQ.mat(D[i,], m[i,]) M[i,m,m] : nargs()=3 diag[i,m,l] : nargs()=4 Csp[i,m,l] : nargs()=4 > assert.EQ.mat(M[i,], m[i,]) M[i,m,m] : nargs()=3 > assert.EQ.mat(s[i,], m[i,]) M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 > assert.EQ.mat(S[i,], m[i,]) M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 > assert.EQ.mat(C[i,], asLogical(m[i,])) M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 > assert.EQ.mat(N[i,], asLogical(m[i,])) M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 > ## column indexing: > assert.EQ.mat(D[,i], m[,i]) M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 > assert.EQ.mat(M[,i], m[,i]) M[m,i,m] : nargs()=3 > assert.EQ.mat(s[,i], m[,i]) M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 > assert.EQ.mat(S[,i], m[,i]) M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 > assert.EQ.mat(C[,i], asLogical(m[,i])) M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 > assert.EQ.mat(N[,i], asLogical(m[,i])) M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 > > > ### --- negative indices ---------- > > ## 1) negative *vector* indexing > eval(.iniDiag.example) > i <- -(2:30) > stopifnot(identical5(m[i], M[i], D[i], s[i], S[i]), + identical3(as.logical(m[i]), C[i], N[i])) M[i,m,m] : nargs()=2 M[i,m,m] : nargs()=2 M[i,m,m] : nargs()=2 M[i,m,m] : nargs()=2 M[i,m,m] : nargs()=2 M[i,m,m] : nargs()=2 > ## negative vector subassignment : > v <- seq_along(m[i]) > m[i] <- v; m.L <- asLogical(m) > M[i] <- v; assert.EQ.mat(M,m) # dge > D[i] <- v; assert.EQ.mat(D,m) # ddi -> dtT -> dgT replCmat[x,i,j,.., val] : nargs()=3; missing (i,j) = (0,1) diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) 'sub-optimal sparse 'x[i] <- v' assignment: Coercing class dtTMatrix to dgTMatrix > s[i] <- v; assert.EQ.mat(s,m) # dtT -> dgT diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) 'sub-optimal sparse 'x[i] <- v' assignment: Coercing class dtTMatrix to dgTMatrix > S[i] <- v; assert.EQ.mat(S,m); S ; assertWarning( # dtC -> dtT -> dgT -> dgC replCmat[x,i,j,.., val] : nargs()=3; missing (i,j) = (0,1) diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) 'sub-optimal sparse 'x[i] <- v' assignment: Coercing class dtTMatrix to dgTMatrix 6 x 6 sparse Matrix of class "dgCMatrix" [1,] 1 . . . . 2 [2,] . 1 . . . 3 [3,] . . 1 . . 4 [4,] . . . 1 . 5 [5,] . . . . 1 6 [6,] . . . . . 7 + N[i] <- v, verbose=TRUE) diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) 'sub-optimal sparse 'x[i] <- v' assignment: Coercing class ntTMatrix to ngTMatrix Asserted warning: x[.] <- val: x is "ngTMatrix", val not in {TRUE, FALSE} is coerced. > assert.EQ.mat(N,m.L); N ; assertWarning( 6 x 6 sparse Matrix of class "ngTMatrix" [1,] | . . . . | [2,] . | . . . | [3,] . . | . . | [4,] . . . | . | [5,] . . . . | | [6,] . . . . . | + C[i] <- v, verbose=TRUE) replCmat[x,i,j,.., val] : nargs()=3; missing (i,j) = (0,1) diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) 'sub-optimal sparse 'x[i] <- v' assignment: Coercing class ntTMatrix to ngTMatrix Asserted warning: x[.] <- val: x is "ngTMatrix", val not in {TRUE, FALSE} is coerced. > assert.EQ.mat(C,m.L); C # 6 x 6 sparse Matrix of class "ngCMatrix" [1,] | . . . . | [2,] . | . . . | [3,] . . | . . | [4,] . . . | . | [5,] . . . . | | [6,] . . . . . | > > options(warn = 2) #---------------------# NO WARNINGS from here ----------------- > # ===================== > ## 2) negative [i,j] indices > mc <- mC[1:5, 1:7] M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > mt <- mT[1:5, 1:7] M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > ## sub matrix > assert.EQ.mat(mC[1:2, 0:3], mm[1:2, 0:3]) # test 0-index M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > stopifnot(identical(mc[-(3:5), 0:2], mC[1:2, 0:2]), + identical(mt[-(3:5), 0:2], mT[1:2, 0:2]), + identical(mC[2:3, 4], mm[2:3, 4])) M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > assert.EQ.mat(mC[1:2,], mm[1:2,]) M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 > ## sub vector > stopifnot(identical4(mc[-(1:4), ], mC[5, 1:7], + mt[-(1:4), ], mT[5, 1:7])) M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > stopifnot(identical4(mc[-(1:4), -(2:4)], mC[5, c(1,5:7)], + mt[-(1:4), -(2:4)], mT[5, c(1,5:7)])) M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > > ## mixing of negative and positive must give error > assertError(mT[-1:1,]) M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 > showProc.time() Time (user system elapsed): 0.26 0.016 0.278 > > ## Sub *Assignment* ---- now works (partially): > mt0 <- mt > nt <- as(mt, "nMatrix") > mt[1, 4] <- -99 .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=dgTMatrix; len.(value)=1; > mt[2:3, 1:6] <- 0 .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=dgTMatrix; len.(value)=1; > mt 5 x 7 sparse Matrix of class "dgTMatrix" c1 c2 c3 c4 c5 c6 c7 r1 . . . -99 . . 241 r2 . . . . . . . r3 . . . . . . 243 r4 . . . . . . . r5 . 45 . . . . . > m2 <- mt+mt > m2[1,4] <- -200 .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=dgTMatrix; len.(value)=1; > m2[c(1,3), c(5:6,2)] <- 1:6 .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=dgTMatrix; len.(value)=6; > stopifnot(m2[1,4] == -200, + as.vector(m2[c(1,3), c(5:6,2)]) == 1:6) M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > mt[,3] <- 30 .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=dgTMatrix; len.(value)=1; missing (i,j) = (1,0) > mt[2:3,] <- 250 .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=dgTMatrix; len.(value)=1; missing (i,j) = (0,1) > mt[1:5 %% 2 == 1, 3] <- 0 .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=dgTMatrix; len.(value)=1; > mt[3:1, 1:7 > 5] <- 0 .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=dgTMatrix; len.(value)=1; > mt 5 x 7 sparse Matrix of class "dgTMatrix" c1 c2 c3 c4 c5 c6 c7 r1 . . . -99 . . . r2 250 250 250 250 250 . . r3 250 250 . 250 250 . . r4 . . 30 . . . . r5 . 45 . . . . . > > tt <- as(mt,"matrix") > ii <- c(0,2,5) > jj <- c(2:3,5) > tt[ii, jj] <- 1:6 # 0 is just "dropped" > mt[ii, jj] <- 1:6 .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=dgTMatrix; len.(value)=6; > assert.EQ.mat(mt, tt) > > mt[1:5, 2:6] M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 5 x 5 sparse Matrix of class "dgTMatrix" c2 c3 c4 c5 c6 r1 . . -99 . . r2 1 3 250 5 . r3 250 . 250 250 . r4 . 30 . . . r5 2 4 . 6 . > as((mt0 - mt)[1:5,], "dsparseMatrix")# [1,5] and lines 2:3 M[i,m,m] : nargs()=3 Csp[i,m,l] : nargs()=4 5 x 7 sparse Matrix of class "dgCMatrix" c1 c2 c3 c4 c5 c6 c7 r1 . . . 220 . . 241 r2 -250 41 -3 -250 -5 202 . r3 -247 -250 . -250 -250 . 243 r4 . . -30 . . . . r5 . 43 -4 . -6 . . > > mt[c(2,4), ] <- 0; stopifnot(as(mt[c(2,4), ],"matrix") == 0) .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=dgTMatrix; len.(value)=1; missing (i,j) = (0,1) M[i,m,m] : nargs()=3 Tsp[i,m,l]: nargs()=4 Csp[i,m,l] : nargs()=4 > mt[2:3, 4:7] <- 33 .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=dgTMatrix; len.(value)=1; > checkMatrix(mt) M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 Csp[m,i,l] : nargs()=4 Compare -- "dgCMatrix" != "dgCMatrix" : norm(m [5 x 7]) : 1 I F M ok Summary: ok as(., "nMatrix") giving full nonzero-pattern: ok 2*m =?= m+m: ok m >= m for all: ok m < m for none: Compare -- "dgCMatrix" < "dgCMatrix" : ok > mt 5 x 7 sparse Matrix of class "dgTMatrix" c1 c2 c3 c4 c5 c6 c7 r1 . . . -99 . . . r2 . . . 33 33 33 33 r3 250 250 . 33 33 33 33 r4 . . . . . . . r5 . 2 4 . 6 . . > > mc[1,4] <- -99 ; stopifnot(mc[1,4] == -99) replCmat[x,i,j,.., val] : nargs()=4; M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > mc[1,4] <- 00 ; stopifnot(mc[1,4] == 00) replCmat[x,i,j,.., val] : nargs()=4; M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > mc[1,4] <- -99 ; stopifnot(mc[1,4] == -99) replCmat[x,i,j,.., val] : nargs()=4; M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > mc[1:2,4:3] <- 4:1; stopifnot(.asmatrix(mc[1:2,4:3]) == 4:1) replCmat[x,i,j,.., val] : nargs()=4; M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > > mc[-1, 3] <- -2:1 # 0 should not be entered; 'value' recycled replCmat[x,i,j,.., val] : nargs()=4; > mt[-1, 3] <- -2:1 .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=dgTMatrix; len.(value)=4; > stopifnot(mc@x != 0, mt@x != 0, + mc[-1,3] == -2:1, mt[-1,3] == -2:1) ## failed earlier M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 M[i,i,m] : nargs()=3 Csp[i,i,l] : nargs()=4 > > mc0 <- mc > mt0 <- as(mc0, "TsparseMatrix") > m0 <- as(mc0, "matrix") > set.seed(1); options(Matrix.verbose = FALSE) > for(i in 1:(if(doExtras) 50 else 4)) { + mc <- mc0; mt <- mt0 ; m <- m0 + ev <- 1:5 %% 2 == round(runif(1))# 0 or 1 + j <- sample(ncol(mc), 1 + round(runif(1))) + nv <- rpois(sum(ev) * length(j), lambda = 1) + mc[ev, j] <- nv + m[ev, j] <- nv + mt[ev, j] <- nv + if(i %% 10 == 1) print(mc[ev,j, drop = FALSE]) + stopifnot(as.vector(mc[ev, j]) == nv, ## failed earlier... + as.vector(mt[ev, j]) == nv) + validObject(mc) ; assert.EQ.mat(mc, m) + validObject(mt) ; assert.EQ.mat(mt, m) + } 2 x 1 sparse Matrix of class "dgCMatrix" c5 r2 2 r4 . > showProc.time() Time (user system elapsed): 0.168 0.001 0.17 > options(Matrix.verbose = TRUE) > > mc # no longer has non-structural zeros 5 x 7 sparse Matrix of class "dgCMatrix" c1 c2 c3 c4 c5 c6 c7 r1 . . 2 4 . . 241 r2 . 42 . 3 . 202 . r3 3 . -1 . . . 243 r4 . . 1 . . . . r5 . 45 1 . . . . > mc[ii, jj] <- 1:6 > mc[c(2,5), c(3,5)] <- 3.2 > checkMatrix(mc) norm(m [5 x 7]) : 1 I F M ok Summary: ok as(., "nMatrix") giving full nonzero-pattern: ok 2*m =?= m+m: identical m >= m for all: ok m < m for none: ok > m. <- mc > mc[4,] <- 0 > mc 5 x 7 sparse Matrix of class "dgCMatrix" c1 c2 c3 c4 c5 c6 c7 r1 . . 2.0 4 . . 241 r2 . 1 3.2 3 3.2 202 . r3 3 . -1.0 . . . 243 r4 . . . . . . . r5 . 2 3.2 . 3.2 . . > > S <- as(Diagonal(5),"TsparseMatrix") > H <- Hilbert(9) > Hc <- as(round(H, 3), "dsCMatrix")# a sparse matrix with no 0 ... > (trH <- tril(Hc[1:5, 1:5])) 5 x 5 sparse Matrix of class "dtCMatrix" [1,] 1.000 . . . . [2,] 0.500 0.333 . . . [3,] 0.333 0.250 0.200 . . [4,] 0.250 0.200 0.167 0.143 . [5,] 0.200 0.167 0.143 0.125 0.111 > stopifnot(is(trH, "triangularMatrix"), trH@uplo == "L", + is(S, "triangularMatrix")) > > ## triangular assignment > ## the slick (but inefficient in case of sparse!) way to assign sub-diagonals: > ## equivalent to tmp <- `diag<-`(S[,-1], -2:1); S[,-1] <- tmp > ## which dispatches to (x="TsparseMatrix", i="missing",j="index", value="replValue") > diag(S[,-1]) <- -2:1 # used to give a wrong warning M[i,j] <- v : coercing symmetric M[] into non-symmetric > S <- as(S,"triangularMatrix") > assert.EQ.mat(S, local({s <- diag(5); diag(s[,-1]) <- -2:1; s})) > > trH[c(1:2,4), c(2:3,5)] <- 0 # gave an *error* upto Jan.2008 > trH[ lower.tri(trH) ] <- 0 # ditto, because of callNextMethod() diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) 'sub-optimal sparse 'x[i] <- v' assignment: Coercing class dtTMatrix to dgTMatrix > > m <- Matrix(0+1:28, nrow = 4) > m[-3,c(2,4:5,7)] <- m[ 3, 1:4] <- m[1:3, 6] <- 0 > mT <- as(m, "dgTMatrix") > stopifnot(identical(mT[lower.tri(mT)], + m [lower.tri(m) ])) [ ] : .M.sub.i.logical() maybe inefficient > lM <- upper.tri(mT, diag=TRUE) > mT[lM] <- 0 diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) > m[lM] <- 0 > assert.EQ.mat(mT, as(m,"matrix")) > mT[lM] <- -1:0 diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) > m[lM] <- -1:0 > assert.EQ.mat(mT, as(m,"matrix")) > (mT <- drop0(mT)) 4 x 7 sparse Matrix of class "dgCMatrix" [1,] -1 . . -1 -1 -1 -1 [2,] 2 -1 -1 . . . . [3,] . . . -1 -1 -1 -1 [4,] 4 . 12 . . . . > > i <- c(1:2, 4, 6:7); j <- c(2:4,6) > H[i,j] <- 0 > (H. <- round(as(H, "sparseMatrix"), 3)[ , 2:7]) 9 x 6 sparse Matrix of class "dgCMatrix" [1,] . . . 0.200 . 0.143 [2,] . . . 0.167 . 0.125 [3,] 0.250 0.200 0.167 0.143 0.125 0.111 [4,] . . . 0.125 . 0.100 [5,] 0.167 0.143 0.125 0.111 0.100 0.091 [6,] . . . 0.100 . 0.083 [7,] . . . 0.091 . 0.077 [8,] 0.111 0.100 0.091 0.083 0.077 0.071 [9,] 0.100 0.091 0.083 0.077 0.071 0.067 > Hc. <- Hc > Hc.[i,j] <- 0 ## now "works", but setting "non-structural" 0s > stopifnot(.asmatrix(Hc.[i,j]) == 0) > Hc.[, 1:6] 9 x 6 sparse Matrix of class "dgCMatrix" [1,] 1.000 . . . 0.200 . [2,] 0.500 . . . 0.167 . [3,] 0.333 0.250 0.200 0.167 0.143 0.125 [4,] 0.250 . . . 0.125 . [5,] 0.200 0.167 0.143 0.125 0.111 0.100 [6,] 0.167 . . . 0.100 . [7,] 0.143 . . . 0.091 . [8,] 0.125 0.111 0.100 0.091 0.083 0.077 [9,] 0.111 0.100 0.091 0.083 0.077 0.071 > > ## an example that failed for a long time > sy3 <- new("dsyMatrix", Dim = as.integer(c(2, 2)), x = c(14, -1, 2, -7)) > checkMatrix(dm <- kronecker(Diagonal(2), sy3))# now sparse with new kronecker Note: method with signature 'sparseMatrix#ANY' chosen for function 'kronecker', target signature 'dtTMatrix#dsyMatrix'. "ANY#Matrix" would also be valid norm(m [4 x 4]) : 1 I F M ok Summary: ok as(., "nMatrix") giving full nonzero-pattern: ok 2*m =?= m+m: ok m >= m for all: ok m < m for none: ok symmpart(m) + skewpart(m) == m: ok; determinant(): ok > dm <- Matrix(.asmatrix(dm))# -> "dsyMatrix" > (s2 <- as(dm, "sparseMatrix")) 4 x 4 sparse Matrix of class "dsCMatrix" [1,] 14 2 . . [2,] 2 -7 . . [3,] . . 14 2 [4,] . . 2 -7 > checkMatrix(st <- as(s2, "TsparseMatrix")) norm(m [4 x 4]) : 1 I F M ok Summary: ok as(., "nMatrix") giving full nonzero-pattern: ok 2*m =?= m+m: suboptimal 'Arith' implementation of 'dsC* o dsC*' identical m >= m for all: ok m < m for none: ok symmpart(m) + skewpart(m) == m: suboptimal 'Arith' implementation of 'dsC* o dsC*' ok; determinant(): ok > stopifnot(is(s2, "symmetricMatrix"), + is(st, "symmetricMatrix")) > checkMatrix(s.32 <- st[1:3,1:2]) ## 3 x 2 - and *not* dsTMatrix norm(m [3 x 2]) : 1 I F M ok Summary: ok as(., "nMatrix") giving full nonzero-pattern: ok 2*m =?= m+m: ok m >= m for all: ok m < m for none: ok > checkMatrix(s2.32 <- s2[1:3,1:2]) norm(m [3 x 2]) : 1 I F M ok Summary: ok as(., "nMatrix") giving full nonzero-pattern: ok 2*m =?= m+m: identical m >= m for all: ok m < m for none: ok > I <- c(1,4:3) > stopifnot(is(s2.32, "generalMatrix"), + is(s.32, "generalMatrix"), + identical(as.mat(s.32), as.mat(s2.32)), + identical3(dm[1:3,-1], asD(s2[1:3,-1]), asD(st[1:3,-1])), + identical4(2, dm[4,3], s2[4,3], st[4,3]), + identical3(diag(dm), diag(s2), diag(st)), + is((cI <- s2[I,I]), "dsCMatrix"), + is((tI <- st[I,I]), "dsTMatrix"), + identical4(as.mat(dm)[I,I], as.mat(dm[I,I]), as.mat(tI), as.mat(cI)) + ) > > ## now sub-assign and check for consistency > ## symmetric subassign should keep symmetry > st[I,I] <- 0; checkMatrix(st); stopifnot(is(st,"symmetricMatrix")) norm(m [4 x 4]) : 1 I F M ok Summary: ok as(., "nMatrix") giving full nonzero-pattern: ok 2*m =?= m+m: suboptimal 'Arith' implementation of 'dsC* o dsC*' identical m >= m for all: ok m < m for none: ok symmpart(m) + skewpart(m) == m: suboptimal 'Arith' implementation of 'dsC* o dsC*' ok; determinant(): ok > s2[I,I] <- 0; checkMatrix(s2); stopifnot(is(s2,"symmetricMatrix")) norm(m [4 x 4]) : 1 I F M ok Summary: ok as(., "nMatrix") giving full nonzero-pattern: ok 2*m =?= m+m: suboptimal 'Arith' implementation of 'dsC* o dsC*' identical m >= m for all: ok m < m for none: ok symmpart(m) + skewpart(m) == m: suboptimal 'Arith' implementation of 'dsC* o dsC*' ok; determinant(): ok > ## > m <- as.mat(st) > m[2:1,2:1] <- 4:1 > st[2:1,2:1] <- 4:1 M[i,j] <- v : coercing symmetric M[] into non-symmetric > s2[2:1,2:1] <- 4:1 > stopifnot(identical(m, as.mat(st)), + 1:4 == as.vector(s2[1:2,1:2]), + identical(m, as.mat(s2))) > > ## now a slightly different situation for 's2' (had bug) > s2 <- as(dm, "sparseMatrix") > s2[I,I] <- 0; diag(s2)[2:3] <- -(1:2) > stopifnot(is(s2,"symmetricMatrix"), diag(s2) == c(0:-2,0)) > t2 <- as(s2, "TsparseMatrix") > m <- as.mat(s2) > s2[2:1,2:1] <- 4:1 > t2[2:1,2:1] <- 4:1 M[i,j] <- v : coercing symmetric M[] into non-symmetric > m[2:1,2:1] <- 4:1 > assert.EQ.mat(t2, m) > assert.EQ.mat(s2, m) > ## and the same (for a different s2 !) > s2[2:1,2:1] <- 4:1 > t2[2:1,2:1] <- 4:1 > assert.EQ.mat(t2, m)# ok > assert.EQ.mat(s2, m)# failed in 0.9975-8 > showProc.time() Time (user system elapsed): 0.443 0.001 0.444 > > ## sub-assign RsparseMatrix -- Matrix bug [#6709] by David Cortes > ## https://r-forge.r-project.org/tracker/?func=detail&atid=294&aid=6709&group_id=61 > ## simplified by MM > X <- new("dgCMatrix", i = c(0L,3L), p = c(0L,2L,2L,2L), x = c(100, -20), Dim = c(12L,3L)) > R <- as(X, "RsparseMatrix") > T <- as(R, "TsparseMatrix") > T[, 2] <- 22 # works fine > R[, 2] <- 22 # failed, as it called replTmat() giving narg() == 3 > ## now R is Tsparse (as documented on ../man/RsparseMatrix-class.Rd), > identical(R, T) ## but as this may change, rather R & T should have the same *content* [1] TRUE > assert.EQ.Mat(R, T) > > > ## m[cbind(i,j)] <- value: (2-column matrix subassignment): ------------------------- > m.[ cbind(3:5, 1:3) ] <- 1:3 > stopifnot(m.[3,1] == 1, m.[4,2] == 2) > nt. <- nt ; nt[rbind(2:3, 3:4, c(3,3))] <- FALSE > s. <- m. ; m.[cbind(3,4:6)] <- 0 ## assigning 0 where there *is* 0 .. > stopifnot(identical(nt.,nt), ## should not have changed + identical(s., m.)) > x.x[ cbind(2:6, 2:6)] <- 12:16 > stopifnot(isValid(x.x, "dsCMatrix"), + 12:16 == as.mat(x.x)[cbind(2:6, 2:6)]) > (ne1 <- (mc - m.) != 0) 5 x 7 sparse Matrix of class "lgCMatrix" c1 c2 c3 c4 c5 c6 c7 r1 . . : : . . : r2 . : : : : : . r3 | . : . . . : r4 . | | . . . . r5 . : | . : . . > stopifnot(identical(ne1, 0 != abs(mc - m.))) > (ge <- m. >= mc) # contains "=" -> result is dense 5 x 7 Matrix of class "lgeMatrix" c1 c2 c3 c4 c5 c6 c7 r1 TRUE TRUE TRUE TRUE TRUE TRUE TRUE r2 TRUE TRUE TRUE TRUE TRUE TRUE TRUE r3 FALSE TRUE TRUE TRUE TRUE TRUE TRUE r4 TRUE TRUE TRUE TRUE TRUE TRUE TRUE r5 TRUE TRUE FALSE TRUE TRUE TRUE TRUE > ne. <- mc != m. # was wrong (+ warning) > stopifnot(identical(!(m. < mc), m. >= mc), + identical(m. < mc, as(!ge, "sparseMatrix")), + identical(ne., drop0(ne1))) > > d6 <- Diagonal(6) > ii <- c(1:2, 4:5) > d6[cbind(ii,ii)] <- 7*ii > stopifnot(is(d6, "ddiMatrix"), identical(d6, Diagonal(x=c(7*1:2,1,7*4:5,1)))) > > sclass <- function(obj) as.vector(class(obj)) # as.v*(): drop attr(*,"package") > show2cls <- function(C,D, chr = "") + cat(sprintf("%s & %s%s: %s %s\n", + deparse(substitute(C)), deparse(substitute(D)), chr, + sclass(C), sclass(D))) > for(j in 2:6) { ## even and odd j used to behave differently + cat("j = ", j, ":\n-------\n") + M <- Matrix(0, j,j); m <- matrix(0, j,j) + T <- as(M, "TsparseMatrix") + TG <- as(T, "generalMatrix") + G <- as(M, "generalMatrix"); show2cls(TG, G) + stopifnot(is(TG, "TsparseMatrix"), + is(G, "CsparseMatrix")) + id <- cbind(1:j,1:j) + i2 <- cbind(1:j,j:1) + m[id] <- 1:j + M[id] <- 1:j + T[id] <- 1:j ; show2cls(M, T,' ("diag")') + stopifnot(is(M, "diagonalMatrix"), # since 2019-07 // FIXME (?!) for j=1 + is(T,"triangularMatrix"), isDiagonal(T)) # was "symmetricMatrix" + G[id] <- 1:j + TG[id]<- 1:j + m[i2] <- 10 + M[i2] <- 10 + T[i2] <- 10 ; show2cls(M, T,' ("symm")') + G[i2] <- 10 + TG[i2]<- 10 + ## + assert.EQ.mat(M, m) + assert.EQ.mat(T, m) + assert.EQ.mat(G, m) + assert.EQ.mat(TG,m) + } j = 2 : ------- TG & G: dgTMatrix dgCMatrix M & T ("diag"): ddiMatrix dtTMatrix M[ij] <- v : coercing symmetric M[] into non-symmetric M[ij] <- v : coercing symmetric M[] into non-symmetric M & T ("symm"): dgTMatrix dgTMatrix j = 3 : ------- TG & G: dgTMatrix dgCMatrix M & T ("diag"): ddiMatrix dtTMatrix M[ij] <- v : coercing symmetric M[] into non-symmetric M[ij] <- v : coercing symmetric M[] into non-symmetric M & T ("symm"): dgTMatrix dgTMatrix j = 4 : ------- TG & G: dgTMatrix dgCMatrix M & T ("diag"): ddiMatrix dtTMatrix M[ij] <- v : coercing symmetric M[] into non-symmetric M[ij] <- v : coercing symmetric M[] into non-symmetric M & T ("symm"): dgTMatrix dgTMatrix j = 5 : ------- TG & G: dgTMatrix dgCMatrix M & T ("diag"): ddiMatrix dtTMatrix M[ij] <- v : coercing symmetric M[] into non-symmetric M[ij] <- v : coercing symmetric M[] into non-symmetric M & T ("symm"): dgTMatrix dgTMatrix j = 6 : ------- TG & G: dgTMatrix dgCMatrix M & T ("diag"): ddiMatrix dtTMatrix M[ij] <- v : coercing symmetric M[] into non-symmetric M[ij] <- v : coercing symmetric M[] into non-symmetric M & T ("symm"): dgTMatrix dgTMatrix > > > ## drop, triangular, ... > (M3 <- Matrix(upper.tri(matrix(, 3, 3)))) # ltC; indexing used to fail 3 x 3 sparse Matrix of class "ltCMatrix" [1,] . | | [2,] . . | [3,] . . . > T3 <- as(M3, "TsparseMatrix") > stopifnot(identical(drop(M3), M3), + identical4(drop(M3[,2, drop = FALSE]), M3[,2, drop = TRUE], + drop(T3[,2, drop = FALSE]), T3[,2, drop = TRUE]), + is(T3, "triangularMatrix"), + !is(T3[,2, drop=FALSE], "triangularMatrix") + ) > > (T6 <- as(as(kronecker(Matrix(c(0,0,1,0),2,2), t(T3)), "lMatrix"), + "triangularMatrix")) 6 x 6 sparse Matrix of class "ltTMatrix" [1,] . . . . . . [2,] . . . | . . [3,] . . . | | . [4,] . . . . . . [5,] . . . . . . [6,] . . . . . . > T6[1:4, -(1:3)] # failed (trying to coerce back to ltTMatrix) 4 x 3 sparse Matrix of class "lgTMatrix" [1,] . . . [2,] | . . [3,] | | . [4,] . . . > stopifnot(identical(T6[1:4, -(1:3)][2:3, -3], + spMatrix(2,2, i=c(1,2,2), j=c(1,1,2), x=rep(TRUE,3)))) > > M <- Diagonal(4); M[1,2] <- 2 > M. <- as(M, "CsparseMatrix") > (R <- as(M., "RsparseMatrix")) 4 x 4 sparse Matrix of class "dtRMatrix" (unitriangular) [1,] I 2 . . [2,] . I . . [3,] . . I . [4,] . . . I > (Ms <- symmpart(M.)) 4 x 4 sparse Matrix of class "dsCMatrix" [1,] 1 1 . . [2,] 1 1 . . [3,] . . 1 . [4,] . . . 1 > Rs <- as(Ms, "RsparseMatrix") > stopifnot(isValid(M, "triangularMatrix"), + isValid(M.,"triangularMatrix"), + isValid(Ms, "dsCMatrix"), + isValid(R, "dtRMatrix"), + isValid(Rs, "dsRMatrix") ) > stopifnot(dim(M[2:3, FALSE]) == c(2,0), + dim(R[2:3, FALSE]) == c(2,0), + identical(M [2:3,TRUE], M [2:3,]), + identical(M.[2:3,TRUE], M.[2:3,]), + identical(R [2:3,TRUE], R [2:3,]), + dim(R[FALSE, FALSE]) == c(0,0)) > > n <- 50000L > Lrg <- new("dgTMatrix", Dim = c(n,n)) > diag(Lrg) <- 1:n > dLrg <- as(Lrg, "diagonalMatrix") > stopifnot(identical(Diagonal(x = 1:n), dLrg)) > diag(dLrg) <- 1 + diag(dLrg) > Clrg <- as(Lrg,"CsparseMatrix") > Ctrg <- as(Clrg, "triangularMatrix") > diag(Ctrg) <- 1 + diag(Ctrg) > stopifnot(identical(Diagonal(x = 1+ 1:n), dLrg), + identical(Ctrg, as(dLrg,"CsparseMatrix"))) > > cc <- capture.output(show(dLrg))# show() used to error for large n > showProc.time() Time (user system elapsed): 0.308 0.009 0.318 > > ## FIXME: "dspMatrix" (symmetric *packed*) not going via "matrix" > > > ## Large Matrix indexing / subassignment > ## ------------------------------------- (from ex. by Imran Rashid) > n <- 7000000 > m <- 100000 > nnz <- 20000 > op <- options(Matrix.verbose = 2, warn = 1) > > set.seed(12) > f <- sparseMatrix(i = sample(n, size=nnz, replace=TRUE), + j = sample(m, size=nnz, replace=TRUE)) > str(f) Formal class 'ngCMatrix' [package "Matrix"] with 5 slots ..@ i : int [1:20000] 6692226 4657233 4490801 3688935 344371 6380246 2797160 3584813 6553304 2327896 ... ..@ p : int [1:99993] 0 1 1 1 1 1 1 1 1 1 ... ..@ Dim : int [1:2] 6999863 99992 ..@ Dimnames:List of 2 .. ..$ : NULL .. ..$ : NULL ..@ factors : list() > dim(f) # 6999863 x 99992 [1] 6999863 99992 > prod(dim(f)) # 699930301096 == 699'930'301'096 (~ 700'000 millions) [1] 699930301096 > str(thisCol <- f[,5000])# logi [~ 7 mio....] M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 logi [1:6999863] FALSE FALSE FALSE FALSE FALSE FALSE ... > sv <- as(thisCol, "sparseVector") > str(sv) ## "empty" ! Formal class 'lsparseVector' [package "Matrix"] with 3 slots ..@ x : logi(0) ..@ length: int 6999863 ..@ i : int(0) > validObject(spCol <- f[,5000, drop=FALSE]) # "empty" [n x 1] ngCmatrix Csp[m,i,l] : nargs()=4 [1] TRUE > ## > ## *not* identical(): as(spCol, "sparseVector")@length is "double"prec: > stopifnot(all.equal(as(spCol, "sparseVector"), + as(sv, "nsparseVector"), tolerance=0)) > if(interactive()) + selectMethod("[<-", c("ngCMatrix", "missing","numeric", "logical")) > # -> replCmat() in ../R/Csparse.R > f[,5762] <- thisCol # now "fine" and fast thanks to replCmat() --> replCmat4() replCmat[x,i,j,.., val] : nargs()=4; missing (i,j) = (1,0) > > fx <- sparseMatrix(i = sample(n, size=nnz, replace=TRUE), + j = sample(m, size=nnz, replace=TRUE), + x = round(10*rnorm(nnz))) > class(fx)## dgCMatrix [1] "dgCMatrix" attr(,"package") [1] "Matrix" > fx[,6000] <- (tC <- rep(thisCol, length=nrow(fx)))# fine replCmat[x,i,j,.., val] : nargs()=4; missing (i,j) = (1,0) > thCol <- fx[,2000] M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 > fx[,5762] <- thCol# fine replCmat[x,i,j,.., val] : nargs()=4; missing (i,j) = (1,0) > stopifnot(is(f, "ngCMatrix"), is(fx, "dgCMatrix"), + identical(thisCol, f[,5762]),# perfect + identical(as.logical(fx[,6000]), tC), + identical(thCol, fx[,5762])) M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 M[m,i,m] : nargs()=3 Csp[m,i,l] : nargs()=4 > > showProc.time() Time (user system elapsed): 1.242 0.222 1.467 > options(op)# revert > ## > if(doExtras) {#----------------------------------------------------------------- + cat("checkMatrix() of all: \n---------\n") + Sys.setlocale("LC_COLLATE", "C")# to keep ls() reproducible + for(nm in ls()) if(is(.m <- get(nm), "Matrix")) { + cat(nm, "\n") + checkMatrix(.m, verbose = FALSE + , doDet = nm != "As" ## <- "As" almost singular <=> det() "ill posed" + ) + } + showProc.time() + }#--------------end if(doExtras) ----------------------------------------------- > > ## Bugs found by Peter Ralph > n <- 17 > x <- Matrix(0, n,n) > ## x must have at least three nonzero entries > x[1,1] <- x[2,1:2] <- 1. > x0 <- x <- as(x,"dgTMatrix") # if x is dgCMatrix, no error > ## > z <- matrix(x) # <== not the "Matrix way": a (n, 1) matrix > z[1] <- 0 > > x[1:n, 1:n] <- as(z, "sparseVector") > ## gave Error: ... invalid subscript type 'S4' > x2 <- x > > dim(zC <- as(z, "dgCMatrix")) [1] 289 1 > x <- x0 > x[] <- zC # did fail, then gave warning. Note: method with signature 'sparseMatrix#missing#missing#ANY' chosen for function '[<-', target signature 'dgTMatrix#missing#missing#dgCMatrix'. "sparseMatrix#missing#ANY#sparseMatrix", "sparseMatrix#ANY#missing#sparseMatrix" would also be valid diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) > x1 <- x > ## > x <- x0 > x[] <- as(zC, "sparseVector") # did fail, too diagnosing replTmat(x,i,j,v): nargs()= 3; missing (i,j) = (0,1) > x2 <- x > stopifnot(identical(x1,x2)) > x <- as(x0, "matrix") > x[] <- z > assert.EQ.mat(x1, x) > > i <- 4:7 > x1 <- x0; x1[cbind(i, i+10)] <- i^2 > x2 <- x0; x2[cbind(i, i+10)] <- .asmatrix(i^2) > ## failed: nargs() = 4 ... please report > > stopifnot(isValid(x1, "dgTMatrix"), identical(x1, x2)) > showProc.time() Time (user system elapsed): 0.033 0 0.033 > > > ## check valid indexing (using *random* indices, often duplicated): > chk_dsp_ind <- function(sv, n=512, negI = FALSE, verbose=FALSE) { + stopifnot(inherits(sv, "dsparseVector"), n >= 1) + d <- length(sv) + ## lambda=2 ==> aiming for short 'i' {easier to work with} + P <- rpois(n, lambda = if(negI) 5 else 2) + for(i in seq_len(n)) { + I <- + if(negI) { # negative indices: 2 are, 4 neither ... always "valid" !! + k <- max(4L, d - max(1L, P[i])) + if(verbose) cat(sprintf("size=k = %2d: ", k)) + - sort(sample.int(d, size=k))# replace=FALSE + } + else + sample.int(d, size=1L+P[i], replace=TRUE) + ## + validObject(ss <- sv[I]) # Error if not true + } + invisible() + } > s <- as(c(3,5,6), "sparseVector") > set.seed(11); chk_dsp_ind(s) > set.seed(3) > (s2 <- as(rsparsematrix(ncol=1, nrow=37, density=1/4),"sparseVector")) sparse vector (nnz/length = 9/37) of class "dsparseVector" [1] . . . -2.200 . . 0.330 . -1.300 . [11] . 0.950 . 0.140 . . 0.810 . . 0.540 [21] . . . . . . . . . 0.013 [31] . . -0.580 . . . . > (s3 <- as(rsparsematrix(ncol=1, nrow=64, density=1/4),"sparseVector")) sparse vector (nnz/length = 16/64) of class "dsparseVector" [1] . . . . . . . . 1.80 . 2.50 . [13] . . -0.76 . . . -0.58 . . . -0.80 0.84 [25] . . 1.30 . . . -0.51 . . . . -0.62 [37] . . . 0.71 . . . . . . -1.30 . [49] -1.60 . . . . 0.10 . . -1.30 . 0.18 . [61] . . . -1.30 > set.seed(1) > chk_dsp_ind(s2) > chk_dsp_ind(s3) > ## > set.seed(47) > ## system.time(e.N2 <- chk_dsp_ind(s2, negI=TRUE, verbose=TRUE)) > chk_dsp_ind(s2, negI=TRUE) > chk_dsp_ind(s3, negI=TRUE) > > iv <- c(rep(0,100), 3, 0,0,7,0,0,0) > sv0 <- sv <- as(iv, "sparseVector") > sv.0 <- sv. <- as(as.integer(iv), "sparseVector") > stopifnot(canCoerce("integer", "sparseVector")) > sv2 <- as(sv, "isparseVector") > stopifnot(validObject(sv), validObject(sv2), identical(sv., sv2), + sv == sv.) > n0 <- sv. != 0 # -> is "lsparseV.." > if(FALSE) + debug(Matrix:::replSPvec) ## --> ../R/sparseVector.R : replSPvec() > ## > sv [n0] <- sv [n0] > sv.[n0] <- sv.[n0] # gave error > stopifnot(identical(sv , sv0), + identical(sv., sv.0)) > sv [3:7] <- 0 > sv.[3:7] <- 0L > stopifnot(identical(sv , sv0), identical(sv., sv.0)) > sv [2:4] <- 2:4 > sv.[2:4] <- 2:4 > stopifnot(which(sv != 0) == (which(sv. != 0) -> in0), + in0 == c(2:4, 101L, 104L)) > sv [2:6] <- 0L > sv.[2:6] <- 0L > stopifnot(identical(sv , sv0), identical(sv., sv.0)) > > ## the next six *all* gave an error -- but should be no-op's: > for(vv in list(sv, sv.0)) + for(ind in list(0, FALSE, logical(length(vv)))) + vv[ind] <- NA > stopifnot(identical(sv , sv0), identical(sv., sv.0)) > > ## [i] <- val -- failed to resort @i sometimes: (R-forge Matrix bug #6659) > y1 <- sparseVector(1:3, 13:15, 16) > y2 <- sparseVector(1:6, c(5, 6, 7, 9, 14, 15), 16) > i <- 1:16*12 # 12 24 36 ... 192 > x <- sparseVector(numeric(1), 1, length=200) > x[i] <- y1 ; validObject(x[i]) # TRUE [1] TRUE > N <- x[i] + y2 ; validObject( N ) # TRUE [1] TRUE > x[i] <- N ## <== bug was here .. > validObject(x) [1] TRUE > ## gave 'Error' invalid ..“dsparseVector”.. 'i' must be sorted strictly increasingly > stopifnot(all.equal(x[i] , y1+y2, tolerance=0), + x[i] == y1+y2) > showProc.time() Time (user system elapsed): 0.688 0.001 0.691 > > if(!interactive()) warnings() > > ## [matrix-Bugs][#6720] Subsetting with empty indices does not drop -- 17 Apr 2021, by David Cortes > ## https://r-forge.r-project.org/tracker/?func=detail&atid=294&aid=6720&group_id=61 > > ## extended by MM to all versions of "empty" : > x <- c(1,8) > (m1 <- rbind(x)) [,1] [,2] x 1 8 > m1[] # remains matrix [,1] [,2] x 1 8 > m1[,,drop=FALSE] # ditto [,1] [,2] x 1 8 > m1[,] # [1] 1 2 -- drops (as default drop=TRUE !) [1] 1 8 > > ## Sparse Matrix and actually *any* Matrix-extending class did not work > (M1 <- as(m1, "denseMatrix")) # "dgeMatrix" 1 x 2 Matrix of class "dgeMatrix" [,1] [,2] x 1 8 > S1 <- as(m1, "CsparseMatrix") > R1 <- as(m1, "RsparseMatrix") > stopifnot(exprs = { + identical(M1[], M1) # remains + identical(S1[], S1) # remains + identical(R1[], R1) # remains + identical(M1[,,drop=FALSE], M1) # ditto + identical(S1[,,drop=FALSE], S1) # " + identical(R1[,,drop=FALSE], R1) # " + ## but drop=TRUE which is the *default* much be obeyed (also for *empty* (i,j): + identical(m1[,], x) + identical(M1[,], x) # should drop, but did not + identical(S1[,], x) # " + identical(R1[,], x) # " + identical(m1[,,drop=TRUE], x) + identical(M1[,,drop=TRUE], x) # should drop, but did not + identical(S1[,,drop=TRUE], x) # " + identical(R1[,,drop=TRUE], x) # " + }) > > > ## [matrix-Bugs][#6721] Assignment to 'dgRMatrix' with missing index takes only first element > ## MM: This has been fixed already! > X <- rbind(0, 1:3, 0, c(0,1,0)) > Rx <- as(X, "RsparseMatrix") > Cx <- as(X, "CsparseMatrix") > X [2,] <- 0 > Cx[2,] <- 0 > Rx[2,] <- 0 > stopifnot(all(Cx == X), + all(Rx == X)) > > ## [matrix-Bugs][#6745] show() > ## NB: is from a bug in head(*); *only* applies to *empty* sparseV: length(x@i) == 0 > op <- options(max.print=999) > ( s0 <- sparseVector(i=integer(), length=2^33)) # show -> head() failed in Matrix <= 1.3-* sparse vector (nnz/length = 0/8589934592) of class "nsparseVector" [1] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [38] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [75] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [112] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [149] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [186] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [223] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [260] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [297] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [334] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [371] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [408] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [445] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [482] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [519] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [556] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [593] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [630] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [667] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [704] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [741] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [778] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [815] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [852] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [889] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [926] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [963] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . ............................ ........suppressing 8589933593 entries in show(); maybe adjust 'options(max.print= *)' ............................ > (xs0 <- sparseVector(i=integer(), length=2^33, x = numeric()))# ditto sparse vector (nnz/length = 0/8589934592) of class "dsparseVector" [1] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [38] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [75] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [112] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [149] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [186] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [223] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [260] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [297] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [334] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [371] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [408] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [445] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [482] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [519] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [556] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [593] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [630] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [667] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [704] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [741] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [778] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [815] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [852] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [889] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [926] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [963] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . ............................ ........suppressing 8589933593 entries in show(); maybe adjust 'options(max.print= *)' ............................ > options(op); tail(s0) ; tail(xs0) # (always worked) sparse vector (nnz/length = 0/6) of class "nsparseVector" [1] . . . . . . sparse vector (nnz/length = 0/6) of class "dsparseVector" [1] . . . . . . > ## *related* bug in `[` --> needed to fix intIv() for such large sparseVectors > stopifnot(exprs = { + identical(s0[length(s0) - 3:0], # gave Error in if (any(i < 0L)) { : missing value .... + new("nsparseVector", i=integer(), length=4L)) + identical(xs0[length(s0) - 3:0], # gave Error .. + new("dsparseVector", i=integer(), length=4L)) + }) > > proc.time() user system elapsed 5.780 0.353 6.241 Matrix/tests/validObj.R0000644000176200001440000001536714040351707014552 0ustar liggesuserslibrary(Matrix) ### Do all kinds of object creation and coercion source(system.file("test-tools.R", package = "Matrix")) ## from ../R/Auxiliaries.R : no_facts <- Matrix:::.drop.factors ## the empty ones: checkMatrix(new("dgeMatrix")) checkMatrix(Matrix(,0,0)) ## "dge" assertError( new("dgeMatrix", Dim = c(2,2), x= 1:4) )# double 'Dim' assertError( new("dgeMatrix", Dim = as.integer(c(2,2)), x= 1:4) )# int 'x' assertError( new("dgeMatrix", Dim = 2:2, x=as.double(1:4)) )# length(Dim) !=2 assertError( new("dgeMatrix", Dim = as.integer(c(2,2)), x= as.double(1:5))) checkMatrix(m1 <- Matrix(1:6, ncol=2)) checkMatrix(m2 <- Matrix(1:7 +0, ncol=3)) # a (desired) warning c("dgeMatrix", "ddenseMatrix", "generalMatrix", "geMatrix", "dMatrix", "denseMatrix", "compMatrix", "Matrix", "xMatrix", "mMatrix") -> m1.cl stopifnot(!anyNA(match(m1.cl, is(m1))), dim(t(m1)) == 2:3, identical(m1, t(t(m1)))) c.nam <- paste("C",1:2, sep='') dimnames(m1) <- list(NULL, c.nam) checkMatrix(m1) # failed in 0.999375-10 checkMatrix(tm1 <- t(m1)) stopifnot(colnames(m1) == c.nam, identical(dimnames(tm1), list(c.nam, NULL)), identical(m1, t(tm1))) ## an example of *named* dimnames (t34N <- as(unclass(table(x = gl(3,4), y=gl(4,3))), "dgeMatrix")) stopifnot(identical(dimnames(t34N), dimnames(as(t34N, "matrix"))), identical(t34N, t(t(t34N)))) ## "dpo" checkMatrix(cm <- crossprod(m1)) checkMatrix(cp <- as(cm, "dppMatrix"))# 'dpp' + factors checkMatrix(cs <- as(cm, "dsyMatrix"))# 'dsy' + factors checkMatrix(dcm <- as(cm, "dgeMatrix"))#'dge' checkMatrix(mcm <- as(cm, "dMatrix")) # 'dsy' + factors -- buglet? rather == cm? checkMatrix(mc. <- as(cm, "Matrix")) # dpo --> dsy -- (as above) FIXME? ?? stopifnot(identical(mc., mcm), identical(no_facts(cm), (2*cm)/2),# remains dpo identical(cm + cp, cp + cs),# dge identical(mc., mcm), all(2*cm == mcm * 2)) checkMatrix(eq <- cm == cs) stopifnot(all(eq@x), identical3(pack(eq), cs == cp, cm == cp), as.logical(!(cs < cp)), identical4(!(cs < cp), !(cp > cs), cp <= cs, cs >= cp)) ## Coercion to 'dpo' should give an error if result would be invalid M <- Matrix(diag(4) - 1) assertError(as(M, "dpoMatrix")) M. <- as(M, "dgeMatrix") M.[1,2] <- 10 # -> not even symmetric anymore assertError(as(M., "dpoMatrix")) ## Cholesky checkMatrix(ch <- chol(cm)) checkMatrix(ch2 <- chol(as(cm, "dsyMatrix"))) checkMatrix(ch3 <- chol(as(cm, "dgeMatrix"))) stopifnot(is.all.equal3(as(ch, "matrix"), as(ch2, "matrix"), as(ch3, "matrix"))) ### Very basic triangular matrix stuff assertError( new("dtrMatrix", Dim = c(2,2), x= 1:4) )# double 'Dim' assertError( new("dtrMatrix", Dim = as.integer(c(2,2)), x= 1:4) )# int 'x' ## This caused a segfault (before revision r1172 in ../src/dtrMatrix.c): assertError( new("dtrMatrix", Dim = 2:2, x=as.double(1:4)) )# length(Dim) !=2 assertError( new("dtrMatrix", Dim = as.integer(c(2,2)), x= as.double(1:5))) tr22 <- new("dtrMatrix", Dim = as.integer(c(2,2)), x=as.double(1:4)) tt22 <- t(tr22) (tPt <- tr22 + tt22) stopifnot(identical(10 * tPt, tPt * 10), as.vector(t.22 <- (tr22 / .5)* .5) == c(1,0,3,4), TRUE) ## not yet: class(t.22) == "dtrMatrix") ## non-square triagonal Matrices --- are forbidden --- assertError(new("dtrMatrix", Dim = 2:3, x=as.double(1:6), uplo="L", diag="U")) n <- 3:3 assertError(new("dtCMatrix", Dim = c(n,n), diag = "U")) validObject(T <- new("dtTMatrix", Dim = c(n,n), diag = "U")) validObject(M <- new("dtCMatrix", Dim = c(n,n), diag = "U", p = rep.int(0:0, n+1))) stopifnot(identical(as.mat(T), diag(n))) suppressWarnings(RNGversion("3.5.0")); set.seed(3) (p9 <- as(sample(9), "pMatrix")) ## Check that the correct error message is triggered: ind.try <- try(p9[1,1] <- 1, silent = TRUE) np9 <- as(p9, "ngTMatrix") stopifnot(grepl("replacing.*sensible", ind.try[1]), is.logical(p9[1,]), is(p9[2,, drop=FALSE], "indMatrix"), is(p9[9:1,], "indMatrix"), isTRUE(p9[-c(1:6, 8:9), 1]), identical(t(p9), solve(p9)), identical(p9[TRUE, ], p9), all.equal(p9[, TRUE], np9), # currently... identical(as(diag(9), "pMatrix"), as(1:9, "pMatrix")) ) assert.EQ.mat(p9[TRUE,], as.matrix(np9)) ## validObject --> Cparse_validate(.) mm <- new("dgCMatrix", Dim = c(3L, 5L), i = c(2L, 0L, 1L, 2L, 0L, 1L), x = c( 2, 1, 1, 2, 1, 2), p = c(0:2, 4L, 4L, 6L)) ## Previously unsorted columns were sorted - now are flagged as invalid m. <- mm ip <- c(1:2, 4:3, 6:5) # permute the 'i' and 'x' slot just "inside column": m.@i <- m.i <- mm@i[ip] m.@x <- m.x <- mm@x[ip] stopifnot(grep("row indices are not", validObject(m., test=TRUE)) == 1) Matrix:::.sortCsparse(m.) # don't use this at home, boys! m. # now is fixed ## Make sure that validObject() objects... ## 1) to wrong 'p' m. <- mm; m.@p[1] <- 1L stopifnot(grep("first element of slot p", validObject(m., test=TRUE)) == 1) m.@p <- mm@p[c(1,3:2,4:6)] stopifnot(grep("^slot p.* non-decreasing", validObject(m., test=TRUE)) == 1) ## 2) to non-strictly increasing i's: m. <- mm ; ix <- c(1:3,3,5:6) m.@i <- mm@i[ix] m.@x <- mm@x[ix] stopifnot(identical(grep("slot i is not.* increasing .*column$", validObject(m., test=TRUE)), 1L)) ## ix <- c(1:3, 3:6) # now the the (i,x) slots are too large (and decreasing at end) ## m.@i <- mm@i[ix] ## m.@x <- mm@x[ix] ## stopifnot(identical(grep("^slot i is not.* increasing .*sort", ## (msg <- validObject(m., test=TRUE))),# seg.fault in the past ## 1L)) ## over-allocation of the i- and x- slot should be allowed: ## (though it does not really help in M[.,.] <- * yet) m. <- mm m.@i <- c(mm@i, NA, NA, NA) m.@x <- c(mm@x, 10:12) validObject(m.) m. # show() now works stopifnot(all(m. == mm), # in spite of length(m.@i) > length(mm@i), identical(t(t(m.)), mm), identical3(m. * m., m. * mm, mm * mm)) m.[1,4] <- 99 ## FIXME: warning and cuts (!) the over-allocated slots ## Low-level construction of invalid object: ## Ensure that it does *NOT* segfault foo <- new("ngCMatrix", i = as.integer(c(12204, 16799, 16799, 33517, 1128, 11930, 1128, 11930, 32183)), p = rep(0:9, c(2,4,1,11,10,0,1,0,9,12)), Dim = c(36952L, 49L)) validObject(foo)# TRUE foo@i[5] <- foo@i[5] + 50000L msg <- validObject(foo, test=TRUE)# is -- correctly -- *not* valid anymore stopifnot(is.character(msg)) ## Error in validObject(foo) : ## invalid class "ngCMatrix" object: all row indices must be between 0 and nrow-1 getLastMsg <- function(tryRes) { ## Extract "final" message from erronous try result sub("\n$", "", sub(".*: ", "", as.character(tryRes))) } t <- try(show(foo)) ## error t2 <- try(head(foo)) stopifnot(identical(msg, getLastMsg(t)), identical(1L, grep("as_cholmod_sparse", getLastMsg(t2)))) cat('Time elapsed: ', proc.time(),'\n') # "stats" if(!interactive()) warnings() Matrix/tests/factorizing.R0000644000176200001440000005537514054451466015352 0ustar liggesusers#### Matrix Factorizations --- of all kinds library(Matrix) source(system.file("test-tools.R", package = "Matrix"))# identical3() etc doExtras (is64bit <- .Machine$sizeof.pointer == 8) ### "sparseQR" : Check consistency of methods ## -------- data(KNex); mm <- KNex$mm; y <- KNex$y stopifnot(is((Y <- Matrix(y)), "dgeMatrix")) md <- as(mm, "matrix") # dense (cS <- system.time(Sq <- qr(mm))) # 0.009 (cD <- system.time(Dq <- qr(md))) # 0.499 (lynne, 2014 f); 1.04 lynne 2019 ????? cD[1] / cS[1] # dense is much ( ~ 100--170 times) slower ## chkQR() in ../inst/test-tools-1.R ; if(doExtras) { ## ~ 20 sec {"large" example} + 2x qr.R() warnings cat("chkQR( ) .. takes time .. ") system.time(chkQR(mm, y=y, a.qr = Sq, verbose=TRUE)) system.time(chkQR(md, y=y, a.qr = Dq, verbose=TRUE)) cat(" done: [Ok]\n") } ## consistency of results dense and sparse ## chk.qr.D.S() and checkQR.DS.both() >>> ../inst/test-tools-Matrix.R chk.qr.D.S(Dq, Sq, y, Y) ## Another small example with pivoting (and column name "mess"): suppressWarnings(RNGversion("3.5.0")); set.seed(1) X <- rsparsematrix(9,5, 1/4, dimnames=list(paste0("r", 1:9), LETTERS[1:5])) qX <- qr(X); qd <- qr(as(X, "matrix")) ## are the same (now, *including* names): assert.EQ(print(qr.coef(qX, 1:9)), qr.coef(qd, 1:9), tol=1e-14) if(FALSE) ## error: (FIXME ?) chk.qr.D.S(d. = qd, s. = qX, y = 1:9) ## rank deficient QR cases: --------------- ## From Simon (15 Jul 2009) + dimnames (11 May 2015) set.seed(10) a <- matrix(round(10 * runif(90)), 10,9, dimnames = list(LETTERS[1:10], paste0("c", 1:9))) a[a < 7.5] <- 0 (A <- Matrix(a))# first column = all zeros qD <- chkQR(a, giveRE=TRUE) ## using base qr qS <- chkQR(A, giveRE=TRUE) ## using Matrix "sparse qr" -- "structurally rank deficient! validObject(qS)# with the validity now (2012-11-18) -- ok, also for "bad" case ## Here, have illegal access Up[-1] in ../src/cs.c try( ## After patch (2016-10-04 - *NOT* committed), this fails ## definitely "fails" (with good singularity message) after c3194 (cs.c): chk.qr.D.S(qD, qS, y = 10 + 1:nrow(A), force=TRUE)# 6 warnings: "structurally rank deficient" ) try( ## NOTE: *Both* checks currently fail here: chkQR(A, Qinv.chk=TRUE, QtQ.chk=TRUE) ) ## Larger Scale random testing oo <- options(Matrix.quiet.qr.R = TRUE, Matrix.verbose = TRUE) set.seed(101) for(N in 1:(if(doExtras) 1008 else 24)) { A <- rsparsematrix(8,5, nnz = rpois(1, lambda=16)) cat(sprintf("%4d -", N)) checkQR.DS.both(A, Qinv.chk= NA, QtQ.chk=NA, ## --- => FALSE if struct. rank deficient giveRE = FALSE, tol = if(is64bit) 2e-13 else 1e-12) } unique(warnings()) ## Look at single "hard" cases: -------------------------------------- ## This is *REALLY* nice and small : A0 <- new("dgCMatrix", Dim = 4:3, i = c(0:3, 3L), p = c(0L, 3:5), x = rep(1,5)) A0 checkQR.DS.both(A0, Qinv.chk = FALSE, QtQ.chk=FALSE) ## ----- *both* still needed : try( checkQR.DS.both(A0, TRUE, FALSE) ) try( checkQR.DS.both(A0, FALSE, TRUE) ) ## and the same when dropping the first row { --> 3 x 3 }: A1 <- A0[-1 ,] checkQR.DS.both(A1, Qinv.chk = FALSE, QtQ.chk=FALSE) ## ----- *both* still needed : try( checkQR.DS.both(A1, TRUE, FALSE) ) try( checkQR.DS.both(A1, FALSE, TRUE) ) qa <- qr(as(A0,"matrix")) qA <- qr(A0) # -> message: ".. Matrix structurally rank deficient" drop0(crossprod( Qd <- qr.Q(qa) ), 1e-15) # perfect = diag( 3 ) drop0(crossprod( Qs <- qr.Q(qA) ), 1e-15) # R[3,3] == 0 -- OOPS! ## OTOH, qr.R() is fine, as checked in the checkQR.DS.both(A0, *) above ## zero-row *and* zero-column : (A2 <- new("dgCMatrix", i = c(0L, 1L, 4L, 7L, 5L, 2L, 4L) , p = c(0L, 3L, 4L, 4L, 5L, 7L) , Dim = c(8L, 5L) , x = c(0.92, 1.06, -1.74, 0.74, 0.19, -0.63, 0.68))) checkQR.DS.both(A2, Qinv.chk = FALSE, QtQ.chk=FALSE) ## ----- *both* still needed : try( checkQR.DS.both(A2, TRUE, FALSE) ) try( checkQR.DS.both(A2, FALSE, TRUE) ) ## Case of *NO* zero-row or zero-column: (A3 <- new("dgCMatrix", Dim = 6:5 , i = c(0L, 2L, 4L, 0L, 1L, 5L, 1L, 3L, 0L) , p = c(0L, 1L, 3L, 6L, 8L, 9L) , x = c(40, -54, -157, -28, 75, 166, 134, 3, -152))) checkQR.DS.both(A3, Qinv.chk = FALSE, QtQ.chk=FALSE) ## ----- *both* still needed : try( checkQR.DS.both(A3, TRUE, FALSE) ) try( checkQR.DS.both(A3, FALSE, TRUE) ) (A4 <- new("dgCMatrix", Dim = c(7L, 5L) , i = c(1:2, 4L, 6L, 1L, 5L, 0:3, 0L, 2:4) , p = c(0L, 4L, 6L, 10L, 10L, 14L) , x = c(9, -8, 1, -9, 1, 10, -1, -2, 6, 14, 10, 2, 12, -9))) checkQR.DS.both(A4, Qinv.chk = FALSE, QtQ.chk=FALSE) ## ----- *both* still needed : try( checkQR.DS.both(A4, TRUE, FALSE) ) try( checkQR.DS.both(A4, FALSE, TRUE) ) (A5 <- new("dgCMatrix", Dim = c(4L, 4L) , i = c(2L, 2L, 0:1, 0L, 2:3), p = c(0:2, 4L, 7L) , x = c(48, 242, 88, 18, -167, -179, 18))) checkQR.DS.both(A5, Qinv.chk = FALSE, QtQ.chk=FALSE) ## ----- *both* still needed : try( checkQR.DS.both(A5, TRUE, FALSE) ) try( checkQR.DS.both(A5, FALSE, TRUE) ) for(N in 1:(if(doExtras) 2^12 else 128)) { A <- round(100*rsparsematrix(5,3, nnz = min(15,rpois(1, lambda=10)))) if(any(apply(A, 2, function(x) all(x == 0)))) ## "column of all 0" next cat(sprintf("%4d -", N)) checkQR.DS.both(A, Qinv.chk=NA, giveRE=FALSE, tol = 1e-12) ## --- => FALSE if struct. rank deficient } unique(warnings()) options(oo) ### "denseLU" ## Testing expansions of factorizations {was ./expand.R, then in simple.R } ## new: [m x n] where m and n may differ x. <- c(2^(0:5),9:1,-3:8, round(sqrt(0:16))) set.seed(1) for(nnn in 1:100) { y <- sample(x., replace=TRUE) m <- sample(2:6, 1) n <- sample(2:7, 1) x <- matrix(seq_len(m*n), m,n) lux <- lu(x)# occasionally a warning about exact singularity xx <- with(expand(lux), (P %*% L %*% U)) print(dim(xx)) assert.EQ.mat(xx, x, tol = 16*.Machine$double.eps) } ### "sparseLU" por1 <- readMM(system.file("external/pores_1.mtx", package = "Matrix")) lu1 <- lu(por1) pm <- as(por1, "CsparseMatrix") (pmLU <- lu(pm)) # -> show() xp <- expand(pmLU) ## permute rows and columns of original matrix ppm <- pm[pmLU@p + 1:1, pmLU@q + 1:1] Ppm <- pmLU@L %*% pmLU@U ## identical only as long as we don't keep the original class info: stopifnot(identical3(lu1, pmLU, pm@factors$LU),# TODO === por1@factors$LU identical(ppm, with(xp, P %*% pm %*% t(Q))), sapply(xp, is, class="Matrix")) Ipm <- solve(pm, sparse=FALSE) Spm <- solve(pm, sparse=TRUE) # is not sparse at all, here assert.EQ.Mat(Ipm, Spm, giveRE=TRUE, tol = 1e-13)# seen 7.36e-15 only on 32-bit stopifnot(abs(as.vector(solve(Diagonal(30, x=10) %*% pm) / Ipm) - 1/10) < 1e-7, abs(as.vector(solve(rep.int(4, 30) * pm) / Ipm) - 1/ 4) < 1e-7) ## these two should be the same, and `are' in some ways: assert.EQ.mat(ppm, as(Ppm, "matrix"), tol = 1e-14, giveRE=TRUE) ## *however* length(ppm@x)# 180 length(Ppm@x)# 317 ! table(Ppm@x == 0)# (194, 123) - has 123 "zero" and 14 ``almost zero" entries ##-- determinant() and det() --- working via LU --- m <- matrix(c(0, NA, 0, NA, NA, 0, 0, 0, 1), 3,3) m0 <- rbind(0,cbind(0,m)) M <- as(m,"Matrix"); M ## "dsCMatrix" ... M0 <- rbind(0, cbind(0, M)) dM <- as(M, "denseMatrix") dM0 <- as(M0,"denseMatrix") try( lum <- lu(M) )# Err: "near-singular A" (lum <- lu(M, errSing=FALSE))# NA --- *BUT* it is not stored in @factors (lum0 <- lu(M0, errSing=FALSE))# NA --- and it is stored in M0@factors[["LU"]] ## "FIXME" - TODO: Consider replNA <- function(x, value) { x[is.na(x)] <- value ; x } (EL.1 <- expand(lu.1 <- lu(M.1 <- replNA(M, -10)))) ## so it's quite clear how lu() of the *singular* matrix M should work ## but it's not supported by the C code in ../src/cs.c which errors out stopifnot(all.equal(M.1, with(EL.1, P %*% L %*% U %*% Q)), is.na(det(M)), is.na(det(dM)), is.na(det(M0)), is.na(det(dM0)) ) ###________ Cholesky() ________ ##-------- LDL' ---- small exact examples set.seed(1) for(n in c(5:12)) { cat("\nn = ",n,"\n-------\n") rr <- mkLDL(n) ## -------- from 'test-tools.R' stopifnot(all(with(rr, A == as(L %*% D %*% t(L), "symmetricMatrix"))), all(with(rr, A == tcrossprod(L %*% sqrt(D))))) d <- rr$d.half A <- rr$A R <- chol(A) assert.EQ.Mat(R, chol(as(A, "TsparseMatrix"))) # gave infinite recursion print(d. <- diag(R)) D. <- Diagonal(x= d.^2) L. <- t(R) %*% Diagonal(x = 1/d.) stopifnot(all.equal(as.matrix(D.), as.matrix(rr$ D)), all.equal(as.matrix(L.), as.matrix(rr$ L))) ## CAp <- Cholesky(A)# perm=TRUE --> Permutation: p <- CAp@perm + 1L P <- as(p, "pMatrix") ## the inverse permutation: invP <- solve(P)@perm lDet <- sum(2* log(d))# the "true" value ldetp <- Matrix:::.diag.dsC(Chx = CAp, res.kind = "sumLog") ldetp. <- sum(log(Matrix:::.diag.dsC(Chx = CAp, res.kind = "diag") )) ## CA <- Cholesky(A,perm=FALSE) ldet <- Matrix:::.diag.dsC(Chx = CA, res.kind = "sumLog") ## not printing CAp : ends up non-integer for n >= 11 mCAp <- as(CAp,"sparseMatrix") print(mCA <- drop0(as(CA, "sparseMatrix"))) stopifnot(identical(A[p,p], as(P %*% A %*% t(P), "symmetricMatrix")), relErr(d.^2, Matrix:::.diag.dsC(Chx= CA, res.kind="diag")) < 1e-14, relErr(A[p,p], tcrossprod(mCAp)) < 1e-14) if(FALSE) rbind(lDet,ldet, ldetp, ldetp.) ## ==> Empirically, I see lDet = ldet != ldetp == ldetp. ## if(rr$rcond.A < ...) warning("condition number of A ..." ## <- TODO cat(1,""); assert.EQ.(lDet, ldet, tol = 1e-14) cat(2,""); assert.EQ.(ldetp, ldetp., tol = 1e-14) cat(3,""); assert.EQ.(lDet, ldetp, tol = n^2* 1e-7)# extreme: have seen 0.0011045 !! }## for() mkCholhash <- function(r.all) { ## r.all %*% (2^(2:0)), but only those that do not have NA / "?" : stopifnot(is.character(rn <- rownames(r.all)), is.matrix(r.all), is.logical(r.all)) c.rn <- vapply(rn, function(ch) strsplit(ch, " ")[[1]], character(3)) ## Now h1 <- function(i) { ok <- c.rn[,i] != "?" r.all[i, ok] %*% 2^((2:0)[ok]) } vapply(seq_len(nrow(r.all)), h1, numeric(1)) } set.seed(17) (rr <- mkLDL(4)) (CA <- Cholesky(rr$A)) stopifnot(all.equal(determinant(rr$A) -> detA, determinant(as(rr$A, "matrix"))), is.all.equal3(c(detA$modulus), log(det(rr$D)), sum(log(rr$D@x)))) A12 <- mkLDL(12, 1/10) (r12 <- allCholesky(A12$A))[-1] aCh.hash <- mkCholhash(r12$r.all) if(FALSE)## if(require("sfsmisc")) split(rownames(r12$r.all), Duplicated(aCh.hash)) ## TODO: find cases for both choices when we leave it to CHOLMOD to choose for(n in 1:50) { ## used to seg.fault at n = 10 ! mkA <- mkLDL(1+rpois(1, 30), 1/10) cat(sprintf("n = %3d, LDL-dim = %d x %d ", n, nrow(mkA$A), ncol(mkA$A))) r <- allCholesky(mkA$A, silentTry=TRUE) ## Compare .. apart from the NAs that happen from (perm=FALSE, super=TRUE) iNA <- apply(is.na(r$r.all), 1, any) cat(sprintf(" -> %3s NAs\n", if(any(iNA)) format(sum(iNA)) else "no")) stopifnot(aCh.hash[!iNA] == mkCholhash(r$r.all[!iNA,])) ## cat("--------\n") } ## This is a relatively small "critical example" : A. <- new("dsCMatrix", Dim = c(25L, 25L), uplo = "U" , i = as.integer( c(0, 1, 2, 3, 4, 2, 5, 6, 0, 8, 8, 9, 3, 4, 10, 11, 6, 12, 13, 4, 10, 14, 15, 1, 2, 5, 16, 17, 0, 7, 8, 18, 9, 19, 10, 11, 16, 20, 0, 6, 7, 16, 17, 18, 20, 21, 6, 9, 12, 14, 19, 21, 22, 9, 11, 19, 20, 22, 23, 1, 16, 24)) ## , p = c(0:6, 8:10, 12L, 15:16, 18:19, 22:23, 27:28, 32L, 34L, 38L, 46L, 53L, 59L, 62L) ## , x = c(1, 1, 1, 1, 2, 100, 2, 40, 1, 2, 100, 6700, 100, 100, 13200, 1, 50, 4100, 1, 5, 400, 20, 1, 40, 100, 5600, 9100, 5000, 5, 100, 100, 5900, 100, 6200, 30, 20, 9, 2800, 1, 100, 8, 10, 8000, 100, 600, 23900, 30, 100, 2800, 50, 5000, 3100, 15100, 100, 10, 5600, 800, 4500, 5500, 7, 600, 18200)) validObject(A.) ## A1: the same pattern as A. just simply filled with '1's : A1 <- A.; A1@x[] <- 1; A1@factors <- list() A1.8 <- A1; diag(A1.8) <- 8 ## nT. <- as(AT <- as(A., "TsparseMatrix"),"nMatrix") stopifnot(all(nT.@i <= nT.@j), identical(qr(A1.8), qr(as(A1.8, "dgCMatrix")))) CA <- Cholesky(A.) stopifnotValid(CAinv <- solve(CA), "dsCMatrix") MA <- as(CA, "Matrix") # with a confusing warning -- FIXME! stopifnotValid(MAinv <- solve(MA), "dtCMatrix") ## comparing MAinv with some solve(CA, system="...") .. *not* trivial? - TODO ## CAinv2 <- solve(CA, Diagonal(nrow(A.))) CAinv2 <- as(CAinv2, "symmetricMatrix") stopifnot(identical(CAinv, CAinv2)) ## FINALLY fix "TODO": (not implemented *symbolic* factorization of nMatrix) try( tc <- Cholesky(nT.) ) for(p in c(FALSE,TRUE)) for(L in c(FALSE,TRUE)) for(s in c(FALSE,TRUE, NA)) { cat(sprintf("p,L,S = (%2d,%2d,%2d): ", p,L,s)) r <- tryCatch(Cholesky(A., perm=p, LDL=L, super=s), error = function(e)e) cat(if(inherits(r, "error")) " *** E ***" else sprintf("%3d", r@type),"\n", sep="") } str(A., max=3) ## look at the 'factors' facs <- A.@factors names(facs) <- sub("Cholesky$", "", names(facs)) facs <- facs[order(names(facs))] sapply(facs, class) str(lapply(facs, slot, "type")) ## super = TRUE currently always entails LDL=FALSE : ## hence isLDL is TRUE for ("D" and not "S"): sapply(facs, isLDL) chkCholesky <- function(chmf, A) { stopifnot(is(chmf, "CHMfactor"), is(A, "Matrix"), isSymmetric(A)) if(!is(A, "dsCMatrix")) A <- as(A, "dsCMatrix") L <- drop0(zapsmall(L. <- as(chmf, "Matrix"))) cat("no. nonzeros in L {before / after drop0(zapsmall(.))}: ", c(nnzero(L.), nnzero(L)), "\n") ## 112, 95 ecc <- expand(chmf) A... <- with(ecc, crossprod(crossprod(L,P))) stopifnot(all.equal(L., ecc$L, tolerance = 1e-14), all.equal(A, A..., tolerance = 1e-14, factorsCheck = FALSE)) invisible(ecc) } c1.8 <- try(Cholesky(A1.8, super = TRUE))# works "always", interestingly ... chkCholesky(c1.8, A1.8) ## --- now a "large" (712 x 712) real data example --------------------------- data(KNex) mtm <- with(KNex, crossprod(mm)) ld.3 <- .Call("dsCMatrix_LDL_D", mtm, perm=TRUE, "sumLog") stopifnot(names(mtm@factors) == "sPDCholesky") ld.4 <- .Call("dsCMatrix_LDL_D", mtm, perm=FALSE, "sumLog")# clearly slower stopifnot(names(mtm@factors) == paste(c("sPD", "spD"),"Cholesky", sep='')) c2 <- Cholesky(mtm, super = TRUE) stopifnot(names(mtm@factors) == paste(c("sPD", "spD", "SPd"), "Cholesky", sep='')) r <- allCholesky(mtm) r[-1] ## is now taken from cache c1 <- Cholesky(mtm) bv <- 1:nrow(mtm) # even integer b <- matrix(bv) ## solve(c2, b) by default solves Ax = b, where A = c2'c2 ! x <- solve(c2,b) stopifnot(identical3(x, solve(c2, bv), solve(c2, b, system = "A")), all.equal(x, solve(mtm, b))) for(sys in c("A", "LDLt", "LD", "DLt", "L", "Lt", "D", "P", "Pt")) { x <- solve(c2, b, system = sys) cat(sys,":\n"); print(head(x)) stopifnot(dim(x) == c(712, 1), identical(x, solve(c2, bv, system = sys))) } ## log(|LL'|) - check if super = TRUE and simplicial give same determinant ld1 <- .Call("CHMfactor_ldetL2", c1) ld2 <- .Call("CHMfactor_ldetL2", c2) (ld1. <- determinant(mtm)) ## experimental ld3 <- .Call("dsCMatrix_LDL_D", mtm, TRUE, "sumLog") ld4 <- .Call("dsCMatrix_LDL_D", mtm, FALSE, "sumLog") stopifnot(all.equal(ld1, ld2), is.all.equal3(ld2, ld3, ld4), all.equal(ld.3, ld3, tolerance = 1e-14), all.equal(ld.4, ld4, tolerance = 1e-14), all.equal(ld1, as.vector(ld1.$modulus), tolerance = 1e-14)) ## Some timing measurements mtm <- with(KNex, crossprod(mm)) I <- .symDiagonal(n=nrow(mtm)) set.seed(101); r <- runif(100) system.time(D1 <- sapply(r, function(rho) Matrix:::ldet1.dsC(mtm + (1/rho) * I))) ## 0.842 on fast cmath-5 system.time(D2 <- sapply(r, function(rho) Matrix:::ldet2.dsC(mtm + (1/rho) * I))) ## 0.819 system.time(D3 <- sapply(r, function(rho) Matrix:::ldet3.dsC(mtm + (1/rho) * I))) ## 0.810 stopifnot(is.all.equal3(D1,D2,D3, tol = 1e-13)) ## Updating LL' should remain LL' and not become LDL' : cholCheck <- function(Ut, tol = 1e-12, super = FALSE, LDL = !super) { L <- Cholesky(UtU <- tcrossprod(Ut), super=super, LDL=LDL, Imult = 1) L1 <- update(L, UtU, mult = 1) L2 <- update(L, Ut, mult = 1) stopifnot(is.all.equal3(L, L1, L2, tol = tol), all.equal(update(L, UtU, mult = pi), update(L, Ut, mult = pi), tolerance = tol) ) } ## Inspired by ## data(Dyestuff, package = "lme4") ## Zt <- as(Dyestuff$Batch, "sparseMatrix") Zt <- new("dgCMatrix", Dim = c(6L, 30L), x = 2*1:30, i = rep(0:5, each=5), p = 0:30, Dimnames = list(LETTERS[1:6], NULL)) cholCheck(0.78 * Zt, tol=1e-14) oo <- options(Matrix.quiet.qr.R = TRUE, warn = 2)# no warnings allowed qrZ <- qr(t(Zt)) Rz <- qr.R(qrZ) stopifnot(exprs = { inherits(qrZ, "sparseQR") inherits(Rz, "sparseMatrix") isTriangular(Rz) isDiagonal(Rz) # even though formally a "dtCMatrix" qr2rankMatrix(qrZ, do.warn=FALSE) == 6 }) options(oo) ## problematic rank deficient rankMatrix() case -- only seen in large cases ?? Z. <- readRDS(system.file("external", "Z_NA_rnk.rds", package="Matrix")) tools::assertWarning(rnkZ. <- rankMatrix(Z., method = "qr")) # gave errors qrZ. <- qr(Z.) options(warn=1) rnk2 <- qr2rankMatrix(qrZ.) # warning ".. only 684 out of 822 finite diag(R) entries" oo <- options(warn=2)# no warnings allowed from here di <- diag(qrZ.@R) stopifnot(is.na(rnkZ.), is(qrZ, "sparseQR"), is.na(rnk2), anyNA(di)) ## The above bug fix was partly wrongly extended to dense matrices for "qr.R": x <- cbind(1, rep(0:9, 18)) qr.R(qr(x)) # one negative diagonal qr.R(qr(x, LAPACK=TRUE)) # two negative diagonals chkRnk <- function(x, rnk) { stopifnot(exprs = { rankMatrix(x) == rnk rankMatrix(x, method="maybeGrad") == rnk ## but "useGrad" is not ! rankMatrix(x, method="qrLINPACK") == rnk rankMatrix(x, method="qr.R" ) == rnk })# the last gave '0' and a warning in Matrix 1.3-0 } chkRnk( x, 2) chkRnk(diag(1), 1) # had "empty stopifnot" (-> Error in MM's experimental setup) + warning 'min()' (m3 <- cbind(2, rbind(diag(pi, 2), 8))) chkRnk(m3, 3) chkRnk(matrix(0, 4,3), 0) chkRnk(matrix(1, 5,5), 1) # had failed for "maybeGrad" chkRnk(matrix(1, 5,2), 1) showSys.time( for(i in 1:120) { set.seed(i) M <- rspMat(n=rpois(1,50), m=rpois(1,20), density = 1/(4*rpois(1, 4))) cat(sprintf("%3d: dim(M) = %2dx%2d, rank=%2d, k=%9.4g; ", i, nrow(M), ncol(M), rankMatrix(M), kappa(M))) for(super in c(FALSE,TRUE)) { cat("super=",super,"M: ") ## 2018-01-04, Avi Adler: needed 1.2e-12 in Windows 64 (for i=55, l.1): cholCheck( M , tol=2e-12, super=super); cat(" M': ") cholCheck(t(M), tol=2e-12, super=super) } cat(" [Ok]\n") }) .updateCHMfactor ## TODO: (--> ../TODO "Cholesky"): ## ---- ## allow Cholesky(A,..) when A is not symmetric *AND* ## we really want to factorize AA' ( + beta * I) ## Schur() ---------------------- checkSchur <- function(A, SchurA = Schur(A), tol = 1e-14) { stopifnot(is(SchurA, "Schur"), isOrthogonal(Q <- SchurA@Q), all.equal(as.mat(A), as.mat(Q %*% SchurA@T %*% t(Q)), tolerance = tol)) } SH <- Schur(H5 <- Hilbert(5)) checkSchur(H5, SH) checkSchur(Diagonal(x = 9:3)) p <- 4L uTp <- new("dtpMatrix", x=c(2, 3, -1, 4:6, -2:1), Dim = c(p,p)) (uT <- as(uTp, "dtrMatrix")) ## Schur ( ) <--> Schur( ) Su <- Schur(uT) ; checkSchur(uT, Su) gT <- as(uT,"generalMatrix") Sg <- Schur(gT) ; checkSchur(gT, Sg) Stg <- Schur(t(gT));checkSchur(t(gT), Stg) Stu <- Schur(t(uT));checkSchur(t(uT), Stu) stopifnot(identical3(Sg@T, uT, Su@T), identical(Sg@Q, as(diag(p), "dgeMatrix")), identical(Stg@T, as(t(gT[,p:1])[,p:1], "triangularMatrix")), identical(Stg@Q, as(diag(p)[,p:1], "dgeMatrix")), identical(Stu@T, Stg@T)) assert.EQ.mat(Stu@Q, as(Stg@Q,"matrix"), tol=0) ## the pedigreemm example where solve(.) failed: p <- new("dtCMatrix", i = c(2L, 3L, 2L, 5L, 4L, 4:5), p = c(0L, 2L, 4:7, 7L), Dim = c(6L, 6L), Dimnames = list(as.character(1:6), NULL), x = rep.int(-0.5, 7), uplo = "L", diag = "U") Sp <- Schur(p) Sp. <- Schur(as(p,"generalMatrix")) Sp.p <- Schur(crossprod(p)) ## the last two failed ip <- solve(p) assert.EQ.mat(solve(ip), as(p,"matrix")) ## chol2inv() for a traditional matrix assert.EQ.mat( crossprod(chol2inv(chol(Diagonal(x = 5:1)))), C <- crossprod(chol2inv(chol( diag(x = 5:1))))) stopifnot(all.equal(C, diag((5:1)^-2))) ## failed in some versions because of a "wrong" implicit generic U <- cbind(1:0, 2*(1:2)) (sU <- as(U, "dtCMatrix")) validObject(sS <- crossprod(sU)) C. <- chol(sS) stopifnot(all.equal(C., sU, tol=1e-15)) ## chol() tC7 <- .trDiagonal(7, 7:1) stopifnotValid(tC7, "dtCMatrix") ch7 <- chol(tC7) ## this (and the next 2) failed: 'no slot .. "factors" ..."dtCMatrix"' chT7 <- chol(tT7 <- as(tC7, "TsparseMatrix")) chR7 <- chol(tR7 <- as(tC7, "RsparseMatrix")) stopifnot(expr = { isDiagonal(ch7) identical(chT7, ch7) # "ddiMatrix" all of them identical(chR7, ch7) # "ddiMatrix" all of them all.equal(sqrt(7:1), diag(ch7 )) }) ## From [Bug 14834] New: chol2inv *** caught segfault *** n <- 1e6 # was 595362 A <- chol( D <- Diagonal(n) ) stopifnot(identical(A,D)) # A remains (unit)diagonal is(tA <- as(A,"triangularMatrix"))# currently a dtTMatrix stopifnotValid(tA, "dsparseMatrix") CA <- as(tA, "CsparseMatrix") selectMethod(solve, c("dtCMatrix","missing")) ##--> .Call(dtCMatrix_sparse_solve, a, .trDiagonal(n)) in ../src/dtCMatrix.c sA <- solve(CA)## -- R_CheckStack() segfault in Matrix <= 1.0-4 nca <- diagU2N(CA) stopifnot(identical(sA, nca)) ## same check with non-unit-diagonal D : A <- chol(D <- Diagonal(n, x = 0.5)) ia <- chol2inv(A) stopifnot(is(ia, "diagonalMatrix"), all.equal(ia@x, rep(2,n), tolerance = 1e-15)) ##------- Factor caches must be cleaned - even after scalar-Ops such as "2 *" set.seed(7) d <- 5 S <- 10*Diagonal(d) + rsparsematrix(d,d, 1/4) class(M <- as(S, "denseMatrix")) # dgeMatrix m <- as.matrix(M) (dS <- determinant(S)) stopifnot(exprs = { all.equal(determinant(m), dS, tol=1e-15) all.equal(dS, determinant(M), tol=1e-15) ## These had failed, as the "LU" factor cache was kept unchanged in 2*M : all.equal(determinant(2*S), determinant(2*M) -> d2M) all.equal(determinant(S^2), determinant(M^2) -> dM2) all.equal(determinant(m^2), dM2) all.equal(d*log(2), c(d2M$modulus - dS$modulus)) }) cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' Matrix/tests/abIndex-tsts.R0000644000176200001440000001053213763003774015363 0ustar liggesusers#### Testing consistency of "abIndex" == "abstract-indexing vectors" class : library(Matrix) source(system.file("test-tools.R", package = "Matrix"))# identical3() etc validObject(ab <- new("abIndex")) str(ab) set.seed(1) ex. <- list(2:1000, 0:10, sample(100), c(-3:40, 20:70), c(1:100,77L, 50:40, 10L), c(17L, 3L*(12:3))) ## we know which kinds will come out: "compressed" for all but random: rD <- "rleDiff"; kinds <- c(rD,rD,"int32", rD, rD, rD) isCmpr <- kinds == rD ab. <- lapply(ex., as, Class = "abIndex") nu. <- lapply(ab., as, Class = "numeric") in. <- lapply(ab., as, Class = "integer") rles <- lapply(ab.[isCmpr], function(u) u@rleD@rle) r.x <- lapply(ex.[isCmpr], function(.) rle(diff(.))) stopifnot(sapply(ab., validObject), identical(ex., nu.), identical(ex., in.), ## Check that the relevant cases really *are* "compressed": sapply(ab., slot, "kind") == kinds, ## Using rle(diff(.)) is equivalent to using our C code: identical(rles, r.x), ## Checking Group Methods - "Summary" : sapply(ab., range) == sapply(ex., range), sapply(ab., any) == sapply(ex., any), TRUE) ## testing c() method, i.e. currently c.abIndex(): tst.c.abI <- function(lii) { stopifnot(is.list(lii), all(unlist(lapply(lii, mode)) == "numeric")) aii <- lapply(lii, as, "abIndex") v.i <- do.call(c, lii) a.i <- do.call(c, aii) avi <- as(v.i, "abIndex") ## identical() is too hard, as values & lengths can be double/integer stopifnot(all.equal(a.i, avi, tolerance = 0)) } tst.c.abI(list(2:6, 70:50, 5:-2)) ## now an example where *all* are uncompressed: tst.c.abI(list(c(5, 3, 2, 4, 7, 1, 6), 3:4, 1:-1)) ## and one with parts that are already non-trivial: exc <- ex.[isCmpr] tst.c.abI(exc) set.seed(101) N <- length(exc) # 5 for(i in 1:10) { tst.c.abI(exc[sample(N, replace=TRUE)]) tst.c.abI(exc[sample(N, N-1)]) tst.c.abI(exc[sample(N, N-2)]) } for(n in 1:120) { cat(".") k <- 1 + 4*rpois(1, 5) # >= 1 ## "random" rle -- NB: consecutive values *must* differ (for uniqueness) v <- as.integer(1+ 10*rnorm(k)) while(any(dv <- duplicated(v))) v[dv] <- v[dv] + 1L rl <- structure(list(lengths = as.integer(1 + rpois(k, 10)), values = v), class = "rle") ai <- new("abIndex", kind = "rleDiff", rleD = new("rleDiff", first = rpois(1, 20), rle = rl)) validObject(ai) ii <- as(ai, "numeric") iN <- ii; iN[180] <- NA; aiN <- as(iN,"abIndex") iN <- as(aiN, "numeric") ## NA from 180 on stopifnot(is.numeric(ii), ii == round(ii), identical(ai, as(ii, "abIndex")), identical(is.na(ai), is.na(ii)), identical(is.na(aiN), is.na(iN)), identical(is.finite (aiN), is.finite(iN)), identical(is.infinite(aiN), is.infinite(iN)) ) if(n %% 40 == 0) cat(n,"\n") } ## we have : identical(lapply(ex., as, "abIndex"), ab.) mkStr <- function(ch, n) paste(rep.int(ch, n), collapse="") ##O for(grMeth in getGroupMembers("Ops")) { ##O cat(sprintf("\n%s :\n%s\n", grMeth, mkStr("=", nchar(grMeth)))) grMeth <- "Arith" for(ng in getGroupMembers(grMeth)) { cat(ng, ": ") G <- get(ng) t.tol <- if(ng == "/") 1e-12 else 0 ## "/" with no long double (e.g. on Sparc Solaris): 1.125e-14 AEq <- function(a,b, ...) assert.EQ(a, b, tol=t.tol, giveRE=TRUE) for(v in ex.) { va <- as(v, "abIndex") for(s in list(-1, 17L, TRUE, FALSE)) # numeric *and* logical if(!((identical(s, FALSE) && ng == "/"))) { ## division by 0 may "fail" AEq(as(G(v, s), "abIndex"), G(va, s)) AEq(as(G(s, v), "abIndex"), G(s, va)) } cat(".") } cat(" [Ok]\n") } ##O } ## check the abIndex versions of indDiag() and indTri() : for(n in 1:7) { stopifnotValid(ii <- Matrix:::abIindDiag(n), "abIndex") stopifnot(ii@kind == "rleDiff", Matrix:::indDiag(n) == as(ii, "numeric")) } for(n in 0:7) for(diag in c(TRUE,FALSE)) for(upper in c(TRUE,FALSE)) { stopifnotValid(ii <- Matrix:::abIindTri(n, diag=diag,upper=upper), "abIndex") if(n) stopifnot(Matrix:::indTri(n, diag=diag,upper=upper) == as(ii, "numeric"), allow.logical0=TRUE) # works also in R versions w/o it as formal argument } cat('Time elapsed: ', (.pt <- proc.time()),'\n') # "stats" Matrix/tests/matprod.R0000644000176200001440000010223414143711312014450 0ustar liggesuserslibrary(Matrix) ### Matrix Products including cross products source(system.file("test-tools.R", package = "Matrix")) # is.EQ.mat(), dnIdentical() ..etc doExtras options(warn=1, # show as they happen Matrix.verbose = doExtras) ##' Check matrix multiplications with (unit) Diagonal matrices chkDiagProd <- function(M) { stopifnot(is.matrix(M) || is(M,"Matrix")) I.l <- Diagonal(nrow(M)) # I_n -- "unit" Diagonal I.r <- Diagonal(ncol(M)) # I_d D2.l <- Diagonal(nrow(M), x = 2) # D_n D2.r <- Diagonal(ncol(M), x = 2) # I_d stopifnot(is.EQ.mat(M, M %*% I.r), is.EQ.mat(M, I.l %*% M), is.EQ.mat(2*M, M %*% D2.r), is.EQ.mat(M*2, D2.l %*% M), ## crossprod is.EQ.mat(t(M), crossprod(M, I.l)), is.EQ.mat( M , crossprod(I.l, M)), is.EQ.mat(t(2*M), crossprod(M, D2.l)), is.EQ.mat( M*2 , crossprod(D2.l, M)), ## tcrossprod is.EQ.mat( M , tcrossprod(M, I.r)), is.EQ.mat(t(M), tcrossprod(I.r, M)), is.EQ.mat( 2*M , tcrossprod(M, D2.r)), is.EQ.mat(t(M*2), tcrossprod(D2.r, M))) } ### dimnames -- notably for matrix products ---------------- # ##' Checks that matrix products are the same, including dimnames ##' ##' @param m matrix = traditional-R-matrix version of M ##' @param M optional Matrix = "Matrix class version of m" ##' @param browse chkDnProd <- function(m = as(M, "matrix"), M = Matrix(m), browse=FALSE, warn.ok=FALSE) { ## TODO: ## if(browse) stopifnot <- f.unction(...) such that it enters browser() when it is not fulfilled if(!warn.ok) { # NO warnings allowd op <- options(warn = 2) on.exit(options(op)) } stopifnot(is.matrix(m), is(M, "Matrix"), identical(dim(m), dim(M)), dnIdentical(m,M)) ## m is n x d (say) is.square <- nrow(m) == ncol(m) p1 <- (tm <- t(m)) %*% m ## d x d p1. <- crossprod(m) stopifnot(is.EQ.mat3(p1, p1., crossprod(m,m))) t1 <- m %*% tm ## n x n t1. <- tcrossprod(m) stopifnot(is.EQ.mat3(t1, t1., tcrossprod(m,m))) if(is.square) { mm <- m %*% m stopifnot(is.EQ.mat3(mm, crossprod(tm,m), tcrossprod(m,tm))) } chkDiagProd(m)## was not ok in Matrix 1.2.0 ## Now the "Matrix" ones -- should match the "matrix" above M0 <- M cat("sparse: ") for(sparse in c(TRUE, FALSE)) { cat(sparse, "; ") M <- as(M0, if(sparse) "sparseMatrix" else "denseMatrix") P1 <- (tM <- t(M)) %*% M P1. <- crossprod(M) stopifnot(is.EQ.mat3(P1, P1., p1), is.EQ.mat3(P1., crossprod(M,M), crossprod(M,m)), is.EQ.mat (P1., crossprod(m,M))) ## P1. is "symmetricMatrix" -- semantically "must have" symm.dimnames PP1 <- P1. %*% P1. ## still d x d R <- triu(PP1); r <- as(R, "matrix") # upper - triangular L <- tril(PP1); l <- as(L, "matrix") # lower - triangular stopifnot(isSymmetric(P1.), isSymmetric(PP1), isDiagonal(L) || is(L,"triangularMatrix"), isDiagonal(R) || is(R,"triangularMatrix"), isTriangular(L, upper=FALSE), isTriangular(R, upper=TRUE), is.EQ.mat(PP1, (pp1 <- p1 %*% p1)), dnIdentical(PP1, R), dnIdentical(L, R)) T1 <- M %*% tM T1. <- tcrossprod(M) stopifnot(is.EQ.mat3(T1, T1., t1), is.EQ.mat3(T1., tcrossprod(M,M), tcrossprod(M,m)), is.EQ.mat (T1., tcrossprod(m,M)), is.EQ.mat(tcrossprod(T1., tM), tcrossprod(t1., tm)), is.EQ.mat(crossprod(T1., M), crossprod(t1., m))) ## Now, *mixing* Matrix x matrix: stopifnot(is.EQ.mat3(tM %*% m, tm %*% M, tm %*% m)) if(is.square) stopifnot(is.EQ.mat (mm, M %*% M), is.EQ.mat3(mm, crossprod(tM,M), tcrossprod(M,tM)), ## "mixing": is.EQ.mat3(mm, crossprod(tm,M), tcrossprod(m,tM)), is.EQ.mat3(mm, crossprod(tM,m), tcrossprod(M,tm))) ## Symmetric and Triangular stopifnot(is.EQ.mat(PP1 %*% tM, pp1 %*% tm), is.EQ.mat(R %*% tM, r %*% tm), is.EQ.mat(L %*% tM, L %*% tm)) ## Diagonal : chkDiagProd(M) } cat("\n") invisible(TRUE) } ## All these are ok {now, (2012-06-11) also for dense (m <- matrix(c(0, 0, 2:0), 3, 5)) m00 <- m # *no* dimnames dimnames(m) <- list(LETTERS[1:3], letters[1:5]) (m.. <- m) # has *both* dimnames m0. <- m.0 <- m.. dimnames(m0.)[1] <- list(NULL); m0. dimnames(m.0)[2] <- list(NULL); m.0 d <- diag(3); dimnames(d) <- list(c("u","v","w"), c("X","Y","Z")); d dU <- diagN2U(Matrix(d)) # unitriangular sparse (T <- new("dtrMatrix", diag = "U", x= c(0,0,5,0), Dim= c(2L,2L), Dimnames= list(paste0("r",1:2),paste0("C",1:2)))) # unitriangular dense ## ^^^^^^^^^^^^ ## currently many warnings about sub-optimal matrix products : chkDnProd(m..) chkDnProd(m0.) chkDnProd(m.0) chkDnProd(m00) chkDnProd(M = T) chkDnProd(M = t(T)) chkDnProd(M = dU) chkDnProd(M = t(dU)) ## all the above failed in 1.2-0 and 1.1-5, 1.1-4 some even earlier chkDnProd(M = Diagonal(4)) chkDnProd(diag(x=3:1)) chkDnProd(d) chkDnProd(M = as(d, "denseMatrix"))# M: dtrMatrix (diag = "N") m5 <- 1 + as(diag(-1:4)[-5,], "dgeMatrix") ## named dimnames: dimnames(m5) <- list(Rows= LETTERS[1:5], paste("C", 1:6, sep="")) tr5 <- tril(m5[,-6]) m. <- as(m5, "matrix") m5.2 <- local({t5 <- as.matrix(tr5); t5 %*% t5}) stopifnotValid(tr5, "dtrMatrix") stopifnot(dim(m5) == 5:6, class(cm5 <- crossprod(m5)) == "dpoMatrix") assert.EQ.mat(t(m5) %*% m5, as(cm5, "matrix")) assert.EQ.mat(tr5.2 <- tr5 %*% tr5, m5.2) stopifnotValid(tr5.2, "dtrMatrix") stopifnot(as.vector(rep(1,6) %*% cm5) == colSums(cm5), as.vector(cm5 %*% rep(1,6)) == rowSums(cm5)) ## uni-diagonal dtrMatrix with "wrong" entries in diagonal ## {the diagonal can be anything: because of diag = "U" it should never be used}: tru <- Diagonal(3, x=3); tru[i.lt <- lower.tri(tru, diag=FALSE)] <- c(2,-3,4) tru@diag <- "U" ; stopifnot(diag(trm <- as.matrix(tru)) == 1) ## TODO: Also add *upper-triangular* *packed* case !! stopifnot((tru %*% tru)[i.lt] == (trm %*% trm)[i.lt]) ## crossprod() with numeric vector RHS and LHS i5 <- rep.int(1, 5) isValid(S5 <- tcrossprod(tr5), "dpoMatrix")# and inherits from "dsy" G5 <- as(S5, "generalMatrix")# "dge" assert.EQ.mat( crossprod(i5, m5), rbind( colSums(m5))) assert.EQ.mat( crossprod(i5, m.), rbind( colSums(m5))) assert.EQ.mat( crossprod(m5, i5), cbind( colSums(m5))) assert.EQ.mat( crossprod(m., i5), cbind( colSums(m5))) assert.EQ.mat( crossprod(i5, S5), rbind( colSums(S5))) # failed in Matrix 1.1.4 ## tcrossprod() with numeric vector RHS and LHS : stopifnot(identical(tcrossprod(i5, S5), # <- lost dimnames tcrossprod(i5, G5) -> m51), identical(dimnames(m51), list(NULL, LETTERS[1:5])) ) m51 <- m5[, 1, drop=FALSE] # [6 x 1] m.1 <- m.[, 1, drop=FALSE] ; assert.EQ.mat(m51, m.1) ## The only (M . v) case assert.EQ.mat(tcrossprod(m51, 5:1), tcrossprod(m.1, 5:1)) ## The two (v . M) cases: assert.EQ.mat(tcrossprod(rep(1,6), m.), rbind( rowSums(m5)))# |v| = ncol(m) assert.EQ.mat(tcrossprod(rep(1,3), m51), tcrossprod(rep(1,3), m.1))# ncol(m) = 1 ## classes differ tc.m5 <- m5 %*% t(m5) # "dge*", no dimnames (FIXME) (tcm5 <- tcrossprod(m5)) # "dpo*" w/ dimnames assert.EQ.mat(tc.m5, mm5 <- as(tcm5, "matrix")) ## tcrossprod(x,y) : assert.EQ.mat(tcrossprod(m5, m5), mm5) assert.EQ.mat(tcrossprod(m5, m.), mm5) assert.EQ.mat(tcrossprod(m., m5), mm5) M50 <- m5[,FALSE, drop=FALSE] M05 <- t(M50) s05 <- as(M05, "sparseMatrix") s50 <- t(s05) assert.EQ.mat(M05, matrix(1, 0,5)) assert.EQ.mat(M50, matrix(1, 5,0)) assert.EQ.mat(tcrossprod(M50), tcrossprod(as(M50, "matrix"))) assert.EQ.mat(tcrossprod(s50), tcrossprod(as(s50, "matrix"))) assert.EQ.mat( crossprod(s50), crossprod(as(s50, "matrix"))) stopifnot(identical( crossprod(s50), tcrossprod(s05)), identical( crossprod(s05), tcrossprod(s50))) (M00 <- crossprod(M50))## used to fail -> .Call(dgeMatrix_crossprod, x, FALSE) stopifnot(identical(M00, tcrossprod(M05)), all(M00 == t(M50) %*% M50), dim(M00) == 0) ## simple cases with 'scalars' treated as 1x1 matrices: d <- Matrix(1:5) d %*% 2 10 %*% t(d) assertError(3 %*% d) # must give an error , similar to assertError(5 %*% as.matrix(d)) # -> error ## right and left "numeric" and "matrix" multiplication: (p1 <- m5 %*% c(10, 2:6)) (p2 <- c(10, 2:5) %*% m5) (pd1 <- m5 %*% diag(1:6)) (pd. <- m5 %*% Diagonal(x = 1:6)) (pd2 <- diag (10:6) %*% m5) (pd..<- Diagonal(x = 10:6) %*% m5) stopifnot(exprs = { dim(crossprod(t(m5))) == c(5,5) c(class(p1),class(p2),class(pd1),class(pd2), class(pd.),class(pd..)) == "dgeMatrix" identical(dimnames(pd.), dimnames(m5)) identical(dimnames(pd..), dimnames(m5)) }) assert.EQ.mat(p1, cbind(c(20,30,33,38,54))) assert.EQ.mat(pd1, m. %*% diag(1:6)) assert.EQ.mat(pd2, diag(10:6) %*% m.) assert.EQ.mat(pd., as(pd1,"matrix")) assert.EQ.mat(pd..,as(pd2,"matrix")) ## check that 'solve' and '%*%' are inverses suppressWarnings(RNGversion("3.5.0")); set.seed(1) A <- Matrix(rnorm(25), nc = 5) y <- rnorm(5) all.equal((A %*% solve(A, y))@x, y) Atr <- new("dtrMatrix", Dim = A@Dim, x = A@x, uplo = "U") all.equal((Atr %*% solve(Atr, y))@x, y) ## R-forge bug 5933 by Sebastian Herbert, ## https://r-forge.r-project.org/tracker/index.php?func=detail&aid=5933&group_id=61&atid=294 mLeft <- matrix(data = double(0), nrow = 3, ncol = 0) mRight <- matrix(data = double(0), nrow = 0, ncol = 4) MLeft <- Matrix(data = double(0), nrow = 3, ncol = 0) MRight <- Matrix(data = double(0), nrow = 0, ncol = 4) stopifnot(exprs = { class(mLeft) == class(mRight) class(MLeft) == class(MRight) class(MLeft) == "dgeMatrix" }) Qidentical3 <- function(a,b,c) Q.eq(a,b) && Q.eq(b,c) Qidentical4 <- function(a,b,c,d) Q.eq(a,b) && Q.eq(b,c) && Q.eq(c,d) chkP <- function(mLeft, mRight, MLeft, MRight, cl = class(MLeft)) { ident4 <- if(extends(cl, "generalMatrix")) function(a,b,c,d) identical4(as(a, cl), b, c, d) else function(a,b,c,d) { assert.EQ.mat(M=b, m=a, tol=0) Qidentical3(b,c,d) } mm <- mLeft %*% mRight # ok m.m <- crossprod(mRight) mm. <- tcrossprod(mLeft, mLeft) stopifnot(mm == 0, ident4(mm, mLeft %*% MRight, MLeft %*% mRight, MLeft %*% MRight),# now ok m.m == 0, identical(m.m, crossprod(mRight, mRight)), mm. == 0, identical(mm., tcrossprod(mLeft, mLeft)), allow.logical0 = TRUE) stopifnot(ident4(m.m, crossprod(MRight, MRight), crossprod(MRight, mRight), crossprod(mRight, MRight))) stopifnot(ident4(mm., tcrossprod(mLeft, MLeft), tcrossprod(MLeft, MLeft), tcrossprod(MLeft, mLeft))) } chkP(mLeft, mRight, MLeft, MRight, "dgeMatrix") m0 <- mLeft[FALSE,] # 0 x 0 for(cls in c("triangularMatrix", "symmetricMatrix")) { cat(cls,": "); stopifnotValid(ML0 <- as(MLeft[FALSE,], cls), cls) chkP(m0, mRight, ML0, MRight, class(ML0)) chkP(mLeft, m0 , MLeft, ML0 , class(ML0)) chkP(m0, m0 , ML0, ML0 , class(ML0)); cat("\n") } ## New in R 3.2.0 -- for traditional matrix m and vector v for(spV in c(FALSE,TRUE)) { cat("sparseV:", spV, "\n") v <- if(spV) as(1:3, "sparseVector") else 1:3 stopifnot(identical(class(v2 <- v[1:2]), class(v))) assertError(crossprod(v, v2)) ; assertError(v %*% v2) assertError(crossprod(v, 1:2)); assertError(v %*% 1:2) assertError(crossprod(v, 2)) ; assertError(v %*% 2) assertError(crossprod(1:2, v)); assertError(1:2 %*% v) cat("doing vec x vec ..\n") stopifnot(identical(crossprod(2, v), t(2) %*% v), identical(5 %*% v, 5 %*% t(v))) for(sp in c(FALSE, TRUE)) { m <- Matrix(1:2, 1,2, sparse=sp) cat(sprintf("class(m): '%s'\n", class(m))) stopifnot(identical( crossprod(m, v), t(m) %*% v), # m'v gave *outer* prod wrongly! identical(tcrossprod(m, v2), m %*% v2)) assert.EQ.Mat(m %*% v2, m %*% 1:2, tol=0) } ## gave error "non-conformable arguments" } ## crossprod(m, v) t(1 x 2) * 3 ==> (2 x 1) * (1 x 3) ==> 2 x 3 ## tcrossprod(m,v2) 1 x 2 * 2 ==> (1 x 2) * t(1 x 2) ==> 1 x 1 ### ------ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Sparse Matrix products ### ------ ## solve() for dtC* mc <- round(chol(crossprod(A)), 2) B <- A[1:3,] # non-square on purpose stopifnot(all.equal(sum(rowSums(B %*% mc)), 5.82424475145)) assert.EQ.mat(tcrossprod(B, mc), as.matrix(t(tcrossprod(mc, B)))) m <- kronecker(Diagonal(2), mc) stopifnot(is(mc, "Cholesky"), is(m, "sparseMatrix")) im <- solve(m) round(im, 3) itm <- solve(t(m)) iim <- solve(im) # should be ~= 'm' of course iitm <- solve(itm) I <- Diagonal(nrow(m)) (del <- c(mean(abs(as.numeric(im %*% m - I))), mean(abs(as.numeric(m %*% im - I))), mean(abs(as.numeric(im - t(itm)))), mean(abs(as.numeric( m - iim))), mean(abs(as.numeric(t(m)- iitm))))) stopifnot(is(m, "triangularMatrix"), is(m, "sparseMatrix"), is(im, "dtCMatrix"), is(itm, "dtCMatrix"), is(iitm, "dtCMatrix"), del < 1e-15) ## crossprod(.,.) & tcrossprod(), mixing dense & sparse v <- c(0,0,2:0) mv <- as.matrix(v) ## == cbind(v) (V <- Matrix(v, 5,1, sparse=TRUE)) sv <- as(v, "sparseVector") a <- as.matrix(A) cav <- crossprod(a,v) tva <- tcrossprod(v,a) assert.EQ.mat(crossprod(A, V), cav) # gave infinite recursion assert.EQ.mat(crossprod(A,sv), cav) assert.EQ.mat(tcrossprod( sv, A), tva) assert.EQ.mat(tcrossprod(t(V),A), tva) ## [t]crossprod() for . incl. one arg.: stopifnotValid(s.s <- crossprod(sv,sv), "Matrix") stopifnotValid(ss. <- tcrossprod(sv,sv), "sparseMatrix") stopifnot(identical(s.s, crossprod(sv)), identical(ss., tcrossprod(sv))) assert.EQ.mat(s.s, crossprod(v,v)) assert.EQ.mat(ss., tcrossprod(v,v)) dm <- Matrix(v, sparse=FALSE) sm <- Matrix(v, sparse=TRUE) validObject(d.vvt <- as(as(vvt <- tcrossprod(v, v), "denseMatrix"), "dgeMatrix")) validObject(s.vvt <- as(as(vvt, "sparseMatrix"), "dgCMatrix")) stopifnot( identical4(tcrossprod(v, v), tcrossprod(mv, v), tcrossprod(v,mv), tcrossprod(mv,mv))## (base R) , identical4(d.vvt, tcrossprod(dm, v), tcrossprod(v,dm), tcrossprod(dm,dm)) ## (v, dm) failed , identical(s.vvt, tcrossprod(sm,sm)) , identical3(d.vvt, tcrossprod(sm, v), tcrossprod(v,sm)) ## both (sm,v) and (v,sm) failed ) assert.EQ.mat(d.vvt, vvt) assert.EQ.mat(s.vvt, vvt) M <- Matrix(0:5, 2,3) ; sM <- as(M, "sparseMatrix"); m <- as(M, "matrix") v <- 1:3; v2 <- 2:1 sv <- as( v, "sparseVector") sv2 <- as(v2, "sparseVector") tvm <- tcrossprod(v, m) assert.EQ.mat(tcrossprod( v, M), tvm) assert.EQ.mat(tcrossprod( v,sM), tvm) assert.EQ.mat(tcrossprod(sv,sM), tvm) assert.EQ.mat(tcrossprod(sv, M), tvm) assert.EQ.mat(crossprod(M, sv2), crossprod(m, v2)) stopifnot(identical(tcrossprod(v, M), v %*% t(M)), identical(tcrossprod(v,sM), v %*% t(sM)), identical(tcrossprod(v, M), crossprod(v, t(M))), identical(tcrossprod(sv,sM), sv %*% t(sM)), identical(crossprod(sM, sv2), t(sM) %*% sv2), identical(crossprod(M, v2), t(M) %*% v2)) ## *unit* triangular : t1 <- new("dtTMatrix", x= c(3,7), i= 0:1, j=3:2, Dim= as.integer(c(4,4))) ## from 0-diagonal to unit-diagonal {low-level step}: tu <- t1 ; tu@diag <- "U" cu <- as(tu, "dtCMatrix") cl <- t(cu) # unit lower-triangular cl10 <- cl %*% Diagonal(4, x=10) assert.EQ.mat(cl10, as(cl, "matrix") %*% diag(4, x=10)) stopifnot(is(cl,"dtCMatrix"), cl@diag == "U") (cu2 <- cu %*% cu) cl2 <- cl %*% cl validObject(cl2) cu3 <- tu[-1,-1] assert.EQ.mat(crossprod(tru, cu3),## <- "FIXME" should return triangular ... crossprod(trm, as.matrix(cu3))) cl2 mcu <- as.matrix(cu) cu2. <- Diagonal(4) + Matrix(c(rep(0,9),14,0,0,6,0,0,0), 4,4) D4 <- Diagonal(4, x=10:7); d4 <- as(D4, "matrix") D.D4 <- crossprod(D4); assert.EQ.mat(D.D4, crossprod(d4)) stopifnotValid(D.D4, "ddiMatrix") stopifnotValid(su <- crossprod(cu), "dsCMatrix") stopifnot( all(cu2 == cu2.) ,# was wrong for ver. <= 0.999375-4 identical(D.D4, tcrossprod(D4)) , identical4(crossprod(d4, D4), crossprod(D4, d4), tcrossprod(d4, D4), D.D4) , is(cu2, "dtCMatrix"), is(cl2, "dtCMatrix"), # triangularity preserved cu2@diag == "U", cl2@diag == "U",# UNIT-triangularity preserved all.equal(D4 %*% cu, D4 %*% mcu) , all.equal(cu %*% D4, mcu %*% D4) , all(D4 %*% su == D4 %*% as.mat(su)) , all(su %*% D4 == as.mat(su) %*% D4) , identical(t(cl2), cu2) , # !! identical ( crossprod(cu, D4), crossprod(mcu, D4)) , identical4(tcrossprod(cu, D4), tcrossprod(mcu, D4), cu %*% D4, mcu %*% D4) , identical4(tcrossprod(D4,cu), tcrossprod(D4,mcu), D4 %*% t(cu), D4 %*% t(mcu)) , identical( crossprod(cu), Matrix( crossprod(mcu),sparse=TRUE)) , identical(tcrossprod(cu), Matrix(tcrossprod(mcu),sparse=TRUE)) ) assert.EQ.mat( crossprod(cu, D4), crossprod(mcu, d4)) assert.EQ.mat(tcrossprod(cu, D4), tcrossprod(mcu, d4)) tr8 <- kronecker(rbind(c(2,0),c(1,4)), cl2) T8 <- tr8 %*% (tr8/2) # triangularity preserved? T8.2 <- (T8 %*% T8) / 4 stopifnot(is(T8, "triangularMatrix"), T8@uplo == "L", is(T8.2, "dtCMatrix")) mr8 <- as(tr8,"matrix") m8. <- (mr8 %*% mr8 %*% mr8 %*% mr8)/16 assert.EQ.mat(T8.2, m8.) data(KNex); mm <- KNex$mm M <- mm[1:500, 1:200] MT <- as(M, "TsparseMatrix") cpr <- t(mm) %*% mm cpr. <- crossprod(mm) cpr.. <- crossprod(mm, mm) stopifnot(is(cpr., "symmetricMatrix"), identical3(cpr, as(cpr., class(cpr)), cpr..)) ## with dimnames: m <- Matrix(c(0, 0, 2:0), 3, 5) dimnames(m) <- list(LETTERS[1:3], letters[1:5]) m p1 <- t(m) %*% m (p1. <- crossprod(m)) t1 <- m %*% t(m) (t1. <- tcrossprod(m)) stopifnot(isSymmetric(p1.), isSymmetric(t1.), identical(p1, as(p1., class(p1))), identical(t1, as(t1., class(t1))), identical(dimnames(p1), dimnames(p1.)), identical(dimnames(p1), list(colnames(m), colnames(m))), identical(dimnames(t1), dimnames(t1.)) ) showMethods("%*%", class=class(M)) v1 <- rep(1, ncol(M)) str(r <- M %*% Matrix(v1)) str(rT <- MT %*% Matrix(v1)) stopifnot(identical(r, rT)) str(r. <- M %*% as.matrix(v1)) stopifnot(identical4(r, r., rT, M %*% as(v1, "matrix"))) v2 <- rep(1,nrow(M)) r2 <- t(Matrix(v2)) %*% M r2T <- v2 %*% MT str(r2. <- v2 %*% M) stopifnot(identical3(r2, r2., t(as(v2, "matrix")) %*% M)) ###------------------------------------------------------------------ ### Close to singular matrix W ### (from micEconAids/tests/aids.R ... priceIndex = "S" ) (load(system.file("external", "symW.rda", package="Matrix"))) # "symW" stopifnot(is(symW, "symmetricMatrix")) n <- nrow(symW) I <- .sparseDiagonal(n, shape="g") S <- as(symW, "matrix") sis <- solve(S, S) ## solve(, ) when Cholmod fails was buggy for *long*: o. <- options(Matrix.verbose = 2) # <-- showing Cholmod error & warning now SIS <- solve(symW, symW) iw <- solve(symW) ## << TODO: LU *not* saved in @factors iss <- iw %*% symW ## nb-mm3 openBLAS (Avi A.) assert.EQ.(I, drop0(sis), tol = 1e-8)# 2.6e-10; 7.96e-9 assert.EQ.(I, SIS, tol = 1e-7)# 8.2e-9 assert.EQ.(I, iss, tol = 4e-4)# 3.3e-5 ## solve(, ) : I <- diag(nr=n) SIS <- solve(symW, as(symW,"denseMatrix")) iw <- solve(symW, I) iss <- iw %*% symW assert.EQ.mat(SIS, I, tol = 1e-7, giveRE=TRUE) assert.EQ.mat(iss, I, tol = 4e-4, giveRE=TRUE) rm(SIS,iss) WW <- as(symW, "generalMatrix") # the one that gave problems IW <- solve(WW) class(I1 <- IW %*% WW)# "dge" or "dgC" (!) class(I2 <- WW %*% IW) ## these two were wrong for for M.._1.0-13: assert.EQ.(as(I1,"matrix"), I, tol = 1e-4) assert.EQ.(as(I2,"matrix"), I, tol = 7e-7) ## now slightly perturb WW (and hence break exact symmetry set.seed(131); ii <- sample(length(WW), size= 100) WW[ii] <- WW[ii] * (1 + 1e-7*runif(100)) SW. <- symmpart(WW) SW2 <- Matrix:::forceSymmetric(WW) stopifnot(all.equal(as(SW.,"matrix"), as(SW2,"matrix"), tol = 1e-7)) (ch <- all.equal(WW, as(SW.,"dgCMatrix"), tolerance =0)) stopifnot(is.character(ch), length(ch) == 1)## had length(.) 2 previously IW <- solve(WW) # ( => stores in WW@factors !) class(I1 <- IW %*% WW)# "dge" or "dgC" (!) class(I2 <- WW %*% IW) I <- diag(nr=nrow(WW)) stopifnot(all.equal(as(I1,"matrix"), I, check.attributes=FALSE, tolerance = 1e-4), ## "Mean relative difference: 3.296549e-05" (or "1.999949" for Matrix_1.0-13 !!!) all.equal(as(I2,"matrix"), I, check.attributes=FALSE)) #default tol gives "1" for M.._1.0-13 options(o.) # revert to less Matrix.verbose if(doExtras) { print(kappa(WW)) ## [1] 5.129463e+12 print(rcond(WW)) ## [1] 6.216103e-14 ## Warning message: rcond(.) via sparse -> dense coercion } class(Iw. <- solve(SW.))# FIXME? should be "symmetric" but is not class(Iw2 <- solve(SW2))# FIXME? should be "symmetric" but is not class(IW. <- as(Iw., "denseMatrix")) class(IW2 <- as(Iw2, "denseMatrix")) ### The next two were wrong for very long, too assert.EQ.(I, as.matrix(IW. %*% SW.), tol= 4e-4) assert.EQ.(I, as.matrix(IW2 %*% SW2), tol= 4e-4) dIW <- as(IW, "denseMatrix") assert.EQ.(dIW, IW., tol= 4e-4) assert.EQ.(dIW, IW2, tol= 8e-4) ##------------------------------------------------------------------ ## Sparse Cov.matrices from Harri Kiiveri @ CSIRO a <- matrix(0,5,5) a[1,2] <- a[2,3] <- a[3,4] <- a[4,5] <- 1 a <- a + t(a) + 2*diag(5) b <- as(a, "dsCMatrix") ## ok, but we recommend to use Matrix() ``almost always'' : (b. <- Matrix(a, sparse = TRUE)) stopifnot(identical(b, b.)) ## calculate conditional variance matrix ( vars 3 4 5 given 1 2 ) (B2 <- b[1:2, 1:2]) bb <- b[1:2, 3:5] stopifnot(is(B2, "dsCMatrix"), # symmetric indexing keeps symmetry identical(as.mat(bb), rbind(0, c(1,0,0))), ## TODO: use fully-sparse cholmod_spsolve() based solution : is(z.s <- solve(B2, bb), "sparseMatrix")) assert.EQ.mat(B2 %*% z.s, as(bb, "matrix")) ## -> dense RHS and dense result z. <- solve(as(B2, "dgCMatrix"), bb)# now *sparse* z <- solve( B2, as(bb,"dgeMatrix")) stopifnot(is(z., "sparseMatrix"), all.equal(z, as(z.,"denseMatrix"))) ## finish calculating conditional variance matrix v <- b[3:5,3:5] - crossprod(bb,z) stopifnot(all.equal(as.mat(v), matrix(c(4/3, 1:0, 1,2,1, 0:2), 3), tol = 1e-14)) ###--- "logical" Matrices : --------------------- ##__ FIXME __ now works for lsparse* and nsparse* but not yet for lge* and nge* ! ## Robert's Example, a bit more readable fromTo <- rbind(c(2,10), c(3, 9)) N <- 10 nrFT <- nrow(fromTo) rowi <- rep.int(1:nrFT, fromTo[,2]-fromTo[,1] + 1) - 1:1 coli <- unlist(lapply(1:nrFT, function(x) fromTo[x,1]:fromTo[x,2])) - 1:1 # ## "n" --- nonzero pattern Matrices chk.ngMatrix <- function(M, verbose = TRUE) { if(!(is(M, "nsparseMatrix") && length(d <- dim(M)) == 2 && d[1] == d[2])) stop("'M' must be a square sparse [patter]n Matrix") if(verbose) show(M) m <- as(M, "matrix") ## Part I : matrix products of pattern Matrices ## ------ For now [by default]: *pattern* <==> boolean arithmetic ## ==> FIXME ??: warning that this will change? MM <- M %*% M # pattern (ngC) if(verbose) { cat("M %*% M:\n"); show(MM) } assert.EQ.mat(MM, m %*% m) assert.EQ.mat(t(M) %*% M, ## <- 'pattern', because of cholmod_ssmult() (t(m) %*% m) > 0, tol=0) cM <- crossprod(M) # pattern {FIXME ?? warning ...} tM <- tcrossprod(M) # pattern {FIXME ?? warning ...} if(verbose) {cat( "crossprod(M):\n"); show(cM) } if(verbose) {cat("tcrossprod(M):\n"); show(tM) } stopifnot(is(cM,"symmetricMatrix"), is(tM,"symmetricMatrix"), identical(as( cM, "ngCMatrix"), t(M) %*% M), identical(as( tM, "ngCMatrix"), M %*% t(M))) assert.EQ.mat( cM, crossprod(m) > 0) assert.EQ.mat( tM, as(tcrossprod(m),"matrix") > 0) ## Part II : matrix products pattern Matrices with numeric: ## ## "n" x "d" (and "d" x "n") --> "d", i.e. numeric in any case dM <- as(M, "dMatrix") stopifnot( ## dense ones: identical( M %*% m, m %*% M -> Mm) , ## sparse ones : identical3( M %*% dM, dM %*% M -> sMM, as(as(m %*% m, "sparseMatrix"), class(sMM))) ) if(verbose) {cat( "M %*% m:\n"); show(Mm) } stopifnotValid(Mm, "dMatrix") # not "n.." stopifnotValid(sMM, "dMatrix") # not "n.." stopifnotValid(cdM <- crossprod(dM, M), "CsparseMatrix") stopifnotValid(tdM <- tcrossprod(dM, M), "CsparseMatrix") assert.EQ.mat (cdM, crossprod(m)) assert.EQ.mat (tdM, tcrossprod(m)) stopifnot(identical( crossprod(dM), as(cdM, "symmetricMatrix"))) stopifnot(identical(tcrossprod(dM), as(tdM, "symmetricMatrix"))) invisible(TRUE) } sM <- new("ngTMatrix", i = rowi, j=coli, Dim=as.integer(c(N,N))) chk.ngMatrix(sM) # "ngTMatrix" chk.ngMatrix(tsM <- as(sM, "triangularMatrix")) # ntT chk.ngMatrix(as( sM, "CsparseMatrix")) # ngC chk.ngMatrix(as(tsM, "CsparseMatrix")) # ntC ## "l" --- logical Matrices -- use usual 0/1 arithmetic nsM <- sM sM <- as(sM, "lMatrix") sm <- as(sM, "matrix") stopifnot(identical(sm, as.matrix(nsM))) stopifnotValid(sMM <- sM %*% sM, "dsparseMatrix") assert.EQ.mat (sMM, sm %*% sm) assert.EQ.mat(t(sM) %*% sM, t(sm) %*% sm, tol=0) stopifnotValid(cM <- crossprod(sM), "dsCMatrix") stopifnotValid(tM <- tcrossprod(sM), "dsCMatrix") stopifnot(identical(cM, as(t(sM) %*% sM, "symmetricMatrix")), identical(tM, forceSymmetric(sM %*% t(sM)))) assert.EQ.mat( cM, crossprod(sm)) assert.EQ.mat( tM, as(tcrossprod(sm),"matrix")) dm <- as(sM, "denseMatrix") ## the following 6 products (dm o sM) all failed up to 2013-09-03 stopifnotValid(dm %*% sM, "CsparseMatrix")## failed {missing coercion} stopifnotValid(crossprod (dm , sM),"CsparseMatrix") stopifnotValid(tcrossprod(dm , sM),"CsparseMatrix") dm[2,1] <- TRUE # no longer triangular stopifnotValid( dm %*% sM, "CsparseMatrix") stopifnotValid(crossprod (dm , sM),"CsparseMatrix") stopifnotValid(tcrossprod(dm , sM),"CsparseMatrix") ## A sparse example - with *integer* matrix: M <- Matrix(cbind(c(1,0,-2,0,0,0,0,0,2.2,0), c(2,0,0,1,0), 0, 0, c(0,0,8,0,0),0)) t(M) (-4:5) %*% M stopifnot(as.vector(print(t(M %*% 1:6))) == c(as(M,"matrix") %*% 1:6)) (M.M <- crossprod(M)) MM. <- tcrossprod(M) stopifnot(class(MM.) == "dsCMatrix", class(M.M) == "dsCMatrix") M3 <- Matrix(c(rep(c(2,0),4),3), 3,3, sparse=TRUE) I3 <- as(Diagonal(3), "CsparseMatrix") m3 <- as.matrix(M3) iM3 <- solve(m3) stopifnot(all.equal(unname(iM3), matrix(c(3/2,0,-1,0,1/2,0,-1,0,1), 3))) assert.EQ.mat(solve(as(M3, "sparseMatrix")), iM3) assert.EQ.mat(solve(I3,I3), diag(3)) assert.EQ.mat(solve(M3, I3), iM3)# was wrong because I3 is unit-diagonal assert.EQ.mat(solve(m3, I3), iM3)# gave infinite recursion in (<=) 0.999375-10 stopifnot(identical(ttI3 <- crossprod(tru, I3), t(tru) %*% I3), identical(tI3t <- crossprod(I3, tru), t(I3) %*% tru), identical(I3tt <- tcrossprod(I3, tru), I3 %*% t(tru))) I3@uplo # U pper triangular tru@uplo# L ower triangular ## "FIXME": These are all FALSE now; the first one *is* ok (L o U); the others *not* isValid(tru %*% I3, "triangularMatrix") isValid(ttI3, "triangularMatrix") isValid(tI3t, "triangularMatrix") isValid(I3tt, "triangularMatrix") ## even simpler m <- matrix(0, 4,7); m[c(1, 3, 6, 9, 11, 22, 27)] <- 1 (mm <- Matrix(m)) (cm <- Matrix(crossprod(m))) stopifnot(identical(crossprod(mm), cm)) (tm1 <- Matrix(tcrossprod(m))) #-> had bug in 'Matrix()' ! (tm2 <- tcrossprod(mm)) Im2 <- solve(tm2[-4,-4]) P <- as(as.integer(c(4,1,3,2)),"pMatrix") p <- as(P, "matrix") P %*% mm assertError(mm %*% P) # dimension mismatch assertError(m %*% P) # ditto assertError(crossprod(t(mm), P)) # ditto stopifnotValid(tm1, "dsCMatrix") stopifnot( all.equal(tm1, tm2, tolerance =1e-15), identical(drop0(Im2 %*% tm2[1:3,]), Matrix(cbind(diag(3),0))), identical(p, as.matrix(P)), identical(P %*% m, as.matrix(P) %*% m), all(P %*% mm == P %*% m), all(P %*% mm - P %*% m == 0), all(t(mm) %*% P == t(m) %*% P), identical(crossprod(m, P), crossprod(mm, P)), TRUE) d <- function(m) as(m,"dsparseMatrix") IM1 <- as(c(3,1,2), "indMatrix") IM2 <- as(c(1,2,1), "indMatrix") assert.EQ.Mat(crossprod( IM1, IM2), crossprod(d(IM1),d(IM2)), tol=0)# failed at first iM <- as(cbind2(IM2, 0), "indMatrix") stopifnot(identical3(crossprod(iM), # <- wrong for Matrix <= 1.1-5 crossprod(iM, iM), Diagonal(x = 2:0))) N3 <- Diagonal(x=1:3) U3 <- Diagonal(3) # unit diagonal (@diag = "U") C3 <- as(N3, "CsparseMatrix") lM <- as(IM2, "lMatrix") nM <- as(IM2, "nMatrix") nCM <- as(nM, "CsparseMatrix") NM <- N3 %*% IM2 NM. <- C3 %*% IM2 stopifnot(Q.C.identical(NM, ## <- failed d(N3) %*% d(IM2), checkClass=FALSE), identical(NM, N3 %*% lM), identical(NM, N3 %*% nM) , ## all these "work" (but partly wrongly gave non-numeric Matrix: Q.C.identical(NM, NM., checkClass=FALSE) , mQidentical(as.matrix(NM.), array(c(1, 0, 3, 0, 2, 0), dim=3:2)) , identical(NM., C3 %*% lM) , identical(NM., C3 %*% nM) # wrongly gave n*Matrix , isValid(U3 %*% IM2, "dsparseMatrix")# was l* , isValid(U3 %*% lM, "dsparseMatrix")# was l* , isValid(U3 %*% nM, "dsparseMatrix")# was n* , identical(C3 %*% nM -> C3n, # wrongly gave ngCMatrix C3 %*% nCM) , isValid(C3n, "dgCMatrix") , identical3(U3 %*% IM2, # wrongly gave lgTMatrix U3 %*% lM -> U3l, # ditto U3 %*% nM) # wrongly gave ngTMatrix , isValid(U3l, "dgTMatrix") ) selectMethod("%*%", c("dtCMatrix", "ngTMatrix")) # x %*% .T.2.C(y) --> selectMethod("%*%", c("dtCMatrix", "ngCMatrix")) # .Call(Csparse_Csparse_prod, x, y) selectMethod("%*%", c("ddiMatrix", "indMatrix")) # x %*% as(y, "lMatrix") -> selectMethod("%*%", c("ddiMatrix", "lgTMatrix")) # diagCspprod(as(x, "Csp.."), y) selectMethod("%*%", c("ddiMatrix", "ngTMatrix")) # (ditto) stopifnot( isValid(show(crossprod(C3, nM)), "dgCMatrix"), # wrongly gave ngCMatrix identical3(## the next 4 should give the same (since C3 and U3 are symmetric): show(crossprod(U3, IM2)),# wrongly gave ngCMatrix crossprod(U3, nM), # ditto crossprod(U3, lM))) # wrongly gave lgCMatrix set.seed(123) for(n in 1:250) { n1 <- 2 + rpois(1, 10) n2 <- 2 + rpois(1, 10) N <- rpois(1, 25) ii <- seq_len(N + min(n1,n2)) IM1 <- as(c(sample(n1), sample(n1, N, replace=TRUE))[ii], "indMatrix") IM2 <- as(c(sample(n2), sample(n2, N, replace=TRUE))[ii], "indMatrix") ## stopifnot(identical(crossprod( IM1, IM2), ## crossprod(d(IM1), d(IM2)))) if(!identical(C1 <- crossprod( IM1, IM2 ), CC <- crossprod(d(IM1), d(IM2))) && !all(C1 == CC)) { cat("The two crossprod()s differ: C1 - CC =\n") print(C1 - CC) stop("The two crossprod()s differ!") } else if(n %% 25 == 0) cat(n, " ") }; cat("\n") ## two with an empty column --- these failed till 2014-06-14 X <- as(c(1,3,4,5,3), "indMatrix") Y <- as(c(2,3,4,2,2), "indMatrix") ## kronecker: stopifnot(identical(X %x% Y, as(as.matrix(X) %x% as.matrix(Y), "indMatrix"))) ## crossprod: (XtY <- crossprod(X, Y))# gave warning in Matrix 1.1-3 XtY_ok <- as(crossprod(as.matrix(X), as.matrix(Y)), "dgCMatrix") stopifnot(identical(XtY, XtY_ok)) # not true, previously ###------- %&% -------- Boolean Arithmetic Matrix products x5 <- c(2,0,0,1,4) D5 <- Diagonal(x=x5) L5 <- D5 != 0 ## an "ldiMatrix" NB: have *no* ndiMatrix class D. <- Diagonal(x=c(TRUE,FALSE,TRUE,TRUE,TRUE)) stopifnot(identical(D5 %&% D., L5)) stopifnot(identical(D5 %&% as(D.,"CsparseMatrix"), as(as(L5, "nMatrix"),"CsparseMatrix"))) set.seed(7) L <- Matrix(rnorm(20) > 1, 4,5) (N <- as(L, "nMatrix")) D <- Matrix(round(rnorm(30)), 5,6) # "dge", values in -1:1 (for this seed) L %&% D stopifnot(identical(L %&% D, N %&% D), all(L %&% D == as((L %*% abs(D)) > 0, "sparseMatrix"))) stopifnotValid(show(crossprod(N )) , "nsCMatrix") # (TRUE/FALSE : boolean arithmetic) stopifnotValid(show(crossprod(N +0)) -> cN0, "dsCMatrix") # -> numeric Matrix (with same "pattern") stopifnot(all(crossprod(N) == t(N) %&% N), identical(crossprod(N, boolArith=TRUE) -> cN., as(cN0 != 0, "nMatrix")), identical (cN., crossprod(L, boolArith=TRUE)), identical3(cN0, crossprod(L), crossprod(L, boolArith=FALSE)) ) stopifnotValid(cD <- crossprod(D, boolArith = TRUE), "nsCMatrix") # sparse: "for now" ## another slightly differing test "series" L.L <- crossprod(L) (NN <- as(L.L > 0,"nMatrix")) nsy <- as(NN,"denseMatrix") stopifnot(identical(NN, crossprod(NN)))# here stopifnotValid(csy <- crossprod(nsy), "dpoMatrix") ## ?? or FIXME ? give 'nsy', as {boolArith=NA -> TRUE if args are "nMatrix"} stopifnotValid(csy. <- crossprod(nsy, boolArith=TRUE),"nsCMatrix") stopifnot(all((csy > 0) == csy.), all(csy. == (nsy %&% nsy))) ## for "many" more seeds: set.seed(7); for(nn in 1:256) { L <- Matrix(rnorm(20) > 1, 4,5) D <- Matrix(round(rnorm(30)), 5,6) stopifnot(all(L %&% D == as((L %*% abs(D)) > 0, "sparseMatrix"))) } ## [Diagonal] o [0-rows/colums] : m20 <- matrix(nrow = 2, ncol = 0); m02 <- t(m20) M20 <- Matrix(nrow = 2, ncol = 0); M02 <- t(M20) stopifnot(identical(dim(Diagonal(x=c(1,2)) %*% m20), c(2L, 0L)), identical(dim(Diagonal(2) %*% M20), c(2L, 0L)), identical(dim(Diagonal(x=2:1) %*% M20), c(2L, 0L))) stopifnot(identical(dim(m02 %*% Diagonal(x=c(1,2))), c(0L, 2L)), identical(dim(M02 %*% Diagonal(2) ), c(0L, 2L)), identical(dim(M02 %*% Diagonal(x=2:1) ), c(0L, 2L))) cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' Matrix/tests/bind.R0000644000176200001440000001764314103006124013721 0ustar liggesusers#### Testing cbind() & rbind() -- based on cbind2() & rbind2() ## (where using 'cBind()' and 'rBind()' in Matrix) library(Matrix) source(system.file("test-tools.R", package = "Matrix"))# identical3() etc ### --- Dense Matrices --- m1 <- m2 <- m <- matrix(1:12, 3,4) dimnames(m2) <- list(LETTERS[1:3], letters[1:4]) dimnames(m1) <- list(NULL,letters[1:4]) M <- Matrix(m) M1 <- Matrix(m1) M2 <- Matrix(m2) stopifnot( identical3(cbind ( M, 10*M), show(cbind2( M, 10*M)), Matrix(cbind ( m, 10*m))) , identical3(cbind (M1, 100+M1), show(cbind2(M1, 100+M1)), Matrix(cbind (m1, 100+m1))) , identical3(cbind (M1, 10*M2), show(cbind2(M1, 10*M2)), Matrix(cbind (m1, 10*m2))) , identical3(cbind (M2, M1+M2), show(cbind2(M2, M1+M2)), Matrix(cbind (m2, m1+m2))) , identical(colnames(show(cbind(M1, MM = -1))), c(colnames(M1), "MM")) , identical3(rbind ( M, 10*M), show(rbind2( M, 10*M)), Matrix(rbind ( m, 10*m))) , identical3(rbind (M2, M1+M2), show(rbind2(M2, M1+M2)), Matrix(rbind (m2, m1+m2))) , Qidentical(show (rbind(R1 = 10:11, M1)), Matrix(rbind(R1 = 10:11, m1)), strict=FALSE) , TRUE) identical.or.eq <- function(x,y, tol=0, ...) { if(identical(x,y, ...)) TRUE else if(isTRUE(aeq <- all.equal(x,y, tolerance = tol))) structure(TRUE, comment = "not identical") else aeq } identicalShow <- function(x,y, ...) if(!isTRUE(id <- identical.or.eq(x, y, ...))) cat(id,"\n") ## Checking deparse.level { <==> example at end of ?cbind }: checkRN <- function(dd, B = rbind) { FN <- function(deparse.level) rownames(B(1:4, c=2,"a+"=10, dd, deparse.level=deparse.level)) rn <- c("1:4", "c", "a+", "dd", "") isMatr <- (length(dim(dd)) == 2) id <- if(isMatr) 5 else 4 identicalShow(rn[c(5,2:3, 5)], FN(deparse.level= 0)) # middle two names identicalShow(rn[c(5,2:3,id)], FN(deparse.level= 1)) # last shown if vector identicalShow(rn[c(1,2:3,id)], FN(deparse.level= 2)) # first shown; (last if vec.) } checkRN(10) # <==> ?cbind's ex checkRN(1:4) checkRN( rbind(c(0:1,0,0))) checkRN(Matrix(rbind(c(0:1,0,0)))) ## in R <= 3.4.1, from methods:::rbind bug : ## Modes: character, NULL Lengths: 4, 0 target is character, current is NULL checkRN(10 , rbind) checkRN(1:4, rbind) checkRN( rbind(c(0:1,0,0)), rbind) checkRN(Matrix(rbind(c(0:1,0,0))), rbind) cbind(0, Matrix(0+0:1, 1,2), 3:2)# FIXME? should warn - as with matrix() as(rbind(0, Matrix(0+0:1, 1,2), 3:2), "sparseMatrix") cbind(M2, 10*M2[nrow(M2):1 ,])# keeps the rownames from the first (im <- cbind(I = 100, M)) str(im) (mi <- cbind(M2, I = 1000)) str(mi) (m1m <- cbind(M,I=100,M2)) showProc.time() ## lgeMatrix -- rbind2() had bug (in C code): is.lge <- function(M) isValid(M, "lgeMatrix") stopifnot(exprs = { is.lge(rbind(M2 > 0, M2 < 0)) # had Error in rbind2(): ## REAL() can only be applied to a 'numeric', not a 'logical' is.lge(rbind(M2 < 0, M2 > 0)) # ditto is.lge(rbind(Matrix(1:6 %% 3 != 0, 2,3), FALSE)) is.lge(L <- rbind(Matrix(TRUE, 2,3), TRUE)) all(L) is.lge(rbind(Matrix(TRUE, 2,3), FALSE)) }) ### --- Diagonal / Sparse - had bugs D4 <- Diagonal(4) (D4T <- as(D4, "TsparseMatrix")) D4C <- as(D4T, "CsparseMatrix") c1 <- Matrix(0+0:3, 4, sparse=TRUE) ; r1 <- t(c1); r1 d4 <- rbind(Diagonal(4), 0:3) m4 <- cbind(Diagonal(x=-1:2), 0:3) c4. <- cbind(Diagonal(4), c1) c.4 <- cbind(c1, Diagonal(4)) r4. <- rbind(Diagonal(4), r1) r.4 <- rbind(r1, Diagonal(4)) assert.EQ.mat(d4, rbind(diag(4), 0:3)) assert.EQ.mat(m4, cbind(diag(-1:2), 0:3)) stopifnot(identical(Matrix(cbind(diag(3),0)), cbind2(Diagonal(3),0)), is(d4, "sparseMatrix"), is(m4, "sparseMatrix"), identical(t(d4), cbind(Diagonal(4), 0:3)), identical(t(m4), rbind(Diagonal(x=-1:2), 0:3))) showProc.time() ### --- Sparse Matrices --- identical4(cbind(diag(4), diag(4)), cbind(D4C, D4C), cbind(D4T, D4C), cbind(D4C, D4T)) nr <- 4 m. <- matrix(c(0, 2:-1), nr ,6) M <- Matrix(m.) (mC <- as(M, "dgCMatrix")) (mT <- as(M, "dgTMatrix")) stopifnot(identical(mT, as(mC, "dgTMatrix")), identical(mC, as(mT, "dgCMatrix"))) for(v in list(0, 2, 1:0)) for(fnam in c("cbind", "rbind")) { cat(fnam,"(m, v=", deparse(v),"), class(m) :") FUN <- get(fnam) for(m in list(M, mC, mT)) { cat("", class(m),"") assert.EQ.mat(FUN(v, m), FUN(v, m.)) ; cat(",") assert.EQ.mat(FUN(m, v), FUN(m., v)) ; cat(".") } cat("\n") } showProc.time() cbind(0, mC); cbind(mC, 0) cbind(0, mT); cbind(mT, 2) cbind(diag(nr), mT) stopifnot(identical(t(cbind(diag(nr), mT)), rbind(diag(nr), t(mT)))) (cc <- cbind(mC, 0,7,0, diag(nr), 0)) stopifnot(identical3(cc, cbind(mT, 0,7,0, diag(nr), 0), as( cbind( M, 0,7,0, diag(nr), 0), "dgCMatrix"))) cbind(mC, 1, 100*mC, 0, 0:2) cbind(mT, 1, 0, mT+10*mT, 0, 0:2) one <- 1 zero <- 0 dimnames(mC) <- dimnames(mT) <- list(LETTERS[1:4], letters[1:6]) op <- options(sparse.colnames = TRUE)# show colnames in print : cbind(mC, one, 100*mC, zero, 0:2) cbind(mC, one, 100*mC, zero, 0:2, deparse.level=0)# no "zero", "one" cbind(mC, one, 100*mC, zero, 0:2, deparse.level=2)# even "0:2" cbind(mT, one, zero, mT+10*mT, zero, 0:2) ## logical (sparse) - should remain logical : L5 <- Diagonal(n = 5, x = TRUE); v5 <- rep(x = c(FALSE,TRUE), length = ncol(L5)) stopifnot(is(show(rbind(L5,v5)), "lsparseMatrix"), is(show(cbind(v5,L5)), "lsparseMatrix"), is(rbind(L5, 2* v5), "dsparseMatrix"), is(cbind(2* v5, L5), "dsparseMatrix")) ## print() / show() of non-structural zeros: (m <- Matrix(c(0, 0, 2:0), 3, 5)) (m2 <- cbind(m,m)) (m4 <- rbind(m2,m2)) diag(m4) for(i in 1:6) { m4[i, i ] <- i m4[i,i+1] <- 0 } m4 ## now show some non-structural zeros: ## Mixture of dense and sparse/diagonal -- used to fail, even in 1.0-0 D5 <- Diagonal(x = 10*(1:5)) (D5.1 <- cbind2(D5, 1)) ## "FIXME" in newer versions of R, do not need Matrix() here: s42 <- Matrix(z42 <- cbind2(rep(0:1,4), rep(1:0,4)), sparse=TRUE) (C86 <- rbind(1, 0, D5.1, 0)) stopifnotValid(D5.1, "dgCMatrix") stopifnotValid(print(rbind2(Matrix(1:10, 2,5), D5)), "dgCMatrix") stopifnotValid(print(cbind2(Matrix(10:1, 5,2), D5.1)), "dgeMatrix") stopifnotValid(zz <- cbind2(z42, C86), "dgCMatrix") stopifnot(identical(zz, cbind2(s42, C86))) ## Using "nMatrix" (m1 <- sparseMatrix(1:3, 1:3)) # ngCMatrix m2 <- sparseMatrix(1:3, 1:3, x = 1:3) stopifnotValid(c12 <- cbind(m1,m2), "dgCMatrix") # was "ngC.." because of cholmod_horzcat ! stopifnotValid(c21 <- cbind(m2,m1), "dgCMatrix") # ditto stopifnotValid(r12 <- rbind(m1,m2), "dgCMatrix") # was "ngC.." because of cholmod_vertcat ! stopifnotValid(r21 <- rbind(m2,m1), "dgCMatrix") # ditto d1 <- as(m1, "denseMatrix") d2 <- as(m2, "denseMatrix") stopifnotValid(cbind2(d2,d1), "dgeMatrix") stopifnotValid(cbind2(d1,d2), "dgeMatrix")## gave an error in Matrix 1.1-5 stopifnotValid(rbind2(d2,d1), "dgeMatrix") stopifnotValid(rbind2(d1,d2), "dgeMatrix")## gave an error in Matrix 1.1-5 ## rbind2() / cbind2() mixing sparse/dense: used to "fail", ## ------------------- then (in 'devel', ~ 2015-03): completely wrong S <- .sparseDiagonal(2) s <- diag(2) S9 <- rbind(S,0,0,S,0,NaN,0,0,0,2)## r/cbind2() failed to determine 'sparse' in Matrix <= 1.2-2 s9 <- rbind(s,0,0,s,0,NaN,0,0,0,2) assert.EQ.mat(S9, s9) D <- Matrix(1:6, 3,2); d <- as(D, "matrix") T9 <- t(S9); t9 <- t(s9); T <- t(D); t <- t(d) stopifnot(identical(rbind (s9,d), rbind2(s9,d)), identical(rbind2(D,S9), t(cbind2(T,T9))), identical(rbind2(S9,D), t(cbind2(T9,T)))) assert.EQ.mat(rbind2(S9,D), rbind2(s9,d)) assert.EQ.mat(rbind2(D,S9), rbind2(d,s9)) ## now with cbind2() -- no problem! stopifnot(identical(cbind (t9,t), cbind2(t9,t))) assert.EQ.mat(cbind2(T9,T), cbind2(t9,t)) assert.EQ.mat(cbind2(T,T9), cbind2(t,t9)) options(op) showProc.time() Matrix/tests/spModel.matrix.R0000644000176200001440000002167414060675611015731 0ustar liggesuserslibrary(Matrix) ## This is example(sp....) -- much extended mEQ <- function(x,y, ...) { ## first drop columns from y which are all 0 : if(any(i0 <- colSums(abs(x)) == 0)) { message(gettextf("x had %d zero-columns", sum(i0))) x <- x[, !i0, drop=FALSE] } if(any(i0 <- colSums(abs(y)) == 0)) { message(gettextf("y had %d zero-columns", sum(i0))) y <- y[, !i0, drop=FALSE] } isTRUE(all.equal(x,y, tolerance =0, ...)) } ##' Is sparse.model.matrix() giving the "same" as dense model.matrix() ? ##' ##' @return logical ##' @param frml formula ##' @param dat data frame ##' @param showFactors ##' @param ... further arguments passed to {sparse.}model.matrix() isEQsparseDense <- function(frml, dat, showFactors = isTRUE(getOption("verboseSparse")), ...) { ## Author: Martin Maechler, Date: 21 Jul 2009 stopifnot(inherits(frml, "formula"), is.data.frame(dat)) if(showFactors) print(attr(terms(frml, data=dat), "factors")) smm <- sparse.model.matrix(frml, dat, ...) mm <- model.matrix(frml, dat, ...) sc <- smm@contrasts mEQ(as(smm, "generalMatrix"), Matrix(mm, sparse=TRUE)) & identical(smm@assign, attr(mm, "assign")) & (if(is.null(mc <- attr(mm, "contrasts"))) length(sc) == 0 else identical(sc, mc)) } ### ------------ all the "datasets" we construct for use ------------- dd <- data.frame(a = gl(3,4), b = gl(4,1,12))# balanced 2-way (dd3 <- cbind(dd, c = gl(2,6), d = gl(3,8))) dd. <- dd3[- c(1, 13:15, 17), ] set.seed(17) dd4 <- cbind(dd, c = gl(2,6), d = gl(8,3)) dd4 <- cbind(dd4, x = round(rnorm(nrow(dd4)), 1)) dd4 <- dd4[- c(1, 13:15, 17), ] ##-> 'd' has unused levels dM <- dd4 dM$X <- outer(10*rpois(nrow(dM), 2), 1:3) dM$Y <- cbind(pmax(0, dM$x - .3), floor(4*rnorm(nrow(dM)))) str(dM)# contains *matrices* options("contrasts") # the default: "contr.treatment" op <- options(sparse.colnames = TRUE) # for convenience stopifnot(identical(## non-sensical, but "should work" (with a warning each): sparse.model.matrix(a~ 1, dd), sparse.model.matrix( ~ 1, dd))) sparse.model.matrix(~ a + b, dd, contrasts = list(a="contr.sum")) sparse.model.matrix(~ a + b, dd, contrasts = list(b="contr.SAS")) xm <- sparse.model.matrix(~ x, dM) # {no warning anymore ...} dxm <- Matrix(model.matrix(~ x, dM), sparse=TRUE) stopifnot(is(xm, "sparseMatrix"), mEQ(as(xm,"generalMatrix"), dxm)) ## Sparse method is equivalent to the traditional one : stopifnot(isEQsparseDense(~ a + b, dd), suppressWarnings(isEQsparseDense(~ x, dM)), isEQsparseDense(~ 0 + a + b, dd), identical(sparse.model.matrix(~ 0 + a + b, dd), sparse.model.matrix(~ -1 + a + b, dd)), isEQsparseDense(~ a + b, dd, contrasts = list(a="contr.sum")), isEQsparseDense(~ a + b, dd, contrasts = list(a="contr.SAS")), ## contrasts as *functions* or contrast *matrices* : isEQsparseDense(~ a + b, dd, contrasts = list(a=contr.sum, b=contr.treatment(4))), isEQsparseDense(~ a + b, dd, contrasts = list(a=contr.SAS(3),# << ok after 'contrasts<-' update b = function(n, contr=TRUE, sparse=FALSE) contr.sum(n=n, contr=contr, sparse=sparse)))) sm <- sparse.model.matrix(~a * b, dd, contrasts = list(a= contr.SAS(3, sparse = TRUE))) sm ## FIXME: Move part of this to ../../MatrixModels/tests/ ##stopifnot(all(sm == model.Matrix( ~a * b, dd, contrasts= list(a= contr.SAS(3))))) ## stopifnot(isEQsparseDense(~ a + b + c + d, dd.)) stopifnot(isEQsparseDense(~ a + b:c + c + d, dd.)) ## no intercept -- works too stopifnot(isEQsparseDense(~ -1+ a + b + c + d, dd.)) stopifnot(isEQsparseDense(~ 0 + a + b:c + c + d, dd.)) Sparse.model.matrix <- function(...) { s <- sparse.model.matrix(...) as(s, "generalMatrix")# dropping 'assign',.. slots } ## dim(mm <- Matrix(model.matrix(~ a + b + c + d, dd4), sparse=TRUE)) dim(sm <- Sparse.model.matrix(~ a + b + c + d, dd4)) ## was (19 13), when 'drop.unused.levels' was implicitly TRUE dim(sm. <- Sparse.model.matrix(~ a + b + c + d, dd4, drop.unused.levels=TRUE)) stopifnot(mEQ(sm , mm), ## (both have a zero column) mEQ(sm., mm)) ## << that's ok, since mm has all-0 column ! ## look at this : all(mm[,"d5"] == 0) ## !!!! --- correct: a column of all 0 <--> dropped level! stopifnot(all.equal(sm., mm[, - which("d5" == colnames(mm))])) ## indeed ! ## i.e., sm has just dropped an all zero column --- which it should! stopifnot(isEQsparseDense(~ 1 + sin(x) + b*c + a:x, dd4, show=TRUE)) stopifnot(isEQsparseDense(~ I(a) + b*c + a:x, dd4, show=TRUE)) ## no intercept -- works too stopifnot(isEQsparseDense(~ 0+ I(a) + b*c + a:x, dd4, show=TRUE)) f <- ~ 1 + a + b*c + a*x attr(terms(f, data=dd4), "factors") dim(mm <- Matrix(model.matrix(f, data=dd4), sparse=TRUE)) dim(sm <- Sparse.model.matrix(f, data=dd4)) # == stopifnot(mEQ(sm, mm)) f <- ~ a*X + X*Y + a*c attr(terms(f, data=dM), "factors") dim(mm <- Matrix(model.matrix(f, data=dM), sparse=TRUE)) dim(sm <- Sparse.model.matrix(f, data=dM, verbose=TRUE)) stopifnot(mEQ(sm, mm)) ## high order f <- ~ a:b:X:c:Y mm <- Matrix(model.matrix(f, data=dM), sparse=TRUE) sm <- Sparse.model.matrix(f, data=dM, verbose=2) stopifnot(mEQ(sm, mm)) f <- ~ 1 + a + b*c + a*x + b*d*x + b:c:d attr(terms(f, data=dd4), "factors") dim(mm <- Matrix(model.matrix(f, data=dd4), sparse=TRUE)) ## 19 100 dim(sm <- Sparse.model.matrix(f, data=dd4)) ## (ditto) dim(sm. <- Sparse.model.matrix(f, data=dd4, drop.unused.levels=TRUE)) # 19 88 stopifnot(mEQ(sm, mm), mEQ(sm., mm))# {32, 32; 20 and 32 zero-columns ..} ## now get a bit courageous: ## ## stopifnot(isEQsparseDense(~ 1 + c + a:b:d, dat=dd4)) dim(mm <- Matrix(model.matrix(~ 1 + a + b*c + a:b:c:d, data=dd4), sparse=TRUE)) ## 19 202 dim(sm <- Sparse.model.matrix(~ 1 + a + b*c + a:b:c:d, data=dd4)) dim(sm. <- Sparse.model.matrix(~ 1 + a + b*c + a:b:c:d, data=dd4, drop.unused.levels=TRUE)) stopifnot(mEQ(sm, mm), mEQ(sm., mm))# {173, 173, 149 and 173 zero-columns !} ## stopifnot(isEQsparseDense(~ 1 + a + b*c + a:b:c:d, dat=dd4)) dim(mm <- Matrix(model.matrix(~ 1 + a + b:c + a:b:d, data=dd4), sparse=TRUE)) ## 19 107 dim(sm <- Sparse.model.matrix(~ 1 + a + b:c + a:b:d, data=dd4)) dim(sm. <- Sparse.model.matrix(~ 1 + a + b:c + a:b:d, data=dd4, drop.unused.levels=TRUE)) stopifnot(mEQ(sm, mm), mEQ(sm., mm)) dim(mm <- Matrix(model.matrix(~ a*b*c +c*d, dd4), sparse=TRUE)) ## 19 38 dim(sm <- Sparse.model.matrix(~ a*b*c +c*d, dd4))# (ditto) dim(sm. <- Sparse.model.matrix(~ a*b*c +c*d, dd4, drop.unused.levels=TRUE)) stopifnot(mEQ(sm, mm), mEQ(sm., mm)) f1 <- ~ (a+b+c+d)^2 + (a+b):c:d + a:b:c:d f2 <- ~ (a+b+c+d)^4 - a:b:c - a:b:d mm1 <- Matrix(model.matrix(f1, dd4), sparse=TRUE) dim(mm2 <- Matrix(model.matrix(f2, dd4), sparse=TRUE)) sm1 <- sparse.model.matrix(f1, dd4) dim(sm2 <- sparse.model.matrix(f2, dd4)) s.1 <- sparse.model.matrix(f1, dd4, drop.unused.levels=TRUE) dim(s.2 <- sparse.model.matrix(f2, dd4, drop.unused.levels=TRUE)) stopifnot(identical(mm1,mm2), identical(sm1,sm2), identical(s.1,s.2), mEQ(sm1,mm1), mEQ(s.1,mm1)) str(dd <- data.frame(d = gl(10,6), a = ordered(gl(3,20)))) X. <- sparse.model.matrix(~ a + d, data = dd) ## failed because of contr.poly default in Matrix 0.999375-33 stopifnot(dim(X.) == c(60, 12), nnzero(X.) == 234, isEQsparseDense(~ 0 + d + I(as.numeric(d)^2), dd)) ## I(.) failed (upto 2010-05-07) ## When the *contrasts* are sparse : spC <- as(contrasts(dd$d), "sparseMatrix") ddS <- dd contrasts(ddS$d) <- spC Xs <- sparse.model.matrix(~ a + d, data=ddS) stopifnot(exprs = { inherits(spC, "sparseMatrix") identical(spC, contrasts(ddS[,"d"])) mEQ(X., Xs) }) ## Fixing matrix-Bugs [#6673] by Davor Josipovic df <- data.frame('a' = factor(1:3), 'b' = factor(4:6)) Cid <- lapply(df, contrasts, contrasts=FALSE) CidS <- lapply(df, contrasts, contrasts=FALSE, sparse=TRUE) X2 <- sparse.model.matrix(~ . -1, data = df, contrasts.arg = Cid) X2S <- sparse.model.matrix(~ . -1, data = df, contrasts.arg = CidS) X2 stopifnot(all.equal(X2, X2S, tol=0)) ## X2S was missing the last column ('b6') in Matrix <= 1.x-y ## Fixing (my repr.ex.) of Matrix bug [#6657] by Nick Hanewinckel mkD <- function(n, p2 = 2^ceiling(log2(n)), sd = 10, rf = 4) { stopifnot(p2 >= n, n >= 0, p2 %% 2 == 0) G <- gl(2, p2/2, labels=c("M","F"))[sample.int(p2, n)] data.frame(sex = G, age = round(rf*rnorm(n, m = 32 + 2*as.numeric(G), sd=sd)) / rf) } set.seed(101) D1 <- mkD(47) Xs <- sparse.model.matrix(~ sex* poly(age, 2), data = D1) ## Error in model.spmatrix(..): no slot of name "i" for .. class "dgeMatrix" validObject(Xs) stopifnot(exprs = { identical(c(47L, 6L), dim(Xs)) identical(colnames(Xs)[3:6], c(1:2, outer("sexF", 1:2, paste, sep=":"))) all(Xs == model.matrix(~ sex* poly(age, 2), data = D1)) }) cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' if(!interactive()) warnings() Matrix/tests/write-read.R0000644000176200001440000000334611200260001015032 0ustar liggesuserslibrary(Matrix) #### Read / Write (sparse) Matrix objects ---------------------- ### Rebuild the 'mm' example matrix, now in KNex data ### This is no longer really important, as we now use ### ../data/KNex.R which creates the S4 object *every time* data(KNex) ## recreate 'mm' from list : sNms <- c("Dim", "i","p","x") L <- lapply(sNms, function(SN) slot(KNex$mm, SN)); names(L) <- sNms mm2 <- new(class(KNex$mm)) for (n in sNms) slot(mm2, n) <- L[[n]] stopifnot(validObject(mm2), identical(mm2, KNex$mm)) L$y <- KNex$y ## save(L, file = "/u/maechler/R/Pkgs/Matrix/inst/external/KNex_slots.rda") ## recreate 'mm' from ASCI file : mmT <- as(KNex$mm, "dgTMatrix") str(mmT) mm3 <- cbind(i = mmT@i, j = mmT@j, x = mmT@x) write.table(mm3, file = "mm-Matrix.tab", row.names=FALSE)# -> ASCII version str(mmr <- read.table("mm-Matrix.tab", header = TRUE)) mmr$i <- as.integer(mmr$i) mmr$j <- as.integer(mmr$j) mmN <- with(mmr, new("dgTMatrix", Dim = c(max(i)+1:1,max(j)+1:1), i = i, j = j, x = x)) stopifnot(identical(mmT, mmN)) # !! ## weaker (and hence TRUE too): stopifnot(all.equal(as(mmN, "matrix"), as(mmT, "matrix"), tol=0)) mm <- as(mmN, "dgCMatrix") stopifnot(all.equal(mm, KNex$mm)) ## save(mm, file = "....../Matrix/data/mm.rda", compress = TRUE) A <- Matrix(c(1,0,3,0,0,5), 10, 10, sparse = TRUE) # warning about [6] vs [10] (fname <- file.path(tempdir(), "kk.mm")) writeMM(A, fname) (B <- readMM(fname)) validObject(B) Bc <- as(B, "CsparseMatrix") stopifnot(identical(A, Bc)) fname <- system.file("external", "wrong.mtx", package = "Matrix") r <- try(readMM(fname)) stopifnot(inherits(r, "try-error"), length(grep("readMM.*row.*1:nr", r)) == 1) ## gave a much less intelligible error message Matrix/tests/group-methods.R0000644000176200001440000004353414103006124015600 0ustar liggesusers### Testing the group methods --- some also happens in ./Class+Meth.R library(Matrix) source(system.file("test-tools.R", package = "Matrix"))# identical3() etc assertErrV <- function(e) tools::assertError(e, verbose=TRUE) cat("doExtras:",doExtras,"\n") set.seed(2001) mm <- Matrix(rnorm(50 * 7), nc = 7) xpx <- crossprod(mm)# -> "factors" in mm ! round(xpx, 3) # works via "Math2" y <- rnorm(nrow(mm)) xpy <- crossprod(mm, y) res <- solve(xpx, xpy) signif(res, 4) # 7 x 1 Matrix stopifnot(all(signif(res) == signif(res, 6)), all(round (xpx) == round (xpx, 0))) ## exp(): component wise signif(dd <- (expm(xpx) - exp(xpx)) / 1e34, 3)# 7 x 7 validObject(xpx) validObject(xpy) validObject(dd) ## "Math" also, for log() and [l]gamma() which need special treatment stopifnot(exprs = { identical(exp(res)@x, exp(res@x)) identical(log(abs(res))@x, log(abs((res@x)))) identical(lgamma(res)@x, lgamma(res@x)) }) ## "Arith" / "Ops" M <- Matrix(1:12, 4,3) m <- cbind(4:1) stopifnot(exprs = { identical(M*m, M*c(m)) # M*m failed in Matrix_1.3-3 pre-release: identical(m*M, c(m)*M) ## M*m: Error in eval(....) : object 'x1' not found isValid(M1 <- M[, 1, drop=FALSE], "dgeMatrix") identical(M*M1, M*M1[,1]) # M*M1 failed .. identical(M-M1, M-M1[,1]) identical(M/M1, M/M1[,1]) identical(M1*M, M1[,1]*M) identical(M1-M, M1[,1]-M) identical(M1/M, M1[,1]/M) }) ###--- sparse matrices --------- m <- Matrix(c(0,0,2:0), 3,5) (mC <- as(m, "dgCMatrix")) sm <- sin(mC) stopifnot(class(sm) == class(mC), class(mC) == class(mC^2), dim(sm) == dim(mC), class(0 + 100*mC) == class(mC), all.equal(0.1 * ((0 + 100*mC)/10), mC), all.equal(sqrt(mC ^ 2), mC), all.equal(m^m, mC^mC), identical(mC^2, mC * mC), identical(mC*2, mC + mC) ) x <- Matrix(rbind(0,cbind(0, 0:3,0,0,-1:2,0),0)) x # sparse (x2 <- x + 10*t(x)) stopifnot(is(x2, "sparseMatrix"), identical(x2, t(x*10 + t(x))), identical(x, as((x + 10) - 10, class(x)))) (px <- Matrix(x^x - 1))#-> sparse again stopifnot(px@i == c(3,4,1,4), px@x == c(3,26,-2,3)) ## From: "Florent D." .. Thu, 23 Feb 2012 -- bug report ##---> MM: Make a regression test: tst <- function(n, i = 1) { stopifnot(i >= 1, n >= i) D <- .sparseDiagonal(n) ee <- numeric(n) ; ee[i] <- 1 stopifnot(all(D - ee == diag(n) - ee), all(D * ee == diag(n) * ee), all(ee - D == ee - diag(n)), {C <- (ee / D == ee / diag(n)); all(is.na(C) | C)}, TRUE) } nn <- if(doExtras) 27 else 7 tmp <- sapply(1:nn, tst) # failed in Matrix 1.0-4 i <- sapply(1:nn, function(i) sample(i,1)) tmp <- mapply(tst, n= 1:nn, i= i)# failed too (lsy <- new("lsyMatrix", Dim = c(2L,2L), x=c(TRUE,FALSE,TRUE,TRUE))) nsy <- as(lsy, "nMatrix") (t1 <- new("ltrMatrix", Dim = c(1L,1L), x = TRUE)) (t2 <- new("ltrMatrix", Dim = c(2L,2L), x = rep(TRUE,4))) stopifnot(all(lsy), # failed in Matrix 1.0-4 all(nsy), # dito all(t1), # " ## ok previously (all following): !all(t2), all(sqrt(lsy) == 1)) dsy <- lsy+1 D3 <- Diagonal(x=4:2); L7 <- Diagonal(7) > 0 validObject(xpp <- pack(round(xpx,2))) lsp <- xpp > 0 (dsyU <- as(as(.diag2sT(D3), "dMatrix"), "denseMatrix")) lsyU <- as(as(.diag2sT(Diagonal(5) > 0), "lMatrix"), "denseMatrix") str(lsyU) stopifnot({ isValid(dsyU, "dsyMatrix") && dsyU@uplo == "U" isValid(dsyL <- t(dsyU), "dsyMatrix") && dsyL@uplo == "L" isValid(dspU <- pack(dsyU), "dspMatrix") && dspU@uplo == "U" isValid(dspL <- pack(dsyL), "dspMatrix") && dspL@uplo == "L" isValid(lsyU, "lsyMatrix") && lsyU@uplo == "U" isValid(lsyL <- t(lsyU), "lsyMatrix") && lsyL@uplo == "L" isValid(lspU <- pack(lsyU), "lspMatrix") && lspU@uplo == "U" isValid(lspL <- pack(lsyL), "lspMatrix") && lspL@uplo == "L" ## ## log(x, ) -- was mostly *wrong* upto 2019-10 [Matrix <= 1.2-17] all.equal(log(abs(dsy), 2), log2(abs(dsy))) all.equal(log(abs(dsyL),2), log2(abs(dsyL))) all.equal(log(abs(dspU),2), log2(abs(dspU))) all.equal(log(abs(dspL),2), log2(abs(dspL))) ## These always worked, as {0,1} -> {-Inf,0} independent of 'base': all.equal(log(abs(lsy), 2), log2(abs(lsy))) all.equal(log(abs(lsyL),2), log2(abs(lsyL))) all.equal(log(abs(lspU),2), log2(abs(lspU))) all.equal(log(abs(lspL),2), log2(abs(lspL))) ## all.equal(log(abs(res), 2), log2(abs(res))) all.equal(log(abs(xpy), 2), log2(abs(xpy))) all.equal(log(abs(xpp), 2), log2(abs(xpp))) all.equal(log(abs( D3), 2), log2(abs( D3))) all.equal(log(abs( L7), 2), log2(abs( L7))) }) showProc.time() set.seed(111) local({ for(i in 1:(if(doExtras) 20 else 5)) { M <- rspMat(n=1000, 200, density = 1/20) v <- rnorm(ncol(M)) m <- as(M,"matrix") stopifnot(all(t(M)/v == t(m)/v)) cat(".") }});cat("\n") ## Now just once, with a large such matrix: local({ n <- 100000; m <- 30000 AA <- rspMat(n, m, density = 1/20000) v <- rnorm(m) st <- system.time({ BB <- t(AA)/v # should happen *fast* stopifnot(dim(BB) == c(m,n), is(BB, "sparseMatrix")) }) str(BB) print(st) if(Sys.info()[["sysname"]] == "Linux") { mips <- try(as.numeric(sub(".*: *", '', grep("bogomips", readLines("/proc/cpuinfo"), ignore.case=TRUE, # e.g. ARM : "BogoMIPS" value=TRUE)[[1]]))) if(is.numeric(mips) && all(mips) > 0) stopifnot(st[1] < 1000/mips)# ensure there was no gross inefficiency } }) ###----- Compare methods ---> logical Matrices ------------ l3 <- upper.tri(matrix(, 3, 3)) (ll3 <- Matrix(l3)) dt3 <- (99* Diagonal(3) + (10 * ll3 + Diagonal(3)))/10 (dsc <- crossprod(ll3)) stopifnot(identical(ll3, t(t(ll3))), identical(dsc, t(t(dsc)))) stopifnotValid(ll3, "ltCMatrix") stopifnotValid(dsc, "dsCMatrix") stopifnotValid(dsc + 3 * Diagonal(nrow(dsc)), "dsCMatrix") stopifnotValid(dt3, "triangularMatrix") # remained triangular stopifnotValid(dt3 > 0, "triangularMatrix")# ditto (lm1 <- dsc >= 1) # now ok (lm2 <- dsc == 1) # now ok nm1 <- as(lm1, "nMatrix") (nm2 <- as(lm2, "nMatrix")) stopifnot(validObject(lm1), validObject(lm2), validObject(nm1), validObject(nm2), identical(dsc, as(dsc * as(lm1, "dMatrix"), "dsCMatrix"))) crossprod(lm1) # lm1: "lsC*" cnm1 <- crossprod(nm1) stopifnot(is(cnm1, "symmetricMatrix"), ## whereas the %*% is not: Q.eq(cnm1, nm1 %*% nm1)) dn1 <- as(nm1, "denseMatrix") stopifnot(all(dn1 == nm1)) dsc[2,3] <- NA ## now has an NA (and no longer is symmetric) ## ----- and "everything" is different ## also add "non-structural 0": dsc@x[1] <- 0 dsc dsc/ 5 dsc + dsc dsc - dsc dsc + 1 # -> no longer sparse Tsc <- as(dsc, "TsparseMatrix") dsc. <- drop0(dsc) stopifnot(Q.eq(dsc., Matrix((dsc + 1) - 1)), identical(as(-Tsc,"CsparseMatrix"), (-1) * Tsc), identical(-dsc., (-1) * dsc.), identical3(-Diagonal(3), Diagonal(3, -1), (-1) * Diagonal(3)), Q.eq(dsc., Matrix((Tsc + 1) -1)), # ok (exact arithmetic) Q.eq(0 != dsc, dsc != Matrix(0, 3, 3)), Q.eq(0 != dsc, dsc != c(0,0)) # with a warning ("not multiple ..") ) str(lm1 <- dsc >= 1) # now ok (NA in proper place, however: lm1 ## NA used to print as ' ' , now 'N' (lm2 <- dsc == 1)# ditto stopifnot(identical(crossprod(lm1),# "lgC": here works! crossprod(as(lm1, "dMatrix"))), identical(lm2, lm1 & lm2), identical(lm1, lm1 | lm2)) ddsc <- kronecker(Diagonal(7), dsc) isValid(ddv <- rowSums(ddsc, sparse=TRUE), "sparseVector") sv <- colSums(kC <- kronecker(mC,kronecker(mC,mC)), sparse=TRUE) EQ <- ddv == rowSums(ddsc) na.ddv <- is.na(ddv) sM <- Matrix(pmax(0, round(rnorm(50*15, -1.5), 2)), 50,15) stopifnot(sv == colSums(kC), is.na(as.vector(ddv)) == na.ddv, isValid(sM/(-7:7), "CsparseMatrix"), all(EQ | na.ddv)) ## Subclasses (!) setClass("m.spV", contains = "dsparseVector") (m.ddv <- as(ddv, "m.spV")) stopifnot(all.equal(m.ddv, ddv))# failed setClass("m.dgC", contains = "dgCMatrix") (m.mC <- as(mC, "m.dgC")) stopifnot(all(m.mC == mC)) ## 2-level inheritance (R-forge Matrix bug #6185) ## https://r-forge.r-project.org/tracker/index.php?func=detail&aid=6185&group_id=61&atid=294 setClass("Z", representation(zz = "list")) setClass("C", contains = c("Z", "dgCMatrix")) setClass("C2", contains = "C") setClass("C3", contains = "C2") (cc <- as(mC, "C")) c2 <- as(mC, "C2") c3 <- as(mC, "C3") # as(*, "matrix") of these __fail__ in R < 3.5.0 # before R_check_class_and_super() became better : print(c2) print(c3) ## ==> Error in asMethod(object) : invalid class of object to as_cholmod_sparse stopifnot(identical(cc > 0, mC > 0 -> m.gt.0), ## cc > 0 - gave error in Matrix <= 1.2-11 identical(c2 > 0, m.gt.0), identical(c3 > 0, m.gt.0)) ## Just for print "show": z <- round(rnorm(77), 2) z[sample(77,10)] <- NA (D <- Matrix(z, 7)) # dense z[sample(77,15)] <- 0 (D <- Matrix(z, 7)) # sparse abs(D) >= 0.5 # logical sparse ## For the checks below, remove some and add a few more objects: rm(list= ls(pat="^.[mMC]?$")) T3 <- Diagonal(3) > 0; stopifnot(T3@diag == "U") # "uni-diagonal" validObject(dtp <- pack(as(dt3, "denseMatrix"))) stopifnot(exprs = { isValid(lsC <- as(lsp, "sparseMatrix"), "lsCMatrix") ## 0-extent matrices {fixes in Feb.2019}: isValid(L00 <- L7[FALSE,FALSE], "ldiMatrix") isValid(x60 <- x2[,FALSE], "dgCMatrix") identical(t(x60), x06 <- x2[FALSE,]) isValid(x00 <- x06[,FALSE], "dgCMatrix") isValid(sv0 <- as(x06, "sparseVector"), "dsparseVector") }) showProc.time() ### Consider "all" Matrix classes cl <- sapply(ls(), function(.) class(get(.))) Mcl <- cl[vapply(cl, extends, "Matrix", FUN.VALUE=NA) | vapply(cl, extends, "sparseVector", FUN.VALUE=NA)] table(Mcl) ## choose *one* of each class: ## M.objs <- names(Mcl[!duplicated(Mcl)]) ## choose all M.objs <- names(Mcl) # == the ls() from above Mat.objs <- M.objs[vapply(M.objs, function(nm) is(get(nm), "Matrix"), NA)] MatDims <- t(vapply(Mat.objs, function(nm) dim(get(nm)), 0:1)) ## Nice summary info : noquote(cbind(Mcl[Mat.objs], format(MatDims))) if(!doExtras && !interactive()) q("no") ## (saving testing time) ### Systematically look at all "Ops" group generics for "all" Matrix classes ### -------------- Main issue: Detect infinite recursion problems mDims <- MatDims %*% (d.sig <- c(1, 1000)) # "dim-signature" to match against m2num <- function(m) { if(is.integer(m)) storage.mode(m) <- "double" ; m } M.knd <- Matrix:::.M.kind cat("Checking all Ops group generics for a set of arguments:\n", "-------------------------------------------------------\n", sep='') op <- options(warn = 2)#, error=recover) for(gr in getGroupMembers("Ops")) { cat(gr,"\n",paste(rep.int("=",nchar(gr)),collapse=""),"\n", sep='') v0 <- if(gr == "Arith") numeric() else logical() for(f in getGroupMembers(gr)) { line <- strrep("-", nchar(f) + 2) cat(sprintf("%s\n%s :\n%s\n", line, dQuote(f), line)) for(nm in M.objs) { if(doExtras) cat(" '",nm,"' ", sep="") M <- get(nm, inherits=FALSE) n.m <- NROW(M) cat("o") for(x in list(TRUE, -3.2, 0L, seq_len(n.m))) { cat(".") validObject(r1 <- do.call(f, list(M,x))) validObject(r2 <- do.call(f, list(x,M))) stopifnot(dim(r1) == dim(M), dim(r2) == dim(M), allow.logical0 = TRUE) } ## M o 0-length === M : validObject(M0. <- do.call(f, list(M, numeric()))) validObject(.M0 <- do.call(f, list(numeric(), M))) if(length(M)) # o <0-length v> == 0-length v stopifnot(identical(M0., v0), identical(.M0, v0)) else if(is(M, "Matrix")) stopifnot(identical(M0., as(M, if(gr == "Arith") "dMatrix" else "lMatrix")), identical(M0., .M0)) else # if(is(M, "sparseVector")) of length 0 stopifnot(identical(M0., v0), identical(.M0, v0)) ## M o x <- numeric(n.m) if(length(x)) x[c(1,length(x))] <- 1:2 sv <- as(x, "sparseVector") cat("s.") validObject(r3 <- do.call(f, list(M, sv))) stopifnot(identical(dim(r3), dim(M))) if(doExtras && is(M, "Matrix")) { ## M o d <- dim(M) ds <- sum(d * d.sig) # signature .. match with all other sigs match. <- ds == mDims # (matches at least itself) cat("\nM o M:") for(oM in Mat.objs[match.]) { M2 <- get(oM) ## R4 := M f M2 validObject(R4 <- do.call(f, list(M, M2))) cat(".") for(M. in list(as.mat(M), M)) { ## two cases .. r4 <- m2num(as.mat(do.call(f, list(M., as.mat(M2))))) cat(",") if(!identical(r4, as.mat(R4))) { cat(sprintf("\n %s %s %s gave not identical r4 & R4:\n", nm, f, oM)); print(r4); print(R4) C1 <- (eq <- R4 == r4) | (N4 <- as.logical((nr4 <- is.na(eq)) & !is.finite(R4))) if(isTRUE(all(C1))) cat(sprintf( " --> %s %s %s (ok): only difference is %s (matrix) and %s (Matrix)\n", M.knd(M), f, M.knd(M2) , paste(vapply(unique(r4[N4]), format, ""), collapse="/") , paste(vapply(unique(R4[N4]), format, ""), collapse="/") )) else if(isTRUE(all(eq | (nr4 & Matrix:::is0(R4))))) cat(" --> 'ok': only difference is 'NA' (matrix) and 0 (Matrix)\n") else stop("R4 & r4 differ \"too much\"") } } cat("i") } } } cat("\n") } } if(length(warnings())) print(summary(warnings())) showProc.time() ###---- Now checking 0-length / 0-dim cases <==> to R >= 3.4.0 ! ## arithmetic, logic, and comparison (relop) for 0-extent arrays (m <- Matrix(cbind(a=1[0], b=2[0]))) Lm <- as(m, "lMatrix") ## Im <- as(m, "iMatrix") stopifnot( identical(m, m + 1), identical(m, m + 1[0]), identical(m, m + NULL),## now (2016-09-27) ok identical(m, Lm+ 1L) , identical(m, m+2:3), ## gave error "length does not match dimension" identical(Lm, m & 1), identical(Lm, m | 2:3),## had Warning "In .... : data length exceeds size of matrix" identical(Lm, m & TRUE[0]), identical(Lm, m | FALSE[0]), identical(Lm, m > NULL), identical(Lm, m > 1), identical(Lm, m > .1[0]),## was losing dimnames identical(Lm, m > NULL), ## was not-yet-implemented identical(Lm, m <= 2:3) ## had "wrong" warning ) mm <- m[,c(1:2,2:1,2)] assertErrV(m + mm) # ... non-conformable arrays assertErrV(m | mm) # ... non-conformable arrays ## Matrix: ok ; R : ok, in R >= 3.4.0 assertErrV(m == mm) ## in R <= 3.3.x, relop returned logical(0) and m + 2:3 returned numeric(0) ## ## arithmetic, logic, and comparison (relop) -- inconsistency for 1x1 array o = 2>: (m1 <- Matrix(1,1,1, dimnames=list("Ro","col"))) ## col ## Ro 1 ## Before Sep.2016, here, Matrix was the *CONTRARY* to R: assertErrV(m1 + 1:2)## M.: "correct" ERROR // R 3.4.0: "deprecated" warning (--> will be error) assertErrV(m1 & 1:2)## gave 1 x 1 [TRUE] -- now Error, as R assertErrV(m1 <= 1:2)## gave 1 x 1 [TRUE] -- now Error, as R assertErrV(m1 & 1:2)## gave 1 x 1 [TRUE] -- now Error, as R assertErrV(m1 <= 1:2)## gave 1 x 1 [TRUE] -- now Error, as R ## ## arrays combined with NULL works now stopifnot(identical(Matrix(3,1,1) + NULL, 3[0])) stopifnot(identical(Matrix(3,1,1) > NULL, T[0])) stopifnot(identical(Matrix(3,1,1) & NULL, T[0])) ## in R >= 3.4.0: logical(0) # with *no* warning and that's correct! options(op)# reset 'warn' mStop <- function(...) stop(..., call. = FALSE) ## cat("Checking the Math (+ Math2) group generics for a set of arguments:\n", "------------ ==== ------------------------------------------------\n", sep='') doStop <- function() mStop("**Math: ", f,"(<",class(M),">) of 'wrong' class ", dQuote(class(R))) mM <- getGroupMembers("Math") mM2 <- getGroupMembers("Math2") (mVec <- grep("^cum", mM, value=TRUE)) ## <<- are special: return *vector* for matrix input for(f in c(mM, mM2)) { cat(sprintf("%-9s :\n %-7s\n", paste0('"',f,'"'), paste(rep("-", nchar(f)), collapse=""))) givesVec <- f %in% mVec fn <- get(f) if(f %in% mM2) { fn0 <- fn ; fn <- function(x) fn0(x, digits=3) } for(nm in M.objs) { M <- get(nm, inherits=FALSE) is.m <- length(dim(M)) == 2 cat(" '",nm,"':", if(is.m) "m" else "v", sep="") R <- fn(M) r <- fn(m <- if(is.m) as.mat(M) else as.vector(M)) stopifnot(identical(dim(R), dim(r))) if(givesVec || !is.m) { assert.EQ(R, r) } else { ## (almost always:) matrix result assert.EQ.mat(R, r) ## check preservation of properties, notably super class if(prod(dim(M)) > 1 && is(M, "diagonalMatrix" ) && isDiagonal (R) && !is(R, "diagonalMatrix" )) doStop() if(prod(dim(M)) > 1 && is(M, "triangularMatrix") && (iT <- isTriangular(R)) && attr(iT, "kind") == M@uplo && !is(R, "triangularMatrix")) doStop() } } cat("\n") } showProc.time() ## cat("Checking the Summary group generics for a set of arguments:\n", "------------ ======= ------------------------------------------------\n", sep='') doStop <- function() warning("**Summary: ", f,"(<",class(M),">) is not all.equal(..)", immediate.=TRUE) for(f in getGroupMembers("Summary")) { cat(sprintf("%-9s :\n %-7s\n", paste0('"',f,'"'), paste(rep("-", nchar(f)), collapse=""))) givesVec <- f %in% mVec fn <- get(f) if(f %in% mM2) { fn0 <- fn ; fn <- function(x) fn0(x, digits=3) } for(nm in M.objs) { M <- get(nm, inherits=FALSE) is.m <- length(dim(M)) == 2 cat(" '",nm,"':", if(is.m) "m" else "v", sep="") R <- fn(M) r <- fn(m <- if(is.m) as.mat(M) else as.vector(M)) stopifnot(identical(dim(R), dim(r))) assert.EQ(R, r) } cat("\n") if(length(warnings())) print(summary(warnings())) } cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' Matrix/tests/bind.Rout.save0000644000176200001440000004453514103006124015406 0ustar liggesusers R version 4.1.1 RC (2021-08-03 r80706) -- "Kick Things" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > #### Testing cbind() & rbind() -- based on cbind2() & rbind2() > ## (where using 'cBind()' and 'rBind()' in Matrix) > > > library(Matrix) > > source(system.file("test-tools.R", package = "Matrix"))# identical3() etc Loading required package: tools > > ### --- Dense Matrices --- > > m1 <- m2 <- m <- matrix(1:12, 3,4) > dimnames(m2) <- list(LETTERS[1:3], + letters[1:4]) > dimnames(m1) <- list(NULL,letters[1:4]) > M <- Matrix(m) > M1 <- Matrix(m1) > M2 <- Matrix(m2) > > stopifnot( + identical3(cbind ( M, 10*M), + show(cbind2( M, 10*M)), + Matrix(cbind ( m, 10*m))) + , + identical3(cbind (M1, 100+M1), + show(cbind2(M1, 100+M1)), + Matrix(cbind (m1, 100+m1))) + , + identical3(cbind (M1, 10*M2), + show(cbind2(M1, 10*M2)), + Matrix(cbind (m1, 10*m2))) + , + identical3(cbind (M2, M1+M2), + show(cbind2(M2, M1+M2)), + Matrix(cbind (m2, m1+m2))) + , + identical(colnames(show(cbind(M1, MM = -1))), + c(colnames(M1), "MM")) + , + identical3(rbind ( M, 10*M), + show(rbind2( M, 10*M)), + Matrix(rbind ( m, 10*m))) + , + identical3(rbind (M2, M1+M2), + show(rbind2(M2, M1+M2)), + Matrix(rbind (m2, m1+m2))) + , + Qidentical(show (rbind(R1 = 10:11, M1)), + Matrix(rbind(R1 = 10:11, m1)), strict=FALSE) + , TRUE) 3 x 8 Matrix of class "dgeMatrix" [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [1,] 1 4 7 10 10 40 70 100 [2,] 2 5 8 11 20 50 80 110 [3,] 3 6 9 12 30 60 90 120 3 x 8 Matrix of class "dgeMatrix" a b c d a b c d [1,] 1 4 7 10 101 104 107 110 [2,] 2 5 8 11 102 105 108 111 [3,] 3 6 9 12 103 106 109 112 3 x 8 Matrix of class "dgeMatrix" a b c d a b c d A 1 4 7 10 10 40 70 100 B 2 5 8 11 20 50 80 110 C 3 6 9 12 30 60 90 120 3 x 8 Matrix of class "dgeMatrix" a b c d a b c d A 1 4 7 10 2 8 14 20 B 2 5 8 11 4 10 16 22 C 3 6 9 12 6 12 18 24 3 x 5 Matrix of class "dgeMatrix" a b c d MM [1,] 1 4 7 10 -1 [2,] 2 5 8 11 -1 [3,] 3 6 9 12 -1 6 x 4 Matrix of class "dgeMatrix" [,1] [,2] [,3] [,4] [1,] 1 4 7 10 [2,] 2 5 8 11 [3,] 3 6 9 12 [4,] 10 40 70 100 [5,] 20 50 80 110 [6,] 30 60 90 120 6 x 4 Matrix of class "dgeMatrix" a b c d A 1 4 7 10 B 2 5 8 11 C 3 6 9 12 2 8 14 20 4 10 16 22 6 12 18 24 4 x 4 Matrix of class "dgeMatrix" a b c d R1 10 11 10 11 1 4 7 10 2 5 8 11 3 6 9 12 > > identical.or.eq <- function(x,y, tol=0, ...) { + if(identical(x,y, ...)) + TRUE + else if(isTRUE(aeq <- all.equal(x,y, tolerance = tol))) + structure(TRUE, comment = "not identical") + else aeq + } > identicalShow <- function(x,y, ...) + if(!isTRUE(id <- identical.or.eq(x, y, ...))) cat(id,"\n") > > ## Checking deparse.level { <==> example at end of ?cbind }: > checkRN <- function(dd, B = rbind) { + FN <- function(deparse.level) + rownames(B(1:4, c=2,"a+"=10, dd, deparse.level=deparse.level)) + rn <- c("1:4", "c", "a+", "dd", "") + isMatr <- (length(dim(dd)) == 2) + id <- if(isMatr) 5 else 4 + identicalShow(rn[c(5,2:3, 5)], FN(deparse.level= 0)) # middle two names + identicalShow(rn[c(5,2:3,id)], FN(deparse.level= 1)) # last shown if vector + identicalShow(rn[c(1,2:3,id)], FN(deparse.level= 2)) # first shown; (last if vec.) + } > checkRN(10) # <==> ?cbind's ex > checkRN(1:4) > checkRN( rbind(c(0:1,0,0))) > checkRN(Matrix(rbind(c(0:1,0,0)))) ## in R <= 3.4.1, from methods:::rbind bug : > ## Modes: character, NULL Lengths: 4, 0 target is character, current is NULL > checkRN(10 , rbind) > checkRN(1:4, rbind) > checkRN( rbind(c(0:1,0,0)), rbind) > checkRN(Matrix(rbind(c(0:1,0,0))), rbind) > > cbind(0, Matrix(0+0:1, 1,2), 3:2)# FIXME? should warn - as with matrix() 1 x 4 Matrix of class "dgeMatrix" [,1] [,2] [,3] [,4] [1,] 0 0 1 3 > as(rbind(0, Matrix(0+0:1, 1,2), 3:2), + "sparseMatrix") 3 x 2 sparse Matrix of class "dgCMatrix" [1,] . . [2,] . 1 [3,] 3 2 > cbind(M2, 10*M2[nrow(M2):1 ,])# keeps the rownames from the first 3 x 8 Matrix of class "dgeMatrix" a b c d a b c d A 1 4 7 10 30 60 90 120 B 2 5 8 11 20 50 80 110 C 3 6 9 12 10 40 70 100 > > (im <- cbind(I = 100, M)) 3 x 5 Matrix of class "dgeMatrix" I [1,] 100 1 4 7 10 [2,] 100 2 5 8 11 [3,] 100 3 6 9 12 > str(im) Formal class 'dgeMatrix' [package "Matrix"] with 4 slots ..@ x : num [1:15] 100 100 100 1 2 3 4 5 6 7 ... ..@ Dim : int [1:2] 3 5 ..@ Dimnames:List of 2 .. ..$ : NULL .. ..$ : chr [1:5] "I" "" "" "" ... ..@ factors : list() > (mi <- cbind(M2, I = 1000)) 3 x 5 Matrix of class "dgeMatrix" a b c d I A 1 4 7 10 1000 B 2 5 8 11 1000 C 3 6 9 12 1000 > str(mi) Formal class 'dgeMatrix' [package "Matrix"] with 4 slots ..@ x : num [1:15] 1 2 3 4 5 6 7 8 9 10 ... ..@ Dim : int [1:2] 3 5 ..@ Dimnames:List of 2 .. ..$ : chr [1:3] "A" "B" "C" .. ..$ : chr [1:5] "a" "b" "c" "d" ... ..@ factors : list() > (m1m <- cbind(M,I=100,M2)) 3 x 9 Matrix of class "dgeMatrix" I a b c d A 1 4 7 10 100 1 4 7 10 B 2 5 8 11 100 2 5 8 11 C 3 6 9 12 100 3 6 9 12 > showProc.time() Time (user system elapsed): 0.085 0.002 0.088 > > ## lgeMatrix -- rbind2() had bug (in C code): > is.lge <- function(M) isValid(M, "lgeMatrix") > stopifnot(exprs = { + is.lge(rbind(M2 > 0, M2 < 0)) # had Error in rbind2(): + ## REAL() can only be applied to a 'numeric', not a 'logical' + is.lge(rbind(M2 < 0, M2 > 0)) # ditto + is.lge(rbind(Matrix(1:6 %% 3 != 0, 2,3), FALSE)) + is.lge(L <- rbind(Matrix(TRUE, 2,3), TRUE)) + all(L) + is.lge(rbind(Matrix(TRUE, 2,3), FALSE)) + }) > > ### --- Diagonal / Sparse - had bugs > > D4 <- Diagonal(4) > (D4T <- as(D4, "TsparseMatrix")) 4 x 4 sparse Matrix of class "dtTMatrix" (unitriangular) [1,] I . . . [2,] . I . . [3,] . . I . [4,] . . . I > D4C <- as(D4T, "CsparseMatrix") > c1 <- Matrix(0+0:3, 4, sparse=TRUE) ; r1 <- t(c1); r1 1 x 4 sparse Matrix of class "dgCMatrix" [1,] . 1 2 3 > > d4 <- rbind(Diagonal(4), 0:3) > m4 <- cbind(Diagonal(x=-1:2), 0:3) > c4. <- cbind(Diagonal(4), c1) > c.4 <- cbind(c1, Diagonal(4)) > r4. <- rbind(Diagonal(4), r1) > r.4 <- rbind(r1, Diagonal(4)) > assert.EQ.mat(d4, rbind(diag(4), 0:3)) > assert.EQ.mat(m4, cbind(diag(-1:2), 0:3)) > stopifnot(identical(Matrix(cbind(diag(3),0)), cbind2(Diagonal(3),0)), + is(d4, "sparseMatrix"), is(m4, "sparseMatrix"), + identical(t(d4), cbind(Diagonal(4), 0:3)), + identical(t(m4), rbind(Diagonal(x=-1:2), 0:3))) > showProc.time() Time (user system elapsed): 0.043 0.005 0.048 > > ### --- Sparse Matrices --- > > identical4(cbind(diag(4), diag(4)), + cbind(D4C, D4C), + cbind(D4T, D4C), + cbind(D4C, D4T)) [1] FALSE > nr <- 4 > m. <- matrix(c(0, 2:-1), nr ,6) Warning message: In matrix(c(0, 2:-1), nr, 6) : data length [5] is not a sub-multiple or multiple of the number of rows [4] > M <- Matrix(m.) > (mC <- as(M, "dgCMatrix")) 4 x 6 sparse Matrix of class "dgCMatrix" [1,] . -1 . 1 2 . [2,] 2 . -1 . 1 2 [3,] 1 2 . -1 . 1 [4,] . 1 2 . -1 . > (mT <- as(M, "dgTMatrix")) 4 x 6 sparse Matrix of class "dgTMatrix" [1,] . -1 . 1 2 . [2,] 2 . -1 . 1 2 [3,] 1 2 . -1 . 1 [4,] . 1 2 . -1 . > stopifnot(identical(mT, as(mC, "dgTMatrix")), + identical(mC, as(mT, "dgCMatrix"))) > > for(v in list(0, 2, 1:0)) + for(fnam in c("cbind", "rbind")) { + cat(fnam,"(m, v=", deparse(v),"), class(m) :") + FUN <- get(fnam) + for(m in list(M, mC, mT)) { + cat("", class(m),"") + assert.EQ.mat(FUN(v, m), FUN(v, m.)) ; cat(",") + assert.EQ.mat(FUN(m, v), FUN(m., v)) ; cat(".") + } + cat("\n") + } cbind (m, v= 0 ), class(m) : dgeMatrix ,. dgCMatrix ,. dgTMatrix ,. rbind (m, v= 0 ), class(m) : dgeMatrix ,. dgCMatrix ,. dgTMatrix ,. cbind (m, v= 2 ), class(m) : dgeMatrix ,. dgCMatrix ,. dgTMatrix ,. rbind (m, v= 2 ), class(m) : dgeMatrix ,. dgCMatrix ,. dgTMatrix ,. cbind (m, v= 1:0 ), class(m) : dgeMatrix ,. dgCMatrix ,. dgTMatrix ,. rbind (m, v= 1:0 ), class(m) : dgeMatrix ,. dgCMatrix ,. dgTMatrix ,. > showProc.time() Time (user system elapsed): 0.049 0.009 0.058 > > cbind(0, mC); cbind(mC, 0) 4 x 7 sparse Matrix of class "dgCMatrix" [1,] . . -1 . 1 2 . [2,] . 2 . -1 . 1 2 [3,] . 1 2 . -1 . 1 [4,] . . 1 2 . -1 . 4 x 7 sparse Matrix of class "dgCMatrix" [1,] . -1 . 1 2 . . [2,] 2 . -1 . 1 2 . [3,] 1 2 . -1 . 1 . [4,] . 1 2 . -1 . . > cbind(0, mT); cbind(mT, 2) 4 x 7 sparse Matrix of class "dgCMatrix" [1,] . . -1 . 1 2 . [2,] . 2 . -1 . 1 2 [3,] . 1 2 . -1 . 1 [4,] . . 1 2 . -1 . 4 x 7 sparse Matrix of class "dgCMatrix" [1,] . -1 . 1 2 . 2 [2,] 2 . -1 . 1 2 2 [3,] 1 2 . -1 . 1 2 [4,] . 1 2 . -1 . 2 > cbind(diag(nr), mT) 4 x 10 sparse Matrix of class "dgCMatrix" [1,] 1 . . . . -1 . 1 2 . [2,] . 1 . . 2 . -1 . 1 2 [3,] . . 1 . 1 2 . -1 . 1 [4,] . . . 1 . 1 2 . -1 . > stopifnot(identical(t(cbind(diag(nr), mT)), + rbind(diag(nr), t(mT)))) > (cc <- cbind(mC, 0,7,0, diag(nr), 0)) 4 x 14 sparse Matrix of class "dgCMatrix" [1,] . -1 . 1 2 . . 7 . 1 . . . . [2,] 2 . -1 . 1 2 . 7 . . 1 . . . [3,] 1 2 . -1 . 1 . 7 . . . 1 . . [4,] . 1 2 . -1 . . 7 . . . . 1 . > stopifnot(identical3(cc, cbind(mT, 0,7,0, diag(nr), 0), + as( cbind( M, 0,7,0, diag(nr), 0), "dgCMatrix"))) > > cbind(mC, 1, 100*mC, 0, 0:2) 4 x 15 sparse Matrix of class "dgCMatrix" [1,] . -1 . 1 2 . 1 . -100 . 100 200 . . . [2,] 2 . -1 . 1 2 1 200 . -100 . 100 200 . 1 [3,] 1 2 . -1 . 1 1 100 200 . -100 . 100 . 2 [4,] . 1 2 . -1 . 1 . 100 200 . -100 . . . > cbind(mT, 1, 0, mT+10*mT, 0, 0:2) 4 x 16 sparse Matrix of class "dgCMatrix" [1,] . -1 . 1 2 . 1 . . -11 . 11 22 . . . [2,] 2 . -1 . 1 2 1 . 22 . -11 . 11 22 . 1 [3,] 1 2 . -1 . 1 1 . 11 22 . -11 . 11 . 2 [4,] . 1 2 . -1 . 1 . . 11 22 . -11 . . . > one <- 1 > zero <- 0 > dimnames(mC) <- dimnames(mT) <- list(LETTERS[1:4], letters[1:6]) > op <- options(sparse.colnames = TRUE)# show colnames in print : > cbind(mC, one, 100*mC, zero, 0:2) 4 x 15 sparse Matrix of class "dgCMatrix" a b c d e f one a b c d e f zero A . -1 . 1 2 . 1 . -100 . 100 200 . . . B 2 . -1 . 1 2 1 200 . -100 . 100 200 . 1 C 1 2 . -1 . 1 1 100 200 . -100 . 100 . 2 D . 1 2 . -1 . 1 . 100 200 . -100 . . . > cbind(mC, one, 100*mC, zero, 0:2, deparse.level=0)# no "zero", "one" 4 x 15 sparse Matrix of class "dgCMatrix" a b c d e f a b c d e f A . -1 . 1 2 . 1 . -100 . 100 200 . . . B 2 . -1 . 1 2 1 200 . -100 . 100 200 . 1 C 1 2 . -1 . 1 1 100 200 . -100 . 100 . 2 D . 1 2 . -1 . 1 . 100 200 . -100 . . . > cbind(mC, one, 100*mC, zero, 0:2, deparse.level=2)# even "0:2" 4 x 15 sparse Matrix of class "dgCMatrix" a b c d e f one a b c d e f zero 0:2 A . -1 . 1 2 . 1 . -100 . 100 200 . . . B 2 . -1 . 1 2 1 200 . -100 . 100 200 . 1 C 1 2 . -1 . 1 1 100 200 . -100 . 100 . 2 D . 1 2 . -1 . 1 . 100 200 . -100 . . . > cbind(mT, one, zero, mT+10*mT, zero, 0:2) 4 x 16 sparse Matrix of class "dgCMatrix" a b c d e f one zero a b c d e f zero A . -1 . 1 2 . 1 . . -11 . 11 22 . . . B 2 . -1 . 1 2 1 . 22 . -11 . 11 22 . 1 C 1 2 . -1 . 1 1 . 11 22 . -11 . 11 . 2 D . 1 2 . -1 . 1 . . 11 22 . -11 . . . > > > ## logical (sparse) - should remain logical : > L5 <- Diagonal(n = 5, x = TRUE); v5 <- rep(x = c(FALSE,TRUE), length = ncol(L5)) > stopifnot(is(show(rbind(L5,v5)), "lsparseMatrix"), + is(show(cbind(v5,L5)), "lsparseMatrix"), + is(rbind(L5, 2* v5), "dsparseMatrix"), + is(cbind(2* v5, L5), "dsparseMatrix")) 6 x 5 sparse Matrix of class "lgCMatrix" [,1] [,2] [,3] [,4] [,5] | . . . . . | . . . . . | . . . . . | . . . . . | v5 . | . | . 5 x 6 sparse Matrix of class "lgCMatrix" v5 [1,] . | . . . . [2,] | . | . . . [3,] . . . | . . [4,] | . . . | . [5,] . . . . . | > > ## print() / show() of non-structural zeros: > (m <- Matrix(c(0, 0, 2:0), 3, 5)) 3 x 5 sparse Matrix of class "dgCMatrix" [,1] [,2] [,3] [,4] [,5] [1,] . 1 . . 2 [2,] . . 2 . 1 [3,] 2 . 1 . . > (m2 <- cbind(m,m)) 3 x 10 sparse Matrix of class "dgCMatrix" [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [1,] . 1 . . 2 . 1 . . 2 [2,] . . 2 . 1 . . 2 . 1 [3,] 2 . 1 . . 2 . 1 . . > (m4 <- rbind(m2,m2)) 6 x 10 sparse Matrix of class "dgCMatrix" [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [1,] . 1 . . 2 . 1 . . 2 [2,] . . 2 . 1 . . 2 . 1 [3,] 2 . 1 . . 2 . 1 . . [4,] . 1 . . 2 . 1 . . 2 [5,] . . 2 . 1 . . 2 . 1 [6,] 2 . 1 . . 2 . 1 . . > diag(m4) [1] 0 0 1 0 1 2 > for(i in 1:6) { + m4[i, i ] <- i + m4[i,i+1] <- 0 + } > m4 ## now show some non-structural zeros: 6 x 10 sparse Matrix of class "dgCMatrix" [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [1,] 1 . . . 2 . 1 . . 2 [2,] . 2 . . 1 . . 2 . 1 [3,] 2 . 3 . . 2 . 1 . . [4,] . 1 . 4 . . 1 . . 2 [5,] . . 2 . 5 . . 2 . 1 [6,] 2 . 1 . . 6 . 1 . . > > ## Mixture of dense and sparse/diagonal -- used to fail, even in 1.0-0 > D5 <- Diagonal(x = 10*(1:5)) > (D5.1 <- cbind2(D5, 1)) 5 x 6 sparse Matrix of class "dgCMatrix" [,1] [,2] [,3] [,4] [,5] [,6] [1,] 10 . . . . 1 [2,] . 20 . . . 1 [3,] . . 30 . . 1 [4,] . . . 40 . 1 [5,] . . . . 50 1 > ## "FIXME" in newer versions of R, do not need Matrix() here: > s42 <- Matrix(z42 <- cbind2(rep(0:1,4), rep(1:0,4)), + sparse=TRUE) > (C86 <- rbind(1, 0, D5.1, 0)) 8 x 6 sparse Matrix of class "dgCMatrix" [,1] [,2] [,3] [,4] [,5] [,6] [1,] 1 1 1 1 1 1 [2,] . . . . . . [3,] 10 . . . . 1 [4,] . 20 . . . 1 [5,] . . 30 . . 1 [6,] . . . 40 . 1 [7,] . . . . 50 1 [8,] . . . . . . > stopifnotValid(D5.1, "dgCMatrix") > stopifnotValid(print(rbind2(Matrix(1:10, 2,5), D5)), "dgCMatrix") 7 x 5 sparse Matrix of class "dgCMatrix" [,1] [,2] [,3] [,4] [,5] [1,] 1 3 5 7 9 [2,] 2 4 6 8 10 [3,] 10 . . . . [4,] . 20 . . . [5,] . . 30 . . [6,] . . . 40 . [7,] . . . . 50 > stopifnotValid(print(cbind2(Matrix(10:1, 5,2), D5.1)), "dgeMatrix") 5 x 8 Matrix of class "dgeMatrix" [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [1,] 10 5 10 0 0 0 0 1 [2,] 9 4 0 20 0 0 0 1 [3,] 8 3 0 0 30 0 0 1 [4,] 7 2 0 0 0 40 0 1 [5,] 6 1 0 0 0 0 50 1 > stopifnotValid(zz <- cbind2(z42, C86), "dgCMatrix") > stopifnot(identical(zz, cbind2(s42, C86))) > > ## Using "nMatrix" > (m1 <- sparseMatrix(1:3, 1:3)) # ngCMatrix 3 x 3 sparse Matrix of class "ngCMatrix" [,1] [,2] [,3] [1,] | . . [2,] . | . [3,] . . | > m2 <- sparseMatrix(1:3, 1:3, x = 1:3) > stopifnotValid(c12 <- cbind(m1,m2), "dgCMatrix") # was "ngC.." because of cholmod_horzcat ! > stopifnotValid(c21 <- cbind(m2,m1), "dgCMatrix") # ditto > stopifnotValid(r12 <- rbind(m1,m2), "dgCMatrix") # was "ngC.." because of cholmod_vertcat ! > stopifnotValid(r21 <- rbind(m2,m1), "dgCMatrix") # ditto > d1 <- as(m1, "denseMatrix") > d2 <- as(m2, "denseMatrix") > stopifnotValid(cbind2(d2,d1), "dgeMatrix") > stopifnotValid(cbind2(d1,d2), "dgeMatrix")## gave an error in Matrix 1.1-5 > stopifnotValid(rbind2(d2,d1), "dgeMatrix") > stopifnotValid(rbind2(d1,d2), "dgeMatrix")## gave an error in Matrix 1.1-5 > > ## rbind2() / cbind2() mixing sparse/dense: used to "fail", > ## ------------------- then (in 'devel', ~ 2015-03): completely wrong > S <- .sparseDiagonal(2) > s <- diag(2) > S9 <- rbind(S,0,0,S,0,NaN,0,0,0,2)## r/cbind2() failed to determine 'sparse' in Matrix <= 1.2-2 > s9 <- rbind(s,0,0,s,0,NaN,0,0,0,2) > assert.EQ.mat(S9, s9) > D <- Matrix(1:6, 3,2); d <- as(D, "matrix") > T9 <- t(S9); t9 <- t(s9); T <- t(D); t <- t(d) > stopifnot(identical(rbind (s9,d), rbind2(s9,d)), + identical(rbind2(D,S9), t(cbind2(T,T9))), + identical(rbind2(S9,D), t(cbind2(T9,T)))) > assert.EQ.mat(rbind2(S9,D), rbind2(s9,d)) > assert.EQ.mat(rbind2(D,S9), rbind2(d,s9)) > ## now with cbind2() -- no problem! > stopifnot(identical(cbind (t9,t), cbind2(t9,t))) > assert.EQ.mat(cbind2(T9,T), cbind2(t9,t)) > assert.EQ.mat(cbind2(T,T9), cbind2(t,t9)) > > > > options(op) > showProc.time() Time (user system elapsed): 0.142 0.01 0.152 > > proc.time() user system elapsed 0.866 0.113 1.030 Matrix/tests/base-matrix-fun.R0000644000176200001440000000302511601431575016010 0ustar liggesusers#### Thanks to the manipulation in base namespace, see ../R/zzz.R , #### all the functions (in 'base' or namespaces that import it) #### starting with something like #### " x <- as.matrix(x) " or " X <- as.array(X) " #### will work for 'Matrix'-matrices library(Matrix) data(KNex); mm <- KNex$mm str(m1 <- mm[1:500, 1:200]) m11 <- m1[1:100, 1:20] ## These now work thanks to using our as.matrix(): str(D1 <- dist(m11)) str(rs <- apply(m1, 1, sum)) stopifnot(identical(kappa(Matrix(2:5, 2)), kappa(matrix(2:5, 2)))) ## used to seg.fault, PR#7984, ## because qr() was calling the wrong as.matrix() ## also matplot() or pairs(). ## a regression test for as.matrix.dist(.) still working stopifnot(c(43, 43) == dim(as.matrix(d <- dist(USJudgeRatings)))) m <- Matrix(0:5, 3, 2) (m2 <- Matrix(diag(c(3,1)))) (m3 <- crossprod(t(m))) # <- that's an S4 method; nothing "base" str( svd(m) ) str( lapply(eigen(m3), zapsmall)) ### outer() used to work thanks to as.array() -- up to R 2.2.1 ## no longer, because the definition of outer has changed -- FIXME? ## Whould work by providing an as.vector(.) method ## *and* is.array(.) \-> TRUE which may be too strong ##--> For %o%: "need" to make outer(.,.) an S3 generic ## *and* provide Matrix S3 methods ## stopifnot(identical(outer(m, m2), ## outer(as(m,"matrix"), as(m2,"matrix"))), ## identical(outer(m3, m2), ## outer(as(m3,"matrix"), as(m2,"matrix")))) cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' Matrix/src/0000755000176200001440000000000014154165627012320 5ustar liggesusersMatrix/src/cs.c0000644000176200001440000025135414060416534013073 0ustar liggesusers#include "cs.h" /* C = alpha*A + beta*B */ cs *cs_add (const cs *A, const cs *B, double alpha, double beta) { csi p, j, nz = 0, anz, *Cp, *Ci, *Bp, m, n, bnz, *w, values ; double *x, *Bx, *Cx ; cs *C ; if (!CS_CSC (A) || !CS_CSC (B)) return (NULL) ; /* check inputs */ if (A->m != B->m || A->n != B->n) return (NULL) ; m = A->m ; anz = A->p [A->n] ; n = B->n ; Bp = B->p ; Bx = B->x ; bnz = Bp [n] ; w = cs_calloc (m, sizeof (csi)) ; /* get workspace */ values = (A->x != NULL) && (Bx != NULL) ; x = values ? cs_malloc (m, sizeof (double)) : NULL ; /* get workspace */ C = cs_spalloc (m, n, anz + bnz, values, 0) ; /* allocate result*/ if (!C || !w || (values && !x)) return (cs_done (C, w, x, 0)) ; Cp = C->p ; Ci = C->i ; Cx = C->x ; for (j = 0 ; j < n ; j++) { Cp [j] = nz ; /* column j of C starts here */ nz = cs_scatter (A, j, alpha, w, x, j+1, C, nz) ; /* alpha*A(:,j)*/ nz = cs_scatter (B, j, beta, w, x, j+1, C, nz) ; /* beta*B(:,j) */ if (values) for (p = Cp [j] ; p < nz ; p++) Cx [p] = x [Ci [p]] ; } Cp [n] = nz ; /* finalize the last column of C */ cs_sprealloc (C, 0) ; /* remove extra space from C */ return (cs_done (C, w, x, 1)) ; /* success; free workspace, return C */ } /* clear w */ static csi cs_wclear (csi mark, csi lemax, csi *w, csi n) { csi k ; if (mark < 2 || (mark + lemax < 0)) { for (k = 0 ; k < n ; k++) if (w [k] != 0) w [k] = 1 ; mark = 2 ; } return (mark) ; /* at this point, w [0..n-1] < mark holds */ } /* keep off-diagonal entries; drop diagonal entries */ static csi cs_diag (csi i, csi j, double aij, void *other) { return (i != j) ; } /* p = amd(A+A') if symmetric is true, or amd(A'A) otherwise */ csi *cs_amd (csi order, const cs *A) /* order 0:natural, 1:Chol, 2:LU, 3:QR */ { cs *C, *A2, *AT ; csi *Cp, *Ci, *last, *W, *len, *nv, *next, *P, *head, *elen, *degree, *w, *hhead, *ATp, *ATi, d, dk, dext, lemax = 0, e, elenk, eln, i, j, k, k1, k2, k3, jlast, ln, dense, nzmax, mindeg = 0, nvi, nvj, nvk, mark, wnvi, ok, cnz, nel = 0, p, p1, p2, p3, p4, pj, pk, pk1, pk2, pn, q, n, m, t ; csi h ; /* --- Construct matrix C ----------------------------------------------- */ if (!CS_CSC (A) || order <= 0 || order > 3) return (NULL) ; /* check */ AT = cs_transpose (A, 0) ; /* compute A' */ if (!AT) return (NULL) ; m = A->m ; n = A->n ; dense = CS_MAX (16, 10 * sqrt ((double) n)) ; /* find dense threshold */ dense = CS_MIN (n-2, dense) ; if (order == 1 && n == m) { C = cs_add (A, AT, 0, 0) ; /* C = A+A' */ } else if (order == 2) { ATp = AT->p ; /* drop dense columns from AT */ ATi = AT->i ; for (p2 = 0, j = 0 ; j < m ; j++) { p = ATp [j] ; /* column j of AT starts here */ ATp [j] = p2 ; /* new column j starts here */ if (ATp [j+1] - p > dense) continue ; /* skip dense col j */ for ( ; p < ATp [j+1] ; p++) ATi [p2++] = ATi [p] ; } ATp [m] = p2 ; /* finalize AT */ A2 = cs_transpose (AT, 0) ; /* A2 = AT' */ C = A2 ? cs_multiply (AT, A2) : NULL ; /* C=A'*A with no dense rows */ cs_spfree (A2) ; } else { C = cs_multiply (AT, A) ; /* C=A'*A */ } cs_spfree (AT) ; if (!C) return (NULL) ; cs_fkeep (C, &cs_diag, NULL) ; /* drop diagonal entries */ Cp = C->p ; cnz = Cp [n] ; P = cs_malloc (n+1, sizeof (csi)) ; /* allocate result */ W = cs_malloc (8*(n+1), sizeof (csi)) ; /* get workspace */ t = cnz + cnz/5 + 2*n ; /* add elbow room to C */ if (!P || !W || !cs_sprealloc (C, t)) return (cs_idone (P, C, W, 0)) ; len = W ; nv = W + (n+1) ; next = W + 2*(n+1) ; head = W + 3*(n+1) ; elen = W + 4*(n+1) ; degree = W + 5*(n+1) ; w = W + 6*(n+1) ; hhead = W + 7*(n+1) ; last = P ; /* use P as workspace for last */ /* --- Initialize quotient graph ---------------------------------------- */ for (k = 0 ; k < n ; k++) len [k] = Cp [k+1] - Cp [k] ; len [n] = 0 ; nzmax = C->nzmax ; Ci = C->i ; for (i = 0 ; i <= n ; i++) { head [i] = -1 ; /* degree list i is empty */ last [i] = -1 ; next [i] = -1 ; hhead [i] = -1 ; /* hash list i is empty */ nv [i] = 1 ; /* node i is just one node */ w [i] = 1 ; /* node i is alive */ elen [i] = 0 ; /* Ek of node i is empty */ degree [i] = len [i] ; /* degree of node i */ } mark = cs_wclear (0, 0, w, n) ; /* clear w */ elen [n] = -2 ; /* n is a dead element */ Cp [n] = -1 ; /* n is a root of assembly tree */ w [n] = 0 ; /* n is a dead element */ /* --- Initialize degree lists ------------------------------------------ */ for (i = 0 ; i < n ; i++) { d = degree [i] ; if (d == 0) /* node i is empty */ { elen [i] = -2 ; /* element i is dead */ nel++ ; Cp [i] = -1 ; /* i is a root of assembly tree */ w [i] = 0 ; } else if (d > dense) /* node i is dense */ { nv [i] = 0 ; /* absorb i into element n */ elen [i] = -1 ; /* node i is dead */ nel++ ; Cp [i] = CS_FLIP (n) ; nv [n]++ ; } else { if (head [d] != -1) last [head [d]] = i ; next [i] = head [d] ; /* put node i in degree list d */ head [d] = i ; } } while (nel < n) /* while (selecting pivots) do */ { /* --- Select node of minimum approximate degree -------------------- */ for (k = -1 ; mindeg < n && (k = head [mindeg]) == -1 ; mindeg++) ; if (next [k] != -1) last [next [k]] = -1 ; head [mindeg] = next [k] ; /* remove k from degree list */ elenk = elen [k] ; /* elenk = |Ek| */ nvk = nv [k] ; /* # of nodes k represents */ nel += nvk ; /* nv[k] nodes of A eliminated */ /* --- Garbage collection ------------------------------------------- */ if (elenk > 0 && cnz + mindeg >= nzmax) { for (j = 0 ; j < n ; j++) { if ((p = Cp [j]) >= 0) /* j is a live node or element */ { Cp [j] = Ci [p] ; /* save first entry of object */ Ci [p] = CS_FLIP (j) ; /* first entry is now CS_FLIP(j) */ } } for (q = 0, p = 0 ; p < cnz ; ) /* scan all of memory */ { if ((j = CS_FLIP (Ci [p++])) >= 0) /* found object j */ { Ci [q] = Cp [j] ; /* restore first entry of object */ Cp [j] = q++ ; /* new pointer to object j */ for (k3 = 0 ; k3 < len [j]-1 ; k3++) Ci [q++] = Ci [p++] ; } } cnz = q ; /* Ci [cnz...nzmax-1] now free */ } /* --- Construct new element ---------------------------------------- */ dk = 0 ; nv [k] = -nvk ; /* flag k as in Lk */ p = Cp [k] ; pk1 = (elenk == 0) ? p : cnz ; /* do in place if elen[k] == 0 */ pk2 = pk1 ; for (k1 = 1 ; k1 <= elenk + 1 ; k1++) { if (k1 > elenk) { e = k ; /* search the nodes in k */ pj = p ; /* list of nodes starts at Ci[pj]*/ ln = len [k] - elenk ; /* length of list of nodes in k */ } else { e = Ci [p++] ; /* search the nodes in e */ pj = Cp [e] ; ln = len [e] ; /* length of list of nodes in e */ } for (k2 = 1 ; k2 <= ln ; k2++) { i = Ci [pj++] ; if ((nvi = nv [i]) <= 0) continue ; /* node i dead, or seen */ dk += nvi ; /* degree[Lk] += size of node i */ nv [i] = -nvi ; /* negate nv[i] to denote i in Lk*/ Ci [pk2++] = i ; /* place i in Lk */ if (next [i] != -1) last [next [i]] = last [i] ; if (last [i] != -1) /* remove i from degree list */ { next [last [i]] = next [i] ; } else { head [degree [i]] = next [i] ; } } if (e != k) { Cp [e] = CS_FLIP (k) ; /* absorb e into k */ w [e] = 0 ; /* e is now a dead element */ } } if (elenk != 0) cnz = pk2 ; /* Ci [cnz...nzmax] is free */ degree [k] = dk ; /* external degree of k - |Lk\i| */ Cp [k] = pk1 ; /* element k is in Ci[pk1..pk2-1] */ len [k] = pk2 - pk1 ; elen [k] = -2 ; /* k is now an element */ /* --- Find set differences ----------------------------------------- */ mark = cs_wclear (mark, lemax, w, n) ; /* clear w if necessary */ for (pk = pk1 ; pk < pk2 ; pk++) /* scan 1: find |Le\Lk| */ { i = Ci [pk] ; if ((eln = elen [i]) <= 0) continue ;/* skip if elen[i] empty */ nvi = -nv [i] ; /* nv [i] was negated */ wnvi = mark - nvi ; for (p = Cp [i] ; p <= Cp [i] + eln - 1 ; p++) /* scan Ei */ { e = Ci [p] ; if (w [e] >= mark) { w [e] -= nvi ; /* decrement |Le\Lk| */ } else if (w [e] != 0) /* ensure e is a live element */ { w [e] = degree [e] + wnvi ; /* 1st time e seen in scan 1 */ } } } /* --- Degree update ------------------------------------------------ */ for (pk = pk1 ; pk < pk2 ; pk++) /* scan2: degree update */ { i = Ci [pk] ; /* consider node i in Lk */ p1 = Cp [i] ; p2 = p1 + elen [i] - 1 ; pn = p1 ; for (h = 0, d = 0, p = p1 ; p <= p2 ; p++) /* scan Ei */ { e = Ci [p] ; if (w [e] != 0) /* e is an unabsorbed element */ { dext = w [e] - mark ; /* dext = |Le\Lk| */ if (dext > 0) { d += dext ; /* sum up the set differences */ Ci [pn++] = e ; /* keep e in Ei */ h += e ; /* compute the hash of node i */ } else { Cp [e] = CS_FLIP (k) ; /* aggressive absorb. e->k */ w [e] = 0 ; /* e is a dead element */ } } } elen [i] = pn - p1 + 1 ; /* elen[i] = |Ei| */ p3 = pn ; p4 = p1 + len [i] ; for (p = p2 + 1 ; p < p4 ; p++) /* prune edges in Ai */ { j = Ci [p] ; if ((nvj = nv [j]) <= 0) continue ; /* node j dead or in Lk */ d += nvj ; /* degree(i) += |j| */ Ci [pn++] = j ; /* place j in node list of i */ h += j ; /* compute hash for node i */ } if (d == 0) /* check for mass elimination */ { Cp [i] = CS_FLIP (k) ; /* absorb i into k */ nvi = -nv [i] ; dk -= nvi ; /* |Lk| -= |i| */ nvk += nvi ; /* |k| += nv[i] */ nel += nvi ; nv [i] = 0 ; elen [i] = -1 ; /* node i is dead */ } else { degree [i] = CS_MIN (degree [i], d) ; /* update degree(i) */ Ci [pn] = Ci [p3] ; /* move first node to end */ Ci [p3] = Ci [p1] ; /* move 1st el. to end of Ei */ Ci [p1] = k ; /* add k as 1st element in of Ei */ len [i] = pn - p1 + 1 ; /* new len of adj. list of node i */ h = ((h<0) ? (-h):h) % n ; /* finalize hash of i */ next [i] = hhead [h] ; /* place i in hash bucket */ hhead [h] = i ; last [i] = h ; /* save hash of i in last[i] */ } } /* scan2 is done */ degree [k] = dk ; /* finalize |Lk| */ lemax = CS_MAX (lemax, dk) ; mark = cs_wclear (mark+lemax, lemax, w, n) ; /* clear w */ /* --- Supernode detection ------------------------------------------ */ for (pk = pk1 ; pk < pk2 ; pk++) { i = Ci [pk] ; if (nv [i] >= 0) continue ; /* skip if i is dead */ h = last [i] ; /* scan hash bucket of node i */ i = hhead [h] ; hhead [h] = -1 ; /* hash bucket will be empty */ for ( ; i != -1 && next [i] != -1 ; i = next [i], mark++) { ln = len [i] ; eln = elen [i] ; for (p = Cp [i]+1 ; p <= Cp [i] + ln-1 ; p++) w [Ci [p]] = mark; jlast = i ; for (j = next [i] ; j != -1 ; ) /* compare i with all j */ { ok = (len [j] == ln) && (elen [j] == eln) ; for (p = Cp [j] + 1 ; ok && p <= Cp [j] + ln - 1 ; p++) { if (w [Ci [p]] != mark) ok = 0 ; /* compare i and j*/ } if (ok) /* i and j are identical */ { Cp [j] = CS_FLIP (i) ; /* absorb j into i */ nv [i] += nv [j] ; nv [j] = 0 ; elen [j] = -1 ; /* node j is dead */ j = next [j] ; /* delete j from hash bucket */ next [jlast] = j ; } else { jlast = j ; /* j and i are different */ j = next [j] ; } } } } /* --- Finalize new element------------------------------------------ */ for (p = pk1, pk = pk1 ; pk < pk2 ; pk++) /* finalize Lk */ { i = Ci [pk] ; if ((nvi = -nv [i]) <= 0) continue ;/* skip if i is dead */ nv [i] = nvi ; /* restore nv[i] */ d = degree [i] + dk - nvi ; /* compute external degree(i) */ d = CS_MIN (d, n - nel - nvi) ; if (head [d] != -1) last [head [d]] = i ; next [i] = head [d] ; /* put i back in degree list */ last [i] = -1 ; head [d] = i ; mindeg = CS_MIN (mindeg, d) ; /* find new minimum degree */ degree [i] = d ; Ci [p++] = i ; /* place i in Lk */ } nv [k] = nvk ; /* # nodes absorbed into k */ if ((len [k] = p-pk1) == 0) /* length of adj list of element k*/ { Cp [k] = -1 ; /* k is a root of the tree */ w [k] = 0 ; /* k is now a dead element */ } if (elenk != 0) cnz = p ; /* free unused space in Lk */ } /* --- Postordering ----------------------------------------------------- */ for (i = 0 ; i < n ; i++) Cp [i] = CS_FLIP (Cp [i]) ;/* fix assembly tree */ for (j = 0 ; j <= n ; j++) head [j] = -1 ; for (j = n ; j >= 0 ; j--) /* place unordered nodes in lists */ { if (nv [j] > 0) continue ; /* skip if j is an element */ next [j] = head [Cp [j]] ; /* place j in list of its parent */ head [Cp [j]] = j ; } for (e = n ; e >= 0 ; e--) /* place elements in lists */ { if (nv [e] <= 0) continue ; /* skip unless e is an element */ if (Cp [e] != -1) { next [e] = head [Cp [e]] ; /* place e in list of its parent */ head [Cp [e]] = e ; } } for (k = 0, i = 0 ; i <= n ; i++) /* postorder the assembly tree */ { if (Cp [i] == -1) k = cs_tdfs (i, k, head, next, P, w) ; } return (cs_idone (P, C, W, 1)) ; } /* L = chol (A, [pinv parent cp]), pinv is optional */ csn *cs_chol (const cs *A, const css *S) { double d, lki, *Lx, *x, *Cx ; csi top, i, p, k, n, *Li, *Lp, *cp, *pinv, *s, *c, *parent, *Cp, *Ci ; cs *L, *C, *E ; csn *N ; if (!CS_CSC (A) || !S || !S->cp || !S->parent) return (NULL) ; n = A->n ; N = cs_calloc (1, sizeof (csn)) ; /* allocate result */ c = cs_malloc (2*n, sizeof (csi)) ; /* get csi workspace */ x = cs_malloc (n, sizeof (double)) ; /* get double workspace */ cp = S->cp ; pinv = S->pinv ; parent = S->parent ; C = pinv ? cs_symperm (A, pinv, 1) : ((cs *) A) ; E = pinv ? C : NULL ; /* E is alias for A, or a copy E=A(p,p) */ if (!N || !c || !x || !C) return (cs_ndone (N, E, c, x, 0)) ; s = c + n ; Cp = C->p ; Ci = C->i ; Cx = C->x ; N->L = L = cs_spalloc (n, n, cp [n], 1, 0) ; /* allocate result */ if (!L) return (cs_ndone (N, E, c, x, 0)) ; Lp = L->p ; Li = L->i ; Lx = L->x ; for (k = 0 ; k < n ; k++) Lp [k] = c [k] = cp [k] ; for (k = 0 ; k < n ; k++) /* compute L(k,:) for L*L' = C */ { /* --- Nonzero pattern of L(k,:) ------------------------------------ */ top = cs_ereach (C, k, parent, s, c) ; /* find pattern of L(k,:) */ x [k] = 0 ; /* x (0:k) is now zero */ for (p = Cp [k] ; p < Cp [k+1] ; p++) /* x = full(triu(C(:,k))) */ { if (Ci [p] <= k) x [Ci [p]] = Cx [p] ; } d = x [k] ; /* d = C(k,k) */ x [k] = 0 ; /* clear x for k+1st iteration */ /* --- Triangular solve --------------------------------------------- */ for ( ; top < n ; top++) /* solve L(0:k-1,0:k-1) * x = C(:,k) */ { i = s [top] ; /* s [top..n-1] is pattern of L(k,:) */ lki = x [i] / Lx [Lp [i]] ; /* L(k,i) = x (i) / L(i,i) */ x [i] = 0 ; /* clear x for k+1st iteration */ for (p = Lp [i] + 1 ; p < c [i] ; p++) { x [Li [p]] -= Lx [p] * lki ; } d -= lki * lki ; /* d = d - L(k,i)*L(k,i) */ p = c [i]++ ; Li [p] = k ; /* store L(k,i) in column i */ Lx [p] = lki ; } /* --- Compute L(k,k) ----------------------------------------------- */ if (d <= 0) return (cs_ndone (N, E, c, x, 0)) ; /* not pos def */ p = c [k]++ ; Li [p] = k ; /* store L(k,k) = sqrt (d) in column k */ Lx [p] = sqrt (d) ; } Lp [n] = cp [n] ; /* finalize L */ return (cs_ndone (N, E, c, x, 1)) ; /* success: free E,s,x; return N */ } /* x=A\b where A is symmetric positive definite; b overwritten with solution */ csi cs_cholsol (csi order, const cs *A, double *b) { double *x ; css *S ; csn *N ; csi n, ok ; if (!CS_CSC (A) || !b) return (0) ; /* check inputs */ n = A->n ; S = cs_schol (order, A) ; /* ordering and symbolic analysis */ N = cs_chol (A, S) ; /* numeric Cholesky factorization */ x = cs_malloc (n, sizeof (double)) ; /* get workspace */ ok = (S && N && x) ; if (ok) { cs_ipvec (S->pinv, b, x, n) ; /* x = P*b */ cs_lsolve (N->L, x) ; /* x = L\x */ cs_ltsolve (N->L, x) ; /* x = L'\x */ cs_pvec (S->pinv, x, b, n) ; /* b = P'*x */ } cs_free (x) ; cs_sfree (S) ; cs_nfree (N) ; return (ok) ; } /* C = compressed-column form of a triplet matrix T */ cs *cs_compress (const cs *T) { csi m, n, nz, p, k, *Cp, *Ci, *w, *Ti, *Tj ; double *Cx, *Tx ; cs *C ; if (!CS_TRIPLET (T)) return (NULL) ; /* check inputs */ m = T->m ; n = T->n ; Ti = T->i ; Tj = T->p ; Tx = T->x ; nz = T->nz ; C = cs_spalloc (m, n, nz, Tx != NULL, 0) ; /* allocate result */ w = cs_calloc (n, sizeof (csi)) ; /* get workspace */ if (!C || !w) return (cs_done (C, w, NULL, 0)) ; /* out of memory */ Cp = C->p ; Ci = C->i ; Cx = C->x ; for (k = 0 ; k < nz ; k++) w [Tj [k]]++ ; /* column counts */ cs_cumsum (Cp, w, n) ; /* column pointers */ for (k = 0 ; k < nz ; k++) { Ci [p = w [Tj [k]]++] = Ti [k] ; /* A(i,j) is the pth entry in C */ if (Cx) Cx [p] = Tx [k] ; } return (cs_done (C, w, NULL, 1)) ; /* success; free w and return C */ } /* column counts of LL'=A or LL'=A'A, given parent & post ordering */ #define HEAD(k,j) (ata ? head [k] : j) #define NEXT(J) (ata ? next [J] : -1) static void init_ata (cs *AT, const csi *post, csi *w, csi **head, csi **next) { csi i, k, p, m = AT->n, n = AT->m, *ATp = AT->p, *ATi = AT->i ; *head = w+4*n, *next = w+5*n+1 ; for (k = 0 ; k < n ; k++) w [post [k]] = k ; /* invert post */ for (i = 0 ; i < m ; i++) { for (k = n, p = ATp[i] ; p < ATp[i+1] ; p++) k = CS_MIN (k, w [ATi[p]]); (*next) [i] = (*head) [k] ; /* place row i in linked list k */ (*head) [k] = i ; } } csi *cs_counts (const cs *A, const csi *parent, const csi *post, csi ata) { csi i, j, k, n, m, J, s, p, q, jleaf, *ATp, *ATi, *maxfirst, *prevleaf, *ancestor, *head = NULL, *next = NULL, *colcount, *w, *first, *delta ; cs *AT ; if (!CS_CSC (A) || !parent || !post) return (NULL) ; /* check inputs */ m = A->m ; n = A->n ; s = 4*n + (ata ? (n+m+1) : 0) ; delta = colcount = cs_malloc (n, sizeof (csi)) ; /* allocate result */ w = cs_malloc (s, sizeof (csi)) ; /* get workspace */ AT = cs_transpose (A, 0) ; /* AT = A' */ if (!AT || !colcount || !w) return (cs_idone (colcount, AT, w, 0)) ; ancestor = w ; maxfirst = w+n ; prevleaf = w+2*n ; first = w+3*n ; for (k = 0 ; k < s ; k++) w [k] = -1 ; /* clear workspace w [0..s-1] */ for (k = 0 ; k < n ; k++) /* find first [j] */ { j = post [k] ; delta [j] = (first [j] == -1) ? 1 : 0 ; /* delta[j]=1 if j is a leaf */ for ( ; j != -1 && first [j] == -1 ; j = parent [j]) first [j] = k ; } ATp = AT->p ; ATi = AT->i ; if (ata) init_ata (AT, post, w, &head, &next) ; for (i = 0 ; i < n ; i++) ancestor [i] = i ; /* each node in its own set */ for (k = 0 ; k < n ; k++) { j = post [k] ; /* j is the kth node in postordered etree */ if (parent [j] != -1) delta [parent [j]]-- ; /* j is not a root */ for (J = HEAD (k,j) ; J != -1 ; J = NEXT (J)) /* J=j for LL'=A case */ { for (p = ATp [J] ; p < ATp [J+1] ; p++) { i = ATi [p] ; q = cs_leaf (i, j, first, maxfirst, prevleaf, ancestor, &jleaf); if (jleaf >= 1) delta [j]++ ; /* A(i,j) is in skeleton */ if (jleaf == 2) delta [q]-- ; /* account for overlap in q */ } } if (parent [j] != -1) ancestor [j] = parent [j] ; } for (j = 0 ; j < n ; j++) /* sum up delta's of each child */ { if (parent [j] != -1) colcount [parent [j]] += colcount [j] ; } return (cs_idone (colcount, AT, w, 1)) ; /* success: free workspace */ } /* p [0..n] = cumulative sum of c [0..n-1], and then copy p [0..n-1] into c */ double cs_cumsum (csi *p, csi *c, csi n) { csi i, nz = 0 ; double nz2 = 0 ; if (!p || !c) return (-1) ; /* check inputs */ for (i = 0 ; i < n ; i++) { p [i] = nz ; nz += c [i] ; nz2 += c [i] ; /* also in double to avoid csi overflow */ c [i] = p [i] ; /* also copy p[0..n-1] back into c[0..n-1]*/ } p [n] = nz ; return (nz2) ; /* return sum (c [0..n-1]) */ } /* depth-first-search of the graph of a matrix, starting at node j */ csi cs_dfs (csi j, cs *G, csi top, csi *xi, csi *pstack, const csi *pinv) { csi i, p, p2, done, jnew, head = 0, *Gp, *Gi ; if (!CS_CSC (G) || !xi || !pstack) return (-1) ; /* check inputs */ Gp = G->p ; Gi = G->i ; xi [0] = j ; /* initialize the recursion stack */ while (head >= 0) { j = xi [head] ; /* get j from the top of the recursion stack */ jnew = pinv ? (pinv [j]) : j ; if (!CS_MARKED (Gp, j)) { CS_MARK (Gp, j) ; /* mark node j as visited */ pstack [head] = (jnew < 0) ? 0 : CS_UNFLIP (Gp [jnew]) ; } done = 1 ; /* node j done if no unvisited neighbors */ p2 = (jnew < 0) ? 0 : CS_UNFLIP (Gp [jnew+1]) ; for (p = pstack [head] ; p < p2 ; p++) /* examine all neighbors of j */ { i = Gi [p] ; /* consider neighbor node i */ if (CS_MARKED (Gp, i)) continue ; /* skip visited node i */ pstack [head] = p ; /* pause depth-first search of node j */ xi [++head] = i ; /* start dfs at node i */ done = 0 ; /* node j is not done */ break ; /* break, to start dfs (i) */ } if (done) /* depth-first search at node j is done */ { head-- ; /* remove j from the recursion stack */ xi [--top] = j ; /* and place in the output stack */ } } return (top) ; } /* breadth-first search for coarse decomposition (C0,C1,R1 or R0,R3,C3) */ static csi cs_bfs (const cs *A, csi n, csi *wi, csi *wj, csi *queue, const csi *imatch, const csi *jmatch, csi mark) { csi *Ap, *Ai, head = 0, tail = 0, j, i, p, j2 ; cs *C ; for (j = 0 ; j < n ; j++) /* place all unmatched nodes in queue */ { if (imatch [j] >= 0) continue ; /* skip j if matched */ wj [j] = 0 ; /* j in set C0 (R0 if transpose) */ queue [tail++] = j ; /* place unmatched col j in queue */ } if (tail == 0) return (1) ; /* quick return if no unmatched nodes */ C = (mark == 1) ? ((cs *) A) : cs_transpose (A, 0) ; if (!C) return (0) ; /* bfs of C=A' to find R3,C3 from R0 */ Ap = C->p ; Ai = C->i ; while (head < tail) /* while queue is not empty */ { j = queue [head++] ; /* get the head of the queue */ for (p = Ap [j] ; p < Ap [j+1] ; p++) { i = Ai [p] ; if (wi [i] >= 0) continue ; /* skip if i is marked */ wi [i] = mark ; /* i in set R1 (C3 if transpose) */ j2 = jmatch [i] ; /* traverse alternating path to j2 */ if (wj [j2] >= 0) continue ;/* skip j2 if it is marked */ wj [j2] = mark ; /* j2 in set C1 (R3 if transpose) */ queue [tail++] = j2 ; /* add j2 to queue */ } } if (mark != 1) cs_spfree (C) ; /* free A' if it was created */ return (1) ; } /* collect matched rows and columns into p and q */ static void cs_matched (csi n, const csi *wj, const csi *imatch, csi *p, csi *q, csi *cc, csi *rr, csi set, csi mark) { csi kc = cc [set], j ; csi kr = rr [set-1] ; for (j = 0 ; j < n ; j++) { if (wj [j] != mark) continue ; /* skip if j is not in C set */ p [kr++] = imatch [j] ; q [kc++] = j ; } cc [set+1] = kc ; rr [set] = kr ; } /* collect unmatched rows into the permutation vector p */ static void cs_unmatched (csi m, const csi *wi, csi *p, csi *rr, csi set) { csi i, kr = rr [set] ; for (i = 0 ; i < m ; i++) if (wi [i] == 0) p [kr++] = i ; rr [set+1] = kr ; } /* return 1 if row i is in R2 */ static csi cs_rprune (csi i, csi j, double aij, void *other) { csi *rr = (csi *) other ; return (i >= rr [1] && i < rr [2]) ; } /* Given A, compute coarse and then fine dmperm */ csd *cs_dmperm (const cs *A, csi seed) { csi m, n, i, j, k, cnz, nc, *jmatch, *imatch, *wi, *wj, *pinv, *Cp, *Ci, *ps, *rs, nb1, nb2, *p, *q, *cc, *rr, *r, *s, ok ; cs *C ; csd *D, *scc ; /* --- Maximum matching ------------------------------------------------- */ if (!CS_CSC (A)) return (NULL) ; /* check inputs */ m = A->m ; n = A->n ; D = cs_dalloc (m, n) ; /* allocate result */ if (!D) return (NULL) ; p = D->p ; q = D->q ; r = D->r ; s = D->s ; cc = D->cc ; rr = D->rr ; jmatch = cs_maxtrans (A, seed) ; /* max transversal */ imatch = jmatch + m ; /* imatch = inverse of jmatch */ if (!jmatch) return (cs_ddone (D, NULL, jmatch, 0)) ; /* --- Coarse decomposition --------------------------------------------- */ wi = r ; wj = s ; /* use r and s as workspace */ for (j = 0 ; j < n ; j++) wj [j] = -1 ; /* unmark all cols for bfs */ for (i = 0 ; i < m ; i++) wi [i] = -1 ; /* unmark all rows for bfs */ cs_bfs (A, n, wi, wj, q, imatch, jmatch, 1) ; /* find C1, R1 from C0*/ ok = cs_bfs (A, m, wj, wi, p, jmatch, imatch, 3) ; /* find R3, C3 from R0*/ if (!ok) return (cs_ddone (D, NULL, jmatch, 0)) ; cs_unmatched (n, wj, q, cc, 0) ; /* unmatched set C0 */ cs_matched (n, wj, imatch, p, q, cc, rr, 1, 1) ; /* set R1 and C1 */ cs_matched (n, wj, imatch, p, q, cc, rr, 2, -1) ; /* set R2 and C2 */ cs_matched (n, wj, imatch, p, q, cc, rr, 3, 3) ; /* set R3 and C3 */ cs_unmatched (m, wi, p, rr, 3) ; /* unmatched set R0 */ cs_free (jmatch) ; /* --- Fine decomposition ----------------------------------------------- */ pinv = cs_pinv (p, m) ; /* pinv=p' */ if (!pinv) return (cs_ddone (D, NULL, NULL, 0)) ; C = cs_permute (A, pinv, q, 0) ;/* C=A(p,q) (it will hold A(R2,C2)) */ cs_free (pinv) ; if (!C) return (cs_ddone (D, NULL, NULL, 0)) ; Cp = C->p ; nc = cc [3] - cc [2] ; /* delete cols C0, C1, and C3 from C */ if (cc [2] > 0) for (j = cc [2] ; j <= cc [3] ; j++) Cp [j-cc[2]] = Cp [j] ; C->n = nc ; if (rr [2] - rr [1] < m) /* delete rows R0, R1, and R3 from C */ { cs_fkeep (C, cs_rprune, rr) ; cnz = Cp [nc] ; Ci = C->i ; if (rr [1] > 0) for (k = 0 ; k < cnz ; k++) Ci [k] -= rr [1] ; } C->m = nc ; scc = cs_scc (C) ; /* find strongly connected components of C*/ if (!scc) return (cs_ddone (D, C, NULL, 0)) ; /* --- Combine coarse and fine decompositions --------------------------- */ ps = scc->p ; /* C(ps,ps) is the permuted matrix */ rs = scc->r ; /* kth block is rs[k]..rs[k+1]-1 */ nb1 = scc->nb ; /* # of blocks of A(R2,C2) */ for (k = 0 ; k < nc ; k++) wj [k] = q [ps [k] + cc [2]] ; for (k = 0 ; k < nc ; k++) q [k + cc [2]] = wj [k] ; for (k = 0 ; k < nc ; k++) wi [k] = p [ps [k] + rr [1]] ; for (k = 0 ; k < nc ; k++) p [k + rr [1]] = wi [k] ; nb2 = 0 ; /* create the fine block partitions */ r [0] = s [0] = 0 ; if (cc [2] > 0) nb2++ ; /* leading coarse block A (R1, [C0 C1]) */ for (k = 0 ; k < nb1 ; k++) /* coarse block A (R2,C2) */ { r [nb2] = rs [k] + rr [1] ; /* A (R2,C2) splits into nb1 fine blocks */ s [nb2] = rs [k] + cc [2] ; nb2++ ; } if (rr [2] < m) { r [nb2] = rr [2] ; /* trailing coarse block A ([R3 R0], C3) */ s [nb2] = cc [3] ; nb2++ ; } r [nb2] = m ; s [nb2] = n ; D->nb = nb2 ; cs_dfree (scc) ; return (cs_ddone (D, C, NULL, 1)) ; } static csi cs_tol (csi i, csi j, double aij, void *tol) { return (fabs (aij) > *((double *) tol)) ; } csi cs_droptol (cs *A, double tol) { return (cs_fkeep (A, &cs_tol, &tol)) ; /* keep all large entries */ } static csi cs_nonzero (csi i, csi j, double aij, void *other) { return (aij != 0) ; } csi cs_dropzeros (cs *A) { return (cs_fkeep (A, &cs_nonzero, NULL)) ; /* keep all nonzero entries */ } /* remove duplicate entries from A */ csi cs_dupl (cs *A) { csi i, j, p, q, nz = 0, n, m, *Ap, *Ai, *w ; double *Ax ; if (!CS_CSC (A)) return (0) ; /* check inputs */ m = A->m ; n = A->n ; Ap = A->p ; Ai = A->i ; Ax = A->x ; w = cs_malloc (m, sizeof (csi)) ; /* get workspace */ if (!w) return (0) ; /* out of memory */ for (i = 0 ; i < m ; i++) w [i] = -1 ; /* row i not yet seen */ for (j = 0 ; j < n ; j++) { q = nz ; /* column j will start at q */ for (p = Ap [j] ; p < Ap [j+1] ; p++) { i = Ai [p] ; /* A(i,j) is nonzero */ if (w [i] >= q) { Ax [w [i]] += Ax [p] ; /* A(i,j) is a duplicate */ } else { w [i] = nz ; /* record where row i occurs */ Ai [nz] = i ; /* keep A(i,j) */ Ax [nz++] = Ax [p] ; } } Ap [j] = q ; /* record start of column j */ } Ap [n] = nz ; /* finalize A */ cs_free (w) ; /* free workspace */ return (cs_sprealloc (A, 0)) ; /* remove extra space from A */ } /* add an entry to a triplet matrix; return 1 if ok, 0 otherwise */ csi cs_entry (cs *T, csi i, csi j, double x) { if (!CS_TRIPLET (T) || i < 0 || j < 0) return (0) ; /* check inputs */ if (T->nz >= T->nzmax && !cs_sprealloc (T,2*(T->nzmax))) return (0) ; if (T->x) T->x [T->nz] = x ; T->i [T->nz] = i ; T->p [T->nz++] = j ; T->m = CS_MAX (T->m, i+1) ; T->n = CS_MAX (T->n, j+1) ; return (1) ; } /* find nonzero pattern of Cholesky L(k,1:k-1) using etree and triu(A(:,k)) */ csi cs_ereach (const cs *A, csi k, const csi *parent, csi *s, csi *w) { csi i, p, n, len, top, *Ap, *Ai ; if (!CS_CSC (A) || !parent || !s || !w) return (-1) ; /* check inputs */ top = n = A->n ; Ap = A->p ; Ai = A->i ; CS_MARK (w, k) ; /* mark node k as visited */ for (p = Ap [k] ; p < Ap [k+1] ; p++) { i = Ai [p] ; /* A(i,k) is nonzero */ if (i > k) continue ; /* only use upper triangular part of A */ for (len = 0 ; !CS_MARKED (w,i) ; i = parent [i]) /* traverse up etree*/ { s [len++] = i ; /* L(k,i) is nonzero */ CS_MARK (w, i) ; /* mark i as visited */ } while (len > 0) s [--top] = s [--len] ; /* push path onto stack */ } for (p = top ; p < n ; p++) CS_MARK (w, s [p]) ; /* unmark all nodes */ CS_MARK (w, k) ; /* unmark node k */ return (top) ; /* s [top..n-1] contains pattern of L(k,:)*/ } /* compute the etree of A (using triu(A), or A'A without forming A'A */ csi *cs_etree (const cs *A, csi ata) { csi i, k, p, m, n, inext, *Ap, *Ai, *w, *parent, *ancestor, *prev ; if (!CS_CSC (A)) return (NULL) ; /* check inputs */ m = A->m ; n = A->n ; Ap = A->p ; Ai = A->i ; parent = cs_malloc (n, sizeof (csi)) ; /* allocate result */ w = cs_malloc (n + (ata ? m : 0), sizeof (csi)) ; /* get workspace */ if (!w || !parent) return (cs_idone (parent, NULL, w, 0)) ; ancestor = w ; prev = w + n ; if (ata) for (i = 0 ; i < m ; i++) prev [i] = -1 ; for (k = 0 ; k < n ; k++) { parent [k] = -1 ; /* node k has no parent yet */ ancestor [k] = -1 ; /* nor does k have an ancestor */ for (p = Ap [k] ; p < Ap [k+1] ; p++) { i = ata ? (prev [Ai [p]]) : (Ai [p]) ; for ( ; i != -1 && i < k ; i = inext) /* traverse from i to k */ { inext = ancestor [i] ; /* inext = ancestor of i */ ancestor [i] = k ; /* path compression */ if (inext == -1) parent [i] = k ; /* no anc., parent is k */ } if (ata) prev [Ai [p]] = k ; } } return (cs_idone (parent, NULL, w, 1)) ; } /* drop entries for which fkeep(A(i,j)) is false; return nz if OK, else -1 */ csi cs_fkeep (cs *A, csi (*fkeep) (csi, csi, double, void *), void *other) { csi j, p, nz = 0, n, *Ap, *Ai ; double *Ax ; if (!CS_CSC (A) || !fkeep) return (-1) ; /* check inputs */ n = A->n ; Ap = A->p ; Ai = A->i ; Ax = A->x ; for (j = 0 ; j < n ; j++) { p = Ap [j] ; /* get current location of col j */ Ap [j] = nz ; /* record new location of col j */ for ( ; p < Ap [j+1] ; p++) { if (fkeep (Ai [p], j, Ax ? Ax [p] : 1, other)) { if (Ax) Ax [nz] = Ax [p] ; /* keep A(i,j) */ Ai [nz++] = Ai [p] ; } } } Ap [n] = nz ; /* finalize A */ cs_sprealloc (A, 0) ; /* remove extra space from A */ return (nz) ; } /* y = A*x+y */ csi cs_gaxpy (const cs *A, const double *x, double *y) { csi p, j, n, *Ap, *Ai ; double *Ax ; if (!CS_CSC (A) || !x || !y) return (0) ; /* check inputs */ n = A->n ; Ap = A->p ; Ai = A->i ; Ax = A->x ; for (j = 0 ; j < n ; j++) { for (p = Ap [j] ; p < Ap [j+1] ; p++) { y [Ai [p]] += Ax [p] * x [j] ; } } return (1) ; } /* apply the ith Householder vector to x */ csi cs_happly (const cs *V, csi i, double beta, double *x) { csi p, *Vp, *Vi ; double *Vx, tau = 0 ; if (!CS_CSC (V) || !x) return (0) ; /* check inputs */ Vp = V->p ; Vi = V->i ; Vx = V->x ; for (p = Vp [i] ; p < Vp [i+1] ; p++) /* tau = v'*x */ { tau += Vx [p] * x [Vi [p]] ; } tau *= beta ; /* tau = beta*(v'*x) */ for (p = Vp [i] ; p < Vp [i+1] ; p++) /* x = x - v*tau */ { x [Vi [p]] -= Vx [p] * tau ; } return (1) ; } /* create a Householder reflection [v,beta,s]=house(x), overwrite x with v, * where (I-beta*v*v')*x = s*e1. See Algo 5.1.1, Golub & Van Loan, 3rd ed. */ double cs_house (double *x, double *beta, csi n) { double s, sigma = 0 ; csi i ; if (!x || !beta) return (-1) ; /* check inputs */ for (i = 1 ; i < n ; i++) sigma += x [i] * x [i] ; if (sigma == 0) { s = fabs (x [0]) ; /* s = |x(0)| */ (*beta) = (x [0] <= 0) ? 2 : 0 ; x [0] = 1 ; } else { s = sqrt (x [0] * x [0] + sigma) ; /* s = norm (x) */ x [0] = (x [0] <= 0) ? (x [0] - s) : (-sigma / (x [0] + s)) ; (*beta) = -1. / (s * x [0]) ; } return (s) ; } /* x(p) = b, for dense vectors x and b; p=NULL denotes identity */ csi cs_ipvec (const csi *p, const double *b, double *x, csi n) { csi k ; if (!x || !b) return (0) ; /* check inputs */ for (k = 0 ; k < n ; k++) x [p ? p [k] : k] = b [k] ; return (1) ; } /* consider A(i,j), node j in ith row subtree and return lca(jprev,j) */ csi cs_leaf (csi i, csi j, const csi *first, csi *maxfirst, csi *prevleaf, csi *ancestor, csi *jleaf) { csi q, s, sparent, jprev ; if (!first || !maxfirst || !prevleaf || !ancestor || !jleaf) return (-1) ; *jleaf = 0 ; if (i <= j || first [j] <= maxfirst [i]) return (-1) ; /* j not a leaf */ maxfirst [i] = first [j] ; /* update max first[j] seen so far */ jprev = prevleaf [i] ; /* jprev = previous leaf of ith subtree */ prevleaf [i] = j ; *jleaf = (jprev == -1) ? 1: 2 ; /* j is first or subsequent leaf */ if (*jleaf == 1) return (i) ; /* if 1st leaf, q = root of ith subtree */ for (q = jprev ; q != ancestor [q] ; q = ancestor [q]) ; for (s = jprev ; s != q ; s = sparent) { sparent = ancestor [s] ; /* path compression */ ancestor [s] = q ; } return (q) ; /* q = least common ancester (jprev,j) */ } /* load a triplet matrix from a file */ cs *cs_load (FILE *f) { double i, j ; /* use double for integers to avoid csi conflicts */ double x ; cs *T ; if (!f) return (NULL) ; /* check inputs */ T = cs_spalloc (0, 0, 1, 1, 1) ; /* allocate result */ while (fscanf (f, "%lg %lg %lg\n", &i, &j, &x) == 3) { if (!cs_entry (T, (csi) i, (csi) j, x)) return (cs_spfree (T)) ; } return (T) ; } /* solve Lx=b where x and b are dense. x=b on input, solution on output. */ csi cs_lsolve (const cs *L, double *x) { csi p, j, n, *Lp, *Li ; double *Lx ; if (!CS_CSC (L) || !x) return (0) ; /* check inputs */ n = L->n ; Lp = L->p ; Li = L->i ; Lx = L->x ; for (j = 0 ; j < n ; j++) { x [j] /= Lx [Lp [j]] ; for (p = Lp [j]+1 ; p < Lp [j+1] ; p++) { x [Li [p]] -= Lx [p] * x [j] ; } } return (1) ; } /* solve L'x=b where x and b are dense. x=b on input, solution on output. */ csi cs_ltsolve (const cs *L, double *x) { csi p, j, n, *Lp, *Li ; double *Lx ; if (!CS_CSC (L) || !x) return (0) ; /* check inputs */ n = L->n ; Lp = L->p ; Li = L->i ; Lx = L->x ; for (j = n-1 ; j >= 0 ; j--) { for (p = Lp [j]+1 ; p < Lp [j+1] ; p++) { x [j] -= Lx [p] * x [Li [p]] ; } x [j] /= Lx [Lp [j]] ; } return (1) ; } /* [L,U,pinv]=lu(A, [q lnz unz]). lnz and unz can be guess */ csn *cs_lu (const cs *A, const css *S, double tol) { cs *L, *U ; csn *N ; double pivot, *Lx, *Ux, *x, a, t ; csi *Lp, *Li, *Up, *Ui, *pinv, *xi, *q, n, ipiv, k, top, p, i, col, lnz,unz; if (!CS_CSC (A) || !S) return (NULL) ; /* check inputs */ n = A->n ; q = S->q ; lnz = S->lnz ; unz = S->unz ; x = cs_malloc (n, sizeof (double)) ; /* get double workspace */ xi = cs_malloc (2*n, sizeof (csi)) ; /* get csi workspace */ N = cs_calloc (1, sizeof (csn)) ; /* allocate result */ if (!x || !xi || !N) return (cs_ndone (N, NULL, xi, x, 0)) ; N->L = L = cs_spalloc (n, n, lnz, 1, 0) ; /* allocate result L */ N->U = U = cs_spalloc (n, n, unz, 1, 0) ; /* allocate result U */ N->pinv = pinv = cs_malloc (n, sizeof (csi)) ; /* allocate result pinv */ if (!L || !U || !pinv) return (cs_ndone (N, NULL, xi, x, 0)) ; Lp = L->p ; Up = U->p ; for (i = 0 ; i < n ; i++) x [i] = 0 ; /* clear workspace */ for (i = 0 ; i < n ; i++) pinv [i] = -1 ; /* no rows pivotal yet */ for (k = 0 ; k <= n ; k++) Lp [k] = 0 ; /* no cols of L yet */ lnz = unz = 0 ; for (k = 0 ; k < n ; k++) /* compute L(:,k) and U(:,k) */ { /* --- Triangular solve --------------------------------------------- */ Lp [k] = lnz ; /* L(:,k) starts here */ Up [k] = unz ; /* U(:,k) starts here */ if ((lnz + n > L->nzmax && !cs_sprealloc (L, 2*L->nzmax + n)) || (unz + n > U->nzmax && !cs_sprealloc (U, 2*U->nzmax + n))) { return (cs_ndone (N, NULL, xi, x, 0)) ; } Li = L->i ; Lx = L->x ; Ui = U->i ; Ux = U->x ; col = q ? (q [k]) : k ; top = cs_spsolve (L, A, col, xi, x, pinv, 1) ; /* x = L\A(:,col) */ /* --- Find pivot --------------------------------------------------- */ ipiv = -1 ; a = -1 ; for (p = top ; p < n ; p++) { i = xi [p] ; /* x(i) is nonzero */ if (pinv [i] < 0) /* row i is not yet pivotal */ { if ((t = fabs (x [i])) > a) { a = t ; /* largest pivot candidate so far */ ipiv = i ; } } else /* x(i) is the entry U(pinv[i],k) */ { Ui [unz] = pinv [i] ; Ux [unz++] = x [i] ; } } if (ipiv == -1 || a <= 0) return (cs_ndone (N, NULL, xi, x, 0)) ; /* tol=1 for partial pivoting; tol<1 gives preference to diagonal */ if (pinv [col] < 0 && fabs (x [col]) >= a*tol) ipiv = col ; /* --- Divide by pivot ---------------------------------------------- */ pivot = x [ipiv] ; /* the chosen pivot */ Ui [unz] = k ; /* last entry in U(:,k) is U(k,k) */ Ux [unz++] = pivot ; pinv [ipiv] = k ; /* ipiv is the kth pivot row */ Li [lnz] = ipiv ; /* first entry in L(:,k) is L(k,k) = 1 */ Lx [lnz++] = 1 ; for (p = top ; p < n ; p++) /* L(k+1:n,k) = x / pivot */ { i = xi [p] ; if (pinv [i] < 0) /* x(i) is an entry in L(:,k) */ { Li [lnz] = i ; /* save unpermuted row in L */ Lx [lnz++] = x [i] / pivot ; /* scale pivot column */ } x [i] = 0 ; /* x [0..n-1] = 0 for next k */ } } /* --- Finalize L and U ------------------------------------------------- */ Lp [n] = lnz ; Up [n] = unz ; Li = L->i ; /* fix row indices of L for final pinv */ for (p = 0 ; p < lnz ; p++) Li [p] = pinv [Li [p]] ; cs_sprealloc (L, 0) ; /* remove extra space from L and U */ cs_sprealloc (U, 0) ; return (cs_ndone (N, NULL, xi, x, 1)) ; /* success */ } /* x=A\b where A is unsymmetric; b overwritten with solution */ csi cs_lusol (csi order, const cs *A, double *b, double tol) { double *x ; css *S ; csn *N ; csi n, ok ; if (!CS_CSC (A) || !b) return (0) ; /* check inputs */ n = A->n ; S = cs_sqr (order, A, 0) ; /* ordering and symbolic analysis */ N = cs_lu (A, S, tol) ; /* numeric LU factorization */ x = cs_malloc (n, sizeof (double)) ; /* get workspace */ ok = (S && N && x) ; if (ok) { cs_ipvec (N->pinv, b, x, n) ; /* x = b(p) */ cs_lsolve (N->L, x) ; /* x = L\x */ cs_usolve (N->U, x) ; /* x = U\x */ cs_ipvec (S->q, x, b, n) ; /* b(q) = x */ } cs_free (x) ; cs_sfree (S) ; cs_nfree (N) ; return (ok) ; } #ifdef MATLAB_MEX_FILE #define malloc mxMalloc #define free mxFree #define realloc mxRealloc #define calloc mxCalloc #endif /* wrapper for malloc */ void *cs_malloc (csi n, size_t size) { return (malloc (CS_MAX (n,1) * size)) ; } /* wrapper for calloc */ void *cs_calloc (csi n, size_t size) { return (calloc (CS_MAX (n,1), size)) ; } /* wrapper for free */ void *cs_free (void *p) { if (p) free (p) ; /* free p if it is not already NULL */ return (NULL) ; /* return NULL to simplify the use of cs_free */ } /* wrapper for realloc */ void *cs_realloc (void *p, csi n, size_t size, csi *ok) { void *pnew ; pnew = realloc (p, CS_MAX (n,1) * size) ; /* realloc the block */ *ok = (pnew != NULL) ; /* realloc fails if pnew is NULL */ return ((*ok) ? pnew : p) ; /* return original p if failure */ } /* find an augmenting path starting at column k and extend the match if found */ static void cs_augment (csi k, const cs *A, csi *jmatch, csi *cheap, csi *w, csi *js, csi *is, csi *ps) { csi found = 0, p, i = -1, *Ap = A->p, *Ai = A->i, head = 0, j ; js [0] = k ; /* start with just node k in jstack */ while (head >= 0) { /* --- Start (or continue) depth-first-search at node j ------------- */ j = js [head] ; /* get j from top of jstack */ if (w [j] != k) /* 1st time j visited for kth path */ { w [j] = k ; /* mark j as visited for kth path */ for (p = cheap [j] ; p < Ap [j+1] && !found ; p++) { i = Ai [p] ; /* try a cheap assignment (i,j) */ found = (jmatch [i] == -1) ; } cheap [j] = p ; /* start here next time j is traversed*/ if (found) { is [head] = i ; /* column j matched with row i */ break ; /* end of augmenting path */ } ps [head] = Ap [j] ; /* no cheap match: start dfs for j */ } /* --- Depth-first-search of neighbors of j ------------------------- */ for (p = ps [head] ; p < Ap [j+1] ; p++) { i = Ai [p] ; /* consider row i */ if (w [jmatch [i]] == k) continue ; /* skip jmatch [i] if marked */ ps [head] = p + 1 ; /* pause dfs of node j */ is [head] = i ; /* i will be matched with j if found */ js [++head] = jmatch [i] ; /* start dfs at column jmatch [i] */ break ; } if (p == Ap [j+1]) head-- ; /* node j is done; pop from stack */ } /* augment the match if path found: */ if (found) for (p = head ; p >= 0 ; p--) jmatch [is [p]] = js [p] ; } /* find a maximum transveral */ csi *cs_maxtrans (const cs *A, csi seed) /*[jmatch [0..m-1]; imatch [0..n-1]]*/ { csi i, j, k, n, m, p, n2 = 0, m2 = 0, *Ap, *jimatch, *w, *cheap, *js, *is, *ps, *Ai, *Cp, *jmatch, *imatch, *q ; cs *C ; if (!CS_CSC (A)) return (NULL) ; /* check inputs */ n = A->n ; m = A->m ; Ap = A->p ; Ai = A->i ; w = jimatch = cs_calloc (m+n, sizeof (csi)) ; /* allocate result */ if (!jimatch) return (NULL) ; for (k = 0, j = 0 ; j < n ; j++) /* count nonempty rows and columns */ { n2 += (Ap [j] < Ap [j+1]) ; for (p = Ap [j] ; p < Ap [j+1] ; p++) { w [Ai [p]] = 1 ; k += (j == Ai [p]) ; /* count entries already on diagonal */ } } if (k == CS_MIN (m,n)) /* quick return if diagonal zero-free */ { jmatch = jimatch ; imatch = jimatch + m ; for (i = 0 ; i < k ; i++) jmatch [i] = i ; for ( ; i < m ; i++) jmatch [i] = -1 ; for (j = 0 ; j < k ; j++) imatch [j] = j ; for ( ; j < n ; j++) imatch [j] = -1 ; return (cs_idone (jimatch, NULL, NULL, 1)) ; } for (i = 0 ; i < m ; i++) m2 += w [i] ; C = (m2 < n2) ? cs_transpose (A,0) : ((cs *) A) ; /* transpose if needed */ if (!C) return (cs_idone (jimatch, (m2 < n2) ? C : NULL, NULL, 0)) ; n = C->n ; m = C->m ; Cp = C->p ; jmatch = (m2 < n2) ? jimatch + n : jimatch ; imatch = (m2 < n2) ? jimatch : jimatch + m ; w = cs_malloc (5*n, sizeof (csi)) ; /* get workspace */ if (!w) return (cs_idone (jimatch, (m2 < n2) ? C : NULL, w, 0)) ; cheap = w + n ; js = w + 2*n ; is = w + 3*n ; ps = w + 4*n ; for (j = 0 ; j < n ; j++) cheap [j] = Cp [j] ; /* for cheap assignment */ for (j = 0 ; j < n ; j++) w [j] = -1 ; /* all columns unflagged */ for (i = 0 ; i < m ; i++) jmatch [i] = -1 ; /* nothing matched yet */ q = cs_randperm (n, seed) ; /* q = random permutation */ for (k = 0 ; k < n ; k++) /* augment, starting at column q[k] */ { cs_augment (q ? q [k]: k, C, jmatch, cheap, w, js, is, ps) ; } cs_free (q) ; for (j = 0 ; j < n ; j++) imatch [j] = -1 ; /* find row match */ for (i = 0 ; i < m ; i++) if (jmatch [i] >= 0) imatch [jmatch [i]] = i ; return (cs_idone (jimatch, (m2 < n2) ? C : NULL, w, 1)) ; } /* C = A*B */ cs *cs_multiply (const cs *A, const cs *B) { csi p, j, nz = 0, anz, *Cp, *Ci, *Bp, m, n, bnz, *w, values, *Bi ; double *x, *Bx, *Cx ; cs *C ; if (!CS_CSC (A) || !CS_CSC (B)) return (NULL) ; /* check inputs */ if (A->n != B->m) return (NULL) ; m = A->m ; anz = A->p [A->n] ; n = B->n ; Bp = B->p ; Bi = B->i ; Bx = B->x ; bnz = Bp [n] ; w = cs_calloc (m, sizeof (csi)) ; /* get workspace */ values = (A->x != NULL) && (Bx != NULL) ; x = values ? cs_malloc (m, sizeof (double)) : NULL ; /* get workspace */ C = cs_spalloc (m, n, anz + bnz, values, 0) ; /* allocate result */ if (!C || !w || (values && !x)) return (cs_done (C, w, x, 0)) ; Cp = C->p ; for (j = 0 ; j < n ; j++) { if (nz + m > C->nzmax && !cs_sprealloc (C, 2*(C->nzmax)+m)) { return (cs_done (C, w, x, 0)) ; /* out of memory */ } Ci = C->i ; Cx = C->x ; /* C->i and C->x may be reallocated */ Cp [j] = nz ; /* column j of C starts here */ for (p = Bp [j] ; p < Bp [j+1] ; p++) { nz = cs_scatter (A, Bi [p], Bx ? Bx [p] : 1, w, x, j+1, C, nz) ; } if (values) for (p = Cp [j] ; p < nz ; p++) Cx [p] = x [Ci [p]] ; } Cp [n] = nz ; /* finalize the last column of C */ cs_sprealloc (C, 0) ; /* remove extra space from C */ return (cs_done (C, w, x, 1)) ; /* success; free workspace, return C */ } /* 1-norm of a sparse matrix = max (sum (abs (A))), largest column sum */ double cs_norm (const cs *A) { csi p, j, n, *Ap ; double *Ax, norm = 0, s ; if (!CS_CSC (A) || !A->x) return (-1) ; /* check inputs */ n = A->n ; Ap = A->p ; Ax = A->x ; for (j = 0 ; j < n ; j++) { for (s = 0, p = Ap [j] ; p < Ap [j+1] ; p++) s += fabs (Ax [p]) ; norm = CS_MAX (norm, s) ; } return (norm) ; } /* C = A(p,q) where p and q are permutations of 0..m-1 and 0..n-1. */ cs *cs_permute (const cs *A, const csi *pinv, const csi *q, csi values) { csi t, j, k, nz = 0, m, n, *Ap, *Ai, *Cp, *Ci ; double *Cx, *Ax ; cs *C ; if (!CS_CSC (A)) return (NULL) ; /* check inputs */ m = A->m ; n = A->n ; Ap = A->p ; Ai = A->i ; Ax = A->x ; C = cs_spalloc (m, n, Ap [n], values && Ax != NULL, 0) ; /* alloc result */ if (!C) return (cs_done (C, NULL, NULL, 0)) ; /* out of memory */ Cp = C->p ; Ci = C->i ; Cx = C->x ; for (k = 0 ; k < n ; k++) { Cp [k] = nz ; /* column k of C is column q[k] of A */ j = q ? (q [k]) : k ; for (t = Ap [j] ; t < Ap [j+1] ; t++) { if (Cx) Cx [nz] = Ax [t] ; /* row i of A is row pinv[i] of C */ Ci [nz++] = pinv ? (pinv [Ai [t]]) : Ai [t] ; } } Cp [n] = nz ; /* finalize the last column of C */ return (cs_done (C, NULL, NULL, 1)) ; } /* pinv = p', or p = pinv' */ csi *cs_pinv (csi const *p, csi n) { csi k, *pinv ; if (!p) return (NULL) ; /* p = NULL denotes identity */ pinv = cs_malloc (n, sizeof (csi)) ; /* allocate result */ if (!pinv) return (NULL) ; /* out of memory */ for (k = 0 ; k < n ; k++) pinv [p [k]] = k ;/* invert the permutation */ return (pinv) ; /* return result */ } /* post order a forest */ csi *cs_post (const csi *parent, csi n) { csi j, k = 0, *post, *w, *head, *next, *stack ; if (!parent) return (NULL) ; /* check inputs */ post = cs_malloc (n, sizeof (csi)) ; /* allocate result */ w = cs_malloc (3*n, sizeof (csi)) ; /* get workspace */ if (!w || !post) return (cs_idone (post, NULL, w, 0)) ; head = w ; next = w + n ; stack = w + 2*n ; for (j = 0 ; j < n ; j++) head [j] = -1 ; /* empty linked lists */ for (j = n-1 ; j >= 0 ; j--) /* traverse nodes in reverse order*/ { if (parent [j] == -1) continue ; /* j is a root */ next [j] = head [parent [j]] ; /* add j to list of its parent */ head [parent [j]] = j ; } for (j = 0 ; j < n ; j++) { if (parent [j] != -1) continue ; /* skip j if it is not a root */ k = cs_tdfs (j, k, head, next, post, stack) ; } return (cs_idone (post, NULL, w, 1)) ; /* success; free w, return post */ } /* print a sparse matrix; use %g for integers to avoid differences with csi */ csi cs_print (const cs *A, csi brief) { csi p, j, m, n, nzmax, nz, *Ap, *Ai ; double *Ax ; if (!A) { Rprintf ("(null)\n") ; return (0) ; } m = A->m ; n = A->n ; Ap = A->p ; Ai = A->i ; Ax = A->x ; nzmax = A->nzmax ; nz = A->nz ; Rprintf ("CSparse Version %d.%d.%d, %s. %s\n", CS_VER, CS_SUBVER, CS_SUBSUB, CS_DATE, CS_COPYRIGHT) ; if (nz < 0) { Rprintf ("%g-by-%g, nzmax: %g nnz: %g, 1-norm: %g\n", (double) m, (double) n, (double) nzmax, (double) (Ap [n]), cs_norm (A)) ; for (j = 0 ; j < n ; j++) { Rprintf (" col %g : locations %g to %g\n", (double) j, (double) (Ap [j]), (double) (Ap [j+1]-1)) ; for (p = Ap [j] ; p < Ap [j+1] ; p++) { Rprintf (" %g : %g\n", (double) (Ai [p]), Ax ? Ax [p] : 1) ; if (brief && p > 20) { Rprintf (" ...\n") ; return (1) ; } } } } else { Rprintf ("triplet: %g-by-%g, nzmax: %g nnz: %g\n", (double) m, (double) n, (double) nzmax, (double) nz) ; for (p = 0 ; p < nz ; p++) { Rprintf (" %g %g : %g\n", (double) (Ai [p]), (double) (Ap [p]), Ax ? Ax [p] : 1) ; if (brief && p > 20) { Rprintf (" ...\n") ; return (1) ; } } } return (1) ; } /* x = b(p), for dense vectors x and b; p=NULL denotes identity */ csi cs_pvec (const csi *p, const double *b, double *x, csi n) { csi k ; if (!x || !b) return (0) ; /* check inputs */ for (k = 0 ; k < n ; k++) x [k] = b [p ? p [k] : k] ; return (1) ; } /* sparse QR factorization [V,beta,pinv,R] = qr (A) */ csn *cs_qr (const cs *A, const css *S) { double *Rx, *Vx, *Ax, *x, *Beta ; csi i, k, p, n, vnz, p1, top, m2, len, col, rnz, *s, *leftmost, *Ap, *Ai, *parent, *Rp, *Ri, *Vp, *Vi, *w, *pinv, *q ; cs *R, *V ; csn *N ; // the result if (!CS_CSC (A) || !S) return (NULL) ; n = A->n ; Ap = A->p ; Ai = A->i ; Ax = A->x ; q = S->q ; parent = S->parent ; pinv = S->pinv ; m2 = S->m2 ; vnz = S->lnz ; rnz = S->unz ; leftmost = S->leftmost ; w = cs_malloc (m2+n, sizeof (csi)) ; /* get csi workspace */ x = cs_malloc (m2, sizeof (double)) ; /* get double workspace */ N = cs_calloc (1, sizeof (csn)) ; /* allocate result */ if (!w || !x || !N) return (cs_ndone (N, NULL, w, x, 0)) ; s = w + m2 ; /* s is size n */ for (k = 0 ; k < m2 ; k++) x [k] = 0 ; /* clear workspace x */ N->L = V = cs_spalloc (m2, n, vnz, 1, 0) ; /* allocate result V */ N->U = R = cs_spalloc (m2, n, rnz, 1, 0) ; /* allocate result R */ N->B = Beta = cs_malloc (n, sizeof (double)) ; /* allocate result Beta */ if (!R || !V || !Beta) return (cs_ndone (N, NULL, w, x, 0)) ; Rp = R->p ; Ri = R->i ; Rx = R->x ; Vp = V->p ; Vi = V->i ; Vx = V->x ; for (i = 0 ; i < m2 ; i++) w [i] = -1 ; /* clear w, to mark nodes */ rnz = 0 ; vnz = 0 ; for (k = 0 ; k < n ; k++) /* compute V and R */ { Rp [k] = rnz ; /* R(:,k) starts here */ Vp [k] = p1 = vnz ; /* V(:,k) starts here */ w [k] = k ; /* add V(k,k) to pattern of V */ Vi [vnz++] = k ; top = n ; col = q ? q [k] : k ; for (p = Ap [col] ; p < Ap [col+1] ; p++) /* find R(:,k) pattern */ { i = leftmost [Ai [p]] ; /* i = min(find(A(i,q))) */ for (len = 0 ; w [i] != k ; i = parent [i]) /* traverse up to k */ { s [len++] = i ; w [i] = k ; } while (len > 0) s [--top] = s [--len] ; /* push path on stack */ i = pinv [Ai [p]] ; /* i = permuted row of A(:,col) */ x [i] = Ax [p] ; /* x (i) = A(:,col) */ if (i > k && w [i] < k) /* pattern of V(:,k) = x (k+1:m) */ { Vi [vnz++] = i ; /* add i to pattern of V(:,k) */ w [i] = k ; } } for (p = top ; p < n ; p++) /* for each i in pattern of R(:,k) */ { i = s [p] ; /* R(i,k) is nonzero */ cs_happly (V, i, Beta [i], x) ; /* apply (V(i),Beta(i)) to x */ Ri [rnz] = i ; /* R(i,k) = x(i) */ Rx [rnz++] = x [i] ; x [i] = 0 ; if (parent [i] == k) vnz = cs_scatter (V, i, 0, w, NULL, k, V, vnz); } for (p = p1 ; p < vnz ; p++) /* gather V(:,k) = x */ { Vx [p] = x [Vi [p]] ; x [Vi [p]] = 0 ; } Ri [rnz] = k ; /* R(k,k) = norm (x) */ Rx [rnz++] = cs_house (Vx+p1, Beta+k, vnz-p1) ; /* [v,beta]=house(x) */ } Rp [n] = rnz ; /* finalize R */ Vp [n] = vnz ; /* finalize V */ return (cs_ndone (N, NULL, w, x, 1)) ; /* success */ } /* x=A\b where A can be rectangular; b overwritten with solution */ csi cs_qrsol (csi order, const cs *A, double *b) { double *x ; css *S ; csn *N ; cs *AT = NULL ; csi k, m, n, ok ; if (!CS_CSC (A) || !b) return (0) ; /* check inputs */ n = A->n ; m = A->m ; if (m >= n) { S = cs_sqr (order, A, 1) ; /* ordering and symbolic analysis */ N = cs_qr (A, S) ; /* numeric QR factorization */ x = cs_calloc (S ? S->m2 : 1, sizeof (double)) ; /* get workspace */ ok = (S && N && x) ; if (ok) { cs_ipvec (S->pinv, b, x, m) ; /* x(0:m-1) = b(p(0:m-1) */ for (k = 0 ; k < n ; k++) /* apply Householder refl. to x */ { cs_happly (N->L, k, N->B [k], x) ; } cs_usolve (N->U, x) ; /* x = R\x */ cs_ipvec (S->q, x, b, n) ; /* b(q(0:n-1)) = x(0:n-1) */ } } else { AT = cs_transpose (A, 1) ; /* Ax=b is underdetermined */ S = cs_sqr (order, AT, 1) ; /* ordering and symbolic analysis */ N = cs_qr (AT, S) ; /* numeric QR factorization of A' */ x = cs_calloc (S ? S->m2 : 1, sizeof (double)) ; /* get workspace */ ok = (AT && S && N && x) ; if (ok) { cs_pvec (S->q, b, x, m) ; /* x(q(0:m-1)) = b(0:m-1) */ cs_utsolve (N->U, x) ; /* x = R'\x */ for (k = m-1 ; k >= 0 ; k--) /* apply Householder refl. to x */ { cs_happly (N->L, k, N->B [k], x) ; } cs_pvec (S->pinv, x, b, n) ; /* b(0:n-1) = x(p(0:n-1)) */ } } cs_free (x) ; cs_sfree (S) ; cs_nfree (N) ; cs_spfree (AT) ; return (ok) ; } /* return a random permutation vector, the identity perm, or p = n-1:-1:0. * seed = -1 means p = n-1:-1:0. seed = 0 means p = identity. otherwise * p = random permutation. */ csi *cs_randperm (csi n, csi seed) { csi *p, k, j, t ; if (seed == 0) return (NULL) ; /* return p = NULL (identity) */ p = cs_malloc (n, sizeof (csi)) ; /* allocate result */ if (!p) return (NULL) ; /* out of memory */ for (k = 0 ; k < n ; k++) p [k] = n-k-1 ; if (seed == -1) return (p) ; /* return reverse permutation */ GetRNGstate();/* <- for R package Matrix srand (seed) ; .* get new random number seed */ for (k = 0 ; k < n ; k++) { j = k + (int)(unif_rand() * (n-k)); // j = rand integer in range k to n-1 t = p [j] ; /* swap p[k] and p[j] */ p [j] = p [k] ; p [k] = t ; } PutRNGstate(); // <- R package Matrix return (p) ; } /* xi [top...n-1] = nodes reachable from graph of G*P' via nodes in B(:,k). * xi [n...2n-1] used as workspace */ csi cs_reach (cs *G, const cs *B, csi k, csi *xi, const csi *pinv) { csi p, n, top, *Bp, *Bi, *Gp ; if (!CS_CSC (G) || !CS_CSC (B) || !xi) return (-1) ; /* check inputs */ n = G->n ; Bp = B->p ; Bi = B->i ; Gp = G->p ; top = n ; for (p = Bp [k] ; p < Bp [k+1] ; p++) { if (!CS_MARKED (Gp, Bi [p])) /* start a dfs at unmarked node i */ { top = cs_dfs (Bi [p], G, top, xi, xi+n, pinv) ; } } for (p = top ; p < n ; p++) CS_MARK (Gp, xi [p]) ; /* restore G */ return (top) ; } /* x = x + beta * A(:,j), where x is a dense vector and A(:,j) is sparse */ csi cs_scatter (const cs *A, csi j, double beta, csi *w, double *x, csi mark, cs *C, csi nz) { csi i, p, *Ap, *Ai, *Ci ; double *Ax ; if (!CS_CSC (A) || !w || !CS_CSC (C)) return (-1) ; /* check inputs */ Ap = A->p ; Ai = A->i ; Ax = A->x ; Ci = C->i ; for (p = Ap [j] ; p < Ap [j+1] ; p++) { i = Ai [p] ; /* A(i,j) is nonzero */ if (w [i] < mark) { w [i] = mark ; /* i is new entry in column j */ Ci [nz++] = i ; /* add i to pattern of C(:,j) */ if (x) x [i] = beta * Ax [p] ; /* x(i) = beta*A(i,j) */ } else if (x) x [i] += beta * Ax [p] ; /* i exists in C(:,j) already */ } return (nz) ; } /* find the strongly connected components of a square matrix */ csd *cs_scc (cs *A) /* matrix A temporarily modified, then restored */ { csi n, i, k, b, nb = 0, top, *xi, *pstack, *p, *r, *Ap, *ATp, *rcopy, *Blk ; cs *AT ; csd *D ; if (!CS_CSC (A)) return (NULL) ; /* check inputs */ n = A->n ; Ap = A->p ; D = cs_dalloc (n, 0) ; /* allocate result */ AT = cs_transpose (A, 0) ; /* AT = A' */ xi = cs_malloc (2*n+1, sizeof (csi)) ; /* get workspace */ if (!D || !AT || !xi) return (cs_ddone (D, AT, xi, 0)) ; Blk = xi ; rcopy = pstack = xi + n ; p = D->p ; r = D->r ; ATp = AT->p ; top = n ; for (i = 0 ; i < n ; i++) /* first dfs(A) to find finish times (xi) */ { if (!CS_MARKED (Ap, i)) top = cs_dfs (i, A, top, xi, pstack, NULL) ; } for (i = 0 ; i < n ; i++) CS_MARK (Ap, i) ; /* restore A; unmark all nodes*/ top = n ; nb = n ; for (k = 0 ; k < n ; k++) /* dfs(A') to find strongly connnected comp */ { i = xi [k] ; /* get i in reverse order of finish times */ if (CS_MARKED (ATp, i)) continue ; /* skip node i if already ordered */ r [nb--] = top ; /* node i is the start of a component in p */ top = cs_dfs (i, AT, top, p, pstack, NULL) ; } r [nb] = 0 ; /* first block starts at zero; shift r up */ for (k = nb ; k <= n ; k++) r [k-nb] = r [k] ; D->nb = nb = n-nb ; /* nb = # of strongly connected components */ for (b = 0 ; b < nb ; b++) /* sort each block in natural order */ { for (k = r [b] ; k < r [b+1] ; k++) Blk [p [k]] = b ; } for (b = 0 ; b <= nb ; b++) rcopy [b] = r [b] ; for (i = 0 ; i < n ; i++) p [rcopy [Blk [i]]++] = i ; return (cs_ddone (D, AT, xi, 1)) ; } /* ordering and symbolic analysis for a Cholesky factorization */ css *cs_schol (csi order, const cs *A) { csi n, *c, *post, *P ; cs *C ; css *S ; if (!CS_CSC (A)) return (NULL) ; /* check inputs */ n = A->n ; S = cs_calloc (1, sizeof (css)) ; /* allocate result S */ if (!S) return (NULL) ; /* out of memory */ P = cs_amd (order, A) ; /* P = amd(A+A'), or natural */ S->pinv = cs_pinv (P, n) ; /* find inverse permutation */ cs_free (P) ; if (order && !S->pinv) return (cs_sfree (S)) ; C = cs_symperm (A, S->pinv, 0) ; /* C = spones(triu(A(P,P))) */ S->parent = cs_etree (C, 0) ; /* find etree of C */ post = cs_post (S->parent, n) ; /* postorder the etree */ c = cs_counts (C, S->parent, post, 0) ; /* find column counts of chol(C) */ cs_free (post) ; cs_spfree (C) ; S->cp = cs_malloc (n+1, sizeof (csi)) ; /* allocate result S->cp */ S->unz = S->lnz = cs_cumsum (S->cp, c, n) ; /* find column pointers for L */ cs_free (c) ; return ((S->lnz >= 0) ? S : cs_sfree (S)) ; } /* solve Gx=b(:,k), where G is either upper (lo=0) or lower (lo=1) triangular */ csi cs_spsolve (cs *G, const cs *B, csi k, csi *xi, double *x, const csi *pinv, csi lo) { csi j, J, p, q, px, top, n, *Gp, *Gi, *Bp, *Bi ; double *Gx, *Bx ; if (!CS_CSC (G) || !CS_CSC (B) || !xi || !x) return (-1) ; Gp = G->p ; Gi = G->i ; Gx = G->x ; n = G->n ; Bp = B->p ; Bi = B->i ; Bx = B->x ; top = cs_reach (G, B, k, xi, pinv) ; /* xi[top..n-1]=Reach(B(:,k)) */ for (p = top ; p < n ; p++) x [xi [p]] = 0 ; /* clear x */ for (p = Bp [k] ; p < Bp [k+1] ; p++) x [Bi [p]] = Bx [p] ; /* scatter B */ for (px = top ; px < n ; px++) { j = xi [px] ; /* x(j) is nonzero */ J = pinv ? (pinv [j]) : j ; /* j maps to col J of G */ if (J < 0) continue ; /* column J is empty */ x [j] /= Gx [lo ? (Gp [J]) : (Gp [J+1]-1)] ;/* x(j) /= G(j,j) */ p = lo ? (Gp [J]+1) : (Gp [J]) ; /* lo: L(j,j) 1st entry */ q = lo ? (Gp [J+1]) : (Gp [J+1]-1) ; /* up: U(j,j) last entry */ for ( ; p < q ; p++) { x [Gi [p]] -= Gx [p] * x [j] ; /* x(i) -= G(i,j) * x(j) */ } } return (top) ; /* return top of stack */ } /* compute nnz(V) = S->lnz, S->pinv, S->leftmost, S->m2 from A and S->parent */ static csi cs_vcount (const cs *A, css *S) { csi i, k, p, pa, n = A->n, m = A->m, *Ap = A->p, *Ai = A->i, *next, *head, *tail, *nque, *pinv, *leftmost, *w, *parent = S->parent ; S->pinv = pinv = cs_malloc (m+n, sizeof (csi)) ; /* allocate pinv, */ S->leftmost = leftmost = cs_malloc (m, sizeof (csi)) ; /* and leftmost */ w = cs_malloc (m+3*n, sizeof (csi)) ; /* get workspace */ if (!pinv || !w || !leftmost) { cs_free (w) ; /* pinv and leftmost freed later */ return (0) ; /* out of memory */ } next = w ; head = w + m ; tail = w + m + n ; nque = w + m + 2*n ; for (k = 0 ; k < n ; k++) head [k] = -1 ; /* queue k is empty */ for (k = 0 ; k < n ; k++) tail [k] = -1 ; for (k = 0 ; k < n ; k++) nque [k] = 0 ; for (i = 0 ; i < m ; i++) leftmost [i] = -1 ; for (k = n-1 ; k >= 0 ; k--) { for (p = Ap [k] ; p < Ap [k+1] ; p++) { leftmost [Ai [p]] = k ; /* leftmost[i] = min(find(A(i,:)))*/ } } for (i = m-1 ; i >= 0 ; i--) /* scan rows in reverse order */ { pinv [i] = -1 ; /* row i is not yet ordered */ k = leftmost [i] ; if (k == -1) continue ; /* row i is empty */ if (nque [k]++ == 0) tail [k] = i ; /* first row in queue k */ next [i] = head [k] ; /* put i at head of queue k */ head [k] = i ; } S->lnz = 0 ; S->m2 = m ; for (k = 0 ; k < n ; k++) /* find row permutation and nnz(V)*/ { i = head [k] ; /* remove row i from queue k */ S->lnz++ ; /* count V(k,k) as nonzero */ if (i < 0) i = S->m2++ ; /* add a fictitious row */ pinv [i] = k ; /* associate row i with V(:,k) */ if (--nque [k] <= 0) continue ; /* skip if V(k+1:m,k) is empty */ S->lnz += nque [k] ; /* nque [k] is nnz (V(k+1:m,k)) */ if ((pa = parent [k]) != -1) /* move all rows to parent of k */ { if (nque [pa] == 0) tail [pa] = tail [k] ; next [tail [k]] = head [pa] ; head [pa] = next [i] ; nque [pa] += nque [k] ; } } for (i = 0 ; i < m ; i++) if (pinv [i] < 0) pinv [i] = k++ ; cs_free (w) ; return (1) ; } /* symbolic ordering and analysis for QR or LU */ css *cs_sqr (csi order, const cs *A, csi qr) { csi n, k, ok = 1, *post ; css *S ; if (!CS_CSC (A)) return (NULL) ; /* check inputs */ n = A->n ; S = cs_calloc (1, sizeof (css)) ; /* allocate result S */ if (!S) return (NULL) ; /* out of memory */ S->q = cs_amd (order, A) ; /* fill-reducing ordering */ if (order && !S->q) return (cs_sfree (S)) ; if (qr) /* QR symbolic analysis */ { cs *C = order ? cs_permute (A, NULL, S->q, 0) : ((cs *) A) ; S->parent = cs_etree (C, 1) ; /* etree of C'*C, where C=A(:,q) */ post = cs_post (S->parent, n) ; S->cp = cs_counts (C, S->parent, post, 1) ; /* col counts chol(C'*C) */ cs_free (post) ; ok = C && S->parent && S->cp && cs_vcount (C, S) ; if (ok) for (S->unz = 0, k = 0 ; k < n ; k++) S->unz += S->cp [k] ; if (order) cs_spfree (C) ; } else { S->unz = 4*(A->p [n]) + n ; /* for LU factorization only, */ S->lnz = S->unz ; /* guess nnz(L) and nnz(U) */ } return (ok ? S : cs_sfree (S)) ; /* return result S */ } /* C = A(p,p) where A and C are symmetric the upper part stored; pinv not p */ cs *cs_symperm (const cs *A, const csi *pinv, csi values) { csi i, j, p, q, i2, j2, n, *Ap, *Ai, *Cp, *Ci, *w ; double *Cx, *Ax ; cs *C ; if (!CS_CSC (A)) return (NULL) ; /* check inputs */ n = A->n ; Ap = A->p ; Ai = A->i ; Ax = A->x ; C = cs_spalloc (n, n, Ap [n], values && (Ax != NULL), 0) ; /* alloc result*/ w = cs_calloc (n, sizeof (csi)) ; /* get workspace */ if (!C || !w) return (cs_done (C, w, NULL, 0)) ; /* out of memory */ Cp = C->p ; Ci = C->i ; Cx = C->x ; for (j = 0 ; j < n ; j++) /* count entries in each column of C */ { j2 = pinv ? pinv [j] : j ; /* column j of A is column j2 of C */ for (p = Ap [j] ; p < Ap [j+1] ; p++) { i = Ai [p] ; if (i > j) continue ; /* skip lower triangular part of A */ i2 = pinv ? pinv [i] : i ; /* row i of A is row i2 of C */ w [CS_MAX (i2, j2)]++ ; /* column count of C */ } } cs_cumsum (Cp, w, n) ; /* compute column pointers of C */ for (j = 0 ; j < n ; j++) { j2 = pinv ? pinv [j] : j ; /* column j of A is column j2 of C */ for (p = Ap [j] ; p < Ap [j+1] ; p++) { i = Ai [p] ; if (i > j) continue ; /* skip lower triangular part of A*/ i2 = pinv ? pinv [i] : i ; /* row i of A is row i2 of C */ Ci [q = w [CS_MAX (i2, j2)]++] = CS_MIN (i2, j2) ; if (Cx) Cx [q] = Ax [p] ; } } return (cs_done (C, w, NULL, 1)) ; /* success; free workspace, return C */ } /* depth-first search and postorder of a tree rooted at node j */ csi cs_tdfs (csi j, csi k, csi *head, const csi *next, csi *post, csi *stack) { csi i, p, top = 0 ; if (!head || !next || !post || !stack) return (-1) ; /* check inputs */ stack [0] = j ; /* place j on the stack */ while (top >= 0) /* while (stack is not empty) */ { p = stack [top] ; /* p = top of stack */ i = head [p] ; /* i = youngest child of p */ if (i == -1) { top-- ; /* p has no unordered children left */ post [k++] = p ; /* node p is the kth postordered node */ } else { head [p] = next [i] ; /* remove i from children of p */ stack [++top] = i ; /* start dfs on child node i */ } } return (k) ; } /* C = A' */ cs *cs_transpose (const cs *A, csi values) { csi p, q, j, *Cp, *Ci, n, m, *Ap, *Ai, *w ; double *Cx, *Ax ; cs *C ; if (!CS_CSC (A)) return (NULL) ; /* check inputs */ m = A->m ; n = A->n ; Ap = A->p ; Ai = A->i ; Ax = A->x ; C = cs_spalloc (n, m, Ap [n], values && Ax, 0) ; /* allocate result */ w = cs_calloc (m, sizeof (csi)) ; /* get workspace */ if (!C || !w) return (cs_done (C, w, NULL, 0)) ; /* out of memory */ Cp = C->p ; Ci = C->i ; Cx = C->x ; for (p = 0 ; p < Ap [n] ; p++) w [Ai [p]]++ ; /* row counts */ cs_cumsum (Cp, w, m) ; /* row pointers */ for (j = 0 ; j < n ; j++) { for (p = Ap [j] ; p < Ap [j+1] ; p++) { Ci [q = w [Ai [p]]++] = j ; /* place A(i,j) as entry C(j,i) */ if (Cx) Cx [q] = Ax [p] ; } } return (cs_done (C, w, NULL, 1)) ; /* success; free w and return C */ } /* sparse Cholesky update/downdate, L*L' + sigma*w*w' (sigma = +1 or -1) */ csi cs_updown (cs *L, csi sigma, const cs *C, const csi *parent) { csi n, p, f, j, *Lp, *Li, *Cp, *Ci ; double *Lx, *Cx, alpha, beta = 1, delta, gamma, w1, w2, *w, beta2 = 1 ; if (!CS_CSC (L) || !CS_CSC (C) || !parent) return (0) ; /* check inputs */ Lp = L->p ; Li = L->i ; Lx = L->x ; n = L->n ; Cp = C->p ; Ci = C->i ; Cx = C->x ; if ((p = Cp [0]) >= Cp [1]) return (1) ; /* return if C empty */ w = cs_malloc (n, sizeof (double)) ; /* get workspace */ if (!w) return (0) ; /* out of memory */ f = Ci [p] ; for ( ; p < Cp [1] ; p++) f = CS_MIN (f, Ci [p]) ; /* f = min (find (C)) */ for (j = f ; j != -1 ; j = parent [j]) w [j] = 0 ; /* clear workspace w */ for (p = Cp [0] ; p < Cp [1] ; p++) w [Ci [p]] = Cx [p] ; /* w = C */ for (j = f ; j != -1 ; j = parent [j]) /* walk path f up to root */ { p = Lp [j] ; alpha = w [j] / Lx [p] ; /* alpha = w(j) / L(j,j) */ beta2 = beta*beta + sigma*alpha*alpha ; if (beta2 <= 0) break ; /* not positive definite */ beta2 = sqrt (beta2) ; delta = (sigma > 0) ? (beta / beta2) : (beta2 / beta) ; gamma = sigma * alpha / (beta2 * beta) ; Lx [p] = delta * Lx [p] + ((sigma > 0) ? (gamma * w [j]) : 0) ; beta = beta2 ; for (p++ ; p < Lp [j+1] ; p++) { w1 = w [Li [p]] ; w [Li [p]] = w2 = w1 - alpha * Lx [p] ; Lx [p] = delta * Lx [p] + gamma * ((sigma > 0) ? w1 : w2) ; } } cs_free (w) ; return (beta2 > 0) ; } /* solve Ux=b where x and b are dense. x=b on input, solution on output. */ csi cs_usolve (const cs *U, double *x) { csi p, j, n, *Up, *Ui ; double *Ux ; if (!CS_CSC (U) || !x) return (0) ; /* check inputs */ n = U->n ; Up = U->p ; Ui = U->i ; Ux = U->x ; for (j = n-1 ; j >= 0 ; j--) { x [j] /= Ux [Up [j+1]-1] ; for (p = Up [j] ; p < Up [j+1]-1 ; p++) { x [Ui [p]] -= Ux [p] * x [j] ; } } return (1) ; } /* allocate a sparse matrix (triplet form or compressed-column form) */ cs *cs_spalloc (csi m, csi n, csi nzmax, csi values, csi triplet) { cs *A = cs_calloc (1, sizeof (cs)) ; /* allocate the cs struct */ if (!A) return (NULL) ; /* out of memory */ A->m = m ; /* define dimensions and nzmax */ A->n = n ; A->nzmax = nzmax = CS_MAX (nzmax, 1) ; A->nz = triplet ? 0 : -1 ; /* allocate triplet or comp.col */ A->p = cs_malloc (triplet ? nzmax : n+1, sizeof (csi)) ; A->i = cs_malloc (nzmax, sizeof (csi)) ; A->x = values ? cs_malloc (nzmax, sizeof (double)) : NULL ; return ((!A->p || !A->i || (values && !A->x)) ? cs_spfree (A) : A) ; } /* change the max # of entries sparse matrix */ csi cs_sprealloc (cs *A, csi nzmax) { csi ok, oki, okj = 1, okx = 1 ; if (!A) return (0) ; if (nzmax <= 0) nzmax = (CS_CSC (A)) ? (A->p [A->n]) : A->nz ; nzmax = CS_MAX (nzmax, 1) ; A->i = cs_realloc (A->i, nzmax, sizeof (csi), &oki) ; if (CS_TRIPLET (A)) A->p = cs_realloc (A->p, nzmax, sizeof (csi), &okj) ; if (A->x) A->x = cs_realloc (A->x, nzmax, sizeof (double), &okx) ; ok = (oki && okj && okx) ; if (ok) A->nzmax = nzmax ; return (ok) ; } /* free a sparse matrix */ cs *cs_spfree (cs *A) { if (!A) return (NULL) ; /* do nothing if A already NULL */ cs_free (A->p) ; cs_free (A->i) ; cs_free (A->x) ; return ((cs *) cs_free (A)) ; /* free the cs struct and return NULL */ } /* free a numeric factorization */ csn *cs_nfree (csn *N) { if (!N) return (NULL) ; /* do nothing if N already NULL */ cs_spfree (N->L) ; cs_spfree (N->U) ; cs_free (N->pinv) ; cs_free (N->B) ; return ((csn *) cs_free (N)) ; /* free the csn struct and return NULL */ } /* free a symbolic factorization */ css *cs_sfree (css *S) { if (!S) return (NULL) ; /* do nothing if S already NULL */ cs_free (S->pinv) ; cs_free (S->q) ; cs_free (S->parent) ; cs_free (S->cp) ; cs_free (S->leftmost) ; return ((css *) cs_free (S)) ; /* free the css struct and return NULL */ } /* allocate a cs_dmperm or cs_scc result */ csd *cs_dalloc (csi m, csi n) { csd *D ; D = cs_calloc (1, sizeof (csd)) ; if (!D) return (NULL) ; D->p = cs_malloc (m, sizeof (csi)) ; D->r = cs_malloc (m+6, sizeof (csi)) ; D->q = cs_malloc (n, sizeof (csi)) ; D->s = cs_malloc (n+6, sizeof (csi)) ; return ((!D->p || !D->r || !D->q || !D->s) ? cs_dfree (D) : D) ; } /* free a cs_dmperm or cs_scc result */ csd *cs_dfree (csd *D) { if (!D) return (NULL) ; /* do nothing if D already NULL */ cs_free (D->p) ; cs_free (D->q) ; cs_free (D->r) ; cs_free (D->s) ; return ((csd *) cs_free (D)) ; /* free the csd struct and return NULL */ } /* free workspace and return a sparse matrix result */ cs *cs_done (cs *C, void *w, void *x, csi ok) { cs_free (w) ; /* free workspace */ cs_free (x) ; return (ok ? C : cs_spfree (C)) ; /* return result if OK, else free it */ } /* free workspace and return csi array result */ csi *cs_idone (csi *p, cs *C, void *w, csi ok) { cs_spfree (C) ; /* free temporary matrix */ cs_free (w) ; /* free workspace */ return (ok ? p : (csi *) cs_free (p)) ; /* return result, or free it */ } /* free workspace and return a numeric factorization (Cholesky, LU, or QR) */ csn *cs_ndone (csn *N, cs *C, void *w, void *x, csi ok) { cs_spfree (C) ; /* free temporary matrix */ cs_free (w) ; /* free workspace */ cs_free (x) ; return (ok ? N : cs_nfree (N)) ; /* return result if OK, else free it */ } /* free workspace and return a csd result */ csd *cs_ddone (csd *D, cs *C, void *w, csi ok) { cs_spfree (C) ; /* free temporary matrix */ cs_free (w) ; /* free workspace */ return (ok ? D : cs_dfree (D)) ; /* return result if OK, else free it */ } /* solve U'x=b where x and b are dense. x=b on input, solution on output. */ csi cs_utsolve (const cs *U, double *x) { csi p, j, n, *Up, *Ui ; double *Ux ; if (!CS_CSC (U) || !x) return (0) ; /* check inputs */ n = U->n ; Up = U->p ; Ui = U->i ; Ux = U->x ; for (j = 0 ; j < n ; j++) { for (p = Up [j] ; p < Up [j+1]-1 ; p++) { x [j] -= Ux [p] * x [Ui [p]] ; } x [j] /= Ux [Up [j+1]-1] ; } return (1) ; } Matrix/src/Syms.h0000644000176200001440000000055113440300120013375 0ustar liggesusersSEXP Matrix_betaSym, Matrix_DimNamesSym, Matrix_DimSym, Matrix_diagSym, Matrix_factorSym, Matrix_iSym, Matrix_jSym, Matrix_lengthSym, Matrix_LSym, Matrix_RSym, Matrix_USym, Matrix_pSym, Matrix_permSym, Matrix_uploSym, Matrix_VSym, Matrix_xSym, Matrix_NS;/* the Matrix Namespace ('environment') */ Matrix/src/cs_utils.h0000644000176200001440000000111512526663046014313 0ustar liggesusers#ifndef CS_UTILS_H #define CS_UTILS_H #include "cs.h" #include "Mutils.h" typedef cs *CSP ; CSP Matrix_as_cs(CSP ans, SEXP x, Rboolean check_Udiag); SEXP Matrix_cs_to_SEXP(CSP A, char *cl, int dofree, SEXP dn); #define AS_CSP(x) Matrix_as_cs((CSP)alloca(sizeof(cs)), x, TRUE) #define AS_CSP__(x) Matrix_as_cs((CSP)alloca(sizeof(cs)), x, FALSE) #if 0 /* unused */ css *Matrix_as_css(css *ans, SEXP x); csn *Matrix_as_csn(csn *ans, SEXP x); SEXP Matrix_css_to_SEXP(css *S, char *cl, int dofree, int m, int n); SEXP Matrix_csn_to_SEXP(csn *N, char *cl, int dofree); #endif #endif Matrix/src/dsCMatrix.h0000644000176200001440000000112712322331041014344 0ustar liggesusers#ifndef MATRIX_SSC_H #define MATRIX_SSC_H #include "Mutils.h" #include "Csparse.h" /* -> diag_tC() */ #include "chm_common.h" SEXP R_chkName_Cholesky(SEXP nm, SEXP perm, SEXP LDL, SEXP super); SEXP R_chm_factor_name ( SEXP perm, SEXP LDL, SEXP super); SEXP dsCMatrix_Cholesky(SEXP A, SEXP perm, SEXP LDL, SEXP super, SEXP Imult); SEXP dsCMatrix_LDL_D(SEXP Ap, SEXP permP, SEXP resultKind); SEXP dsCMatrix_chol(SEXP x, SEXP pivot); SEXP dsCMatrix_Csparse_solve(SEXP a, SEXP b, SEXP LDL); SEXP dsCMatrix_matrix_solve (SEXP a, SEXP b, SEXP LDL); SEXP dsCMatrix_to_dgTMatrix(SEXP x); #endif Matrix/src/chm_common.h0000644000176200001440000000741313652535054014612 0ustar liggesusers#ifndef CHM_COMMON_H #define CHM_COMMON_H #include "SuiteSparse_config/SuiteSparse_config.h" #include "CHOLMOD/Include/cholmod.h" #include "Mutils.h" // -> R_check_class() et al #ifdef Matrix_with_SPQR # include "SPQR/Include/SuiteSparseQR_C.h" #endif /* typedef struct cholmod_common_struct *CHM_CM ; typedef struct cholmod_dense_struct *CHM_DN ; typedef struct cholmod_factor_struct *CHM_FR ; typedef struct cholmod_sparse_struct *CHM_SP ; typedef struct cholmod_triplet_struct *CHM_TR ; */ typedef cholmod_common* CHM_CM; typedef cholmod_dense* CHM_DN; typedef const cholmod_dense* const_CHM_DN; typedef cholmod_factor* CHM_FR; typedef const cholmod_factor* const_CHM_FR; typedef cholmod_sparse* CHM_SP; typedef const cholmod_sparse* const_CHM_SP; typedef cholmod_triplet* CHM_TR; typedef const cholmod_triplet* const_CHM_TR; extern cholmod_common c; /* structure for int CHM routines */ extern cholmod_common cl; /* structure for SuiteSparse_long routines */ /* NOTE: Versions of these are *EXPORTED* via ../inst/include/Matrix.h * ---- and used e.g., in the lme4 package */ CHM_SP as_cholmod_sparse (CHM_SP ans, SEXP x, Rboolean check_Udiag, Rboolean sort_in_place); CHM_TR as_cholmod_triplet(CHM_TR ans, SEXP x, Rboolean check_Udiag); CHM_DN as_cholmod_dense (CHM_DN ans, SEXP x); CHM_DN as_cholmod_x_dense(CHM_DN ans, SEXP x); CHM_DN numeric_as_chm_dense(CHM_DN ans, double *v, int nr, int nc); CHM_FR as_cholmod_factor (CHM_FR ans, SEXP x); CHM_FR as_cholmod_factor3(CHM_FR ans, SEXP x, Rboolean do_check); #define AS_CHM_DN(x) as_cholmod_dense ((CHM_DN)alloca(sizeof(cholmod_dense)), x ) #define AS_CHM_xDN(x) as_cholmod_x_dense ((CHM_DN)alloca(sizeof(cholmod_dense)), x ) #define AS_CHM_FR2(x, chk) as_cholmod_factor3((CHM_FR)alloca(sizeof(cholmod_factor)), x, chk) #define AS_CHM_FR(x) AS_CHM_FR2(x, TRUE) // non-checking version (fast but "risky"): #define AS_CHM_FR__(x) AS_CHM_FR2(x, FALSE) #define AS_CHM_SP(x) as_cholmod_sparse ((CHM_SP)alloca(sizeof(cholmod_sparse)), x, TRUE, FALSE) #define AS_CHM_TR(x) as_cholmod_triplet((CHM_TR)alloca(sizeof(cholmod_triplet)),x, TRUE) /* the non-diagU2N-checking versions : */ #define AS_CHM_SP__(x) as_cholmod_sparse ((CHM_SP)alloca(sizeof(cholmod_sparse)), x, FALSE, FALSE) #define AS_CHM_TR__(x) as_cholmod_triplet((CHM_TR)alloca(sizeof(cholmod_triplet)), x, FALSE) // optional diagU2N-checking #define AS_CHM_SP2(x,chk) as_cholmod_sparse ((CHM_SP)alloca(sizeof(cholmod_sparse)), x, chk, FALSE) #define N_AS_CHM_DN(x,nr,nc) M_numeric_as_chm_dense((CHM_DN)alloca(sizeof(cholmod_dense)), x , nr, nc ) static R_INLINE Rboolean chm_factor_ok(CHM_FR f) { return (Rboolean) (f->minor >= f->n); } Rboolean check_sorted_chm(CHM_SP A); int R_cholmod_start(CHM_CM Common); int R_cholmod_l_start(CHM_CM Common); void R_cholmod_error(int status, const char *file, int line, const char *message); SEXP get_SuiteSparse_version(); SEXP chm_factor_to_SEXP(CHM_FR f, int dofree); SEXP chm_sparse_to_SEXP(CHM_SP a, int dofree, int uploT, int Rkind, const char *diag, SEXP dn); SEXP chm_triplet_to_SEXP(CHM_TR a, int dofree, int uploT, int Rkind, const char* diag, SEXP dn); SEXP chm_dense_to_SEXP(CHM_DN a, int dofree, int Rkind, SEXP dn, Rboolean transp); /* int uploST, char *diag, SEXP dn); */ SEXP chm_dense_to_matrix(CHM_DN a, int dofree, SEXP dn); SEXP chm_dense_to_vector(CHM_DN a, int dofree); Rboolean chm_MOD_xtype(int to_xtype, cholmod_sparse *A, CHM_CM Common); void chm_diagN2U(CHM_SP chx, int uploT, Rboolean do_realloc); void chm_transpose_dense(CHM_DN ans, CHM_DN x); SEXP CHMfactor_validate(SEXP obj); SEXP CHMsimpl_validate(SEXP obj); SEXP CHMsuper_validate(SEXP obj); SEXP CHM_set_common_env(SEXP rho); void CHM_store_common(); void CHM_restore_common(); #endif Matrix/src/dsCMatrix.c0000644000176200001440000002047213766216404014365 0ustar liggesusers#include "dsCMatrix.h" static int chk_nm(const char *nm, int perm, int LDL, int super) { if (strlen(nm) != 11) return 0; if (strcmp(nm + 3, "Cholesky")) return 0; if (super > 0 && nm[0] != 'S') return 0; if (super == 0 && nm[0] != 's') return 0; if (perm > 0 && nm[1] != 'P') return 0; if (perm == 0 && nm[1] != 'p') return 0; if (LDL > 0 && nm[2] != 'D') return 0; if (LDL == 0 && nm[2] != 'd') return 0; return 1; } SEXP R_chkName_Cholesky(SEXP nm, SEXP perm, SEXP LDL, SEXP super) { return ScalarLogical(chk_nm(CHAR(asChar(nm)), asLogical(perm), asLogical(LDL), asLogical(super))); } // must be called with 'nm' a string of length 11 static void chm_factor_name(char* nm, int perm, int LDL, int super) { if (strlen(nm) != 11) { error(_("chm_factor_name(): did not get string of length 11")); return; } nm[0] = (super > 0) ? 'S' : 's'; nm[1] = (perm == 0) ? 'p' : 'P'; nm[2] = (LDL == 0) ? 'd' : 'D'; return; } // must be called with 'nm' a string of length 11 SEXP R_chm_factor_name(SEXP perm, SEXP LDL, SEXP super) { char nm[12] = "...Cholesky";// 11 + final \0 chm_factor_name(nm, asLogical(perm), asLogical(LDL), asLogical(super)); return mkString(nm); } /** * Return a CHOLMOD copy of the cached Cholesky decomposition with the * required perm, LDL and super attributes. If Imult is nonzero, * update the numeric values before returning. * * If no cached copy is available then evaluate one, cache it (for * zero Imult), and return a copy. * * @param Ap dsCMatrix object * @param perm integer indicating if permutation is required (!= 0), * forbidden (0) [not yet: or optional (<0)] * @param LDL integer indicating if the LDL' form is required (>0), * forbidden (0) or optional (<0) * @param super integer indicating if the supernodal form is required (>0), * forbidden (0) or optional (<0) * @param Imult numeric multiplier of I in |A + Imult * I| */ static CHM_FR internal_chm_factor(SEXP Ap, int perm, int LDL, int super, double Imult) { SEXP facs = GET_SLOT(Ap, Matrix_factorSym); SEXP nms = PROTECT(getAttrib(facs, R_NamesSymbol)); // being very careful.. CHM_FR L; CHM_SP A = AS_CHM_SP__(Ap); double mm[2] = {0, 0}; mm[0] = Imult; R_CheckStack(); CHM_store_common(); /* save settings from c */ if (LENGTH(facs)) { for (int i = 0; i < LENGTH(nms); i++) { /* look for a match in cache */ if (chk_nm(CHAR(STRING_ELT(nms, i)), perm, LDL, super)) { L = AS_CHM_FR(VECTOR_ELT(facs, i)); R_CheckStack(); /* copy the factor so later it can safely be cholmod_free'd */ L = cholmod_copy_factor(L, &c); if (Imult) cholmod_factorize_p(A, mm, (int*)NULL, 0, L, &c); UNPROTECT(1); return L; } } } /* Else: No cached factor - create one */ c.final_ll = (LDL == 0) ? 1 : 0; c.supernodal = (super > 0) ? CHOLMOD_SUPERNODAL : ((super < 0) ? CHOLMOD_AUTO : /* super == 0 */ CHOLMOD_SIMPLICIAL); if (perm) { /* obtain fill-reducing permutation */ L = cholmod_analyze(A, &c); } else { /* require identity permutation */ c.nmethods = 1; c.method[0].ordering = CHOLMOD_NATURAL; c.postorder = FALSE; // *_restore_*() below or in R_cholmod_error() will restore c. L = cholmod_analyze(A, &c); } if (!cholmod_factorize_p(A, mm, (int*)NULL, 0 /*fsize*/, L, &c)) // have never seen this, rather R_cholmod_error(status, ..) is called : error(_("Cholesky factorization failed; unusually, please report to Matrix-authors")); if (!Imult) { /* cache the factor */ if(!chm_factor_ok(L)) { cholmod_free_factor(&L, &c);// <- do not leak! CHM_restore_common(); error(_("internal_chm_factor: Cholesky factorization failed")); } /* now that we allow (super, LDL) to be "< 0", be careful :*/ if(super < 0) super = L->is_super ? 1 : 0; if(LDL < 0) LDL = L->is_ll ? 0 : 1; char fnm[12] = "...Cholesky";// 11 + final \0 chm_factor_name(fnm, perm, LDL, super); set_factors(Ap, chm_factor_to_SEXP(L, 0), fnm); } CHM_restore_common(); UNPROTECT(1); return L; } SEXP dsCMatrix_chol(SEXP x, SEXP pivot) { int pivP = asLogical(pivot); CHM_FR L = internal_chm_factor(x, pivP, /*LDL = */ 0, /* super = */ 0, /* Imult = */ 0.); CHM_SP R, Rt; SEXP ans; Rt = cholmod_factor_to_sparse(L, &c); R = cholmod_transpose(Rt, /*values*/ 1, &c); cholmod_free_sparse(&Rt, &c); ans = PROTECT(chm_sparse_to_SEXP(R, 1/*do_free*/, 1/*uploT*/, 0/*Rkind*/, "N"/*diag*/, GET_SLOT(x, Matrix_DimNamesSym))); if (pivP) { SEXP piv = PROTECT(allocVector(INTSXP, L->n)), L_n = PROTECT(ScalarInteger((size_t) L->minor)); int *dest = INTEGER(piv), *src = (int*)L->Perm; for (int i = 0; i < L->n; i++) dest[i] = src[i] + 1; setAttrib(ans, install("pivot"), piv); setAttrib(ans, install("rank"), L_n); UNPROTECT(2); } cholmod_free_factor(&L, &c); UNPROTECT(1); return ans; } SEXP dsCMatrix_Cholesky(SEXP Ap, SEXP perm, SEXP LDL, SEXP super, SEXP Imult) { int iSuper = asLogical(super), iPerm = asLogical(perm), iLDL = asLogical(LDL); /* When parameter is set to NA in R, let CHOLMOD choose */ if(iSuper == NA_LOGICAL) iSuper = -1; /* if(iPerm == NA_LOGICAL) iPerm = -1; */ if(iLDL == NA_LOGICAL) iLDL = -1; SEXP r = chm_factor_to_SEXP(internal_chm_factor(Ap, iPerm, iLDL, iSuper, asReal(Imult)), 1 /* dofree */); return r; } /** * Fast version of getting at the diagonal matrix D of the * (generalized) simplicial Cholesky LDL' decomposition of a * (sparse symmetric) dsCMatrix. * * @param Ap symmetric CsparseMatrix * @param permP logical indicating if permutation is allowed * @param resultKind an (SEXP) string indicating which kind of result * is desired. * * @return SEXP containing either the vector diagonal entries of D, * or just sum_i D[i], prod_i D[i] or sum_i log(D[i]). */ SEXP dsCMatrix_LDL_D(SEXP Ap, SEXP permP, SEXP resultKind) { CHM_FR L; SEXP ans; L = internal_chm_factor(Ap, asLogical(permP), /*LDL*/ 1, /*super*/0, /*Imult*/0.); // ./Csparse.c : ans = PROTECT(diag_tC_ptr(L->n, L->p, L->x, /* is_U = */ FALSE, L->Perm, resultKind)); cholmod_free_factor(&L, &c); UNPROTECT(1); return(ans); } // using cholmod_spsolve() --> sparse result SEXP dsCMatrix_Csparse_solve(SEXP a, SEXP b, SEXP LDL) { int iLDL = asLogical(LDL); // When parameter is set to NA in R, let CHOLMOD choose if(iLDL == NA_LOGICAL) iLDL = -1; CHM_FR L = internal_chm_factor(a, /*perm*/-1, iLDL, /*super*/-1, /*Imult*/0.); if(!chm_factor_ok(L)) { cholmod_free_factor(&L, &c); return R_NilValue;// == "CHOLMOD factorization failed" } CHM_SP cb = AS_CHM_SP(b), cx; R_CheckStack(); cx = cholmod_spsolve(CHOLMOD_A, L, cb, &c); cholmod_free_factor(&L, &c); return chm_sparse_to_SEXP(cx, /*do_free*/ 1, /*uploT*/ 0, /*Rkind*/ 0, /*diag*/ "N", /*dimnames = */ R_NilValue); } // using cholmod_solve() --> dense result SEXP dsCMatrix_matrix_solve(SEXP a, SEXP b, SEXP LDL) { int iLDL = asLogical(LDL); // When parameter is set to NA in R, let CHOLMOD choose if(iLDL == NA_LOGICAL) iLDL = -1; CHM_FR L = internal_chm_factor(a, /*perm*/-1, iLDL, /*super*/-1, /*Imult*/0.); if(!chm_factor_ok(L)) { cholmod_free_factor(&L, &c); return R_NilValue;// == "CHOLMOD factorization failed" } CHM_DN cx, cb = AS_CHM_DN(PROTECT(mMatrix_as_dgeMatrix(b))); R_CheckStack(); cx = cholmod_solve(CHOLMOD_A, L, cb, &c); cholmod_free_factor(&L, &c); UNPROTECT(1); return chm_dense_to_SEXP(cx, 1, 0, /*dimnames = */ R_NilValue, /* transp: */ FALSE); } /* Needed for printing dsCMatrix objects */ /* FIXME: Create a more general version of this operation: also for lsC, (dsR?),.. * e.g. make compressed_to_dgTMatrix() in ./dgCMatrix.c work for dsC */ SEXP dsCMatrix_to_dgTMatrix(SEXP x) { CHM_SP A = AS_CHM_SP__(x); CHM_SP Afull = cholmod_copy(A, /*stype*/ 0, /*mode*/ 1, &c); CHM_TR At = cholmod_sparse_to_triplet(Afull, &c); R_CheckStack(); if (!A->stype) error(_("Non-symmetric matrix passed to dsCMatrix_to_dgTMatrix")); cholmod_free_sparse(&Afull, &c); return chm_triplet_to_SEXP(At, 1, /*uploT*/ 0, /*Rkind*/ 0, "", GET_SLOT(x, Matrix_DimNamesSym)); } Matrix/src/ldense.c0000644000176200001440000001116114154104143013720 0ustar liggesusers#include "ldense.h" /* dense logical Matrices "ldenseMatrix" classes --- almost identical to * dense nonzero-pattern: "ndenseMatrix" ones */ /* this is very close to dspMatrix_as_dsy* () in ./dspMatrix.c : */ SEXP lspMatrix_as_lsyMatrix(SEXP from, SEXP kind) { SEXP val = PROTECT(NEW_OBJECT_OF_CLASS( (asInteger(kind) == 1) ? "nsyMatrix" : "lsyMatrix")), uplo = GET_SLOT(from, Matrix_uploSym), dimP = GET_SLOT(from, Matrix_DimSym), dmnP = GET_SLOT(from, Matrix_DimNamesSym); int n = *INTEGER(dimP); SET_SLOT(val, Matrix_DimSym, duplicate(dimP)); SET_SLOT(val, Matrix_DimNamesSym, duplicate(dmnP)); SET_SLOT(val, Matrix_uploSym, duplicate(uplo)); packed_to_full_int(LOGICAL(ALLOC_SLOT(val, Matrix_xSym, LGLSXP, n*n)), LOGICAL( GET_SLOT(from, Matrix_xSym)), n, *CHAR(STRING_ELT(uplo, 0)) == 'U' ? UPP : LOW); UNPROTECT(1); return val; } // this is very close to dsyMatrix_as_lsp*() in ./dsyMatrix.c -- keep synced ! SEXP lsyMatrix_as_lspMatrix(SEXP from, SEXP kind) { SEXP val = PROTECT(NEW_OBJECT_OF_CLASS( (asInteger(kind) == 1) ? "nspMatrix" : "lspMatrix")), uplo = GET_SLOT(from, Matrix_uploSym), dimP = GET_SLOT(from, Matrix_DimSym); int n = *INTEGER(dimP); SET_SLOT(val, Matrix_DimSym, duplicate(dimP)); SET_SLOT(val, Matrix_uploSym, duplicate(uplo)); full_to_packed_int( LOGICAL(ALLOC_SLOT(val, Matrix_xSym, LGLSXP, (n*(n+1))/2)), LOGICAL( GET_SLOT(from, Matrix_xSym)), n, *CHAR(STRING_ELT(uplo, 0)) == 'U' ? UPP : LOW, NUN); SET_SLOT(val, Matrix_DimNamesSym, duplicate(GET_SLOT(from, Matrix_DimNamesSym))); SET_SLOT(val, Matrix_factorSym, duplicate(GET_SLOT(from, Matrix_factorSym))); UNPROTECT(1); return val; } // this is very close to dtpMatrix_as_dtr*() in ./dtpMatrix.c -- keep synced! SEXP ltpMatrix_as_ltrMatrix(SEXP from, SEXP kind) { SEXP val = PROTECT(NEW_OBJECT_OF_CLASS( (asInteger(kind) == 1) ? "ntrMatrix" : "ltrMatrix")), uplo = GET_SLOT(from, Matrix_uploSym), diag = GET_SLOT(from, Matrix_diagSym), dimP = GET_SLOT(from, Matrix_DimSym), dmnP = GET_SLOT(from, Matrix_DimNamesSym); int n = *INTEGER(dimP); SET_SLOT(val, Matrix_DimSym, duplicate(dimP)); SET_SLOT(val, Matrix_DimNamesSym, duplicate(dmnP)); SET_SLOT(val, Matrix_diagSym, duplicate(diag)); SET_SLOT(val, Matrix_uploSym, duplicate(uplo)); packed_to_full_int(LOGICAL(ALLOC_SLOT(val, Matrix_xSym, LGLSXP, n*n)), LOGICAL(GET_SLOT(from, Matrix_xSym)), n, *CHAR(STRING_ELT(uplo, 0)) == 'U' ? UPP : LOW); SET_SLOT(val, Matrix_DimNamesSym, duplicate(GET_SLOT(from, Matrix_DimNamesSym))); UNPROTECT(1); return val; } /* this is very close to dtrMatrix_as_dtp* () in ./dtrMatrix.c : */ SEXP ltrMatrix_as_ltpMatrix(SEXP from, SEXP kind) { SEXP val = PROTECT(NEW_OBJECT_OF_CLASS( (asInteger(kind) == 1) ? "ntpMatrix" : "ltpMatrix")), uplo = GET_SLOT(from, Matrix_uploSym), diag = GET_SLOT(from, Matrix_diagSym), dimP = GET_SLOT(from, Matrix_DimSym); int n = *INTEGER(dimP); SET_SLOT(val, Matrix_DimSym, duplicate(dimP)); SET_SLOT(val, Matrix_diagSym, duplicate(diag)); SET_SLOT(val, Matrix_uploSym, duplicate(uplo)); full_to_packed_int( LOGICAL(ALLOC_SLOT(val, Matrix_xSym, LGLSXP, (n*(n+1))/2)), LOGICAL(GET_SLOT(from, Matrix_xSym)), n, *CHAR(STRING_ELT(uplo, 0)) == 'U' ? UPP : LOW, *CHAR(STRING_ELT(diag, 0)) == 'U' ? UNT : NUN); SET_SLOT(val, Matrix_DimNamesSym, duplicate(GET_SLOT(from, Matrix_DimNamesSym))); UNPROTECT(1); return val; } /* this is very close to dtrMatrix_as_dge*() :*/ SEXP ltrMatrix_as_lgeMatrix(SEXP from, SEXP kind) { SEXP val = PROTECT(NEW_OBJECT_OF_CLASS( (asInteger(kind) == 1) ? "ngeMatrix" : "lgeMatrix")); slot_dup(val, from, Matrix_xSym); slot_dup(val, from, Matrix_DimSym); slot_dup(val, from, Matrix_DimNamesSym); SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0)); make_i_matrix_triangular(LOGICAL(GET_SLOT(val, Matrix_xSym)), from); UNPROTECT(1); return val; } // this is somewhat close to dup_mMatrix_as_geMatrix(.)) : SEXP lsyMatrix_as_lgeMatrix(SEXP from, SEXP kind) { SEXP val = PROTECT(NEW_OBJECT_OF_CLASS( (asInteger(kind) == 1) ? "ngeMatrix" : "lgeMatrix")); slot_dup(val, from, Matrix_xSym); slot_dup(val, from, Matrix_DimSym); // slot_dup(val, from, Matrix_DimNamesSym) + symmetric_Dimnames(): SET_SLOT(val, Matrix_DimNamesSym, symmetric_DimNames(duplicate(GET_SLOT(from, Matrix_DimNamesSym)))); SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0)); make_i_matrix_symmetric(LOGICAL(GET_SLOT(val, Matrix_xSym)), from); UNPROTECT(1); return val; } Matrix/src/dppMatrix.c0000644000176200001440000000550113622027022014416 0ustar liggesusers#include "dppMatrix.h" SEXP dppMatrix_validate(SEXP obj) { /* int i, n = INTEGER(GET_SLOT(obj, Matrix_DimSym))[0]; */ /* double *x = REAL(GET_SLOT(obj, Matrix_xSym)); */ /* quick but nondefinitive check on positive definiteness */ /* for (i = 0; i < n; i++) */ /* if (x[i * np1] < 0) */ /* return mkString(_("dppMatrix is not positive definite")); */ return dspMatrix_validate(obj); } SEXP dppMatrix_chol(SEXP x) { SEXP val = get_factors(x, "pCholesky"), dimP = GET_SLOT(x, Matrix_DimSym), uploP = GET_SLOT(x, Matrix_uploSym); const char *uplo = CHAR(STRING_ELT(uploP, 0)); int *dims = INTEGER(dimP), info; if (val != R_NilValue) return val; dims = INTEGER(dimP); val = PROTECT(NEW_OBJECT_OF_CLASS("pCholesky")); SET_SLOT(val, Matrix_uploSym, duplicate(uploP)); SET_SLOT(val, Matrix_diagSym, mkString("N")); SET_SLOT(val, Matrix_DimSym, duplicate(dimP)); slot_dup(val, x, Matrix_xSym); F77_CALL(dpptrf)(uplo, dims, REAL(GET_SLOT(val, Matrix_xSym)), &info FCONE); if (info) { if(info > 0) /* e.g. x singular */ error(_("the leading minor of order %d is not positive definite"), info); else /* should never happen! */ error(_("Lapack routine %s returned error code %d"), "dpptrf", info); } UNPROTECT(1); return set_factors(x, val, "pCholesky"); } SEXP dppMatrix_rcond(SEXP obj, SEXP type) { SEXP Chol = dppMatrix_chol(obj); char typnm[] = {'O', '\0'}; /* always use the one norm */ int *dims = INTEGER(GET_SLOT(Chol, Matrix_DimSym)), info; double anorm = get_norm_sp(obj, typnm), rcond; F77_CALL(dppcon)(uplo_P(Chol), dims, REAL(GET_SLOT(Chol, Matrix_xSym)), &anorm, &rcond, (double *) R_alloc(3*dims[0], sizeof(double)), (int *) R_alloc(dims[0], sizeof(int)), &info FCONE); return ScalarReal(rcond); } SEXP dppMatrix_solve(SEXP x) { SEXP Chol = dppMatrix_chol(x); SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("dppMatrix")); int *dims = INTEGER(GET_SLOT(x, Matrix_DimSym)), info; slot_dup(val, Chol, Matrix_uploSym); slot_dup(val, Chol, Matrix_xSym); slot_dup(val, Chol, Matrix_DimSym); F77_CALL(dpptri)(uplo_P(val), dims, REAL(GET_SLOT(val, Matrix_xSym)), &info FCONE); UNPROTECT(1); return val; } SEXP dppMatrix_matrix_solve(SEXP a, SEXP b) { SEXP val = PROTECT(dup_mMatrix_as_dgeMatrix(b)); SEXP Chol = dppMatrix_chol(a); int *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)), *bdims = INTEGER(GET_SLOT(val, Matrix_DimSym)); int n = bdims[0], nrhs = bdims[1], info; if (*adims != *bdims || bdims[1] < 1 || *adims < 1) error(_("Dimensions of system to be solved are inconsistent")); F77_CALL(dpptrs)(uplo_P(Chol), &n, &nrhs, REAL(GET_SLOT(Chol, Matrix_xSym)), REAL(GET_SLOT(val, Matrix_xSym)), &n, &info FCONE); UNPROTECT(1); return val; } Matrix/src/factorizations.h0000644000176200001440000000057712526662711015536 0ustar liggesusers#ifndef MATRIX_FACTORS_H #define MATRIX_FACTORS_H #include "Mutils.h" SEXP MatrixFactorization_validate(SEXP obj); SEXP LU_validate(SEXP obj); SEXP BunchKaufman_validate(SEXP obj); SEXP pBunchKaufman_validate(SEXP obj); SEXP Cholesky_validate(SEXP obj); SEXP pCholesky_validate(SEXP obj); #ifdef _Matrix_has_SVD_ SEXP SVD_validate(SEXP obj); #endif SEXP LU_expand(SEXP x); #endif Matrix/src/dense.h0000644000176200001440000000062513774624325013574 0ustar liggesusers#ifndef MATRIX_DENSE_H #define MATRIX_DENSE_H #include #include "Lapack-etc.h" SEXP lsq_dense_Chol(SEXP X, SEXP y); SEXP lsq_dense_QR(SEXP X, SEXP y); SEXP lapack_qr(SEXP Xin, SEXP tl); SEXP dense_to_Csparse(SEXP x); SEXP dense_band(SEXP x, SEXP k1, SEXP k2); SEXP dense_to_symmetric(SEXP x, SEXP uplo, SEXP symm_test); SEXP ddense_symmpart(SEXP x); SEXP ddense_skewpart(SEXP x); #endif Matrix/src/dtpMatrix.c0000644000176200001440000001522514060416534014435 0ustar liggesusers/* double (precision) Triangular Packed Matrices * Note: this means *square* {n x n} matrices */ #include "dtpMatrix.h" SEXP dtpMatrix_validate(SEXP obj) { SEXP val = triangularMatrix_validate(obj); if(isString(val)) return(val); else { int d = INTEGER(GET_SLOT(obj, Matrix_DimSym))[0]; R_xlen_t lx = xlength(GET_SLOT(obj, Matrix_xSym)); /* packed_ncol() [Mutils.h] checks, but gives *error* .. need string: */ if(lx * 2 != d*(R_xlen_t)(d+1)) return(mkString(_("Incorrect length of 'x' slot"))); return ScalarLogical(1); } } static double get_norm(SEXP obj, const char *typstr) { char typnm[] = {'\0', '\0'}; int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)); double *work = (double *) NULL; typnm[0] = La_norm_type(typstr); if (*typnm == 'I') { work = (double *) R_alloc(dims[0], sizeof(double)); } return F77_CALL(dlantp)(typnm, uplo_P(obj), diag_P(obj), dims, REAL(GET_SLOT(obj, Matrix_xSym)), work FCONE FCONE FCONE); } SEXP dtpMatrix_norm(SEXP obj, SEXP type) { return ScalarReal(get_norm(obj, CHAR(asChar(type)))); } SEXP dtpMatrix_rcond(SEXP obj, SEXP type) { int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)), info; char typnm[] = {'\0', '\0'}; double rcond; typnm[0] = La_rcond_type(CHAR(asChar(type))); F77_CALL(dtpcon)(typnm, uplo_P(obj), diag_P(obj), dims, REAL(GET_SLOT(obj, Matrix_xSym)), &rcond, (double *) R_alloc(3*dims[0], sizeof(double)), (int *) R_alloc(dims[0], sizeof(int)), &info FCONE FCONE FCONE); return ScalarReal(rcond); } SEXP dtpMatrix_solve(SEXP a) { SEXP val = PROTECT(duplicate(a)); int info, *Dim = INTEGER(GET_SLOT(val, Matrix_DimSym)); F77_CALL(dtptri)(uplo_P(val), diag_P(val), Dim, REAL(GET_SLOT(val, Matrix_xSym)), &info FCONE FCONE); UNPROTECT(1); return val; } // also applicable to dspMatrix , dppMatrix : SEXP dtpMatrix_getDiag(SEXP x) { int n = *INTEGER(GET_SLOT(x, Matrix_DimSym)); SEXP val = PROTECT(allocVector(REALSXP, n)); tr_d_packed_getDiag(REAL(val), x, n); UNPROTECT(1); return val; } // also applicable to lspMatrix : SEXP ltpMatrix_getDiag(SEXP x) { int n = *INTEGER(GET_SLOT(x, Matrix_DimSym)); SEXP val = PROTECT(allocVector(LGLSXP, n)); tr_l_packed_getDiag(LOGICAL(val), x, n); UNPROTECT(1); return val; } SEXP dtpMatrix_setDiag(SEXP x, SEXP d) { int n = INTEGER(GET_SLOT(x, Matrix_DimSym))[0]; return tr_d_packed_setDiag(REAL(d), LENGTH(d), x, n); } SEXP ltpMatrix_setDiag(SEXP x, SEXP d) { int n = INTEGER(GET_SLOT(x, Matrix_DimSym))[0]; return tr_l_packed_setDiag(INTEGER(d), LENGTH(d), x, n); } SEXP dtpMatrix_addDiag(SEXP x, SEXP d) { int n = INTEGER(GET_SLOT(x, Matrix_DimSym))[0]; return tr_d_packed_addDiag(REAL(d), LENGTH(d), x, n); } SEXP dtpMatrix_matrix_mm(SEXP x, SEXP y, SEXP right, SEXP trans) { SEXP val = PROTECT(dup_mMatrix_as_dgeMatrix(y)); int rt = asLogical(right); // if(rt), compute b %*% op(a), else op(a) %*% b int tr = asLogical(trans); // if(tr), op(a) = t(a), else op(a) = a /* Since 'x' is square (n x n ), dim(x %*% y) = dim(y) */ int *xDim = INTEGER(GET_SLOT(x, Matrix_DimSym)), *yDim = INTEGER(GET_SLOT(val, Matrix_DimSym)); int m = yDim[0], n = yDim[1]; int ione = 1; const char *uplo = uplo_P(x), *diag = diag_P(x); double *xx = REAL(GET_SLOT(x, Matrix_xSym)), *vx = REAL(GET_SLOT(val, Matrix_xSym)); if (yDim[0] != xDim[1]) if ((rt && xDim[0] != n) || (!rt && xDim[1] != m)) error(_("Dimensions of a (%d,%d) and b (%d,%d) do not conform"), xDim[0], xDim[1], yDim[0], yDim[1]); if (m < 1 || n < 1) { /* error(_("Matrices with zero extents cannot be multiplied")); */ } else /* BLAS */ // go via BLAS 2 dtpmv(.); there is no dtpmm in Lapack! if(rt) { error(_("right=TRUE is not yet implemented __ FIXME")); } else { for (int j = 0; j < n; j++) // X %*% y[,j] F77_CALL(dtpmv)(uplo, /*trans = */ tr ? "T" : "N", diag, yDim, xx, vx + j * (size_t) m, &ione FCONE FCONE FCONE); } UNPROTECT(1); return val; } SEXP dtpMatrix_matrix_solve(SEXP a, SEXP b) { SEXP val = PROTECT(dup_mMatrix_as_dgeMatrix(b)); /* Since 'a' is square (n x n ), dim(a %*% b) = dim(b) */ int *aDim = INTEGER(GET_SLOT(a, Matrix_DimSym)), *bDim = INTEGER(GET_SLOT(val, Matrix_DimSym)); int ione = 1; const char *uplo = uplo_P(a), *diag = diag_P(a); if (bDim[0] != aDim[1]) error(_("Dimensions of a (%d,%d) and b (%d,%d) do not conform"), aDim[0], aDim[1], bDim[0], bDim[1]); #ifdef pre_2013_08_30 double *ax = REAL(GET_SLOT(a, Matrix_xSym)), *vx = REAL(GET_SLOT(val, Matrix_xSym)); for (int j = 0; j < bDim[1]; j++) /* a^{-1} %*% b[,j] via BLAS 2 DTPSV(.) */ F77_CALL(dtpsv)(uplo, "N", diag, bDim, ax, vx + j * (size_t) bDim[0], &ione FCONE FCONE); #else F77_CALL(dtptrs)(uplo, "N", diag, /* n= */ aDim, /* nrhs = */ &bDim[1], /* ap = */ REAL(GET_SLOT(a, Matrix_xSym)), /* b = */ REAL(GET_SLOT(val, Matrix_xSym)), bDim, &ione FCONE FCONE); #endif UNPROTECT(1); return val; } /* FIXME: This function should be removed and a rt argument added to * dtpMatrix_matrix_mm -- also to be more parallel to ./dtrMatrix.c code */ SEXP dgeMatrix_dtpMatrix_mm(SEXP x, SEXP y) { SEXP val = PROTECT(duplicate(x)); /* Since 'y' is square (n x n ), dim(x %*% y) = dim(x) */ int *xDim = INTEGER(GET_SLOT(x, Matrix_DimSym)), *yDim = INTEGER(GET_SLOT(y, Matrix_DimSym)); const char *uplo = uplo_P(y), *diag = diag_P(y); double *yx = REAL(GET_SLOT(y, Matrix_xSym)), *vx = REAL(GET_SLOT(val, Matrix_xSym)); if (yDim[0] != xDim[1]) error(_("Dimensions of a (%d,%d) and b (%d,%d) do not conform"), xDim[0], xDim[1], yDim[0], yDim[1]); for (int i = 0; i < xDim[0]; i++)/* val[i,] := Y' %*% x[i,] */ F77_CALL(dtpmv)(uplo, "T", diag, yDim, yx, vx + i, /* incr = */ xDim FCONE FCONE FCONE); UNPROTECT(1); return val; } SEXP dtpMatrix_as_dtrMatrix(SEXP from) { SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("dtrMatrix")), uplo = GET_SLOT(from, Matrix_uploSym), diag = GET_SLOT(from, Matrix_diagSym), dimP = GET_SLOT(from, Matrix_DimSym), dmnP = GET_SLOT(from, Matrix_DimNamesSym); int n = *INTEGER(dimP); SET_SLOT(val, Matrix_DimSym, duplicate(dimP)); SET_SLOT(val, Matrix_DimNamesSym, duplicate(dmnP)); SET_SLOT(val, Matrix_diagSym, duplicate(diag)); SET_SLOT(val, Matrix_uploSym, duplicate(uplo)); packed_to_full_double(REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, n*n)), REAL(GET_SLOT(from, Matrix_xSym)), n, *CHAR(STRING_ELT(uplo, 0)) == 'U' ? UPP : LOW); SET_SLOT(val, Matrix_DimNamesSym, duplicate(GET_SLOT(from, Matrix_DimNamesSym))); UNPROTECT(1); return val; } Matrix/src/sparseQR.c0000644000176200001440000001775014060416534014226 0ustar liggesusers#include "sparseQR.h" SEXP sparseQR_validate(SEXP x) { CSP V = AS_CSP__(GET_SLOT(x, Matrix_VSym)), R = AS_CSP__(GET_SLOT(x, Matrix_RSym)); SEXP beta = GET_SLOT(x, Matrix_betaSym), p = GET_SLOT(x, Matrix_pSym), q = GET_SLOT(x, install("q")); R_CheckStack(); if (LENGTH(p) != V->m) return mkString(_("length(p) must match nrow(V)")); if (LENGTH(beta) != V->n) return mkString(_("length(beta) must match ncol(V)")); int lq = LENGTH(q); if (lq && lq != R->n) return mkString(_("length(q) must be zero or ncol(R)")); if (V->n != R->n) return mkString("ncol(V) != ncol(R)"); /* FIXME: Check that the permutations are permutations */ return ScalarLogical(1); } /** * Apply Householder transformations and the row permutation P to y * * @param V sparse matrix containing the vectors defining the * Householder transformations * @param dmns == dimnames(V) or "NULL" (R_NilValue) * @param beta scaling factors for the Householder transformations * @param p 0-based permutation vector of length V->m * @param trans logical value - if TRUE create Q'y[p] otherwise Qy[p] * @param ans : both function argument and result ("input and output") */ static void sparseQR_Qmult(cs *V, SEXP dmns, double *beta, int *p, int trans, /* --> */ SEXP ans) { double *y = REAL( GET_SLOT(ans, Matrix_xSym)); int *ydims = INTEGER(GET_SLOT(ans, Matrix_DimSym)); /* y: contents of a V->m by nrhs, i.e. dim(y) == ydims[0:1], dense matrix * -- Note that V->m = m2 : V may contain "spurious 0 rows" (structural rank deficiency) */ int m = V->m, n = V->n; size_t m_ = m; if (ydims[0] != m) error(_("sparseQR_Qmult(): nrow(y) = %d != %d = nrow(V)"), ydims[0], m); double *x; // workspace C_or_Alloca_TO(x, m, double); if (trans) { for (int j = 0; j < ydims[1]; j++) { double *yj = y + j * m_; cs_pvec(p, yj, x, m); /* x(0:m-1) = y(p(0:m-1), j) */ Memcpy(yj, x, m); /* replace it */ for (int k = 0 ; k < n ; k++) /* apply H[1]...H[n] */ cs_happly(V, k, beta[k], yj); } } else { for (int j = 0; j < ydims[1]; j++) { double *yj = y + j * m_; for (int k = n - 1 ; k >= 0 ; k--) /* apply H[n]...H[1] */ cs_happly(V, k, beta[k], yj); cs_ipvec(p, yj, x, m); /* inverse permutation */ Memcpy(yj, x, m); } } if(m >= SMALL_4_Alloca) Free(x); if(!isNull(dmns)) { // assign rownames to 'ans' matrix // FIXME? colnames taken from 'y' ?! if(!isNull(VECTOR_ELT(dmns, 0))) { SEXP nms_0 = PROTECT(duplicate(VECTOR_ELT(dmns, 0))); SET_VECTOR_ELT(GET_SLOT(ans, Matrix_DimNamesSym), 0, nms_0); UNPROTECT(1); } } } // sparseQR_Qmult /** * Given a sparse QR decomposition and y, compute Q y or Q'y * * @param qr a "sparseQR" object * @param y a (dense) Matrix * @param trans logical, if TRUE compute Q'y else Q y * @return Q'y ("qty") or Qy ("qy") */ SEXP sparseQR_qty(SEXP qr, SEXP y, SEXP trans, SEXP keep_dimnames) { //--- will be prepended also to other sparseQR_..() functions below ----------- #define INIT_sparseQR_(_DM_NMS_) \ SEXP V_ = GET_SLOT(qr, Matrix_VSym); \ CSP V = AS_CSP__(V_); \ R_CheckStack(); \ SEXP ans, aa, dmns = R_NilValue; \ if(_DM_NMS_) dmns = GET_SLOT(V_, Matrix_DimNamesSym); \ PROTECT_INDEX ipx; \ PROTECT_WITH_INDEX(ans = dup_mMatrix_as_dgeMatrix(y), &ipx); \ int *ydims = INTEGER(GET_SLOT(ans, Matrix_DimSym)), \ m = ydims[0], n = ydims[1], M = V->m, *d_a; \ Rboolean rank_def = (m < M); \ if(rank_def) { /* must add 0-rows to y, i.e. ans, and remove them *before* return */ \ aa = PROTECT(NEW_OBJECT_OF_CLASS("dgeMatrix")); \ d_a = INTEGER(GET_SLOT(aa, Matrix_DimSym)); d_a[0] = M; d_a[1] = n; \ SEXP dn = GET_SLOT(aa, Matrix_DimNamesSym); \ SET_VECTOR_ELT(dn, 1, \ duplicate(VECTOR_ELT(GET_SLOT(ans, Matrix_DimNamesSym), 1))); \ SET_SLOT(aa, Matrix_DimNamesSym, dn); \ double *yy = REAL( GET_SLOT(ans, Matrix_xSym)); /* m * n */ \ double *xx = REAL(ALLOC_SLOT(aa, Matrix_xSym, REALSXP, M * (R_xlen_t) n)); \ for(int j = 0; j < n; j++) { /* j-th column */ \ Memcpy(xx + j*M, yy + j*m, m); /* copy x[ 1:m , j ] := yy[,j] */ \ for(int i = m; i < M; i++) xx[i + j*M] = 0.;/* x[(m+1):M, j ] := 0 */ \ } \ REPROTECT(ans = duplicate(aa), ipx); /* is M x n now */ \ } //--- end {INIT_sparseQR_} ----------------------------------------------------- INIT_sparseQR_(TRUE) ; sparseQR_Qmult(V, dmns, REAL(GET_SLOT(qr, Matrix_betaSym)), INTEGER(GET_SLOT(qr, Matrix_pSym)), asLogical(trans), ans); #define EXIT_sparseQR_ \ /* remove the extra rows from ans */ \ d_a[0] = m;/* -> @Dim is ok; @Dimnames (i.e. colnames) still are */ \ double *yy = REAL( GET_SLOT(ans, Matrix_xSym)); /* is M x n */ \ double *xx = REAL(ALLOC_SLOT(aa, Matrix_xSym, REALSXP, m * (R_xlen_t) n)); \ for(int j = 0; j < n; j++) { /* j-th column */ \ Memcpy(xx + j*m, yy + j*M, m); /* copy x[ 1:m, j ] := yy[,j] */ \ } \ ans = duplicate(aa); /* m x n finally */ \ UNPROTECT(1) // aa if(rank_def) { warning(_("%s(): structurally rank deficient case: possibly WRONG zeros"), "sparseQR_qty"); EXIT_sparseQR_; } UNPROTECT(1); return ans; } // Compute qr.coef(qr, y) := R^{-1} Q' y {modulo row and column permutations} SEXP sparseQR_coef(SEXP qr, SEXP y) { SEXP qslot = GET_SLOT(qr, install("q")), R_ = GET_SLOT(qr, Matrix_RSym); CSP R = AS_CSP__(R_); // FIXME: check n_R, M (= R->m) vs n, m int *q = INTEGER(qslot), lq = LENGTH(qslot), n_R = R->n; // = ncol(R) INIT_sparseQR_(FALSE); // <- FALSE: no dimnames from V // ans := R^{-1} Q' y ==> rownames(ans) := rownames(R^{-1}) = colnames(R) dmns = PROTECT(duplicate(GET_SLOT(R_, Matrix_DimNamesSym))); if(!isNull(VECTOR_ELT(dmns, 1))) { // need to correctly *permute* the colnames SEXP cns = PROTECT(duplicate(VECTOR_ELT(dmns, 1))); // *back* permute colnames from 'qslot' : for(int j=0; j < lq; j++) SET_STRING_ELT(VECTOR_ELT(dmns, 1), q[j], STRING_ELT(cns, j)); UNPROTECT(1); } // rownames(ans) := colnames(ans) SET_VECTOR_ELT(dmns, 0, VECTOR_ELT(dmns, 1)); /* apply row permutation and multiply by Q' */ sparseQR_Qmult(V, dmns, REAL(GET_SLOT(qr, Matrix_betaSym)), INTEGER(GET_SLOT(qr, Matrix_pSym)), /* trans = */ TRUE, ans); UNPROTECT(1); // dmns double *ax = REAL(GET_SLOT(ans, Matrix_xSym)), *x = (double*) NULL; if(lq) { C_or_Alloca_TO(x, M, double); } for (int j = 0; j < n; j++) { double *aj = ax + j * M; cs_usolve(R, aj); if (lq) { cs_ipvec(q, aj, x, n_R); Memcpy(aj, x, n_R); } } if(lq && M >= SMALL_4_Alloca) Free(x); if(rank_def) { warning(_("%s(): structurally rank deficient case: possibly WRONG zeros"), "sparseQR_coef"); EXIT_sparseQR_; } UNPROTECT(1); return ans; } /** Compute qr.resid(qr, y) or qr.fitted(qr, y) */ SEXP sparseQR_resid_fitted(SEXP qr, SEXP y, SEXP want_resid) { int *p = INTEGER(GET_SLOT(qr, Matrix_pSym)), resid = asLogical(want_resid); double *beta = REAL(GET_SLOT(qr, Matrix_betaSym)); INIT_sparseQR_(FALSE); // ..... ans should get rownames of 'y' ... /* apply row permutation and multiply by Q' */ sparseQR_Qmult(V, dmns, beta, p, /* trans = */ TRUE, ans); double *ax = REAL(GET_SLOT(ans, Matrix_xSym)); // FIXME (n,m) := dim(y) vs (N,M) := dim(V) -- ok ?? int N = V->n; // M = V->m (in INIT_.. above) for (int j = 0; j < n; j++) { if (resid) // qr.resid(): zero first N rows for (int i = 0; i < N; i++) ax[i + j * M] = 0; else // qr.fitted(): zero last M - N rows for (int i = N; i < M; i++) ax[i + j * M] = 0; } /* multiply by Q and apply inverse row permutation */ sparseQR_Qmult(V, dmns, beta, p, /* trans = */ FALSE, ans); if(rank_def) { warning(_("%s(): structurally rank deficient case: possibly WRONG zeros"), "sparseQR_resid_fitted"); EXIT_sparseQR_; } UNPROTECT(1); return ans; } Matrix/src/dsyMatrix.h0000644000176200001440000000102413774624325014454 0ustar liggesusers#ifndef MATRIX_SYMATRIX_H #define MATRIX_SYMATRIX_H #include "Lapack-etc.h" #include "Mutils.h" SEXP dsyMatrix_as_dspMatrix(SEXP from); SEXP dsyMatrix_as_matrix(SEXP from, SEXP keep_dimnames); SEXP dsyMatrix_matrix_mm(SEXP a, SEXP b, SEXP rt); SEXP dsyMatrix_matrix_solve(SEXP a, SEXP b); SEXP dsyMatrix_norm(SEXP obj, SEXP type); SEXP dsyMatrix_rcond(SEXP obj, SEXP type); SEXP dsyMatrix_solve(SEXP a); SEXP dsyMatrix_trf(SEXP x); SEXP matrix_trf(SEXP x, SEXP uploP); double get_norm_sy(SEXP obj, const char *typstr); #endif Matrix/src/sparseQR.h0000644000176200001440000000050212526663046014225 0ustar liggesusers#ifndef MATRIX_SPARSEQR_H #define MATRIX_SPARSEQR_H #include "Mutils.h" #include "cs_utils.h" #include "chm_common.h" SEXP sparseQR_validate(SEXP x); SEXP sparseQR_qty(SEXP qr, SEXP y, SEXP trans, SEXP keep_dimnames); SEXP sparseQR_coef(SEXP qr, SEXP y); SEXP sparseQR_resid_fitted(SEXP qr, SEXP y, SEXP resid); #endif Matrix/src/dtTMatrix.c0000644000176200001440000000175611036422221014373 0ustar liggesusers /* Sparse triangular matrices in triplet format */ #include "dtTMatrix.h" #include "dgTMatrix.h" /* xTMatrix_validate */ /* This should be use for *BOTH* triangular and symmetric Tsparse: */ SEXP tTMatrix_validate(SEXP x) { SEXP val = xTMatrix_validate(x);/* checks x slot */ if(isString(val)) return(val); else { SEXP islot = GET_SLOT(x, Matrix_iSym), jslot = GET_SLOT(x, Matrix_jSym); int uploT = (*uplo_P(x) == 'U'), k, nnz = length(islot), *xj = INTEGER(jslot), *xi = INTEGER(islot); /* Maybe FIXME: ">" should be ">=" for diag = 'U' (uplo = 'U') */ if(uploT) { for (k = 0; k < nnz; k++) if(xi[k] > xj[k]) return mkString(_("uplo='U' must not have sparse entries below the diagonal")); } else { for (k = 0; k < nnz; k++) if(xi[k] < xj[k]) return mkString(_("uplo='L' must not have sparse entries above the diagonal")); } return ScalarLogical(1); } } /* SEXP dtTMatrix_as_dtrMatrix(SEXP x) ---> now in ./TMatrix_as.c */ Matrix/src/dgCMatrix.h0000644000176200001440000000206412526663046014354 0ustar liggesusers#ifndef MATRIX_DGCMATRIX_H #define MATRIX_DGCMATRIX_H #include #include "Mutils.h" #include "cs_utils.h" SEXP xCMatrix_validate(SEXP x); SEXP xRMatrix_validate(SEXP x); SEXP compressed_to_TMatrix(SEXP x, SEXP colP); SEXP compressed_non_0_ij(SEXP x, SEXP colP); SEXP R_to_CMatrix(SEXP x); SEXP dgCMatrix_colSums(SEXP x, SEXP NArm, SEXP spRes, SEXP trans, SEXP means); SEXP igCMatrix_colSums(SEXP x, SEXP NArm, SEXP spRes, SEXP trans, SEXP means); SEXP lgCMatrix_colSums(SEXP x, SEXP NArm, SEXP spRes, SEXP trans, SEXP means); SEXP ngCMatrix_colSums(SEXP x, SEXP NArm, SEXP spRes, SEXP trans, SEXP means); /* SEXP dgCMatrix_lusol(SEXP x, SEXP y); */ SEXP dgCMatrix_qrsol(SEXP x, SEXP y, SEXP ord); SEXP dgCMatrix_cholsol(SEXP x, SEXP y); SEXP dgCMatrix_QR(SEXP Ap, SEXP order, SEXP keep_dimnames); #ifdef Matrix_with_SPQR SEXP dgCMatrix_SPQR(SEXP Ap, SEXP ordering, SEXP econ, SEXP tol); #endif SEXP dgCMatrix_LU(SEXP Ap, SEXP orderp, SEXP tolp, SEXP error_on_sing, SEXP keep_dimnames); SEXP dgCMatrix_matrix_solve(SEXP Ap, SEXP bp, SEXP give_sparse); #endif Matrix/src/dtCMatrix.h0000644000176200001440000000110311037724612014353 0ustar liggesusers#ifndef MATRIX_TSC_H #define MATRIX_TSC_H #include "Mutils.h" #include "dgCMatrix.h" extern SEXP Csparse_diagU2N(SEXP x); /* SEXP Parent_inverse(SEXP par, SEXP unitdiag); */ /* int parent_inv_ap(int n, int countDiag, const int pr[], int ap[]); */ /* void parent_inv_ai(int n, int countDiag, const int pr[], int ai[]); */ SEXP tCMatrix_validate(SEXP x); SEXP tRMatrix_validate(SEXP x); /* SEXP dtCMatrix_solve(SEXP a); */ SEXP dtCMatrix_matrix_solve(SEXP a, SEXP b, SEXP classed); SEXP dtCMatrix_sparse_solve(SEXP a, SEXP b); /* SEXP dtCMatrix_upper_solve(SEXP a); */ #endif Matrix/src/factorizations.c0000644000176200001440000001135013255476364015527 0ustar liggesusers#include "factorizations.h" SEXP MatrixFactorization_validate(SEXP obj) { SEXP val; if (isString(val = dim_validate(GET_SLOT(obj, Matrix_DimSym), "MatrixFactorization"))) return(val); return ScalarLogical(1); } SEXP LU_validate(SEXP obj) { SEXP x = GET_SLOT(obj, Matrix_xSym), Dim = GET_SLOT(obj, Matrix_DimSym); int m = INTEGER(Dim)[0], n = INTEGER(Dim)[1]; // checked already in MatrixF.._validate() if(TYPEOF(x) != REALSXP) return mkString(_("x slot is not \"double\"")); if(XLENGTH(x) != ((double) m) * n) return mkString(_("x slot is not of correct length")); return dimNames_validate(obj); } SEXP BunchKaufman_validate(SEXP obj) { // TODO return ScalarLogical(1); } SEXP pBunchKaufman_validate(SEXP obj) { // TODO return ScalarLogical(1); } SEXP Cholesky_validate(SEXP obj) { // TODO return ScalarLogical(1); } SEXP pCholesky_validate(SEXP obj) { // TODO return ScalarLogical(1); } #ifdef _Matrix_has_SVD_ SEXP SVD_validate(SEXP obj) { return ScalarLogical(1); } #endif SEXP LU_expand(SEXP x) { const char *nms[] = {"L", "U", "P", ""}; // x[,] is m x n (using LAPACK dgetrf notation) SEXP L, U, P, val = PROTECT(Rf_mkNamed(VECSXP, nms)), lux = GET_SLOT(x, Matrix_xSym), dd = GET_SLOT(x, Matrix_DimSym); int *iperm, *perm, *pivot = INTEGER(GET_SLOT(x, Matrix_permSym)), *dim = INTEGER(dd), m = dim[0], n = dim[1], nn = m, i; size_t m_ = (size_t) m; // to prevent integer (multiplication) overflow Rboolean is_sq = (n == m), L_is_tri = TRUE, U_is_tri = TRUE; // nn := min(n,m) == length(pivot[]) if(!is_sq) { if(n < m) { // "long" nn = n; L_is_tri = FALSE; } else { // m < n : "wide" U_is_tri = FALSE; } } SET_VECTOR_ELT(val, 0, NEW_OBJECT_OF_CLASS(L_is_tri ? "dtrMatrix":"dgeMatrix")); SET_VECTOR_ELT(val, 1, NEW_OBJECT_OF_CLASS(U_is_tri ? "dtrMatrix":"dgeMatrix")); SET_VECTOR_ELT(val, 2, NEW_OBJECT_OF_CLASS("pMatrix")); L = VECTOR_ELT(val, 0); U = VECTOR_ELT(val, 1); P = VECTOR_ELT(val, 2); if(is_sq || !L_is_tri) { SET_SLOT(L, Matrix_xSym, duplicate(lux)); SET_SLOT(L, Matrix_DimSym, duplicate(dd)); } else { // !is_sq && L_is_tri -- m < n -- "wide" -- L is m x m size_t m2 = m_ * m; double *Lx = REAL(ALLOC_SLOT(L, Matrix_xSym, REALSXP, m2)); int *dL = INTEGER(ALLOC_SLOT(L, Matrix_DimSym, INTSXP, 2)); dL[0] = dL[1] = m; // fill lower-diagonal (non-{0,1}) part -- remainder by make_d_matrix*() below: Memcpy(Lx, REAL(lux), m2); } if(is_sq || !U_is_tri) { SET_SLOT(U, Matrix_xSym, duplicate(lux)); SET_SLOT(U, Matrix_DimSym, duplicate(dd)); } else { // !is_sq && U_is_tri -- m > n -- "long" -- U is n x n double *Ux = REAL(ALLOC_SLOT(U, Matrix_xSym, REALSXP, ((size_t) n) * n)), *xx = REAL(lux); int *dU = INTEGER(ALLOC_SLOT(U, Matrix_DimSym, INTSXP, 2)); dU[0] = dU[1] = n; /* fill upper-diagonal (non-0) part -- remainder by make_d_matrix*() below: * this is more complicated than in the L case, as the x / lux part we need * is *not* continguous: Memcpy(Ux, REAL(lux), n * n); -- is WRONG */ for (size_t j = 0; j < n; j++) { Memcpy(Ux+j*n, xx+j*m, j+1); // for (i = 0; i <= j; i++) // Ux[i + j*n] = xx[i + j*m]; } } if(L_is_tri) { SET_SLOT(L, Matrix_uploSym, mkString("L")); SET_SLOT(L, Matrix_diagSym, mkString("U")); make_d_matrix_triangular(REAL(GET_SLOT(L, Matrix_xSym)), L); } else { // L is "unit-diagonal" trapezoidal -- m > n -- "long" // fill the upper right part with 0 *and* the diagonal with 1 double *Lx = REAL(GET_SLOT(L, Matrix_xSym)); size_t ii; for (i = 0, ii = 0; i < n; i++, ii+=(m+1)) { // ii = i*(m+1) Lx[ii] = 1.; for (size_t j = i*m_; j < ii; j++) Lx[j] = 0.; } } if(U_is_tri) { SET_SLOT(U, Matrix_uploSym, mkString("U")); SET_SLOT(U, Matrix_diagSym, mkString("N")); make_d_matrix_triangular(REAL(GET_SLOT(U, Matrix_xSym)), U); } else { // U is trapezoidal -- m < n // fill the lower left part with 0 double *Ux = REAL(GET_SLOT(U, Matrix_xSym)); for (i = 0; i < m; i++) for (size_t j = i*(m_+1) +1; j < (i+1)*m_; j++) Ux[j] = 0.; } SET_SLOT(P, Matrix_DimSym, duplicate(dd)); if(!is_sq) // m != n -- P is m x m INTEGER(GET_SLOT(P, Matrix_DimSym))[1] = m; perm = INTEGER(ALLOC_SLOT(P, Matrix_permSym, INTSXP, m)); C_or_Alloca_TO(iperm, m, int); for (i = 0; i < m; i++) iperm[i] = i + 1; /* initialize permutation*/ for (i = 0; i < nn; i++) { /* generate inverse permutation */ int newp = pivot[i] - 1; if (newp != i) { // swap int tmp = iperm[i]; iperm[i] = iperm[newp]; iperm[newp] = tmp; } } // invert the inverse for (i = 0; i < m; i++) perm[iperm[i] - 1] = i + 1; if(m >= SMALL_4_Alloca) Free(iperm); UNPROTECT(1); return val; } Matrix/src/t_gCMatrix_colSums.c0000644000176200001440000001321113255137750016225 0ustar liggesusers/*------ Definition of a template for [diln]gCMatrix_colsums(...) : * * -------- ~~~~~~~~~~~~~~~~~~~~~~ * i.e., included several times from ./dgCMatrix.c * ~~~~~~~~~~~~~ */ /* for all cases with an 'x' slot -- i.e. almost all cases ; * just redefine this in the other cases: */ #ifdef _dgC_ # define gCMatrix_colSums dgCMatrix_colSums # define _DOUBLE_ans # define _has_x_slot_ /*Future? # define _has_x_d_slot_ */ # undef _dgC_ #elif defined (_igC_) # define gCMatrix_colSums igCMatrix_colSums # define _DOUBLE_ans # define _has_x_slot_ /*Future? # define _has_x_d_slot_ */ # undef _igC_ #elif defined (_lgC_) # define gCMatrix_colSums lgCMatrix_colSums_i # define _INT_ans # define _has_x_slot_ /*Future? # define _has_x_l_slot_ */ # undef _lgC_ #elif defined (_lgC_mn) # define gCMatrix_colSums lgCMatrix_colSums_d # define _DOUBLE_ans # define _has_x_slot_ /*Future? # define _has_x_l_slot_ */ # undef _lgC_mn #elif defined (_ngC_) # define gCMatrix_colSums ngCMatrix_colSums_i # define _INT_ans /* withOUT 'x' slot */ # undef _ngC_ #elif defined (_ngC_mn) # define gCMatrix_colSums ngCMatrix_colSums_d # define _DOUBLE_ans /* withOUT 'x' slot */ # undef _ngC_mn #elif defined (_zgC_) # error "zgC* not yet implemented" #else # error "no valid _[dilnz]gC_ option" #endif /* - - - - - - - - - - - - - - - - - - - - */ /* Most of this is maybe for the future, * when cholmod has integer 'x' slot :*/ #ifdef _has_x_d_slot_ # define Type_x_ double # define STYP_x_ REAL # define _has_x_slot_ # undef _has_x_d_slot_ #elif defined (_has_x_i_slot_) # define Type_x_ int # define STYP_x_ INTEGER # define _has_x_slot_ # undef _has_x_i_slot_ #elif defined (_has_x_l_slot_) # define Type_x_ int # define STYP_x_ LOGICAL # define _has_x_slot_ # undef _has_x_l_slot_ #endif /* - - - - - - - - - - - - - - - - - - - - */ #ifdef _DOUBLE_ans # define SparseResult_class "dsparseVector" # define Type_ans double # define STYP_ans REAL # define NA_ans NA_REAL # define SXP_ans REALSXP # define COERCED(x) (x) #undef _DOUBLE_ans #elif defined (_INT_ans) # define SparseResult_class "isparseVector" # define Type_ans int # define STYP_ans INTEGER # define NA_ans NA_INTEGER # define SXP_ans INTSXP # define COERCED(x) (Type_ans)(x != 0) #undef _INT_ans #else # error "invalid macro logic" #endif /* - - - - - - - - - - - - - - - - - - - - */ #ifdef _has_x_slot_ /* currently have x slot always double (cholmod restriction): */ # define is_NA_x_(u) ISNAN(u) # define ColSUM_column(_i1_,_i2_,_SUM_) \ if(mn) dnm = cx->nrow; /* denominator for means */ \ for(i = _i1_, _SUM_ = 0; i < _i2_; i++) { \ if (is_NA_x_(xx[i])) { \ if(!na_rm) { \ _SUM_ = NA_ans; \ break; \ } \ /* else: na_rm : skip NAs , */ \ if(mn) /* but decrement denominator */ \ dnm--; \ } else _SUM_ += COERCED(xx[i]); \ } \ if(mn) _SUM_ = (dnm > 0) ? _SUM_/dnm : NA_ans #else /* no 'x' slot -> no NAs ... */ # define ColSUM_column(_i1_,_i2_,_SUM_) \ _SUM_ = _i2_ - _i1_; \ if(mn) _SUM_ /= cx->nrow #endif /* Now the template which depends on the above macros : */ /** * colSums(), colMeans(), rowSums() and rowMeans() for all sparce *gCMatrix()es * @param x a ?gCMatrix, i.e. sparse column-compressed Matrix * @param NArm logical indicating if NA's should be remove 'na.rm' in R * @param spRes logical = 'sparseResult' indicating if result should be sparse * @param trans logical: TRUE <==> row[Sums/Means] <==> compute col*s( t(x) ) * @param means logical: TRUE <==> compute [row/col]Means() , not *Sums() */ SEXP gCMatrix_colSums(SEXP x, SEXP NArm, SEXP spRes, SEXP trans, SEXP means) { int mn = asLogical(means), sp = asLogical(spRes), tr = asLogical(trans); /* cholmod_sparse: drawback of coercing lgC to double: */ CHM_SP cx = AS_CHM_SP__(x); R_CheckStack(); if (tr) { cholmod_sparse *cxt = cholmod_transpose(cx, (int)cx->xtype, &c); cx = cxt; } /* everything else *after* the above potential transpose : */ int j, nc = cx->ncol; int *xp = (int *)(cx -> p); #ifdef _has_x_slot_ int na_rm = asLogical(NArm), // can have NAs only with an 'x' slot i, dnm = 0/*Wall*/; double *xx = (double *)(cx -> x); #endif // result value: sparseResult (==> "*sparseVector") or dense (atomic)vector SEXP ans = PROTECT(sp ? NEW_OBJECT_OF_CLASS(SparseResult_class) : allocVector(SXP_ans, nc)); if (sp) { // sparseResult, i.e. *sparseVector (never allocating length-nc) int nza, i1, i2, p, *ai; Type_ans *ax; for (j = 0, nza = 0; j < nc; j++) if(xp[j] < xp[j + 1]) nza++; ai = INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, nza)); ax = STYP_ans(ALLOC_SLOT(ans, Matrix_xSym, SXP_ans, nza)); SET_SLOT(ans, Matrix_lengthSym, ScalarInteger(nc)); i2 = xp[0]; for (j = 1, p = 0; j <= nc; j++) { /* j' =j+1, since 'i' slot will be 1-based */ i1 = i2; i2 = xp[j]; if(i1 < i2) { Type_ans sum; ColSUM_column(i1,i2, sum); ai[p] = j; ax[p++] = sum; } } } else { /* "numeric" (non sparse) result */ Type_ans *a = STYP_ans(ans); for (j = 0; j < nc; j++) { ColSUM_column(xp[j], xp[j + 1], a[j]); } } if (tr) cholmod_free_sparse(&cx, &c); if (!sp) { SEXP nms = VECTOR_ELT(GET_SLOT(x, Matrix_DimNamesSym), tr ? 0 : 1); if (!isNull(nms)) setAttrib(ans, R_NamesSymbol, duplicate(nms)); } UNPROTECT(1); return ans; } #undef ColSUM_column #undef NA_ans #undef STYP_ans #undef SXP_ans #undef SparseResult_class #undef Type_ans #undef COERCED #ifdef _has_x_slot_ # undef NA_x_ # undef Type_x_ # undef STYP_x_ # undef _has_x_slot_ #endif #undef gCMatrix_colSums Matrix/src/dtpMatrix.h0000644000176200001440000000122513774624325014447 0ustar liggesusers #ifndef MATRIX_TPMATRIX_H #define MATRIX_TPMATRIX_H #include "Lapack-etc.h" #include "Mutils.h" SEXP dtpMatrix_validate(SEXP obj); SEXP dtpMatrix_norm(SEXP obj, SEXP type); SEXP dtpMatrix_rcond(SEXP obj, SEXP type); SEXP dtpMatrix_addDiag(SEXP x, SEXP d); SEXP dtpMatrix_getDiag(SEXP x); SEXP ltpMatrix_getDiag(SEXP x); SEXP dtpMatrix_setDiag(SEXP x, SEXP d); SEXP ltpMatrix_setDiag(SEXP x, SEXP d); SEXP dtpMatrix_solve(SEXP a); SEXP dtpMatrix_matrix_solve(SEXP a, SEXP b); SEXP dtpMatrix_as_dtrMatrix(SEXP from); SEXP dgeMatrix_dtpMatrix_mm(SEXP x, SEXP y); SEXP dtpMatrix_matrix_mm(SEXP x, SEXP y, SEXP right, SEXP trans); #endif /* MATRIX_TPMATRIX_H */ Matrix/src/cs.h0000644000176200001440000001460713652535054013103 0ustar liggesusers#ifndef _CS_H #define _CS_H #include #include #include // needed for FILE: #include #include // For use with R package 'Matrix' (NA_REAL, warning(), REprintf(), ..) # include # include # include # include # define printf Rprintf #ifdef MATLAB_MEX_FILE #include "mex.h" #endif #define CS_VER 3 /* CSparse Version */ #define CS_SUBVER 2 #define CS_SUBSUB 0 #define CS_DATE "Sept 12, 2017" /* CSparse release date */ #define CS_COPYRIGHT "Copyright (c) Timothy A. Davis, 2006-2016" #ifdef MATLAB_MEX_FILE #undef csi #define csi mwSignedIndex #endif // Matrix pkg: #define csi int #ifndef csi #define csi ptrdiff_t #endif /* --- primary CSparse routines and data structures ------------------------- */ typedef struct cs_sparse /* matrix in compressed-column or triplet form */ { csi nzmax ; /* maximum number of entries */ csi m ; /* number of rows */ csi n ; /* number of columns */ csi *p ; /* column pointers (size n+1) or col indices (size nzmax) */ csi *i ; /* row indices, size nzmax */ double *x ; /* numerical values, size nzmax */ csi nz ; /* # of entries in triplet matrix, -1 for compressed-col */ } cs ; cs *cs_add (const cs *A, const cs *B, double alpha, double beta) ; csi cs_cholsol (csi order, const cs *A, double *b) ; cs *cs_compress (const cs *T) ; csi cs_dupl (cs *A) ; csi cs_entry (cs *T, csi i, csi j, double x) ; csi cs_gaxpy (const cs *A, const double *x, double *y) ; cs *cs_load (FILE *f) ; csi cs_lusol (csi order, const cs *A, double *b, double tol) ; cs *cs_multiply (const cs *A, const cs *B) ; double cs_norm (const cs *A) ; csi cs_print (const cs *A, csi brief) ; csi cs_qrsol (csi order, const cs *A, double *b) ; cs *cs_transpose (const cs *A, csi values) ; /* utilities */ void *cs_calloc (csi n, size_t size) ; void *cs_free (void *p) ; void *cs_realloc (void *p, csi n, size_t size, csi *ok) ; cs *cs_spalloc (csi m, csi n, csi nzmax, csi values, csi triplet) ; cs *cs_spfree (cs *A) ; csi cs_sprealloc (cs *A, csi nzmax) ; void *cs_malloc (csi n, size_t size) ; /* --- secondary CSparse routines and data structures ----------------------- */ typedef struct cs_symbolic /* symbolic Cholesky, LU, or QR analysis */ { csi *pinv ; /* inverse row perm. for QR, fill red. perm for Chol */ csi *q ; /* fill-reducing column permutation for LU and QR */ csi *parent ; /* elimination tree for Cholesky and QR */ csi *cp ; /* column pointers for Cholesky, row counts for QR */ csi *leftmost ; /* leftmost[i] = min(find(A(i,:))), for QR */ csi m2 ; /* # of rows for QR, after adding fictitious rows */ double lnz ; /* # entries in L for LU or Cholesky; in V for QR */ double unz ; /* # entries in U for LU; in R for QR */ } css ; typedef struct cs_numeric /* numeric Cholesky, LU, or QR factorization */ { cs *L ; /* L for LU and Cholesky, V for QR */ cs *U ; /* U for LU, R for QR, not used for Cholesky */ csi *pinv ; /* partial pivoting for LU */ double *B ; /* beta [0..n-1] for QR */ } csn ; typedef struct cs_dmperm_results /* cs_dmperm or cs_scc output */ { csi *p ; /* size m, row permutation */ csi *q ; /* size n, column permutation */ csi *r ; /* size nb+1, block k is rows r[k] to r[k+1]-1 in A(p,q) */ csi *s ; /* size nb+1, block k is cols s[k] to s[k+1]-1 in A(p,q) */ csi nb ; /* # of blocks in fine dmperm decomposition */ csi rr [5] ; /* coarse row decomposition */ csi cc [5] ; /* coarse column decomposition */ } csd ; csi *cs_amd (csi order, const cs *A) ; csn *cs_chol (const cs *A, const css *S) ; csd *cs_dmperm (const cs *A, csi seed) ; csi cs_droptol (cs *A, double tol) ; csi cs_dropzeros (cs *A) ; csi cs_happly (const cs *V, csi i, double beta, double *x) ; csi cs_ipvec (const csi *p, const double *b, double *x, csi n) ; csi cs_lsolve (const cs *L, double *x) ; csi cs_ltsolve (const cs *L, double *x) ; csn *cs_lu (const cs *A, const css *S, double tol) ; cs *cs_permute (const cs *A, const csi *pinv, const csi *q, csi values) ; csi *cs_pinv (const csi *p, csi n) ; csi cs_pvec (const csi *p, const double *b, double *x, csi n) ; csn *cs_qr (const cs *A, const css *S) ; css *cs_schol (csi order, const cs *A) ; css *cs_sqr (csi order, const cs *A, csi qr) ; cs *cs_symperm (const cs *A, const csi *pinv, csi values) ; csi cs_updown (cs *L, csi sigma, const cs *C, const csi *parent) ; csi cs_usolve (const cs *U, double *x) ; csi cs_utsolve (const cs *U, double *x) ; /* utilities */ css *cs_sfree (css *S) ; csn *cs_nfree (csn *N) ; csd *cs_dfree (csd *D) ; /* --- tertiary CSparse routines -------------------------------------------- */ csi *cs_counts (const cs *A, const csi *parent, const csi *post, csi ata) ; double cs_cumsum (csi *p, csi *c, csi n) ; csi cs_dfs (csi j, cs *G, csi top, csi *xi, csi *pstack, const csi *pinv) ; csi cs_ereach (const cs *A, csi k, const csi *parent, csi *s, csi *w) ; csi *cs_etree (const cs *A, csi ata) ; csi cs_fkeep (cs *A, csi (*fkeep) (csi, csi, double, void *), void *other) ; double cs_house (double *x, double *beta, csi n) ; csi cs_leaf (csi i, csi j, const csi *first, csi *maxfirst, csi *prevleaf, csi *ancestor, csi *jleaf) ; csi *cs_maxtrans (const cs *A, csi seed) ; csi *cs_post (const csi *parent, csi n) ; csi *cs_randperm (csi n, csi seed) ; csi cs_reach (cs *G, const cs *B, csi k, csi *xi, const csi *pinv) ; csi cs_scatter (const cs *A, csi j, double beta, csi *w, double *x, csi mark, cs *C, csi nz) ; csd *cs_scc (cs *A) ; csi cs_spsolve (cs *G, const cs *B, csi k, csi *xi, double *x, const csi *pinv, csi lo) ; csi cs_tdfs (csi j, csi k, csi *head, const csi *next, csi *post, csi *stack) ; /* utilities */ csd *cs_dalloc (csi m, csi n) ; csd *cs_ddone (csd *D, cs *C, void *w, csi ok) ; cs *cs_done (cs *C, void *w, void *x, csi ok) ; csi *cs_idone (csi *p, cs *C, void *w, csi ok) ; csn *cs_ndone (csn *N, cs *C, void *w, void *x, csi ok) ; #define CS_MAX(a,b) (((a) > (b)) ? (a) : (b)) #define CS_MIN(a,b) (((a) < (b)) ? (a) : (b)) #define CS_FLIP(i) (-(i)-2) #define CS_UNFLIP(i) (((i) < 0) ? CS_FLIP(i) : (i)) #define CS_MARKED(w,j) (w [j] < 0) #define CS_MARK(w,j) { w [j] = CS_FLIP (w [j]) ; } #define CS_CSC(A) (A && (A->nz == -1)) #define CS_TRIPLET(A) (A && (A->nz >= 0)) #endif Matrix/src/dtrMatrix.h0000644000176200001440000000136613774624325014457 0ustar liggesusers#ifndef MATRIX_TRMATRIX_H #define MATRIX_TRMATRIX_H #include "Lapack-etc.h" #include "Mutils.h" SEXP dtrMatrix_norm(SEXP obj, SEXP type); SEXP dtrMatrix_rcond(SEXP obj, SEXP type); SEXP dtrMatrix_solve(SEXP a); SEXP dtrMatrix_chol2inv(SEXP a); SEXP dtrMatrix_matrix_solve(SEXP a, SEXP b); SEXP dtrMatrix_matrix_mm (SEXP a, SEXP b, SEXP right, SEXP trans); SEXP dtrMatrix_dtrMatrix_mm(SEXP a, SEXP b, SEXP right, SEXP trans); SEXP dtrMatrix_as_dgeMatrix(SEXP from); SEXP dtrMatrix_as_matrix(SEXP from, SEXP keep_dimnames); SEXP dtrMatrix_as_dtpMatrix(SEXP from); SEXP dtrMatrix_addDiag(SEXP x, SEXP d); SEXP dtrMatrix_getDiag(SEXP x); SEXP ltrMatrix_getDiag(SEXP x); SEXP dtrMatrix_setDiag(SEXP x, SEXP d); SEXP ltrMatrix_setDiag(SEXP x, SEXP d); #endif Matrix/src/dspMatrix.c0000644000176200001440000001312714060416534014433 0ustar liggesusers#include "dspMatrix.h" /* Note: also used for lspMatrix */ SEXP dspMatrix_validate(SEXP obj) { SEXP val = symmetricMatrix_validate(obj); if(isString(val)) return(val); else { /* identical to the test in dtpMatrix_validate() : */ int d = INTEGER(GET_SLOT(obj, Matrix_DimSym))[0]; R_xlen_t lx = xlength(GET_SLOT(obj, Matrix_xSym)); if(lx * 2 != d*(R_xlen_t)(d+1)) return(mkString(_("Incorrect length of 'x' slot"))); return ScalarLogical(1); } } double get_norm_sp(SEXP obj, const char *typstr) { char typnm[] = {'\0', '\0'}; int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)); double *work = (double *) NULL; typnm[0] = La_norm_type(typstr); if (*typnm == 'I' || *typnm == 'O') { work = (double *) R_alloc(dims[0], sizeof(double)); } return F77_CALL(dlansp)(typnm, uplo_P(obj), dims, REAL(GET_SLOT(obj, Matrix_xSym)), work FCONE FCONE); } SEXP dspMatrix_norm(SEXP obj, SEXP type) { return ScalarReal(get_norm_sp(obj, CHAR(asChar(type)))); } SEXP dspMatrix_rcond(SEXP obj, SEXP type) { SEXP trf = dspMatrix_trf(obj); int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)), info; double anorm = get_norm_sp(obj, "O"), rcond; F77_CALL(dspcon)(uplo_P(trf), dims, REAL (GET_SLOT(trf, Matrix_xSym)), INTEGER(GET_SLOT(trf, Matrix_permSym)), &anorm, &rcond, (double *) R_alloc(2*dims[0], sizeof(double)), (int *) R_alloc(dims[0], sizeof(int)), &info FCONE); return ScalarReal(rcond); } SEXP dspMatrix_solve(SEXP a) { SEXP trf = dspMatrix_trf(a); SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("dspMatrix")); int *dims = INTEGER(GET_SLOT(trf, Matrix_DimSym)), info; slot_dup(val, trf, Matrix_uploSym); slot_dup(val, trf, Matrix_xSym); slot_dup(val, trf, Matrix_DimSym); F77_CALL(dsptri)(uplo_P(val), dims, REAL(GET_SLOT(val, Matrix_xSym)), INTEGER(GET_SLOT(trf, Matrix_permSym)), (double *) R_alloc((long) dims[0], sizeof(double)), &info FCONE); UNPROTECT(1); return val; } SEXP dspMatrix_matrix_solve(SEXP a, SEXP b) { SEXP trf = dspMatrix_trf(a), val = PROTECT(dup_mMatrix_as_dgeMatrix(b)); int *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)), *bdims = INTEGER(GET_SLOT(val, Matrix_DimSym)); int n = bdims[0], nrhs = bdims[1], info; if (adims[0] != n || nrhs < 1 || n < 1) error(_("Dimensions of system to be solved are inconsistent")); F77_CALL(dsptrs)(uplo_P(trf), &n, &nrhs, REAL(GET_SLOT(trf, Matrix_xSym)), INTEGER(GET_SLOT(trf, Matrix_permSym)), REAL(GET_SLOT(val, Matrix_xSym)), &n, &info FCONE); UNPROTECT(1); return val; } SEXP dspMatrix_getDiag(SEXP x) { int n = *INTEGER(GET_SLOT(x, Matrix_DimSym)); SEXP val = PROTECT(allocVector(REALSXP, n)); d_packed_getDiag(REAL(val), x, n); UNPROTECT(1); return val; } SEXP lspMatrix_getDiag(SEXP x) { int n = *INTEGER(GET_SLOT(x, Matrix_DimSym)); SEXP val = PROTECT(allocVector(LGLSXP, n)); l_packed_getDiag(LOGICAL(val), x, n); UNPROTECT(1); return val; } SEXP dspMatrix_setDiag(SEXP x, SEXP d) { int n = INTEGER(GET_SLOT(x, Matrix_DimSym))[0]; return d_packed_setDiag(REAL(d), LENGTH(d), x, n); } SEXP lspMatrix_setDiag(SEXP x, SEXP d) { int n = INTEGER(GET_SLOT(x, Matrix_DimSym))[0]; return l_packed_setDiag(INTEGER(d), LENGTH(d), x, n); } SEXP dspMatrix_as_dsyMatrix(SEXP from) { SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("dsyMatrix")), uplo = GET_SLOT(from, Matrix_uploSym), dimP = GET_SLOT(from, Matrix_DimSym), dmnP = GET_SLOT(from, Matrix_DimNamesSym); int n = *INTEGER(dimP); SET_SLOT(val, Matrix_DimSym, duplicate(dimP)); SET_SLOT(val, Matrix_DimNamesSym, duplicate(dmnP)); SET_SLOT(val, Matrix_uploSym, duplicate(uplo)); packed_to_full_double(REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, n*n)), REAL(GET_SLOT(from, Matrix_xSym)), n, *CHAR(STRING_ELT(uplo, 0)) == 'U' ? UPP : LOW); UNPROTECT(1); return val; } SEXP dspMatrix_matrix_mm(SEXP a, SEXP b) { SEXP val = PROTECT(dup_mMatrix_as_dgeMatrix(b)); int *bdims = INTEGER(GET_SLOT(val, Matrix_DimSym)); int i, ione = 1, n = bdims[0], nrhs = bdims[1]; R_xlen_t nn = n * (R_xlen_t) nrhs; const char *uplo = uplo_P(a); double *ax = REAL(GET_SLOT(a, Matrix_xSym)), one = 1., zero = 0., *vx = REAL(GET_SLOT(val, Matrix_xSym)), *bx; C_or_Alloca_TO(bx, nn, double); Memcpy(bx, vx, nn); if (bdims[0] != n) error(_("Matrices are not conformable for multiplication")); if (nrhs >= 1 && n >= 1) { R_xlen_t in; for (i = 0, in = 0; i < nrhs; i++, in += n) { // in := i * n (w/o overflow!) F77_CALL(dspmv)(uplo, &n, &one, ax, bx + in, &ione, &zero, vx + in, &ione FCONE); } if(nn >= SMALL_4_Alloca) Free(bx); } UNPROTECT(1); return val; } SEXP dspMatrix_trf(SEXP x) { SEXP val = get_factors(x, "pBunchKaufman"), dimP = GET_SLOT(x, Matrix_DimSym), uploP = GET_SLOT(x, Matrix_uploSym); int *dims = INTEGER(dimP), *perm, info; int n = dims[0]; const char *uplo = CHAR(STRING_ELT(uploP, 0)); if (val != R_NilValue) return val; dims = INTEGER(dimP); val = PROTECT(NEW_OBJECT_OF_CLASS("pBunchKaufman")); SET_SLOT(val, Matrix_uploSym, duplicate(uploP)); SET_SLOT(val, Matrix_diagSym, mkString("N")); SET_SLOT(val, Matrix_DimSym, duplicate(dimP)); slot_dup(val, x, Matrix_xSym); perm = INTEGER(ALLOC_SLOT(val, Matrix_permSym, INTSXP, n)); F77_CALL(dsptrf)(uplo, dims, REAL(GET_SLOT(val, Matrix_xSym)), perm, &info FCONE); if (info) error(_("Lapack routine %s returned error code %d"), "dsptrf", info); UNPROTECT(1); return set_factors(x, val, "pBunchKaufman"); } Matrix/src/init.c0000644000176200001440000003007014040351707013415 0ustar liggesusers#include #include #include "abIndex.h" #include "chm_common.h" #include "CHMfactor.h" #include "Csparse.h" #include "Tsparse.h" #include "dense.h" #include "dgCMatrix.h" #include "dgTMatrix.h" #include "dgeMatrix.h" #include "dpoMatrix.h" #include "dppMatrix.h" #include "dsCMatrix.h" #include "TMatrix_as.h" #include "dspMatrix.h" #include "dsyMatrix.h" #include "dtCMatrix.h" #include "dtTMatrix.h" #include "dtrMatrix.h" #include "dtpMatrix.h" #include "factorizations.h" #include "ldense.h" #include "lgCMatrix.h" #include "sparseQR.h" #include #include "Syms.h" #define CALLDEF(name, n) {#name, (DL_FUNC) &name, n} #define EXTDEF(name, n) {#name, (DL_FUNC) &name, n} static R_CallMethodDef CallEntries[] = { CALLDEF(BunchKaufman_validate, 1), CALLDEF(pBunchKaufman_validate, 1), CALLDEF(CHMfactor_to_sparse, 1), CALLDEF(CHMfactor_solve, 3), CALLDEF(CHMfactor_spsolve, 3), CALLDEF(CHMfactor_ldetL2, 1), CALLDEF(CHMfactor_ldetL2up, 3), CALLDEF(CHMfactor_update, 3), CALLDEF(CHMfactor_updown,3), CALLDEF(destructive_CHM_update, 3), CALLDEF(Cholesky_validate, 1), CALLDEF(Csparse_Csparse_prod, 3), CALLDEF(Csparse_Csparse_crossprod, 4), CALLDEF(Csparse_MatrixMarket, 2), CALLDEF(Csparse_band, 3), CALLDEF(Csparse_crossprod, 4), CALLDEF(Csparse_dense_crossprod, 3), CALLDEF(Csparse_dense_prod, 3), CALLDEF(Csparse_diagN2U, 1), CALLDEF(Csparse_diagU2N, 1), CALLDEF(Csparse_drop, 2), CALLDEF(Csparse_horzcat, 2), CALLDEF(Csparse_sort, 1), CALLDEF(Csparse_to_Tsparse, 2), CALLDEF(Csparse_to_tCsparse, 3), CALLDEF(Csparse_to_tTsparse, 3), CALLDEF(Csparse_to_dense, 2), CALLDEF(Csparse_to_nz_pattern, 2), CALLDEF(Csparse_to_matrix, 3), CALLDEF(Csparse_to_vector, 1), CALLDEF(Csparse_submatrix, 3), CALLDEF(dCsparse_subassign, 4), CALLDEF(lCsparse_subassign, 4), CALLDEF(iCsparse_subassign, 4), CALLDEF(nCsparse_subassign, 4), CALLDEF(zCsparse_subassign, 4), CALLDEF(Csparse_general_to_symmetric, 3), CALLDEF(Csparse_symmetric_to_general, 1), CALLDEF(Csparse_transpose, 2), CALLDEF(Csparse_validate, 1), CALLDEF(Csparse_validate2, 2), CALLDEF(Csparse_vertcat, 2), CALLDEF(pCholesky_validate, 1), CALLDEF(Rsparse_validate, 1), CALLDEF(diag_tC, 2), CALLDEF(LU_expand, 1), CALLDEF(LU_validate, 1), CALLDEF(matrix_to_Csparse, 2), CALLDEF(MatrixFactorization_validate, 1), CALLDEF(Matrix_expand_pointers, 1), CALLDEF(R_rbind2_vector, 2), CALLDEF(R_all0, 1), CALLDEF(R_any0, 1), CALLDEF(R_to_CMatrix, 1), #ifdef _Matrix_has_SVD_ CALLDEF(SVD_validate, 1), #endif CALLDEF(Tsparse_validate, 1), CALLDEF(Tsparse_diagU2N, 1), CALLDEF(Tsparse_to_Csparse, 2), CALLDEF(Tsparse_to_tCsparse, 3), CALLDEF(compressed_to_TMatrix, 2), CALLDEF(compressed_non_0_ij, 2), CALLDEF(dense_to_Csparse, 1), CALLDEF(nz_pattern_to_Csparse, 2), CALLDEF(dense_nonpacked_validate, 1), CALLDEF(dense_band, 3), CALLDEF(dense_to_symmetric, 3), CALLDEF(ddense_symmpart, 1), CALLDEF(ddense_skewpart, 1), CALLDEF(dimNames_validate, 1), CALLDEF(Dim_validate, 2), CALLDEF(dMatrix_validate, 1), CALLDEF(dgCMatrix_LU, 5), CALLDEF(dgCMatrix_QR, 3), #ifdef Matrix_with_SPQR CALLDEF(dgCMatrix_SPQR, 4), #endif CALLDEF(dgCMatrix_colSums, 5), CALLDEF(igCMatrix_colSums, 5), CALLDEF(lgCMatrix_colSums, 5), CALLDEF(ngCMatrix_colSums, 5), CALLDEF(dgCMatrix_cholsol, 2), /* CALLDEF(dgCMatrix_lusol, 2), */ CALLDEF(dgCMatrix_matrix_solve, 3), CALLDEF(dgCMatrix_qrsol, 3), CALLDEF(dgTMatrix_to_dgeMatrix, 1), CALLDEF(lgTMatrix_to_lgeMatrix, 1), CALLDEF(dgTMatrix_to_matrix, 1), CALLDEF(lgTMatrix_to_matrix, 1), CALLDEF(dgeMatrix_LU, 2), CALLDEF(dgeMatrix_Schur, 3), CALLDEF(dgeMatrix_colsums, 4), CALLDEF(dgeMatrix_crossprod, 2), CALLDEF (geMatrix_crossprod, 2), CALLDEF(dgeMatrix_determinant, 2), CALLDEF(dgeMatrix_dgeMatrix_crossprod, 3), CALLDEF (geMatrix_geMatrix_crossprod, 3), CALLDEF(dgeMatrix_matrix_mm, 3), CALLDEF (geMatrix_matrix_mm, 3), CALLDEF(dgeMatrix_matrix_solve, 2), CALLDEF(dgeMatrix_dtpMatrix_mm, 2), CALLDEF(dgeMatrix_exp, 1), CALLDEF(dgeMatrix_addDiag, 2), CALLDEF(dgeMatrix_getDiag, 1), CALLDEF(lgeMatrix_getDiag, 1), CALLDEF(dgeMatrix_setDiag, 2), CALLDEF(lgeMatrix_setDiag, 2), CALLDEF(dgeMatrix_matrix_crossprod, 3), CALLDEF (geMatrix_matrix_crossprod, 3), CALLDEF(dgeMatrix_norm, 2), CALLDEF(dgeMatrix_rcond, 2), CALLDEF(dgeMatrix_solve, 1), CALLDEF(dgeMatrix_validate, 1), CALLDEF(dpoMatrix_chol, 1), CALLDEF(dpoMatrix_dgeMatrix_solve, 2), CALLDEF(dpoMatrix_matrix_solve, 2), CALLDEF(dpoMatrix_rcond, 2), CALLDEF(dpoMatrix_solve, 1), CALLDEF(dpoMatrix_validate, 1), CALLDEF(dppMatrix_chol, 1), CALLDEF(dppMatrix_matrix_solve, 2), CALLDEF(dppMatrix_rcond, 2), CALLDEF(dppMatrix_solve, 1), CALLDEF(dppMatrix_validate, 1), CALLDEF(R_chkName_Cholesky, 4), CALLDEF(R_chm_factor_name, 3), CALLDEF(dsCMatrix_Cholesky, 5), CALLDEF(dsCMatrix_LDL_D, 3), CALLDEF(dsCMatrix_chol, 2), CALLDEF(dsCMatrix_Csparse_solve, 3), CALLDEF(dsCMatrix_matrix_solve, 3), CALLDEF(dsCMatrix_to_dgTMatrix, 1), CALLDEF(dsTMatrix_as_dgTMatrix, 1), CALLDEF(lsTMatrix_as_lgTMatrix, 1), CALLDEF(nsTMatrix_as_ngTMatrix, 1), CALLDEF(dsTMatrix_as_dsyMatrix, 1), CALLDEF(lsTMatrix_as_lsyMatrix, 1), CALLDEF(nsTMatrix_as_nsyMatrix, 1), CALLDEF(dsyMatrix_as_dspMatrix, 1), CALLDEF(dsyMatrix_as_matrix, 2), CALLDEF(dsyMatrix_matrix_mm, 3), CALLDEF(dsyMatrix_matrix_solve, 2), CALLDEF(dsyMatrix_norm, 2), CALLDEF(dsyMatrix_rcond, 2), CALLDEF(dsyMatrix_solve, 1), CALLDEF(dsyMatrix_trf, 1), CALLDEF(dspMatrix_as_dsyMatrix, 1), CALLDEF(dspMatrix_matrix_mm, 2), CALLDEF(dspMatrix_matrix_solve, 2), CALLDEF(dspMatrix_norm, 2), CALLDEF(dspMatrix_rcond, 2), CALLDEF(dspMatrix_solve, 1), CALLDEF(dspMatrix_trf, 1), CALLDEF(dspMatrix_validate, 1), CALLDEF(dspMatrix_getDiag, 1), CALLDEF(lspMatrix_getDiag, 1), CALLDEF(dspMatrix_setDiag, 2), CALLDEF(lspMatrix_setDiag, 2), /* CALLDEF(dtCMatrix_solve, 1), */ CALLDEF(dtCMatrix_matrix_solve, 3), CALLDEF(dtCMatrix_sparse_solve, 2), CALLDEF(dtTMatrix_as_dtrMatrix, 1), CALLDEF(ltTMatrix_as_ltrMatrix, 1), CALLDEF(ntTMatrix_as_ntrMatrix, 1), CALLDEF(dtpMatrix_as_dtrMatrix, 1), CALLDEF(dtpMatrix_addDiag, 2), CALLDEF(dtpMatrix_getDiag, 1), CALLDEF(ltpMatrix_getDiag, 1), CALLDEF(dtpMatrix_setDiag, 2), CALLDEF(ltpMatrix_setDiag, 2), CALLDEF(dtpMatrix_matrix_mm, 4), CALLDEF(dtpMatrix_matrix_solve, 2), CALLDEF(dtpMatrix_norm, 2), CALLDEF(dtpMatrix_rcond, 2), CALLDEF(dtpMatrix_solve, 1), CALLDEF(dtpMatrix_validate, 1), CALLDEF(dtrMatrix_as_dtpMatrix, 1), CALLDEF(dtrMatrix_as_matrix, 2), CALLDEF(dtrMatrix_matrix_mm, 4), CALLDEF(dtrMatrix_dtrMatrix_mm, 4), CALLDEF(dtrMatrix_chol2inv, 1), CALLDEF(dtrMatrix_addDiag, 2), CALLDEF(dtrMatrix_getDiag, 1), CALLDEF(ltrMatrix_getDiag, 1), CALLDEF(dtrMatrix_setDiag, 2), CALLDEF(ltrMatrix_setDiag, 2), CALLDEF(dtrMatrix_matrix_solve, 2), CALLDEF(dtrMatrix_norm, 2), CALLDEF(dtrMatrix_rcond, 2), CALLDEF(dtrMatrix_solve, 1), CALLDEF(dup_mMatrix_as_dgeMatrix, 1), CALLDEF(dup_mMatrix_as_geMatrix, 1), /* for dgC* _and_ lgC* : */ CALLDEF(xCMatrix_validate, 1), CALLDEF(xRMatrix_validate, 1), CALLDEF(xTMatrix_validate, 1), CALLDEF(tCMatrix_validate, 1), CALLDEF(tRMatrix_validate, 1), CALLDEF(tTMatrix_validate, 1), CALLDEF(lapack_qr, 2), CALLDEF(lgC_to_matrix, 1), CALLDEF(ngC_to_matrix, 1), CALLDEF(lspMatrix_as_lsyMatrix, 2), CALLDEF(lsyMatrix_as_lspMatrix, 2), CALLDEF(lsyMatrix_as_lgeMatrix, 2), CALLDEF(ltpMatrix_as_ltrMatrix, 2), CALLDEF(ltrMatrix_as_lgeMatrix, 2), CALLDEF(ltrMatrix_as_ltpMatrix, 2), CALLDEF(lsq_dense_Chol, 2), CALLDEF(lsq_dense_QR, 2), CALLDEF(sparseQR_validate, 1), CALLDEF(sparseQR_qty, 4), CALLDEF(sparseQR_coef, 2), CALLDEF(sparseQR_resid_fitted, 3), CALLDEF(triangularMatrix_validate, 1), CALLDEF(symmetricMatrix_validate, 1), CALLDEF(R_symmetric_Dimnames, 1), /* still simple placeholders, but already used in ../R/AllClass.R : */ CALLDEF(CHMfactor_validate, 1), CALLDEF(CHMsimpl_validate, 1), CALLDEF(CHMsuper_validate, 1), CALLDEF(CHM_set_common_env, 1), CALLDEF(inv_permutation, 3), CALLDEF(m_encodeInd, 4), CALLDEF(m_encodeInd2, 5), CALLDEF(matrix_trf, 2), CALLDEF(Matrix_rle_i, 2), CALLDEF(Matrix_rle_d, 2), CALLDEF(R_set_factors, 4), CALLDEF(R_empty_factors, 2), CALLDEF(get_SuiteSparse_version, 0), {NULL, NULL, 0} }; static const R_ExternalMethodDef ExtEntries[] = { EXTDEF(Mmatrix, 7), {NULL, NULL, 0} }; void #ifdef HAVE_VISIBILITY_ATTRIBUTE __attribute__ ((visibility ("default"))) #endif R_init_Matrix(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, ExtEntries); R_useDynamicSymbols(dll, FALSE); /* These are callable from other packages' C code: */ #define RREGDEF(name) R_RegisterCCallable("Matrix", #name, (DL_FUNC) name) RREGDEF(Csparse_diagU2N); RREGDEF(as_cholmod_dense); RREGDEF(as_cholmod_factor); RREGDEF(as_cholmod_factor3); RREGDEF(as_cholmod_sparse); RREGDEF(as_cholmod_triplet); RREGDEF(chm_factor_to_SEXP); RREGDEF(chm_factor_ldetL2); RREGDEF(chm_factor_update); RREGDEF(chm_sparse_to_SEXP); RREGDEF(chm_triplet_to_SEXP); RREGDEF(cholmod_aat); RREGDEF(cholmod_add); RREGDEF(cholmod_allocate_dense); RREGDEF(cholmod_allocate_sparse); RREGDEF(cholmod_allocate_triplet); RREGDEF(cholmod_analyze); RREGDEF(cholmod_analyze_p); RREGDEF(cholmod_band_inplace); RREGDEF(cholmod_change_factor); RREGDEF(cholmod_copy); RREGDEF(cholmod_copy_dense); RREGDEF(cholmod_copy_factor); RREGDEF(cholmod_copy_sparse); RREGDEF(cholmod_dense_to_sparse); RREGDEF(cholmod_factor_to_sparse); RREGDEF(cholmod_factorize); RREGDEF(cholmod_factorize_p); RREGDEF(cholmod_finish); RREGDEF(cholmod_free_dense); RREGDEF(cholmod_free_factor); RREGDEF(cholmod_free_sparse); RREGDEF(cholmod_free_triplet); RREGDEF(cholmod_nnz); RREGDEF(cholmod_scale); RREGDEF(cholmod_sdmult); RREGDEF(cholmod_solve); RREGDEF(cholmod_solve2); RREGDEF(cholmod_sort); RREGDEF(cholmod_sparse_to_dense); RREGDEF(cholmod_sparse_to_triplet); RREGDEF(cholmod_speye); RREGDEF(cholmod_spsolve); RREGDEF(cholmod_ssmult); RREGDEF(cholmod_start); RREGDEF(cholmod_submatrix); RREGDEF(cholmod_transpose); RREGDEF(cholmod_triplet_to_sparse); RREGDEF(cholmod_vertcat); RREGDEF(cholmod_updown); RREGDEF(dpoMatrix_chol); RREGDEF(numeric_as_chm_dense); R_cholmod_start(&c); // R_cholmod_start(&cl); << TODO; needs more work in ./chm_common.c etc Matrix_betaSym = install("beta"); Matrix_DimNamesSym = install("Dimnames"); Matrix_DimSym = install("Dim"); Matrix_diagSym = install("diag"); Matrix_factorSym = install("factors"); Matrix_iSym = install("i"); Matrix_jSym = install("j"); Matrix_lengthSym = install("length"); Matrix_pSym = install("p"); Matrix_permSym = install("perm"); Matrix_uploSym = install("uplo"); Matrix_xSym = install("x"); Matrix_LSym = install("L"); Matrix_RSym = install("R"); Matrix_USym = install("U"); Matrix_VSym = install("V"); Matrix_NS = R_FindNamespace(mkString("Matrix")); if(Matrix_NS == R_UnboundValue) error(_("missing 'Matrix' namespace: should never happen")); #ifdef DEBUG_Matrix if(isEnvironment(Matrix_NS)) Rprintf("Matrix_NS: %s\n", CHAR(asChar(eval(lang2(install("format"),Matrix_NS), R_GlobalEnv)))); else #else if(!isEnvironment(Matrix_NS)) #endif error(_("Matrix namespace not determined correctly")); } void R_unload_Matrix(DllInfo *dll) { cholmod_finish(&c); } Matrix/src/Tsparse.h0000644000176200001440000000036010763341311014075 0ustar liggesusers#ifndef MATRIX_TSPARSE_H #define MATRIX_TSPARSE_H #include "Mutils.h" SEXP Tsparse_validate(SEXP x); SEXP Tsparse_diagU2N(SEXP x); SEXP Tsparse_to_Csparse(SEXP x, SEXP tri); SEXP Tsparse_to_tCsparse(SEXP x, SEXP uplo, SEXP diag); #endif Matrix/src/chm_common.c0000644000176200001440000012534614127645633014616 0ustar liggesusers/** @file chm_common.c */ #include "chm_common.h" // -> Mutils.h Rboolean isValid_Csparse(SEXP x); /* -> Csparse.c */ SEXP get_SuiteSparse_version() { SEXP ans = allocVector(INTSXP, 3); int* version = INTEGER(ans); SuiteSparse_version(version); return ans; } cholmod_common c; // for cholmod_ (..) cholmod_common cl;// for cholmod_l_(..) SEXP chm_common_env; static SEXP dboundSym, grow0Sym, grow1Sym, grow2Sym, maxrankSym, supernodal_switchSym, supernodalSym, final_asisSym, final_superSym, final_llSym, final_packSym, final_monotonicSym, final_resymbolSym, prefer_zomplexSym, prefer_upperSym, quick_return_if_not_posdefSym, nmethodsSym, m0_ordSym, postorderSym; void CHM_store_common() { SEXP rho = chm_common_env; defineVar(dboundSym, ScalarReal(c.dbound), rho); defineVar(grow0Sym, ScalarReal(c.grow0), rho); defineVar(grow1Sym, ScalarReal(c.grow1), rho); defineVar(grow2Sym, ScalarInteger(c.grow2), rho); defineVar(maxrankSym, ScalarInteger(c.maxrank), rho); defineVar(supernodal_switchSym, ScalarReal(c.supernodal_switch), rho); defineVar(supernodalSym, ScalarInteger(c.supernodal), rho); defineVar(final_asisSym, ScalarLogical(c.final_asis), rho); defineVar(final_superSym, ScalarLogical(c.final_super), rho); defineVar(final_llSym, ScalarLogical(c.final_ll), rho); defineVar(final_packSym, ScalarLogical(c.final_pack), rho); defineVar(final_monotonicSym, ScalarLogical(c.final_monotonic), rho); defineVar(final_resymbolSym, ScalarLogical(c.final_resymbol), rho); defineVar(prefer_zomplexSym, ScalarLogical(c.prefer_zomplex), rho); defineVar(prefer_upperSym, ScalarLogical(c.prefer_upper), rho); defineVar(quick_return_if_not_posdefSym, ScalarLogical(c.quick_return_if_not_posdef), rho); defineVar(nmethodsSym, ScalarInteger(c.nmethods), rho); defineVar(m0_ordSym, ScalarInteger(c.method[0].ordering), rho); defineVar(postorderSym, ScalarLogical(c.postorder), rho); } void CHM_restore_common() { SEXP rho = chm_common_env, var; #define SET_AS_FROM_FRAME(_V_, _KIND_, _SYM_) \ var = PROTECT(findVarInFrame(rho, _SYM_)); \ _V_ = _KIND_(var); \ UNPROTECT(1) SET_AS_FROM_FRAME(c.dbound, asReal, dboundSym); SET_AS_FROM_FRAME(c.grow0, asReal, grow0Sym); SET_AS_FROM_FRAME(c.grow1, asReal, grow1Sym); SET_AS_FROM_FRAME(c.grow2, asInteger, grow2Sym); SET_AS_FROM_FRAME(c.maxrank,asInteger, maxrankSym); SET_AS_FROM_FRAME(c.supernodal_switch, asReal, supernodal_switchSym); SET_AS_FROM_FRAME(c.supernodal, asLogical, supernodalSym); SET_AS_FROM_FRAME(c.final_asis, asLogical, final_asisSym); SET_AS_FROM_FRAME(c.final_super, asLogical, final_superSym); SET_AS_FROM_FRAME(c.final_ll, asLogical, final_llSym); SET_AS_FROM_FRAME(c.final_pack, asLogical, final_packSym); SET_AS_FROM_FRAME(c.final_monotonic,asLogical, final_monotonicSym); SET_AS_FROM_FRAME(c.final_resymbol, asLogical, final_resymbolSym); SET_AS_FROM_FRAME(c.prefer_zomplex, asLogical, prefer_zomplexSym); SET_AS_FROM_FRAME(c.prefer_upper, asLogical, prefer_upperSym); SET_AS_FROM_FRAME(c.quick_return_if_not_posdef, asLogical, quick_return_if_not_posdefSym); SET_AS_FROM_FRAME(c.nmethods, asInteger, nmethodsSym); SET_AS_FROM_FRAME(c.method[0].ordering, asInteger, m0_ordSym); SET_AS_FROM_FRAME(c.postorder, asLogical, postorderSym); } SEXP CHM_set_common_env(SEXP rho) { if (!isEnvironment(rho)) error(_("Argument rho must be an environment")); chm_common_env = rho; dboundSym = install("dbound"); grow0Sym = install("grow0"); grow1Sym = install("grow1"); grow2Sym = install("grow2"); maxrankSym = install("maxrank"); supernodal_switchSym = install("supernodal_switch"); supernodalSym = install("supernodal"); final_asisSym = install("final_asis"); final_superSym = install("final_super"); final_llSym = install("final_ll"); final_packSym = install("final_pack"); final_monotonicSym = install("final_monotonic"); final_resymbolSym = install("final_resymbol"); prefer_zomplexSym = install("final_zomplex"); prefer_upperSym = install("final_upper"); quick_return_if_not_posdefSym = install("quick_return_if_not_posdef"); nmethodsSym = install("nmethods"); m0_ordSym = install("m0.ord"); postorderSym = install("postorder"); CHM_store_common(); return R_NilValue; } /** @brief stype := "symmetry type". * * ./CHOLMOD/Include/cholmod_core.h says about 'int stype' entry of cholmod_sparse_struct: * ------------------------------ * 0: matrix is "unsymmetric": use both upper and lower triangular parts * (the matrix may actually be symmetric in pattern and value, but * both parts are explicitly stored and used). May be square or * rectangular. * >0: matrix is square and symmetric, use upper triangular part. * Entries in the lower triangular part are ignored. * <0: matrix is square and symmetric, use lower triangular part. * Entries in the upper triangular part are ignored. */ static int stype(int ctype, SEXP x) { if ((ctype % 3) == 1) return (*uplo_P(x) == 'U') ? 1 : -1; return 0; } /** @brief xtype: the _kind_ of numeric (think "x slot") of Cholmod sparse matrices. #define CHOLMOD_PATTERN 0 pattern only, no numerical values #define CHOLMOD_REAL 1 a real matrix #define CHOLMOD_COMPLEX 2 a complex matrix (ANSI C99 compatible) #define CHOLMOD_ZOMPLEX 3 a complex matrix (MATLAB compatible) */ static int xtype(int ctype) { switch(ctype / 3) { case 0: /* "d" */ case 1: /* "l" */ return CHOLMOD_REAL; case 2: /* "n" */ return CHOLMOD_PATTERN; case 3: /* "z" */ return CHOLMOD_COMPLEX; } return -1; } /* coerce a vector to REAL and copy the result to freshly R_alloc'd memory */ static void *RallocedREAL(SEXP x) { SEXP rx = PROTECT(coerceVector(x, REALSXP)); int lx = LENGTH(rx); /* We over-allocate the memory chunk so that it is never NULL. */ /* The CHOLMOD code checks for a NULL pointer even in the length-0 case. */ double *ans = Memcpy((double*)R_alloc(lx + 1, sizeof(double)), REAL(rx), lx); UNPROTECT(1); return (void*)ans; } static void *xpt(int ctype, SEXP x) { switch(ctype / 3) { case 0: /* "d" */ return (void *) REAL(GET_SLOT(x, Matrix_xSym)); case 1: /* "l" */ return RallocedREAL(GET_SLOT(x, Matrix_xSym)); case 2: /* "n" */ return (void *) NULL; case 3: /* "z" */ return (void *) COMPLEX(GET_SLOT(x, Matrix_xSym)); } return (void *) NULL; /* -Wall */ } Rboolean check_sorted_chm(CHM_SP A) { int *Ai = (int*)(A->i), *Ap = (int*)(A->p); int j, p; for (j = 0; j < A->ncol; j++) { int p1 = Ap[j], p2 = Ap[j + 1] - 1; for (p = p1; p < p2; p++) if (Ai[p] >= Ai[p + 1]) return FALSE; } return TRUE; } /** Copy cholmod_sparse, to an R_alloc()ed version of it */ static void chm2Ralloc(CHM_SP dest, CHM_SP src) { int np1, nnz; /* copy all the characteristics of src to dest */ memcpy(dest, src, sizeof(cholmod_sparse)); /* R_alloc the vector storage for dest and copy the contents from src */ np1 = src->ncol + 1; nnz = (int) cholmod_nnz(src, &c); dest->p = (void*) Memcpy((int*)R_alloc(np1, sizeof(int)), (int*)(src->p), np1); dest->i = (void*) Memcpy((int*)R_alloc(nnz, sizeof(int)), (int*)(src->i), nnz); if(src->xtype) dest->x = (void*) Memcpy((double*)R_alloc(nnz, sizeof(double)), (double*)(src->x), nnz); } /** Copy cholmod_triplet to an R_alloc()ed version of it */ static void chTr2Ralloc(CHM_TR dest, CHM_TR src) { int nnz; /* copy all the (non-pointer) characteristics of src to dest */ memcpy(dest, src, sizeof(cholmod_triplet)); /* R_alloc the vector storage for dest and copy the contents from src */ nnz = src->nnz; dest->i = (void*) Memcpy((int*)R_alloc(nnz, sizeof(int)), (int*)(src->i), nnz); dest->j = (void*) Memcpy((int*)R_alloc(nnz, sizeof(int)), (int*)(src->j), nnz); if(src->xtype) dest->x = (void*) Memcpy((double*)R_alloc(nnz, sizeof(double)), (double*)(src->x), nnz); } /** * Populate ans with the pointers from x and modify its scalar * elements accordingly. Note that later changes to the contents of * ans will change the contents of the SEXP. * * In most cases this function is called through the macros * AS_CHM_SP() or AS_CHM_SP__(). It is unusual to call it directly. * * @param ans a CHM_SP pointer * @param x pointer to an object that inherits from CsparseMatrix * @param check_Udiag boolean - should a check for (and consequent * expansion of) a unit diagonal be performed. * @param sort_in_place boolean - if the i and x slots are to be sorted * should they be sorted in place? If the i and x slots are pointers * to an input SEXP they should not be modified. * * @return ans containing pointers to the slots of x, *unless* * check_Udiag and x is unitriangular. */ /* AS_CHM_SP (x) := as_cholmod_sparse((CHM_SP)alloca(sizeof(cholmod_sparse)), x, TRUE, FALSE) * AS_CHM_SP__(x) := as_cholmod_sparse((CHM_SP)alloca(sizeof(cholmod_sparse)), x, FALSE, FALSE) */ CHM_SP as_cholmod_sparse(CHM_SP ans, SEXP x, Rboolean check_Udiag, Rboolean sort_in_place) { static const char *valid[] = { MATRIX_VALID_Csparse, ""}; int *dims = INTEGER(GET_SLOT(x, Matrix_DimSym)), ctype = R_check_class_etc(x, valid); SEXP islot = GET_SLOT(x, Matrix_iSym); if (ctype < 0) error(_("invalid class of object to as_cholmod_sparse")); if (!isValid_Csparse(x)) error(_("invalid object passed to as_cholmod_sparse")); memset(ans, 0, sizeof(cholmod_sparse)); /* zero the struct */ ans->itype = CHOLMOD_INT; /* characteristics of the system */ ans->dtype = CHOLMOD_DOUBLE; ans->packed = TRUE; /* slots always present */ ans->i = INTEGER(islot); ans->p = INTEGER(GET_SLOT(x, Matrix_pSym)); /* dimensions and nzmax */ ans->nrow = dims[0]; ans->ncol = dims[1]; /* Allow for over-allocation of the i and x slots. Needed for * sparse X form in lme4. Right now it looks too difficult to * check for the length of the x slot, because of the xpt * utility, but the lengths of x and i should agree. */ ans->nzmax = LENGTH(islot); /* values depending on ctype */ ans->x = xpt (ctype, x); ans->stype = stype(ctype, x); ans->xtype = xtype(ctype); /* are the columns sorted (increasing row numbers) ?*/ ans->sorted = check_sorted_chm(ans); if (!(ans->sorted)) { /* sort columns */ if(sort_in_place) { if (!cholmod_sort(ans, &c)) error(_("in_place cholmod_sort returned an error code")); ans->sorted = 1; } else { CHM_SP tmp = cholmod_copy_sparse(ans, &c); if (!cholmod_sort(tmp, &c)) error(_("cholmod_sort returned an error code")); #ifdef DEBUG_Matrix /* This "triggers" exactly for return values of dtCMatrix_sparse_solve():*/ /* Don't want to translate this: want it report */ Rprintf("Note: as_cholmod_sparse() needed cholmod_sort()ing\n"); #endif chm2Ralloc(ans, tmp); cholmod_free_sparse(&tmp, &c); } } if (check_Udiag && ctype % 3 == 2 /* triangular */ && ans->nrow // fails for Dim = (0,0) && (*diag_P(x) == 'U')) { /* diagU2N(.) "in place" : */ double one[] = {1, 0}; CHM_SP eye = cholmod_speye(ans->nrow, ans->ncol, ans->xtype, &c); CHM_SP tmp = cholmod_add(ans, eye, one, one, TRUE, TRUE, &c); #ifdef DEBUG_Matrix_verbose /* happens quite often, e.g. in ../tests/indexing.R : */ Rprintf("Note: as_cholmod_sparse() - diagU2N\n", ctype); #endif chm2Ralloc(ans, tmp); cholmod_free_sparse(&tmp, &c); cholmod_free_sparse(&eye, &c); } /* else : * NOTE: if(*diag_P(x) == 'U'), the diagonal is lost (!); * ---- that may be ok, e.g. if we are just converting from/to Tsparse, * but is *not* at all ok, e.g. when used before matrix products */ return ans; } /** * Copy the contents of a to an appropriate CsparseMatrix object and, * optionally, free a or free both a and its the pointers to its contents. * * @param a (cholmod_sparse) matrix to be converted * @param dofree 0 - don't free a; > 0 cholmod_free a; < 0 Free a * @param uploT 0 - not triangular; > 0 upper triangular; < 0 lower * @param Rkind - vector type to store for a->xtype == CHOLMOD_REAL, * 0 - REAL; 1 - LOGICAL [unused for other a->xtype] * @param diag character string suitable for the diag slot of a * triangular matrix (not accessed if uploT == 0). * @param dn either R_NilValue or an SEXP suitable for the Dimnames slot. * * @return SEXP containing a copy of a */ SEXP chm_sparse_to_SEXP(CHM_SP a, int dofree, int uploT, int Rkind, const char* diag, SEXP dn) { SEXP ans; char *cls = "";/* -Wall */ Rboolean longi = (a->itype) == CHOLMOD_LONG; int *dims, nnz, *ansp, *ansi; // if (longi) : SuiteSparse_long *ail = (SuiteSparse_long*)(a->i), *apl = (SuiteSparse_long*)(a->p); // else ((a->itype) == CHOLMOD_INT) : int *aii = (int*)(a->i), *api = (int*)(a->p); PROTECT(dn); /* dn is usually UNPROTECTed before the call */ /* ensure a is sorted and packed */ if (!a->sorted || !a->packed) longi ? cholmod_l_sort(a, &cl) : cholmod_sort(a, &c); /* determine the class of the result */ #define DOFREE_MAYBE \ if (dofree > 0) \ longi ? cholmod_l_free_sparse(&a, &cl) : cholmod_free_sparse(&a, &c); \ else if (dofree < 0) Free(a) switch(a->xtype) { case CHOLMOD_PATTERN: cls = uploT ? "ntCMatrix": ((a->stype) ? "nsCMatrix" : "ngCMatrix"); break; case CHOLMOD_REAL: switch(Rkind) { case 0: cls = uploT ? "dtCMatrix": ((a->stype) ? "dsCMatrix" : "dgCMatrix"); break; case 1: cls = uploT ? "ltCMatrix": ((a->stype) ? "lsCMatrix" : "lgCMatrix"); break; default: DOFREE_MAYBE; error(_("chm_sparse_to_SEXP(, *): invalid 'Rkind' (real kind code)")); } break; case CHOLMOD_COMPLEX: cls = uploT ? "ztCMatrix": ((a->stype) ? "zsCMatrix" : "zgCMatrix"); break; default: DOFREE_MAYBE; error(_("unknown xtype in cholmod_sparse object")); } ans = PROTECT(NEW_OBJECT_OF_CLASS(cls)); /* allocate and copy common slots */ nnz = longi ? cholmod_l_nnz(a, &cl) : cholmod_nnz(a, &c); dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2)); dims[0] = a->nrow; dims[1] = a->ncol; ansp = INTEGER(ALLOC_SLOT(ans, Matrix_pSym, INTSXP, a->ncol + 1)); ansi = INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, nnz)); for (int j = 0; j <= a->ncol; j++) ansp[j] = longi ? (int)(apl[j]) : api[j]; for (int p = 0; p < nnz; p++) ansi[p] = longi ? (int)(ail[p]) : aii[p]; /* copy data slot if present */ if (a->xtype == CHOLMOD_REAL) { int i, *m_x; double *a_x = (double *) a->x; switch(Rkind) { case 0: Memcpy(REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, nnz)), a_x, nnz); break; case 1: m_x = LOGICAL(ALLOC_SLOT(ans, Matrix_xSym, LGLSXP, nnz)); for (i=0; i < nnz; i++) m_x[i] = ISNAN(a_x[i]) ? NA_LOGICAL : (a_x[i] != 0); break; } } else if (a->xtype == CHOLMOD_COMPLEX) { DOFREE_MAYBE; error(_("complex sparse matrix code not yet written")); /* Memcpy(COMPLEX(ALLOC_SLOT(ans, Matrix_xSym, CPLXSXP, nnz)), */ /* (complex *) a->x, nnz); */ } if (uploT) { /* slots for triangularMatrix */ if (a->stype) error(_("Symmetric and triangular both set")); SET_SLOT(ans, Matrix_uploSym, mkString((uploT > 0) ? "U" : "L")); SET_SLOT(ans, Matrix_diagSym, mkString(diag)); } if (a->stype) /* slot for symmetricMatrix */ SET_SLOT(ans, Matrix_uploSym, mkString((a->stype > 0) ? "U" : "L")); DOFREE_MAYBE; if (dn != R_NilValue) SET_SLOT(ans, Matrix_DimNamesSym, duplicate(dn)); UNPROTECT(2); return ans; } #undef DOFREE_MAYBE /** * Change the "type" of a cholmod_sparse matrix, i.e. modify it "in place" * * @param to_xtype requested xtype (pattern, real, complex, zomplex) * @param A sparse matrix to change * @param Common cholmod's common * * @return TRUE/FALSE , TRUE iff success */ Rboolean chm_MOD_xtype(int to_xtype, cholmod_sparse *A, CHM_CM Common) { // *MOD*: shouting, as A is modified in place /* -------------------------------------------------------------------------- * cholmod_sparse_xtype: change the xtype of a sparse matrix * -------------------------------------------------------------------------- int cholmod_sparse_xtype ( // ---- input ---- int to_xtype, // // ---- in/out --- cholmod_sparse *A, // // --------------- cholmod_common *Common ) ; int cholmod_l_sparse_xtype (int, cholmod_sparse *, cholmod_common *) ; */ if((A->itype) == CHOLMOD_LONG) { return (Rboolean) cholmod_l_sparse_xtype (to_xtype, A, Common); } else { return (Rboolean) cholmod_sparse_xtype (to_xtype, A, Common); } } /** * Populate ans with the pointers from x and modify its scalar * elements accordingly. Note that later changes to the contents of * ans will change the contents of the SEXP. * * In most cases this function is called through the macros * AS_CHM_TR() or AS_CHM_TR__(). It is unusual to call it directly. * * @param ans a CHM_TR pointer * @param x pointer to an object that inherits from TsparseMatrix * @param check_Udiag boolean - should a check for (and consequent * expansion of) a unit diagonal be performed. * * @return ans containing pointers to the slots of x, *unless* * check_Udiag and x is unitriangular. */ CHM_TR as_cholmod_triplet(CHM_TR ans, SEXP x, Rboolean check_Udiag) { static const char *valid[] = { MATRIX_VALID_Tsparse, ""}; int ctype = R_check_class_etc(x, valid), *dims = INTEGER(GET_SLOT(x, Matrix_DimSym)); SEXP islot = GET_SLOT(x, Matrix_iSym); int m = LENGTH(islot); Rboolean do_Udiag = (check_Udiag && ctype % 3 == 2 && (*diag_P(x) == 'U')); if (ctype < 0) error(_("invalid class of object to as_cholmod_triplet")); memset(ans, 0, sizeof(cholmod_triplet)); /* zero the struct */ ans->itype = CHOLMOD_INT; /* characteristics of the system */ ans->dtype = CHOLMOD_DOUBLE; /* nzmax, dimensions, types and slots : */ ans->nnz = ans->nzmax = m; ans->nrow = dims[0]; ans->ncol = dims[1]; ans->stype = stype(ctype, x); ans->xtype = xtype(ctype); ans->i = (void *) INTEGER(islot); ans->j = (void *) INTEGER(GET_SLOT(x, Matrix_jSym)); ans->x = xpt(ctype, x); if(do_Udiag) { /* diagU2N(.) "in place", similarly to Tsparse_diagU2N [./Tsparse.c] (but without new SEXP): */ int k = m + dims[0]; CHM_TR tmp = cholmod_l_copy_triplet(ans, &cl); int *a_i, *a_j; if(!cholmod_reallocate_triplet((size_t) k, tmp, &cl)) error(_("as_cholmod_triplet(): could not reallocate for internal diagU2N()" )); /* TODO? instead of copy_triplet() & reallocate_triplet() * ---- allocate to correct length + Memcpy() here, as in * Tsparse_diagU2N() & chTr2Ralloc() below */ a_i = tmp->i; a_j = tmp->j; /* add (@i, @j)[k+m] = k, @x[k+m] = 1. for k = 0,..,(n-1) */ for(k=0; k < dims[0]; k++) { a_i[k+m] = k; a_j[k+m] = k; switch(ctype / 3) { case 0: { /* "d" */ double *a_x = tmp->x; a_x[k+m] = 1.; break; } case 1: { /* "l" */ int *a_x = tmp->x; a_x[k+m] = 1; break; } case 2: /* "n" */ break; case 3: { /* "z" */ double *a_x = tmp->x; a_x[2*(k+m) ] = 1.; a_x[2*(k+m)+1] = 0.; break; } } } /* for(k) */ chTr2Ralloc(ans, tmp); cholmod_l_free_triplet(&tmp, &c); } /* else : * NOTE: if(*diag_P(x) == 'U'), the diagonal is lost (!); * ---- that may be ok, e.g. if we are just converting from/to Tsparse, * but is *not* at all ok, e.g. when used before matrix products */ return ans; } /** * Copy the contents of a to an appropriate TsparseMatrix object and, * optionally, free a or free both a and its the pointers to its contents. * * @param a matrix to be converted * @param dofree 0 - don't free a; > 0 cholmod_free a; < 0 Free a * @param uploT 0 - not triangular; > 0 upper triangular; < 0 lower * @param Rkind - vector type to store for a->xtype == CHOLMOD_REAL, * 0 - REAL; 1 - LOGICAL * @param diag character string suitable for the diag slot of a * triangular matrix (not accessed if uploT == 0). * @param dn either R_NilValue or an SEXP suitable for the Dimnames slot. * * @return SEXP containing a copy of a */ SEXP chm_triplet_to_SEXP(CHM_TR a, int dofree, int uploT, int Rkind, const char* diag, SEXP dn) { SEXP ans; char *cl = ""; /* -Wall */ int *dims; PROTECT(dn); /* dn is usually UNPROTECTed before the call */ /* determine the class of the result */ #define DOFREE_MAYBE \ if (dofree > 0) cholmod_free_triplet(&a, &c); \ else if (dofree < 0) Free(a) switch(a->xtype) { case CHOLMOD_PATTERN: cl = uploT ? "ntTMatrix" : ((a->stype) ? "nsTMatrix" : "ngTMatrix"); break; case CHOLMOD_REAL: switch(Rkind) { case 0: cl = uploT ? "dtTMatrix" : ((a->stype) ? "dsTMatrix" : "dgTMatrix"); break; case 1: cl = uploT ? "ltTMatrix" : ((a->stype) ? "lsTMatrix" : "lgTMatrix"); break; } break; case CHOLMOD_COMPLEX: cl = uploT ? "ztTMatrix" : ((a->stype) ? "zsTMatrix" : "zgTMatrix"); break; default: DOFREE_MAYBE; error(_("unknown xtype in cholmod_triplet object")); } ans = PROTECT(NEW_OBJECT_OF_CLASS(cl)); /* allocate and copy common slots */ dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2)); dims[0] = a->nrow; dims[1] = a->ncol; Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, a->nnz)), (int *) a->i, a->nnz); Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_jSym, INTSXP, a->nnz)), (int *) a->j, a->nnz); /* copy data slot if present */ if (a->xtype == CHOLMOD_REAL) { int i, *m_x; double *a_x = (double *) a->x; switch(Rkind) { case 0: Memcpy(REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, a->nnz)), a_x, a->nnz); break; case 1: m_x = LOGICAL(ALLOC_SLOT(ans, Matrix_xSym, LGLSXP, a->nnz)); for (i=0; i < a->nnz; i++) m_x[i] = ISNAN(a_x[i]) ? NA_LOGICAL : (a_x[i] != 0); break; } } else if (a->xtype == CHOLMOD_COMPLEX) { DOFREE_MAYBE; error(_("complex sparse matrix code not yet written")); /* Memcpy(COMPLEX(ALLOC_SLOT(ans, Matrix_xSym, CPLXSXP, a->nnz)), */ /* (complex *) a->x, a->nz); */ } if (uploT) { /* slots for triangularMatrix */ if (a->stype) error(_("Symmetric and triangular both set")); SET_SLOT(ans, Matrix_uploSym, mkString((uploT > 0) ? "U" : "L")); SET_SLOT(ans, Matrix_diagSym, mkString(diag)); } /* set symmetry attributes */ if (a->stype) SET_SLOT(ans, Matrix_uploSym, mkString((a->stype > 0) ? "U" : "L")); DOFREE_MAYBE; if (dn != R_NilValue) SET_SLOT(ans, Matrix_DimNamesSym, duplicate(dn)); UNPROTECT(2); return ans; } #undef DOFREE_MAYBE /** * Populate ans with the pointers from x and modify its scalar * elements accordingly. Note that later changes to the contents of * ans will change the contents of the SEXP. * * In most cases this function is called through the macro AS_CHM_DN. * It is unusual to call it directly. * * @param ans a CHM_DN pointer. * @param x pointer to an object that inherits from (denseMatrix ^ generalMatrix) * * @return ans containing pointers to the slots of x. */ CHM_DN as_cholmod_dense(CHM_DN ans, SEXP x) { #define _AS_cholmod_dense_1 \ static const char *valid[] = { MATRIX_VALID_ge_dense, ""}; \ int dims[2], ctype = R_check_class_etc(x, valid), nprot = 0; \ \ if (ctype < 0) { /* not a classed matrix */ \ if (isMatrix(x)) Memcpy(dims, INTEGER(getAttrib(x, R_DimSymbol)), 2); \ else {dims[0] = LENGTH(x); dims[1] = 1;} \ if (isInteger(x)) { \ x = PROTECT(coerceVector(x, REALSXP)); \ nprot++; \ } \ ctype = (isReal(x) ? 0 : \ (isLogical(x) ? 2 : /* logical -> default to "l", not "n" */ \ (isComplex(x) ? 6 : -1))); \ } else Memcpy(dims, INTEGER(GET_SLOT(x, Matrix_DimSym)), 2); \ if (ctype < 0) error(_("invalid class of object to as_cholmod_dense")); \ memset(ans, 0, sizeof(cholmod_dense)); /* zero the struct */ \ \ ans->dtype = CHOLMOD_DOUBLE; /* characteristics of the system */ \ ans->x = ans->z = (void *) NULL; \ /* dimensions and nzmax */ \ ans->d = ans->nrow = dims[0]; \ ans->ncol = dims[1]; \ ans->nzmax = ((size_t)dims[0]) * dims[1]; \ /* set the xtype and any elements */ \ switch(ctype / 2) { \ case 0: /* "d" */ \ ans->xtype = CHOLMOD_REAL; \ ans->x = (void *) REAL((ctype % 2) ? GET_SLOT(x, Matrix_xSym) : x); \ break _AS_cholmod_dense_1; case 1: /* "l" */ ans->xtype = CHOLMOD_REAL; ans->x = RallocedREAL((ctype % 2) ? GET_SLOT(x, Matrix_xSym) : x); break; case 2: /* "n" */ ans->xtype = CHOLMOD_PATTERN; ans->x = (void *) LOGICAL((ctype % 2) ? GET_SLOT(x, Matrix_xSym) : x); break; #define _AS_cholmod_dense_2 \ case 3: /* "z" */ \ ans->xtype = CHOLMOD_COMPLEX; \ ans->x = (void *) COMPLEX((ctype % 2) ? GET_SLOT(x, Matrix_xSym) : x); \ break; \ } \ UNPROTECT(nprot); \ return ans _AS_cholmod_dense_2; } /* version of as_cholmod_dense() that produces a cholmod_dense matrix * with REAL 'x' slot -- i.e. treats "nMatrix" as "lMatrix" -- as only difference; * Not just via a flag in as_cholmod_dense() since that has fixed API */ CHM_DN as_cholmod_x_dense(CHM_DN ans, SEXP x) { _AS_cholmod_dense_1; case 1: /* "l" */ case 2: /* "n" (no NA in 'x', but *has* 'x' slot => treat as "l" */ ans->xtype = CHOLMOD_REAL; ans->x = RallocedREAL((ctype % 2) ? GET_SLOT(x, Matrix_xSym) : x); break; _AS_cholmod_dense_2; } #undef _AS_cholmod_dense_1 #undef _AS_cholmod_dense_2 /** * Transpose a cholmod_dense matrix ("too trivial to be in CHOLMOD?") * * @param ans (pointer to) already allocated result of correct dimension * @param x (pointer to) cholmod_dense matrix to be transposed * */ void chm_transpose_dense(CHM_DN ans, CHM_DN x) { if (x->xtype != CHOLMOD_REAL) error(_("chm_transpose_dense(ans, x) not yet implemented for %s different from %s"), "x->xtype", "CHOLMOD_REAL"); double *xx = x->x, *ansx = ans->x; // Inspired from R's do_transpose() in .../R/src/main/array.c : int i,j, nrow = x->nrow, len = x->nzmax, l_1 = len-1; for (i = 0, j = 0; i < len; i++, j += nrow) { if (j > l_1) j -= l_1; ansx[i] = xx[j]; } return; } void R_cholmod_error(int status, const char *file, int line, const char *message) { CHM_restore_common(); /* restore any setting that may have been changed */ /* NB: keep in sync with M_R_cholmod_error(), ../inst/include/Matrix_stubs.c */ /* From CHOLMOD/Include/cholmod_core.h : ...status values. zero means success, negative means a fatal error, positive is a warning. */ #ifndef R_CHOLMOD_ALWAYS_ERROR if(status < 0) { #endif error(_("Cholmod error '%s' at file %s, line %d"), message, file, line); #ifndef R_CHOLMOD_ALWAYS_ERROR } else warning(_("Cholmod warning '%s' at file %s, line %d"), message, file, line); #endif } /* just to get 'int' instead of 'void' as required by CHOLMOD's print_function */ static int R_cholmod_printf(const char* fmt, ...) { va_list(ap); va_start(ap, fmt); Rprintf((char *)fmt, ap); va_end(ap); return 0; } /** * Initialize the CHOLMOD library and replace the print and error functions * by R-specific versions. * * @param c pointer to a cholmod_common structure to be initialized * * @return TRUE if successful */ int R_cholmod_start(CHM_CM c) { int res; if (!(res = cholmod_start(c))) error(_("Unable to initialize cholmod: error code %d"), res); /*SuiteSparse <= 4.x.y : * c->print_function = R_cholmod_printf; /. Rprintf gives warning */ SuiteSparse_config.printf_func = R_cholmod_printf;/* Rprintf gives warning */ // ^^^^^^^^^ now is misnomer /* Since we provide an error handler, it may not be a good idea to allow CHOLMOD printing, * because that's not easily suppressed on the R level : * Hence consider, at least temporarily * c->print_function = NULL; */ c->error_handler = R_cholmod_error; return TRUE; } /** * Copy the contents of a to an appropriate denseMatrix object and, * optionally, free a or free both a and its pointer to its contents. * * @param a matrix to be converted * @param dofree 0 - don't free a; > 0 cholmod_free a; < 0 Free a * @param Rkind type of R matrix to be generated (special to this function) * @param dn -- dimnames [list(.,.) or NULL; __already__ transposed when transp is TRUE ] * @param transp Rboolean, if TRUE, the result must be a copy of t(a), i.e., "a transposed" * * @return SEXP containing a copy of a */ SEXP chm_dense_to_SEXP(CHM_DN a, int dofree, int Rkind, SEXP dn, Rboolean transp) { /* FIXME: should also have args (int uploST, char *diag) */ SEXP ans; char *cl = ""; /* -Wall */ int *dims, ntot; PROTECT(dn); // <-- no longer protected in caller #define DOFREE_de_MAYBE \ if (dofree > 0) cholmod_free_dense(&a, &c); \ else if (dofree < 0) Free(a); switch(a->xtype) { /* determine the class of the result */ /* CHOLMOD_PATTERN never happens because cholmod_dense can't : * case CHOLMOD_PATTERN: * cl = "ngeMatrix"; break; */ case CHOLMOD_REAL: switch(Rkind) { /* -1: special for this function! */ case -1: cl = "ngeMatrix"; break; case 0: cl = "dgeMatrix"; break; case 1: cl = "lgeMatrix"; break; default: DOFREE_de_MAYBE; error(_("unknown 'Rkind'")); } break; case CHOLMOD_COMPLEX: cl = "zgeMatrix"; break; default: DOFREE_de_MAYBE; error(_("unknown xtype")); } ans = PROTECT(NEW_OBJECT_OF_CLASS(cl)); /* allocate and copy common slots */ dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2)); if(transp) { dims[1] = a->nrow; dims[0] = a->ncol; } else { dims[0] = a->nrow; dims[1] = a->ncol; } ntot = ((size_t)dims[0]) * dims[1]; if (a->d == a->nrow) { /* copy data slot -- always present in dense(!) */ if (a->xtype == CHOLMOD_REAL) { int i, *m_x; double *ansx, *a_x = (double *) a->x; switch(Rkind) { case 0: ansx = REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, ntot)); if(transp) { // Inspired from R's do_transpose() in .../R/src/main/array.c : int i,j, nrow = a->nrow, len = ntot, l_1 = len-1; for (i = 0, j = 0; i < len; i++, j += nrow) { if (j > l_1) j -= l_1; ansx[i] = a_x[j]; } } else { Memcpy(ansx, a_x, ntot); } break; case -1: /* nge*/ case 1: /* lge*/ m_x = LOGICAL(ALLOC_SLOT(ans, Matrix_xSym, LGLSXP, ntot)); if(transp) { // Inspired from R's do_transpose() in .../R/src/main/array.c : int i,j, nrow = a->nrow, len = ntot, l_1 = len-1; for (i = 0, j = 0; i < len; i++, j += nrow) { if (j > l_1) j -= l_1; m_x[i] = a_x[j]; } } else { for (i=0; i < ntot; i++) m_x[i] = ISNAN(a_x[i]) ? NA_LOGICAL : (a_x[i] != 0); } break; } } else if (a->xtype == CHOLMOD_COMPLEX) { DOFREE_de_MAYBE; error(_("complex sparse matrix code not yet written")); /* Memcpy(COMPLEX(ALLOC_SLOT(ans, Matrix_xSym, CPLXSXP, ntot)), */ /* (complex *) a->x, ntot); */ } } else { DOFREE_de_MAYBE; error(_("code for cholmod_dense with holes not yet written")); } DOFREE_de_MAYBE; if (dn != R_NilValue) SET_SLOT(ans, Matrix_DimNamesSym, duplicate(dn)); UNPROTECT(2); return ans; } /** * Copy the contents of a to a matrix object and, optionally, free a * or free both a and its pointer to its contents. * * @param a cholmod_dense structure to be converted {already REAL for original l..CMatrix} * @param dofree 0 - don't free a; > 0 cholmod_free a; < 0 Free a * @param dn either R_NilValue or an SEXP suitable for the Dimnames slot. * * @return SEXP containing a copy of a as a matrix object */ SEXP chm_dense_to_matrix(CHM_DN a, int dofree, SEXP dn) { #define CHM_DENSE_TYPE \ SEXPTYPE typ; \ /* determine the class of the result */ \ typ = (a->xtype == CHOLMOD_PATTERN) ? LGLSXP : \ ((a->xtype == CHOLMOD_REAL) ? REALSXP : \ ((a->xtype == CHOLMOD_COMPLEX) ? CPLXSXP : NILSXP)); \ if (typ == NILSXP) { \ DOFREE_de_MAYBE; \ error(_("unknown xtype")); \ } PROTECT(dn); CHM_DENSE_TYPE; SEXP ans = PROTECT(allocMatrix(typ, a->nrow, a->ncol)); #define CHM_DENSE_COPY_DATA \ if (a->d == a->nrow) { /* copy data slot if present */ \ if (a->xtype == CHOLMOD_REAL) \ Memcpy(REAL(ans), (double *) a->x, a->nrow * a->ncol); \ else if (a->xtype == CHOLMOD_COMPLEX) { \ DOFREE_de_MAYBE; \ error(_("complex sparse matrix code not yet written")); \ /* Memcpy(COMPLEX(ALLOC_SLOT(ans, Matrix_xSym, CPLXSXP, a->nnz)), */ \ /* (complex *) a->x, a->nz); */ \ } else if (a->xtype == CHOLMOD_PATTERN) { \ DOFREE_de_MAYBE; \ error(_("don't know if a dense pattern matrix makes sense")); \ } \ } else { \ DOFREE_de_MAYBE; \ error(_("code for cholmod_dense with holes not yet written")); \ } CHM_DENSE_COPY_DATA; DOFREE_de_MAYBE; if (dn != R_NilValue) setAttrib(ans, R_DimNamesSymbol, duplicate(dn)); UNPROTECT(2); return ans; } /** * Copy the contents of a to a numeric R object and, optionally, free a * or free both a and its pointer to its contents. * * @param a cholmod_dense structure to be converted * @param dofree 0 - don't free a; > 0 cholmod_free a; < 0 Free a * * @return SEXP containing a copy of a in the sense of as.vector(a) */ SEXP chm_dense_to_vector(CHM_DN a, int dofree) { CHM_DENSE_TYPE; SEXP ans = PROTECT(allocVector(typ, a->nrow * a->ncol)); CHM_DENSE_COPY_DATA; DOFREE_de_MAYBE; UNPROTECT(1); return ans; } CHM_DN numeric_as_chm_dense(CHM_DN ans, double *v, int nr, int nc) { ans->d = ans->nrow = nr; ans->ncol = nc; ans->nzmax = nr * nc; ans->x = (void *) v; ans->xtype = CHOLMOD_REAL; ans->dtype = CHOLMOD_DOUBLE; return ans; } /** * Populate ans with the pointers from x and modify its scalar * elements accordingly. Note that later changes to the contents of * ans will change the contents of the SEXP. * * @param ans an CHM_FR object * @param x pointer to an object that inherits from CHMfactor * @param do_check logical indicating if check for correctness should happen * * @return ans containing pointers to the slots of x. */ CHM_FR as_cholmod_factor3(CHM_FR ans, SEXP x, Rboolean do_check) { static const char *valid[] = { MATRIX_VALID_CHMfactor, ""}; int *type = INTEGER(GET_SLOT(x, install("type"))), ctype = R_check_class_etc(x, valid); SEXP tmp; if (ctype < 0) error(_("invalid class of object to as_cholmod_factor")); memset(ans, 0, sizeof(cholmod_factor)); /* zero the struct */ ans->itype = CHOLMOD_INT; /* characteristics of the system */ ans->dtype = CHOLMOD_DOUBLE; ans->z = (void *) NULL; ans->xtype = (ctype < 2) ? CHOLMOD_REAL : CHOLMOD_PATTERN; ans->ordering = type[0]; /* unravel the type */ ans->is_ll = (type[1] ? 1 : 0); ans->is_super = (type[2] ? 1 : 0); ans->is_monotonic = (type[3] ? 1 : 0); /* check for consistency */ if ((!(ans->is_ll)) && ans->is_super) error(_("Supernodal LDL' decomposition not available")); if ((!type[2]) ^ (ctype % 2)) error(_("Supernodal/simplicial class inconsistent with type flags")); /* slots always present */ tmp = GET_SLOT(x, Matrix_permSym); ans->minor = ans->n = LENGTH(tmp); ans->Perm = INTEGER(tmp); ans->ColCount = INTEGER(GET_SLOT(x, install("colcount"))); ans->z = ans->x = (void *) NULL; if (ctype < 2) { tmp = GET_SLOT(x, Matrix_xSym); ans->x = REAL(tmp); } if (ans->is_super) { /* supernodal factorization */ ans->xsize = LENGTH(tmp); ans->maxcsize = type[4]; ans->maxesize = type[5]; ans->i = (int*)NULL; tmp = GET_SLOT(x, install("super")); ans->nsuper = LENGTH(tmp) - 1; ans->super = INTEGER(tmp); /* Move these checks to the CHMfactor_validate function */ if (ans->nsuper < 1) error(_("Number of supernodes must be positive when is_super is TRUE")); tmp = GET_SLOT(x, install("pi")); if (LENGTH(tmp) != ans->nsuper + 1) error(_("Lengths of super and pi must be equal")); ans->pi = INTEGER(tmp); tmp = GET_SLOT(x, install("px")); if (LENGTH(tmp) != ans->nsuper + 1) error(_("Lengths of super and px must be equal")); ans->px = INTEGER(tmp); tmp = GET_SLOT(x, install("s")); ans->ssize = LENGTH(tmp); ans->s = INTEGER(tmp); } else { ans->nzmax = LENGTH(tmp); ans->p = INTEGER(GET_SLOT(x, Matrix_pSym)); ans->i = INTEGER(GET_SLOT(x, Matrix_iSym)); ans->nz = INTEGER(GET_SLOT(x, install("nz"))); ans->next = INTEGER(GET_SLOT(x, install("nxt"))); ans->prev = INTEGER(GET_SLOT(x, install("prv"))); } if (do_check && !cholmod_check_factor(ans, &c)) error(_("failure in as_cholmod_factor")); return ans; } // This has been in the Matrix API ( ../inst/include/Matrix.h /** * Populate ans with the pointers from x and modify its scalar * elements accordingly. Note that later changes to the contents of * ans will change the contents of the SEXP. * * In most cases this function is called through the macro AS_CHM_FR. * It is unusual to call it directly. * * @param ans an CHM_FR object * @param x pointer to an object that inherits from CHMfactor * * @return ans containing pointers to the slots of x. */ CHM_FR as_cholmod_factor(CHM_FR ans, SEXP x) { return as_cholmod_factor3(ans, x, /* do_check = */ TRUE); } /** * Copy the contents of f to an appropriate CHMfactor object and, * optionally, free f or free both f and its pointer to its contents. * * @param f cholmod_factor object to be converted * @param dofree 0 - don't free a; > 0 cholmod_free a; < 0 Free a * * @return SEXP containing a copy of a */ SEXP chm_factor_to_SEXP(CHM_FR f, int dofree) { SEXP ans; int *dims, *type; char *class = (char*) NULL; /* -Wall */ #define DOFREE_MAYBE \ if(dofree) { \ if (dofree > 0) cholmod_free_factor(&f, &c); \ else /* dofree < 0 */ Free(f); \ } if(!chm_factor_ok(f)) { DOFREE_MAYBE; error(_("CHOLMOD factorization was unsuccessful")); // error(_("previous CHOLMOD factorization was unsuccessful")); } switch(f->xtype) { case CHOLMOD_REAL: class = f->is_super ? "dCHMsuper" : "dCHMsimpl"; break; case CHOLMOD_PATTERN: class = f->is_super ? "nCHMsuper" : "nCHMsimpl"; break; default: DOFREE_MAYBE; error(_("f->xtype of %d not recognized"), f->xtype); } ans = PROTECT(NEW_OBJECT_OF_CLASS(class)); dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2)); dims[0] = dims[1] = f->n; /* copy component of known length */ Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_permSym, INTSXP, f->n)), (int*)f->Perm, f->n); Memcpy(INTEGER(ALLOC_SLOT(ans, install("colcount"), INTSXP, f->n)), (int*)f->ColCount, f->n); type = INTEGER(ALLOC_SLOT(ans, install("type"), INTSXP, f->is_super ? 6 : 4)); type[0] = f->ordering; type[1] = f->is_ll; type[2] = f->is_super; type[3] = f->is_monotonic; if (f->is_super) { type[4] = f->maxcsize; type[5] = f->maxesize; Memcpy(INTEGER(ALLOC_SLOT(ans, install("super"), INTSXP, f->nsuper + 1)), (int*)f->super, f->nsuper+1); Memcpy(INTEGER(ALLOC_SLOT(ans, install("pi"), INTSXP, f->nsuper + 1)), (int*)f->pi, f->nsuper + 1); Memcpy(INTEGER(ALLOC_SLOT(ans, install("px"), INTSXP, f->nsuper + 1)), (int*)f->px, f->nsuper + 1); Memcpy(INTEGER(ALLOC_SLOT(ans, install("s"), INTSXP, f->ssize)), (int*)f->s, f->ssize); Memcpy(REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, f->xsize)), (double*)f->x, f->xsize); } else { Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, f->nzmax)), (int*)f->i, f->nzmax); Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_pSym, INTSXP, f->n + 1)), (int*)f->p, f->n + 1); Memcpy(REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, f->nzmax)), (double*)f->x, f->nzmax); Memcpy(INTEGER(ALLOC_SLOT(ans, install("nz"), INTSXP, f->n)), (int*)f->nz, f->n); Memcpy(INTEGER(ALLOC_SLOT(ans, install("nxt"), INTSXP, f->n + 2)), (int*)f->next, f->n + 2); Memcpy(INTEGER(ALLOC_SLOT(ans, install("prv"), INTSXP, f->n + 2)), (int*)f->prev, f->n + 2); } DOFREE_MAYBE; UNPROTECT(1); return ans; } #undef DOFREE_MAYBE /** * Drop the (unit) diagonal entries from a cholmod_sparse matrix * * @param chx cholmod_sparse matrix. * Note that the matrix "slots" are modified _in place_ * @param uploT integer code (= +/- 1) indicating if chx is * upper (+1) or lower (-1) triangular * @param do_realloc Rboolean indicating, if a cholmod_sprealloc() should * finalize the procedure; not needed, e.g. when the * result is converted to a SEXP immediately afterwards. */ void chm_diagN2U(CHM_SP chx, int uploT, Rboolean do_realloc) { int i, n = chx->nrow, nnz = (int)cholmod_nnz(chx, &c), n_nnz = nnz - n, /* the new nnz : we will have removed n entries */ i_to = 0, i_from = 0; if(chx->ncol != n) error(_("chm_diagN2U(): nrow=%d, ncol=%d"), n, chx->ncol); if (!chx->sorted || !chx->packed) cholmod_sort(chx, &c); /* dimensions and nzmax */ #define _i(I) ( (int*) chx->i)[I] #define _x(I) ((double*) chx->x)[I] #define _p(I) ( (int*) chx->p)[I] /* work by copying from i_from to i_to ==> MUST i_to <= i_from */ if(uploT == 1) { /* "U" : upper triangular */ for(i = 0; i < n; i++) { /* looking at i-th column */ int j, n_i = _p(i+1) - _p(i); /* = #{entries} in this column */ /* 1) copy all but the last _above-diagonal_ column-entries: */ for(j = 1; j < n_i; j++, i_to++, i_from++) { _i(i_to) = _i(i_from); _x(i_to) = _x(i_from); } /* 2) drop the last column-entry == diagonal entry */ i_from++; } } else if(uploT == -1) { /* "L" : lower triangular */ for(i = 0; i < n; i++) { /* looking at i-th column */ int j, n_i = _p(i+1) - _p(i); /* = #{entries} in this column */ /* 1) drop the first column-entry == diagonal entry */ i_from++; /* 2) copy the other _below-diagonal_ column-entries: */ for(j = 1; j < n_i; j++, i_to++, i_from++) { _i(i_to) = _i(i_from); _x(i_to) = _x(i_from); } } } else { error(_("chm_diagN2U(x, uploT = %d): uploT should be +- 1"), uploT); } /* the column pointers are modified the same in both cases :*/ for(i=1; i <= n; i++) _p(i) -= i; #undef _i #undef _x #undef _p if(do_realloc) /* shorten (i- and x-slots from nnz to n_nnz */ cholmod_reallocate_sparse(n_nnz, chx, &c); return; } /* Placeholders; TODO: use checks above (search "CHMfactor_validate"): */ SEXP CHMfactor_validate(SEXP obj) /* placeholder */ { return ScalarLogical(1); } SEXP CHMsimpl_validate(SEXP obj) /* placeholder */ { return ScalarLogical(1); } SEXP CHMsuper_validate(SEXP obj) /* placeholder */ { return ScalarLogical(1); } Matrix/src/dgTMatrix.c0000644000176200001440000001147514060416534014367 0ustar liggesusers#include /* for R_LEN... */ #include "dgTMatrix.h" #include "chm_common.h" #include "Tsparse.h" SEXP xTMatrix_validate(SEXP x) { /* Almost everything now in Tsparse_validate ( ./Tsparse.c ) * *but* the checking of the 'x' slot : */ if (LENGTH(GET_SLOT(x, Matrix_iSym)) != LENGTH(GET_SLOT(x, Matrix_xSym))) return mkString(_("lengths of slots i and x must match")); return ScalarLogical(1); } static void d_insert_triplets_in_array(int m, int n, int nnz, const int xi[], const int xj[], const double xx[], /* --> */ double vx[]) { // For ( m*n ) > INT_MAX, we here assume that size_t is using 64-bit ! size_t m_ = (size_t) m, len = sizeof(double) * m_ * n; if(len == sizeof(double) * (double)m_ * n) memset(vx, 0, len); else { // len did overflow -- this should call memset() several times: size_t max_l = (1 << (sizeof(size_t)-1)); // = 2^(N-1) max_l += ((long)max_l - 1); // = 2^(N-1) + 2^(N-1) - 1 = 2^N - 1 double dlen = ((double)m_) * n; if(dlen > max_l) error(_("too large matrix: %.0f"), dlen); // else : m * n does fit -- call memset() several times: dlen *= sizeof(double); memset(vx, 0, max_l); double len_done = 0.; // length in bytes // but also need length in double while((len_done += max_l) < dlen) { size_t dd = (dlen - len_done < max_l) ? (size_t)(dlen - len_done) : max_l; memset(vx + (int)(len_done/sizeof(double)), 0, dd); } } for (int i = 0; i < nnz; i++) { vx[xi[i] + xj[i] * m_] += xx[i]; /* allow redundant entries in x */ } } static void l_insert_triplets_in_array(int m, int n, int nnz, const int xi[], const int xj[], const int xx[], /* --> */ int vx[]) { // For ( m*n ) > INT_MAX, we here assume that size_t is using 64-bit ! size_t m_ = (size_t) m, len = sizeof(int) * m_ * n; if(len == sizeof(int) * (double)m_ * n) memset(vx, 0, len); else { // len did overflow -- this should call memset() several times: size_t max_l = (1 << (sizeof(size_t)-1)); // = 2^(N-1) max_l += ((long)max_l - 1); // = 2^(N-1) + 2^(N-1) - 1 = 2^N - 1 double dlen = ((double)m_) * n; if(dlen > max_l) error(_("too large matrix: %.0f"), dlen); // else : m * n does fit -- call memset() several times: dlen *= sizeof(int); memset(vx, 0, max_l); double len_done = 0.; // length in bytes // but also need length in int while((len_done += max_l) < dlen) { size_t dd = (dlen - len_done < max_l) ? (size_t)(dlen - len_done) : max_l; memset(vx + (int)(len_done/sizeof(int)), 0, dd); } } for (int i = 0; i < nnz; i++) { size_t ind = xi[i] + xj[i] * m_; if(vx[ind] == NA_LOGICAL) { // do nothing: remains NA } else if(xx[i] == NA_LOGICAL) vx[ind] = NA_LOGICAL; else // "or" : vx[ind] |= xx[i]; } } #define MAKE_gTMatrix_to_geMatrix(_t1_, _SEXPTYPE_, _SEXP_) \ SEXP _t1_ ## gTMatrix_to_ ## _t1_ ## geMatrix(SEXP x) \ { \ SEXP dd = GET_SLOT(x, Matrix_DimSym), \ islot = GET_SLOT(x, Matrix_iSym), \ ans = PROTECT(NEW_OBJECT_OF_CLASS(#_t1_ "geMatrix")); \ \ int *dims = INTEGER(dd), \ m = dims[0], \ n = dims[1]; \ double len = m * (double)n; \ \ if (len > R_XLEN_T_MAX) \ error(_("Cannot coerce to too large *geMatrix with %.0f entries"), \ len); \ \ SET_SLOT(ans, Matrix_factorSym, allocVector(VECSXP, 0)); \ SET_SLOT(ans, Matrix_DimSym, duplicate(dd)); \ SET_DimNames(ans, x); \ SET_SLOT(ans, Matrix_xSym, allocVector(_SEXPTYPE_, (R_xlen_t)len)); \ _t1_ ## _insert_triplets_in_array(m, n, length(islot), \ INTEGER(islot), \ INTEGER(GET_SLOT(x, Matrix_jSym)),\ _SEXP_(GET_SLOT(x, Matrix_xSym)), \ _SEXP_(GET_SLOT(ans, Matrix_xSym))); \ UNPROTECT(1); \ return ans; \ } MAKE_gTMatrix_to_geMatrix(d, REALSXP, REAL) MAKE_gTMatrix_to_geMatrix(l, LGLSXP, LOGICAL) #undef MAKE_gTMatrix_to_geMatrix #define MAKE_gTMatrix_to_matrix(_t1_, _SEXPTYPE_, _SEXP_) \ SEXP _t1_ ## gTMatrix_to_matrix(SEXP x) \ { \ SEXP dd = GET_SLOT(x, Matrix_DimSym), \ dn = GET_SLOT(x, Matrix_DimNamesSym), \ islot = GET_SLOT(x, Matrix_iSym); \ int m = INTEGER(dd)[0], \ n = INTEGER(dd)[1]; \ SEXP ans = PROTECT(allocMatrix(_SEXPTYPE_, m, n)); \ if(VECTOR_ELT(dn, 0) != R_NilValue || VECTOR_ELT(dn, 1) != R_NilValue) \ /* matrix() with non-trivial dimnames */ \ setAttrib(ans, R_DimNamesSymbol, duplicate(dn)); \ _t1_ ## _insert_triplets_in_array(m, n, length(islot), \ INTEGER(islot), \ INTEGER(GET_SLOT(x, Matrix_jSym)),\ _SEXP_(GET_SLOT(x, Matrix_xSym)), \ _SEXP_(ans)); \ UNPROTECT(1); \ return ans; \ } MAKE_gTMatrix_to_matrix(d, REALSXP, REAL) MAKE_gTMatrix_to_matrix(l, LGLSXP, LOGICAL) #undef MAKE_gTMatrix_to_matrix Matrix/src/Mutils.h0000644000176200001440000003704714154104143013743 0ustar liggesusers#ifndef MATRIX_MUTILS_H #define MATRIX_MUTILS_H #undef Matrix_with_SPQR #ifdef __cplusplus extern "C" { #endif #include // C99 for int64_t #include #include /* includes Rconfig.h */ #include #include #include /* for Memzero() */ // previously from : #ifndef GET_SLOT # define GET_SLOT(x, what) R_do_slot(x, what) # define SET_SLOT(x, what, value) R_do_slot_assign(x, what, value) # define MAKE_CLASS(what) R_do_MAKE_CLASS(what) # define NEW_OBJECT(class_def) R_do_new_object(class_def) #endif // NB: For 'FCONE' etc (for LTO), the "includer" will #include "Lapack-etc.h" // -- #define imax2(x, y) ((x < y) ? y : x) #define imin2(x, y) ((x < y) ? x : y) // must come after above, for clang (2015-08-05) #ifdef __GNUC__ # undef alloca # define alloca(x) __builtin_alloca((x)) #elif defined(__sun) || defined(_AIX) /* this is necessary (and sufficient) for Solaris 10 and AIX 6: */ # include #endif /* For R >= 3.2.2, the 'elif' above shall be replaced by #elif defined(HAVE_ALLOCA_H) */ #ifdef ENABLE_NLS #include #define _(String) dgettext ("Matrix", String) #else #define _(String) (String) /* Note that this is not yet supported (for Windows, e.g.) in R 2.9.0 : */ #define dngettext(pkg, String, StringP, N) (N > 1 ? StringP : String) #endif #ifndef LONG_VECTOR_SUPPORT // notably for R <= 2.15.x : # define XLENGTH(x) LENGTH(x) # if R_VERSION < R_Version(2,16,0) typedef int R_xlen_t; # endif #endif #define Alloca(n, t) (t *) alloca( ((size_t) n) * sizeof(t) ) #define SMALL_4_Alloca 10000 // ==== R uses the same cutoff in several places #define C_or_Alloca_TO(_VAR_, _N_, _TYPE_) \ if(_N_ < SMALL_4_Alloca) { \ _VAR_ = Alloca(_N_, _TYPE_); R_CheckStack(); \ } else { \ _VAR_ = Calloc(_N_, _TYPE_); \ } // and user needs to if(_N_ >= SMALL_4_Alloca) Free(_VAR_); SEXP triangularMatrix_validate(SEXP obj); SEXP symmetricMatrix_validate(SEXP obj); SEXP dense_nonpacked_validate(SEXP obj); SEXP dim_validate(SEXP Dim, const char* name); SEXP Dim_validate(SEXP obj, SEXP name); SEXP dimNames_validate(SEXP obj); SEXP dimNames_validate__(SEXP dmNms, int dims[], const char* obj_name); // La_norm_type() & La_rcond_type() have been in R_ext/Lapack.h // but have still not been available to package writers ... char La_norm_type (const char *typstr); char La_rcond_type(const char *typstr); /* enum constants from cblas.h and some short forms */ enum CBLAS_ORDER {CblasRowMajor=101, CblasColMajor=102}; enum CBLAS_TRANSPOSE {CblasNoTrans=111, CblasTrans=112, CblasConjTrans=113}; enum CBLAS_UPLO {CblasUpper=121, CblasLower=122}; enum CBLAS_DIAG {CblasNonUnit=131, CblasUnit=132}; enum CBLAS_SIDE {CblasLeft=141, CblasRight=142}; #define RMJ CblasRowMajor #define CMJ CblasColMajor #define NTR CblasNoTrans #define TRN CblasTrans #define CTR CblasConjTrans #define UPP CblasUpper #define LOW CblasLower #define NUN CblasNonUnit #define UNT CblasUnit #define LFT CblasLeft #define RGT CblasRight double get_double_by_name(SEXP obj, char *nm); SEXP set_double_by_name(SEXP obj, double val, char *nm); SEXP as_det_obj(double val, int log, int sign); SEXP get_factors(SEXP obj, char *nm); SEXP set_factors(SEXP obj, SEXP val, char *nm); SEXP R_set_factors(SEXP obj, SEXP val, SEXP name, SEXP warn); SEXP R_empty_factors(SEXP obj, SEXP warn); #if 0 SEXP dgCMatrix_set_Dim(SEXP x, int nrow); #endif /* unused */ /* int csc_unsorted_columns(int ncol, const int p[], const int i[]); */ /* void csc_sort_columns(int ncol, const int p[], int i[], double x[]); */ /* SEXP csc_check_column_sorting(SEXP A); */ SEXP check_scalar_string(SEXP sP, char *vals, char *nm); Rboolean equal_string_vectors(SEXP s1, SEXP s2); void d_packed_getDiag(double *dest, SEXP x, int n); void l_packed_getDiag( int *dest, SEXP x, int n); SEXP d_packed_setDiag(double *diag, int l_d, SEXP x, int n); SEXP l_packed_setDiag( int *diag, int l_d, SEXP x, int n); SEXP d_packed_addDiag(double *diag, int l_d, SEXP x, int n); void tr_d_packed_getDiag(double *dest, SEXP x, int n); void tr_l_packed_getDiag( int *dest, SEXP x, int n); SEXP tr_d_packed_setDiag(double *diag, int l_d, SEXP x, int n); SEXP tr_l_packed_setDiag( int *diag, int l_d, SEXP x, int n); SEXP tr_d_packed_addDiag(double *diag, int l_d, SEXP x, int n); SEXP Matrix_getElement(SEXP list, char *nm); #define PACKED_TO_FULL(TYPE) \ TYPE *packed_to_full_ ## TYPE(TYPE *dest, const TYPE *src, \ int n, enum CBLAS_UPLO uplo) PACKED_TO_FULL(double); PACKED_TO_FULL(int); #undef PACKED_TO_FULL #define FULL_TO_PACKED(TYPE) \ TYPE *full_to_packed_ ## TYPE(TYPE *dest, const TYPE *src, int n, \ enum CBLAS_UPLO uplo, enum CBLAS_DIAG diag) FULL_TO_PACKED(double); FULL_TO_PACKED(int); #undef FULL_TO_PACKED extern /* stored pointers to symbols initialized in R_init_Matrix */ #include "Syms.h" /* zero an array */ #define AZERO(x, n) {int _I_, _SZ_ = (n); for(_I_ = 0; _I_ < _SZ_; _I_++) (x)[_I_] = 0;} /* number of elements in one triangle of a square matrix of order n */ #define PACKED_LENGTH(n) ((n) * ((n) + 1))/2 /* duplicate the slot with name given by sym from src to dest */ #define slot_dup(dest, src, sym) SET_SLOT(dest, sym, duplicate(GET_SLOT(src, sym))) /* is not yet used: */ #define slot_nonNull_dup(dest, src, sym) \ if(GET_SLOT(src, sym) != R_NilValue) \ SET_SLOT(dest, sym, duplicate(GET_SLOT(src, sym))) #define slot_dup_if_has(dest, src, sym) \ if(R_has_slot(src, sym)) \ SET_SLOT(dest, sym, duplicate(GET_SLOT(src, sym))) static R_INLINE void SET_DimNames(SEXP dest, SEXP src) { SEXP dn = GET_SLOT(src, Matrix_DimNamesSym); // Be fast (do nothing!) for the case where dimnames = list(NULL,NULL) : if (!(isNull(VECTOR_ELT(dn,0)) && isNull(VECTOR_ELT(dn,1)))) SET_SLOT(dest, Matrix_DimNamesSym, duplicate(dn)); } // code in ./Mutils.c : SEXP symmetric_DimNames(SEXP dn); SEXP R_symmetric_Dimnames(SEXP x); void SET_DimNames_symm(SEXP dest, SEXP src); #define uplo_P(_x_) CHAR(STRING_ELT(GET_SLOT(_x_, Matrix_uploSym), 0)) #define diag_P(_x_) CHAR(STRING_ELT(GET_SLOT(_x_, Matrix_diagSym), 0)) #define Diag_P(_x_) (R_has_slot(x, Matrix_diagSym) ? \ CHAR(STRING_ELT(GET_SLOT(_x_, Matrix_diagSym), 0)) : " ") #define class_P(_x_) CHAR(asChar(getAttrib(_x_, R_ClassSymbol))) enum dense_enum { ddense, ldense, ndense }; // Define this "Cholmod compatible" to some degree enum x_slot_kind { x_unknown=-2, x_pattern=-1, x_double=0, x_logical=1, x_integer=2, x_complex=3}; // NA n d l i z // FIXME: use 'x_slot_kind' instead of 'int' everywhere Real_(KIND2?|kind) is used /* should also work for "matrix" matrices: */ #define Real_KIND(_x_) (IS_S4_OBJECT(_x_) ? Real_kind(_x_) : \ (isReal(_x_) ? x_double : (isLogical(_x_) ? x_logical : x_pattern))) /* This one gives 'x_double' also for integer "matrix" :*/ #define Real_KIND2(_x_) (IS_S4_OBJECT(_x_) ? Real_kind(_x_) : \ (isLogical(_x_) ? x_logical : x_double)) /* requires 'x' slot, i.e., not for ..nMatrix. FIXME ? via R_has_slot(obj, name) */ #define Real_kind(_x_) (isReal(GET_SLOT(_x_, Matrix_xSym)) ? x_double : \ (isLogical(GET_SLOT(_x_, Matrix_xSym)) ? x_logical : x_pattern)) #define DECLARE_AND_GET_X_SLOT(__C_TYPE, __SEXP) \ __C_TYPE *xx = __SEXP(GET_SLOT(x, Matrix_xSym)) /** * Check for valid length of a packed triangular array and return the * corresponding number of columns * * @param len length of a packed triangular array * * @return number of columns */ static R_INLINE int packed_ncol(int len) { int disc = 8 * len + 1; /* discriminant */ int sqrtd = (int) sqrt((double) disc); if (len < 0 || disc != sqrtd * sqrtd) error(_("invalid 'len' = %d in packed_ncol")); return (sqrtd - 1)/2; } /** * Allocate an SEXP of given type and length, assign it as slot nm in * the object, and return the SEXP. The validity of this function * depends on SET_SLOT not duplicating val when NAMED(val) == 0. If * this behavior changes then ALLOC_SLOT must use SET_SLOT followed by * GET_SLOT to ensure that the value returned is indeed the SEXP in * the slot. * NOTE: GET_SLOT(x, what) :== R_do_slot (x, what) * ---- SET_SLOT(x, what, value) :== R_do_slot_assign(x, what, value) * and the R_do_slot* are in src/main/attrib.c * * @param obj object in which to assign the slot * @param nm name of the slot, as an R name object * @param type type of SEXP to allocate * @param length length of SEXP to allocate * * @return SEXP of given type and length assigned as slot nm in obj */ static R_INLINE SEXP ALLOC_SLOT(SEXP obj, SEXP nm, SEXPTYPE type, R_xlen_t length) { SEXP val = allocVector(type, length); SET_SLOT(obj, nm, val); return val; } /** * Expand compressed pointers in the array mp into a full set of indices * in the array mj. * * @param ncol number of columns (or rows) * @param mp column pointer vector of length ncol + 1 * @param mj vector of length mp[ncol] to hold the result * * @return mj */ static R_INLINE int* expand_cmprPt(int ncol, const int mp[], int mj[]) { int j; for (j = 0; j < ncol; j++) { int j2 = mp[j+1], jj; for (jj = mp[j]; jj < j2; jj++) mj[jj] = j; } return mj; } /** * Check if slot(obj, "x") contains any NA (or NaN). * * @param obj a 'Matrix' object with a (double precision) 'x' slot. * * @return Rboolean :== any(is.na(slot(obj, "x") ) */ static R_INLINE Rboolean any_NA_in_x(SEXP obj) { double *x = REAL(GET_SLOT(obj, Matrix_xSym)); int i, n = LENGTH(GET_SLOT(obj, Matrix_xSym)); for(i=0; i < n; i++) if(ISNAN(x[i])) return TRUE; /* else */ return FALSE; } /** Inverse Permutation * C version of .inv.perm.R <- function(p) { p[p] <- seq_along(p) ; p } */ static R_INLINE SEXP inv_permutation(SEXP p_, SEXP zero_p, SEXP zero_res) { int np = 1; if(!isInteger(p_)) {p_ = PROTECT(coerceVector(p_, INTSXP)); np++; } int *p = INTEGER(p_), n = LENGTH(p_); SEXP val = PROTECT(allocVector(INTSXP, n)); int *v = INTEGER(val), p_0 = asLogical(zero_p), r_0 = asLogical(zero_res); if(!p_0) v--; // ==> use 1-based indices // shorter (but not 100% sure if ok: is LHS always eval'ed *before* RHS ?) : // for(int i=0; i < n; ) v[p[i]] = ++i; for(int i=0; i < n; ) { int j = p[i]; v[j] = (r_0) ? i++ : ++i; } UNPROTECT(np); return val; } SEXP Mmatrix(SEXP args); void make_d_matrix_triangular(double *x, SEXP from); void make_i_matrix_triangular( int *x, SEXP from); void make_d_matrix_symmetric(double *to, SEXP from); void make_i_matrix_symmetric( int *to, SEXP from); SEXP Matrix_expand_pointers(SEXP pP); SEXP dup_mMatrix_as_dgeMatrix2(SEXP A, Rboolean tr_if_vec); SEXP dup_mMatrix_as_dgeMatrix (SEXP A); SEXP dup_mMatrix_as_geMatrix (SEXP A); SEXP new_dgeMatrix(int nrow, int ncol); SEXP m_encodeInd (SEXP ij, SEXP di, SEXP orig_1, SEXP chk_bnds); SEXP m_encodeInd2(SEXP i, SEXP j, SEXP di, SEXP orig_1, SEXP chk_bnds); SEXP R_rbind2_vector(SEXP a, SEXP b); SEXP R_all0(SEXP x); SEXP R_any0(SEXP x); static R_INLINE SEXP mMatrix_as_dgeMatrix(SEXP A) { return strcmp(class_P(A), "dgeMatrix") ? dup_mMatrix_as_dgeMatrix(A) : A; } static R_INLINE SEXP mMatrix_as_dgeMatrix2(SEXP A, Rboolean tr_if_vec) { return strcmp(class_P(A), "dgeMatrix") ? dup_mMatrix_as_dgeMatrix2(A, tr_if_vec) : A; } static R_INLINE SEXP mMatrix_as_geMatrix(SEXP A) { return strcmp(class_P(A) + 1, "geMatrix") ? dup_mMatrix_as_geMatrix(A) : A; } // Keep centralized --- *and* in sync with ../inst/include/Matrix.h : #define MATRIX_VALID_ge_dense \ "dmatrix", "dgeMatrix", \ "lmatrix", "lgeMatrix", \ "nmatrix", "ngeMatrix", \ "zmatrix", "zgeMatrix" /* NB: ddiMatrix & ldiMatrix are part of VALID_ddense / VALID_ldense * -- even though they are no longer "denseMatrix" formally. * CARE: dup_mMatrix_as_geMatrix() code depends on 14 ddense and 6 ldense * ---- entries here : */ #define MATRIX_VALID_ddense \ "dgeMatrix", "dtrMatrix", \ "dsyMatrix", "dpoMatrix", "ddiMatrix", \ "dtpMatrix", "dspMatrix", "dppMatrix", \ /* sub classes of those above:*/ \ /* dtr */ "Cholesky", "LDL", "BunchKaufman",\ /* dtp */ "pCholesky", "pBunchKaufman", \ /* dpo */ "corMatrix" #define MATRIX_VALID_ldense \ "lgeMatrix", "ltrMatrix", \ "lsyMatrix", "ldiMatrix", \ "ltpMatrix", "lspMatrix" #define MATRIX_VALID_ndense \ "ngeMatrix", "ntrMatrix", \ "nsyMatrix", \ "ntpMatrix", "nspMatrix" #define MATRIX_VALID_dCsparse \ "dgCMatrix", "dsCMatrix", "dtCMatrix" #define MATRIX_VALID_nCsparse \ "ngCMatrix", "nsCMatrix", "ntCMatrix" #define MATRIX_VALID_Csparse \ MATRIX_VALID_dCsparse, \ "lgCMatrix", "lsCMatrix", "ltCMatrix", \ MATRIX_VALID_nCsparse, \ "zgCMatrix", "zsCMatrix", "ztCMatrix" #define MATRIX_VALID_Tsparse \ "dgTMatrix", "dsTMatrix", "dtTMatrix", \ "lgTMatrix", "lsTMatrix", "ltTMatrix", \ "ngTMatrix", "nsTMatrix", "ntTMatrix", \ "zgTMatrix", "zsTMatrix", "ztTMatrix" #define MATRIX_VALID_Rsparse \ "dgRMatrix", "dsRMatrix", "dtRMatrix", \ "lgRMatrix", "lsRMatrix", "ltRMatrix", \ "ngRMatrix", "nsRMatrix", "ntRMatrix", \ "zgRMatrix", "zsRMatrix", "ztRMatrix" #define MATRIX_VALID_tri_Csparse \ "dtCMatrix", "ltCMatrix", "ntCMatrix", "ztCMatrix" #define MATRIX_VALID_sym_Csparse \ "dsCMatrix", "lsCMatrix", "nsCMatrix", "zsCMatrix" #ifdef __UN_USED__ #define MATRIX_VALID_tri_sparse \ "dtCMatrix", "dtTMatrix", "dtRMatrix", \ "ltCMatrix", "ltTMatrix", "ltRMatrix", \ "ntCMatrix", "ntTMatrix", "ntRMatrix", \ "ztCMatrix", "ztTMatrix", "ztRMatrix" #define MATRIX_VALID_tri_dense \ "dtrMatrix", "dtpMatrix" \ "ltrMatrix", "ltpMatrix" \ "ntrMatrix", "ntpMatrix" \ "ztrMatrix", "ztpMatrix" #endif #define MATRIX_VALID_CHMfactor "dCHMsuper", "dCHMsimpl", "nCHMsuper", "nCHMsimpl" /** * Return the 0-based index of a string match in a vector of strings * terminated by an empty string. Returns -1 for no match. * Is __cheap__ : __not__ looking at superclasses --> better use R_check_class_etc(obj, *) * * @param class string to match * @param valid vector of possible matches terminated by an empty string * * @return index of match or -1 for no match */ static R_INLINE int Matrix_check_class(char *class, const char **valid) { int ans; for (ans = 0; ; ans++) { if (!strlen(valid[ans])) return -1; if (!strcmp(class, valid[ans])) return ans; } } /** * These are the ones "everyone" should use -- is() versions, also looking * at super classes: * They now use R(semi_API) from Rinternals.h : * int R_check_class_and_super(SEXP x, const char **valid, SEXP rho); * int R_check_class_etc (SEXP x, const char **valid); * R_check_class_etc (x, v) basically does rho <- .classEnv(x) and then calls * R_check_class_and_super(x, v, rho) */ // No longer: #ifdef DEPRECATED_Matrix_check_class_ # define Matrix_check_class_etc R_check_class_etc # define Matrix_check_class_and_super R_check_class_and_super #endif SEXP NEW_OBJECT_OF_CLASS(const char* cls); /** Accessing *sparseVectors : fast (and recycling) v[i] for v = ?sparseVector: * -> ./sparseVector.c -> ./t_sparseVector.c : */ // Type_ans sparseVector_sub(int64_t i, int nnz_v, int* v_i, Type_ans* v_x, int len_v): /* Define all of * dsparseVector_sub(....) * isparseVector_sub(....) * lsparseVector_sub(....) * nsparseVector_sub(....) * zsparseVector_sub(....) */ #define _dspV_ #include "t_sparseVector.c" #define _ispV_ #include "t_sparseVector.c" #define _lspV_ #include "t_sparseVector.c" #define _nspV_ #include "t_sparseVector.c" #define _zspV_ #include "t_sparseVector.c" #ifdef __cplusplus } #endif #endif /* MATRIX_MUTILS_H_ */ Matrix/src/lgCMatrix.c0000644000176200001440000000346414060416534014355 0ustar liggesusers#include "lgCMatrix.h" #include "dgCMatrix.h" /* validate: -> xCMatrix_validate() in ./dgCMatrix.c */ SEXP lgC_to_matrix(SEXP x) { SEXP ans, pslot = GET_SLOT(x, Matrix_pSym), dn = GET_SLOT(x, Matrix_DimNamesSym); int j, ncol = length(pslot) - 1, nrow = INTEGER(GET_SLOT(x, Matrix_DimSym))[0], *xp = INTEGER(pslot), *xi = INTEGER(GET_SLOT(x, Matrix_iSym)); int *xx = LOGICAL(GET_SLOT(x, Matrix_xSym)), *ax; ax = LOGICAL(ans = PROTECT(allocMatrix(LGLSXP, nrow, ncol))); for (j = 0; j < (nrow * ncol); j++) ax[j] = 0; for (j = 0; j < ncol; j++) { int ind; for (ind = xp[j]; ind < xp[j+1]; ind++) ax[j * (size_t)nrow + xi[ind]] = xx[ind]; } if (!(isNull(VECTOR_ELT(dn,0)) && isNull(VECTOR_ELT(dn,1)))) setAttrib(ans, R_DimNamesSymbol, duplicate(dn)); UNPROTECT(1); return ans; } /* as above, '1' instead of 'x' slot: */ SEXP ngC_to_matrix(SEXP x) { SEXP ans, pslot = GET_SLOT(x, Matrix_pSym), dn = GET_SLOT(x, Matrix_DimNamesSym); int j, ncol = length(pslot) - 1, nrow = INTEGER(GET_SLOT(x, Matrix_DimSym))[0], *xp = INTEGER(pslot), *xi = INTEGER(GET_SLOT(x, Matrix_iSym)); int *ax; ax = LOGICAL(ans = PROTECT(allocMatrix(LGLSXP, nrow, ncol))); for (j = 0; j < (nrow * ncol); j++) ax[j] = 0; for (j = 0; j < ncol; j++) { int ind; for (ind = xp[j]; ind < xp[j+1]; ind++) ax[j * (size_t)nrow + xi[ind]] = 1; } if (!(isNull(VECTOR_ELT(dn,0)) && isNull(VECTOR_ELT(dn,1)))) setAttrib(ans, R_DimNamesSymbol, duplicate(dn)); UNPROTECT(1); return ans; } #ifdef _NEED_logical_to_csc_FIRST_ /* very parallel to matrix_to_csc() in ./dgCMatrix.c */ SEXP matrix_to_lcsc(SEXP A) { if (!(isMatrix(A) && isLogical(A))) error(_("A must be a logical matrix")); return logical_to_csc(LOGICAL(A), INTEGER(getAttrib(A, R_DimSymbol))); } #endif Matrix/src/dense.c0000644000176200001440000004540414060416534013561 0ustar liggesusers#include "dense.h" #include "Mutils.h" #include "chm_common.h" /** * Perform a left cyclic shift of columns j to k in the upper triangular * matrix x, then restore it to upper triangular form with Givens rotations. * The algorithm is based on the Fortran routine DCHEX from Linpack. * * The lower triangle of x is not modified. * * @param x Matrix stored in column-major order * @param ldx leading dimension of x * @param j column number (0-based) that will be shifted to position k * @param k last column number (0-based) to be shifted * @param cosines cosines of the Givens rotations * @param sines sines of the Givens rotations * * @return 0 for success */ static int left_cyclic(double x[], int ldx, int j, int k, double cosines[], double sines[]) { if (j >= k) error(_("incorrect left cyclic shift, j (%d) >= k (%d)"), j, k); if (j < 0) error(_("incorrect left cyclic shift, j (%d) < 0"), j, k); if (ldx < k) error(_("incorrect left cyclic shift, k (%d) > ldx (%d)"), k, ldx); double *lastcol = (double*) R_alloc(k+1, sizeof(double)); int i; /* keep a copy of column j */ for(i = 0; i <= j; i++) lastcol[i] = x[i + j*ldx]; /* For safety, zero the rest */ for(i = j+1; i <= k; i++) lastcol[i] = 0.; for(int jj = j+1, ind = 0; jj <= k; jj++, ind++) { /* columns to be shifted */ int diagind = jj*(ldx+1); // ind == (jj-j) - 1 double tmp = x[diagind], cc, ss; /* Calculate the Givens rotation. */ /* This modified the super-diagonal element */ F77_CALL(drotg)(x + diagind-1, &tmp, cosines + ind, sines + ind); cc = cosines[ind]; ss = sines[ind]; /* Copy column jj+1 to column jj. */ for(i = 0; i < jj; i++) x[i + (jj-1)*ldx] = x[i+jj*ldx]; /* Apply rotation to columns up to k */ for(i = jj; i < k; i++) { tmp = cc*x[(jj-1)+i*ldx] + ss*x[jj+i*ldx]; x[jj+i*ldx] = cc*x[jj+i*ldx] - ss*x[(jj-1)+i*ldx]; x[(jj-1)+i*ldx] = tmp; } /* Apply rotation to lastcol */ lastcol[jj] = -ss*lastcol[jj-1]; lastcol[jj-1] *= cc; } /* Copy lastcol to column k */ for(i = 0; i <= k; i++) x[i+k*ldx] = lastcol[i]; return 0; } static SEXP getGivens(double x[], int ldx, int jmin, int rank) { int shiftlen = (rank - jmin) - 1; SEXP ans = PROTECT(allocVector(VECSXP, 4)), nms, cosines, sines; SET_VECTOR_ELT(ans, 0, ScalarInteger(jmin)); SET_VECTOR_ELT(ans, 1, ScalarInteger(rank)); SET_VECTOR_ELT(ans, 2, cosines = allocVector(REALSXP, shiftlen)); SET_VECTOR_ELT(ans, 3, sines = allocVector(REALSXP, shiftlen)); setAttrib(ans, R_NamesSymbol, nms = allocVector(STRSXP, 4)); SET_STRING_ELT(nms, 0, mkChar("jmin")); SET_STRING_ELT(nms, 1, mkChar("rank")); SET_STRING_ELT(nms, 2, mkChar("cosines")); SET_STRING_ELT(nms, 3, mkChar("sines")); if (left_cyclic(x, ldx, jmin, rank - 1, REAL(cosines), REAL(sines))) error(_("Unknown error in getGivens")); UNPROTECT(1); return ans; } SEXP checkGivens(SEXP X, SEXP jmin, SEXP rank) { SEXP ans = PROTECT(allocVector(VECSXP, 2)), Xcp = PROTECT(duplicate(X)); int *Xdims; if (!(isReal(X) & isMatrix(X))) error(_("X must be a numeric (double precision) matrix")); Xdims = INTEGER(coerceVector(getAttrib(X, R_DimSymbol), INTSXP)); SET_VECTOR_ELT(ans, 1, getGivens(REAL(Xcp), Xdims[0], asInteger(jmin), asInteger(rank))); SET_VECTOR_ELT(ans, 0, Xcp); UNPROTECT(2); return ans; } SEXP lsq_dense_Chol(SEXP X, SEXP y) { SEXP ans; double d_one = 1., d_zero = 0.; if (!(isReal(X) & isMatrix(X))) error(_("X must be a numeric (double precision) matrix")); int *Xdims = INTEGER(coerceVector(getAttrib(X, R_DimSymbol), INTSXP)), n = Xdims[0], p = Xdims[1]; if (!(isReal(y) & isMatrix(y))) error(_("y must be a numeric (double precision) matrix")); int *ydims = INTEGER(coerceVector(getAttrib(y, R_DimSymbol), INTSXP)); if (ydims[0] != n) error(_( "number of rows in y (%d) does not match number of rows in X (%d)"), ydims[0], n); int k = ydims[1]; if (k < 1 || p < 1) return allocMatrix(REALSXP, p, k); ans = PROTECT(allocMatrix(REALSXP, p, k)); F77_CALL(dgemm)("T", "N", &p, &k, &n, &d_one, REAL(X), &n, REAL(y), &n, &d_zero, REAL(ans), &p FCONE FCONE); double *xpx = (double *) R_alloc(p * p, sizeof(double)); F77_CALL(dsyrk)("U", "T", &p, &n, &d_one, REAL(X), &n, &d_zero, xpx, &p FCONE FCONE); int info; F77_CALL(dposv)("U", &p, &k, xpx, &p, REAL(ans), &p, &info FCONE); if (info) error(_("Lapack routine dposv returned error code %d"), info); UNPROTECT(1); return ans; } SEXP lsq_dense_QR(SEXP X, SEXP y) { if (!(isReal(X) & isMatrix(X))) error(_("X must be a numeric (double precision) matrix")); int *Xdims = INTEGER(coerceVector(getAttrib(X, R_DimSymbol), INTSXP)), n = Xdims[0], p = Xdims[1]; if (!(isReal(y) & isMatrix(y))) error(_("y must be a numeric (double precision) matrix")); int *ydims = INTEGER(coerceVector(getAttrib(y, R_DimSymbol), INTSXP)); if (ydims[0] != n) error(_( "number of rows in y (%d) does not match number of rows in X (%d)"), ydims[0], n); int k = ydims[1]; if (k < 1 || p < 1) return allocMatrix(REALSXP, p, k); double tmp, *xvals = (double *) Memcpy(R_alloc(n * p, sizeof(double)), REAL(X), n * p); SEXP ans = PROTECT(duplicate(y)); int lwork = -1, info; F77_CALL(dgels)("N", &n, &p, &k, xvals, &n, REAL(ans), &n, &tmp, &lwork, &info FCONE); if (info) error(_("First call to Lapack routine dgels returned error code %d"), info); lwork = (int) tmp; double *work = (double *) R_alloc(lwork, sizeof(double)); F77_CALL(dgels)("N", &n, &p, &k, xvals, &n, REAL(ans), &n, work, &lwork, &info FCONE); if (info) error(_("Second call to Lapack routine dgels returned error code %d"), info); UNPROTECT(1); return ans; } /* Rank-Correcting/Adapting LAPACK QR Decomposition * From Doug Bates' initial import; __unused__ * Provides a qr() with 'rcond' and rank reduction while(rcond < tol), * possibly via Givens rotations but WITHOUT PIVOTING * .Call(Matrix:::lapack_qr, A, 1e-17) --> ~/R/MM/Pkg-ex/Matrix/qr-rank-deficient.R * TODO: export as Matrix::qrNoPiv() or qr1() or similar */ SEXP lapack_qr(SEXP Xin, SEXP tl) { if (!(isReal(Xin) & isMatrix(Xin))) error(_("X must be a real (numeric) matrix")); double tol = asReal(tl); if (tol < 0.) error(_("tol, given as %g, must be non-negative"), tol); if (tol > 1.) error(_("tol, given as %g, must be <= 1"), tol); SEXP ans = PROTECT(allocVector(VECSXP,5)), X, qraux, pivot; SET_VECTOR_ELT(ans, 0, X = duplicate(Xin)); int *Xdims = INTEGER(coerceVector(getAttrib(X, R_DimSymbol), INTSXP)), n = Xdims[0], i, p = Xdims[1], trsz = (n < p) ? n : p ; /* size of triangular part of decomposition */ SET_VECTOR_ELT(ans, 2, qraux = allocVector(REALSXP, trsz)); SET_VECTOR_ELT(ans, 3, pivot = allocVector(INTSXP, p)); for (i = 0; i < p; i++) INTEGER(pivot)[i] = i + 1; SEXP nms, Givens = PROTECT(allocVector(VECSXP, trsz - 1)); setAttrib(ans, R_NamesSymbol, nms = allocVector(STRSXP, 5)); SET_STRING_ELT(nms, 0, mkChar("qr")); SET_STRING_ELT(nms, 1, mkChar("rank")); SET_STRING_ELT(nms, 2, mkChar("qraux")); SET_STRING_ELT(nms, 3, mkChar("pivot")); SET_STRING_ELT(nms, 4, mkChar("Givens")); int rank = trsz, nGivens = 0; double rcond = 0.; if (n > 0 && p > 0) { int info, *iwork, lwork; double *xpt = REAL(X), *work, tmp; lwork = -1; F77_CALL(dgeqrf)(&n, &p, xpt, &n, REAL(qraux), &tmp, &lwork, &info); if (info) error(_("First call to dgeqrf returned error code %d"), info); lwork = (int) tmp; work = (double *) R_alloc((lwork < 3*trsz) ? 3*trsz : lwork, sizeof(double)); F77_CALL(dgeqrf)(&n, &p, xpt, &n, REAL(qraux), work, &lwork, &info); if (info) error(_("Second call to dgeqrf returned error code %d"), info); iwork = (int *) R_alloc(trsz, sizeof(int)); F77_CALL(dtrcon)("1", "U", "N", &rank, xpt, &n, &rcond, work, iwork, &info FCONE FCONE FCONE); if (info) error(_("Lapack routine dtrcon returned error code %d"), info); while (rcond < tol) { /* check diagonal elements */ double minabs = (xpt[0] < 0.) ? -xpt[0]: xpt[0]; int jmin = 0; for (i = 1; i < rank; i++) { double el = xpt[i*n]; // had i*(n+1) which looks wrong to MM if(el < 0.) el = -el; if (el < minabs) { jmin = i; minabs = el; } } if (jmin < (rank - 1)) { SET_VECTOR_ELT(Givens, nGivens, getGivens(xpt, n, jmin, rank)); nGivens++; } // otherwise jmin == (rank - 1) , so just "drop that column" rank--; // new rcond := ... for reduced rank F77_CALL(dtrcon)("1", "U", "N", &rank, xpt, &n, &rcond, work, iwork, &info FCONE FCONE FCONE); if (info) error(_("Lapack routine dtrcon returned error code %d"), info); } } SEXP Gcpy, sym; SET_VECTOR_ELT(ans, 4, Gcpy = allocVector(VECSXP, nGivens)); for (i = 0; i < nGivens; i++) SET_VECTOR_ELT(Gcpy, i, VECTOR_ELT(Givens, i)); SET_VECTOR_ELT(ans, 1, ScalarInteger(rank)); sym = PROTECT(install("useLAPACK")); setAttrib(ans, sym, ScalarLogical(1)); UNPROTECT(1); sym = PROTECT(install("rcond")); setAttrib(ans, sym, ScalarReal(rcond));UNPROTECT(1); UNPROTECT(2); return ans; } SEXP dense_to_Csparse(SEXP x) { SEXP ge_x = PROTECT(mMatrix_as_geMatrix(x)), Dim = GET_SLOT(ge_x, Matrix_DimSym); int *dims = INTEGER(Dim); Rboolean longi = (dims[0] * (double)dims[1] > INT_MAX); // int itype = longi ? CHOLMOD_LONG : CHOLMOD_INT; CHM_DN chxd = AS_CHM_xDN(ge_x); // cholmod_dense (has no itype) CHM_SP chxs; /* cholmod_dense_to_sparse() in CHOLMOD/Core/ below does only work for "REAL" 'xtypes', i.e. *not* for "nMatrix". ===> need "_x" in above AS_CHM_xDN() call. Also it cannot keep symmetric / triangular, hence the as_geMatrix() above. Note that this is already a *waste* for symmetric matrices; However, we could conceivably use an enhanced cholmod_dense_to_sparse(), with an extra boolean argument for symmetry. */ #define DLONG /* You can try defining DLONG -- then just get a seg.fault : * I think it is because of this in ./CHOLMOD/Include/cholmod_core.h : * The itype of all parameters for all CHOLMOD routines must match. --- ^^^^^ ------------------------------------------------------ but then as_cholmod_dense should *not* make a difference: cholmod_dense has *no* itype (????) */ if(longi) { // calling cholmod_dense_to_sparse() gives wrong matrix #ifdef DLONG chxs = cholmod_l_dense_to_sparse(chxd, 1, &cl); // in gdb, I found that 'chxs' seems "basically empty": all // p chxs->foo give ''Cannot access memory at address 0x....'' // for now rather give error: if(cl.status) error(_("dense_to_Csparse(): cholmod_l_dense_to_sparse failure status=%d"), cl.status); #else error(_("Matrix dimension %d x %d (= %g) too large [FIXME calling cholmod_l_dense_to_sparse]"), m,n, m * (double)n); #endif } else { // fits, using integer (instead of long int) 'itype' chxs = cholmod_dense_to_sparse(chxd, 1, &c); } int Rkind = (chxd->xtype == CHOLMOD_REAL) ? Real_KIND2(x) : 0; /* Note: when 'x' was integer Matrix, Real_KIND(x) = -1, but *_KIND2(.) = 0 */ R_CheckStack(); UNPROTECT(1); /* chm_sparse_to_SEXP() *could* deal with symmetric * if chxs had such an stype; and we should be able to use uplo below */ return chm_sparse_to_SEXP(chxs, 1, 0/*TODO: uplo_P(x) if x has an uplo slot*/, Rkind, "", isMatrix(x) ? getAttrib(x, R_DimNamesSymbol) : GET_SLOT(x, Matrix_DimNamesSym)); } SEXP dense_band(SEXP x, SEXP k1P, SEXP k2P) /* Always returns a full matrix with entries outside the band zeroed * Class of the value can be [dln]trMatrix or [dln]geMatrix */ { int k1 = asInteger(k1P), k2 = asInteger(k2P); if (k1 > k2) { error(_("Lower band %d > upper band %d"), k1, k2); return R_NilValue; /* -Wall */ } else { SEXP ans = PROTECT(dup_mMatrix_as_geMatrix(x)); int *adims = INTEGER(GET_SLOT(ans, Matrix_DimSym)), j, m = adims[0], n = adims[1], sqr = (adims[0] == adims[1]), tru = (k1 >= 0), trl = (k2 <= 0); const char *cl = class_P(ans); enum dense_enum M_type = ( (cl[0] == 'd') ? ddense : ((cl[0] == 'l') ? ldense : ndense)); #define SET_ZERO_OUTSIDE \ for (j = 0; j < n; j++) { \ int i, i1 = j - k2, i2 = j + 1 - k1; \ R_xlen_t jm = j * (R_xlen_t) m; \ if(i1 > m) i1 = m; \ if(i2 < 0) i2 = 0; \ for (i = 0; i < i1; i++) xx[i + jm] = 0; \ for (i = i2; i < m; i++) xx[i + jm] = 0; \ } if(M_type == ddense) { double *xx = REAL(GET_SLOT(ans, Matrix_xSym)); SET_ZERO_OUTSIDE } else { /* (M_type == ldense || M_type == ndense) */ int *xx = LOGICAL(GET_SLOT(ans, Matrix_xSym)); SET_ZERO_OUTSIDE } if (!sqr || (!tru && !trl)) { /* return the *geMatrix */ UNPROTECT(1); return ans; } else { /* Copy ans to a *trMatrix object (must be square) */ SEXP aa= PROTECT(NEW_OBJECT_OF_CLASS(M_type == ddense? "dtrMatrix": (M_type== ldense? "ltrMatrix": "ntrMatrix"))); /* Because slots of ans are freshly allocated and ans will not be * used, we use the slots themselves and don't duplicate */ SET_SLOT(aa, Matrix_xSym, GET_SLOT(ans, Matrix_xSym)); SET_SLOT(aa, Matrix_DimSym, GET_SLOT(ans, Matrix_DimSym)); SET_SLOT(aa, Matrix_DimNamesSym,GET_SLOT(ans, Matrix_DimNamesSym)); SET_SLOT(aa, Matrix_diagSym, mkString("N")); SET_SLOT(aa, Matrix_uploSym, mkString(tru ? "U" : "L")); UNPROTECT(2); return aa; } } } SEXP dense_to_symmetric(SEXP x, SEXP uplo, SEXP symm_test) /* Class of result will be [dln]syMatrix */ { /*== FIXME: allow uplo = NA and then behave a bit like symmpart(): *== ----- would use the *dimnames* to determine U or L (??) */ int symm_tst = asLogical(symm_test); SEXP dx = PROTECT(dup_mMatrix_as_geMatrix(x)); SEXP ans, dns, nms_dns; const char *cl = class_P(dx); /* same as in ..._geMatrix() above:*/ enum dense_enum M_type = ( (cl[0] == 'd') ? ddense : ((cl[0] == 'l') ? ldense : ndense)); int *adims = INTEGER(GET_SLOT(dx, Matrix_DimSym)), n = adims[0]; if(n != adims[1]) { UNPROTECT(1); error(_("ddense_to_symmetric(): matrix is not square!")); return R_NilValue; /* -Wall */ } if(symm_tst) { int i,j; R_xlen_t n_ = n; # define CHECK_SYMMETRIC \ for (j = 0; j < n; j++) \ for (i = 0; i < j; i++) \ if(xx[j * n_ + i] != xx[i * n_ + j]) { \ UNPROTECT(1); \ error(_("matrix is not symmetric [%d,%d]"), i+1, j+1); \ return R_NilValue; /* -Wall */ \ } if(M_type == ddense) { double *xx = REAL(GET_SLOT(dx, Matrix_xSym)); CHECK_SYMMETRIC } else { /* (M_type == ldense || M_type == ndense) */ int *xx = LOGICAL(GET_SLOT(dx, Matrix_xSym)); CHECK_SYMMETRIC } } # undef CHECK_SYMMETRIC ans = PROTECT(NEW_OBJECT_OF_CLASS(M_type == ddense ? "dsyMatrix" : (M_type == ldense ? "lsyMatrix" : "nsyMatrix"))); // --- FIXME: Use MK_SYMMETRIC_DIMNAMES_AND_RETURN from below -- with "uplo" argument /* need _symmetric_ dimnames */ dns = GET_SLOT(dx, Matrix_DimNamesSym); if(!equal_string_vectors(VECTOR_ELT(dns,0), VECTOR_ELT(dns,1))) { if(*CHAR(asChar(uplo)) == 'U') SET_VECTOR_ELT(dns,0, VECTOR_ELT(dns,1)); else SET_VECTOR_ELT(dns,1, VECTOR_ELT(dns,0)); } nms_dns = PROTECT(getAttrib(dns, R_NamesSymbol)); if(!isNull(nms_dns) && !R_compute_identical(STRING_ELT(nms_dns, 0), STRING_ELT(nms_dns, 1), 16)) { // names(dimnames(.)) : if(*CHAR(asChar(uplo)) == 'U') SET_STRING_ELT(nms_dns, 0, STRING_ELT(nms_dns,1)); else SET_STRING_ELT(nms_dns, 1, STRING_ELT(nms_dns,0)); setAttrib(dns, R_NamesSymbol, nms_dns); } /* Copy dx to ans; * Because slots of dx are freshly allocated and dx will not be * used, we use the slots themselves and don't duplicate */ SET_SLOT(ans, Matrix_xSym, GET_SLOT(dx, Matrix_xSym)); SET_SLOT(ans, Matrix_DimSym, GET_SLOT(dx, Matrix_DimSym)); SET_SLOT(ans, Matrix_DimNamesSym, dns); SET_SLOT(ans, Matrix_uploSym, ScalarString(asChar(uplo))); UNPROTECT(3); return ans; } SEXP ddense_symmpart(SEXP x) /* Class of the value will be dsyMatrix */ { SEXP dx = PROTECT(dup_mMatrix_as_dgeMatrix(x)); int *adims = INTEGER(GET_SLOT(dx, Matrix_DimSym)), n = adims[0]; if(n != adims[1]) { error(_("matrix is not square! (symmetric part)")); return R_NilValue; /* -Wall */ } else { SEXP ans = PROTECT(NEW_OBJECT_OF_CLASS("dsyMatrix")), dns, nms_dns; double *xx = REAL(GET_SLOT(dx, Matrix_xSym)); /* only need to assign the *upper* triangle (uplo = "U"); * noting that diagonal remains unchanged */ R_xlen_t n_ = n; for (int j = 0; j < n; j++) { for (int i = 0; i < j; i++) { xx[j * n_ + i] = (xx[j * n_ + i] + xx[i * n_ + j]) / 2.; } } // FIXME?: Compare and synchronize with symmetric_DimNames() in ./Mutils.c # define MK_SYMMETRIC_DIMNAMES_AND_RETURN \ \ dns = GET_SLOT(dx, Matrix_DimNamesSym); \ int J = 1; \ if(!equal_string_vectors(VECTOR_ELT(dns,0), \ VECTOR_ELT(dns,1))) { \ /* _symmetric_ dimnames: behave as symmDN(*, col=TRUE) */ \ if(isNull(VECTOR_ELT(dns, J))) \ J = !J; \ SET_VECTOR_ELT(dns, !J, VECTOR_ELT(dns, J)); \ } \ /* names(dimnames(.)): */ \ nms_dns = PROTECT(getAttrib(dns, R_NamesSymbol)); \ if(!isNull(nms_dns) && \ !R_compute_identical(STRING_ELT(nms_dns, 0), \ STRING_ELT(nms_dns, 1), 16)) { \ SET_STRING_ELT(nms_dns, !J, STRING_ELT(nms_dns, J)); \ setAttrib(dns, R_NamesSymbol, nms_dns); \ } \ \ /* Copy dx to ans; \ * Because slots of dx are freshly allocated and dx will not be \ * used, we use the slots themselves and don't duplicate */ \ \ SET_SLOT(ans, Matrix_xSym, GET_SLOT(dx, Matrix_xSym)); \ SET_SLOT(ans, Matrix_DimSym, GET_SLOT(dx, Matrix_DimSym)); \ SET_SLOT(ans, Matrix_DimNamesSym, dns); \ SET_SLOT(ans, Matrix_uploSym, mkString("U")); \ \ UNPROTECT(3); \ return ans MK_SYMMETRIC_DIMNAMES_AND_RETURN; } } SEXP ddense_skewpart(SEXP x) /* Class of the value will be dgeMatrix */ { SEXP dx = PROTECT(dup_mMatrix_as_dgeMatrix(x)); int *adims = INTEGER(GET_SLOT(dx, Matrix_DimSym)), n = adims[0]; if(n != adims[1]) { error(_("matrix is not square! (skew-symmetric part)")); return R_NilValue; /* -Wall */ } else { SEXP ans = PROTECT(NEW_OBJECT_OF_CLASS("dgeMatrix")), dns, nms_dns; double *xx = REAL(GET_SLOT(dx, Matrix_xSym)); R_xlen_t n_ = n; for (int j = 0; j < n_; j++) { xx[j * n_ + j] = 0.; for (int i = 0; i < j; i++) { double s = (xx[j * n_ + i] - xx[i * n_ + j]) / 2.; xx[j * n_ + i] = s; xx[i * n_ + j] = -s; } } MK_SYMMETRIC_DIMNAMES_AND_RETURN; } } Matrix/src/dtrMatrix.c0000644000176200001440000002734614060416534014446 0ustar liggesusers/* double (precision) TRiangular Matrices */ #include "dtrMatrix.h" SEXP triangularMatrix_validate(SEXP obj) { SEXP val = GET_SLOT(obj, Matrix_DimSym); if (LENGTH(val) < 2) return mkString(_("'Dim' slot has length less than two")); if (INTEGER(val)[0] != INTEGER(val)[1]) return mkString(_("Matrix is not square")); if (isString(val = check_scalar_string(GET_SLOT(obj, Matrix_uploSym), "LU", "uplo"))) return val; if (isString(val = check_scalar_string(GET_SLOT(obj, Matrix_diagSym), "NU", "diag"))) return val; return ScalarLogical(1); } static double get_norm(SEXP obj, const char *typstr) { char typnm[] = {'\0', '\0'}; int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)); double *work = (double *) NULL; typnm[0] = La_norm_type(typstr); if (*typnm == 'I') { work = (double *) R_alloc(dims[0], sizeof(double)); } return F77_CALL(dlantr)(typnm, uplo_P(obj), diag_P(obj), dims, dims+1, REAL(GET_SLOT(obj, Matrix_xSym)), dims, work FCONE FCONE FCONE); } SEXP dtrMatrix_norm(SEXP obj, SEXP type) { return ScalarReal(get_norm(obj, CHAR(asChar(type)))); } SEXP dtrMatrix_rcond(SEXP obj, SEXP type) { char typnm[] = {'\0', '\0'}; int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)), info; double rcond; typnm[0] = La_rcond_type(CHAR(asChar(type))); F77_CALL(dtrcon)(typnm, uplo_P(obj), diag_P(obj), dims, REAL(GET_SLOT(obj, Matrix_xSym)), dims, &rcond, (double *) R_alloc(3*dims[0], sizeof(double)), (int *) R_alloc(dims[0], sizeof(int)), &info FCONE FCONE FCONE); return ScalarReal(rcond); } SEXP dtrMatrix_solve(SEXP a) { SEXP val = PROTECT(duplicate(a)); int info, *Dim = INTEGER(GET_SLOT(val, Matrix_DimSym)); F77_CALL(dtrtri)(uplo_P(val), diag_P(val), Dim, REAL(GET_SLOT(val, Matrix_xSym)), Dim, &info FCONE FCONE); UNPROTECT(1); return val; } SEXP dtrMatrix_chol2inv(SEXP a) { SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("dpoMatrix")); int info, n; slot_dup(val, a, Matrix_DimSym); slot_dup(val, a, Matrix_uploSym); slot_dup(val, a, Matrix_diagSym); slot_dup(val, a, Matrix_DimNamesSym); slot_dup(val, a, Matrix_xSym); n = *INTEGER(GET_SLOT(val, Matrix_DimSym)); F77_CALL(dpotri)(uplo_P(val), &n, REAL(GET_SLOT(val, Matrix_xSym)), &n, &info FCONE); UNPROTECT(1); return val; } SEXP dtrMatrix_matrix_solve(SEXP a, SEXP b) { SEXP ans = PROTECT(dup_mMatrix_as_dgeMatrix(b)); int *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)), *bdims = INTEGER(GET_SLOT(ans, Matrix_DimSym)); int n = bdims[0], nrhs = bdims[1]; double one = 1.0; if (adims[0] != n || n != adims[1]) error(_("Dimensions of system to be solved are inconsistent")); F77_CALL(dtrsm)("L", uplo_P(a), "N", diag_P(a), &n, &nrhs, &one, REAL(GET_SLOT(a, Matrix_xSym)), &n, REAL(GET_SLOT(ans, Matrix_xSym)), &n FCONE FCONE FCONE FCONE); UNPROTECT(1); return ans; } // to be used for all three: '%*%', crossprod() and tcrossprod() /** Matrix products dense triangular Matrices o * * @param a triangular matrix of class "dtrMatrix" * @param b a or * @param right logical, if true, compute b %*% a, else a %*% b * @param trans logical, if true, "transpose a", i.e., use t(a), otherwise a * * @return the matrix product, one of a %*% b, t(a) %*% b, b %*% a, or b %*% t(a) * depending on (right, trans) = (F, F) (F, T) (T, F) (T, T) */ SEXP dtrMatrix_matrix_mm(SEXP a, SEXP b, SEXP right, SEXP trans) { /* called from "%*%", crossprod() and tcrossprod() in ../R/products.R * * Because 'a' must be square, the size of the answer 'val', * is the same as the size of 'b' */ SEXP val = PROTECT(dup_mMatrix_as_dgeMatrix(b)); int rt = asLogical(right); /* if(rt), compute b %*% op(a), else op(a) %*% b */ int tr = asLogical(trans);/* if true, use t(a) */ int *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)), *bdims = INTEGER(GET_SLOT(val, Matrix_DimSym)); int m = bdims[0], n = bdims[1]; double one = 1.; if (adims[0] != adims[1]) error(_("dtrMatrix must be square")); if ((rt && adims[0] != n) || (!rt && adims[1] != m)) error(_("Matrices are not conformable for multiplication")); if (m >= 1 && n >= 1) { // Level 3 BLAS - DTRMM() --> see call further below F77_CALL(dtrmm)(rt ? "R" : "L", uplo_P(a), /*trans_A = */ tr ? "T" : "N", diag_P(a), &m, &n, &one, REAL(GET_SLOT(a, Matrix_xSym)), adims, REAL(GET_SLOT(val, Matrix_xSym)), &m FCONE FCONE FCONE FCONE); } SEXP dn_a = GET_SLOT( a, Matrix_DimNamesSym), dn = GET_SLOT(val, Matrix_DimNamesSym); /* matrix product a %*% b, t(a) %*% b, b %*% a, or b %*% t(a) * (right, trans) = (F, F) (F, T) (T, F) (T, T) * set:from_a = 0:0 0:1 1:1 1:0 */ SET_VECTOR_ELT(dn, rt ? 1 : 0, VECTOR_ELT(dn_a, (rt+tr) % 2)); UNPROTECT(1); return val; } /** Matrix products of dense triangular Matrices * * @param a triangular matrix of class "dtrMatrix" * @param b ( ditto ) * @param right logical, if true, compute b %*% a, else a %*% b * @param trans logical, if true, "transpose a", i.e., use t(a), otherwise a * * @return the matrix product, one of a %*% b, t(a) %*% b, b %*% a, or b %*% t(a) * depending on (right, trans) = (F, F) (F, T) (T, F) (T, T) */ SEXP dtrMatrix_dtrMatrix_mm(SEXP a, SEXP b, SEXP right, SEXP trans) { /* called from "%*%" : (x,y, FALSE,FALSE), crossprod() : (x,y, FALSE, TRUE) , and tcrossprod(): (y,x, TRUE , TRUE) * - * TWO cases : (1) result is triangular <=> uplo's "match" (i.e., non-equal iff trans) * === (2) result is "general" */ SEXP val,/* = in case (2): PROTECT(dup_mMatrix_as_dgeMatrix(b)); */ d_a = GET_SLOT(a, Matrix_DimSym), uplo_a = GET_SLOT(a, Matrix_uploSym), diag_a = GET_SLOT(a, Matrix_diagSym), uplo_b = GET_SLOT(b, Matrix_uploSym), diag_b = GET_SLOT(b, Matrix_diagSym); int rt = asLogical(right); int tr = asLogical(trans); int *adims = INTEGER(d_a), n = adims[0]; double *valx = (double *) NULL /*Wall*/; const char *uplo_a_ch = CHAR(STRING_ELT(uplo_a, 0)), /* = uplo_P(a) */ *diag_a_ch = CHAR(STRING_ELT(diag_a, 0)), /* = diag_P(a) */ *uplo_b_ch = CHAR(STRING_ELT(uplo_b, 0)), /* = uplo_P(b) */ *diag_b_ch = CHAR(STRING_ELT(diag_b, 0)); /* = diag_P(b) */ Rboolean same_uplo = (*uplo_a_ch == *uplo_b_ch), matching_uplo = tr ? (!same_uplo) : same_uplo, uDiag_b = /* -Wall: */ FALSE; if (INTEGER(GET_SLOT(b, Matrix_DimSym))[0] != n) /* validity checking already "assures" square matrices ... */ error(_("dimension mismatch in matrix multiplication of \"dtrMatrix\": %d != %d"), n, INTEGER(GET_SLOT(b, Matrix_DimSym))[0]); if(matching_uplo) { /* ==> result is triangular -- "dtrMatrix" ! * val := dup_mMatrix_as_dtrMatrix(b) : */ R_xlen_t sz = n * (R_xlen_t) n, np1 = n+1; val = PROTECT(NEW_OBJECT_OF_CLASS("dtrMatrix")); SET_SLOT(val, Matrix_uploSym, duplicate(uplo_b)); SET_SLOT(val, Matrix_DimSym, duplicate(d_a)); SET_DimNames(val, b); valx = REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, sz)); Memcpy(valx, REAL(GET_SLOT(b, Matrix_xSym)), sz); if((uDiag_b = (*diag_b_ch == 'U'))) { /* unit-diagonal b - may contain garbage in diagonal */ for (int i = 0; i < n; i++) valx[i * np1] = 1.; } } else { /* different "uplo" ==> result is "dgeMatrix" ! */ val = PROTECT(dup_mMatrix_as_dgeMatrix(b)); SEXP dn_a = GET_SLOT( a , Matrix_DimNamesSym), dn = GET_SLOT(val, Matrix_DimNamesSym); /* matrix product a %*% b, t(a) %*% b, b %*% a, or b %*% t(a) * (right, trans) = (F, F) (F, T) (T, F) (T, T) * set:from_a = 0:0 0:1 1:1 1:0 */ SET_VECTOR_ELT(dn, rt ? 1 : 0, VECTOR_ELT(dn_a, (rt+tr) % 2)); } if (n >= 1) { double alpha = 1.; /* Level 3 BLAS - DTRMM(): Compute one of the matrix multiplication operations * B := alpha*op( A )*B ["L"], or B := alpha*B*op( A ) ["R"], * where trans_A determines op(A):= A "N"one or * op(A):= t(A) "T"ransposed */ F77_CALL(dtrmm)(rt ? "R" : "L", uplo_a_ch, /*trans_A = */ tr ? "T" : "N", diag_a_ch, &n, &n, &alpha, REAL(GET_SLOT(a, Matrix_xSym)), adims, REAL(GET_SLOT(val, Matrix_xSym)), &n FCONE FCONE FCONE FCONE); } if(matching_uplo) { make_d_matrix_triangular(valx, tr ? b : a); /* set "other triangle" to 0 */ if(*diag_a_ch == 'U' && uDiag_b) /* result remains uni-diagonal */ SET_SLOT(val, Matrix_diagSym, duplicate(diag_a)); } UNPROTECT(1); return val; } SEXP dtrMatrix_as_matrix(SEXP from, SEXP keep_dimnames) { int *Dim = INTEGER(GET_SLOT(from, Matrix_DimSym)); int m = Dim[0], n = Dim[1]; SEXP val = PROTECT(allocMatrix(REALSXP, m, n)); make_d_matrix_triangular(Memcpy(REAL(val), REAL(GET_SLOT(from, Matrix_xSym)), m * n), from); if(asLogical(keep_dimnames)) setAttrib(val, R_DimNamesSymbol, GET_SLOT(from, Matrix_DimNamesSym)); UNPROTECT(1); return val; } #define GET_trMatrix_Diag(_C_TYPE_, _SEXPTYPE_, _SEXP_, _ONE_) \ int i, n = INTEGER(GET_SLOT(x, Matrix_DimSym))[0]; \ SEXP x_x = GET_SLOT(x, Matrix_xSym); \ \ SEXP ret = PROTECT(allocVector(_SEXPTYPE_, n)); \ _C_TYPE_ *rv = _SEXP_(ret), \ *xv = _SEXP_(x_x); \ \ if ('U' == diag_P(x)[0]) { \ for (i = 0; i < n; i++) rv[i] = _ONE_; \ } else { \ for (i = 0; i < n; i++) rv[i] = xv[i * (n + 1)]; \ } \ UNPROTECT(1); \ return ret SEXP dtrMatrix_getDiag(SEXP x) { GET_trMatrix_Diag(double, REALSXP, REAL, 1.); } SEXP ltrMatrix_getDiag(SEXP x) { GET_trMatrix_Diag( int, LGLSXP, LOGICAL, 1); } #define SET_trMatrix_Diag(_C_TYPE_, _SEXP_) \ if ('U' == diag_P(x)[0]) \ error(_("cannot set diag() as long as 'diag = \"U\"'")); \ /* careful to recycle RHS value: */ \ int n = INTEGER(GET_SLOT(x, Matrix_DimSym))[0]; \ int l_d = LENGTH(d); Rboolean d_full = (l_d == n); \ if (!d_full && l_d != 1) \ error(_("replacement diagonal has wrong length")); \ SEXP ret = PROTECT(duplicate(x)), \ r_x = GET_SLOT(ret, Matrix_xSym); \ _C_TYPE_ *dv = _SEXP_(d), \ *rv = _SEXP_(r_x); \ \ if(d_full) for (int i = 0; i < n; i++) \ rv[i * (n + 1)] = dv[i]; \ else for (int i = 0; i < n; i++) \ rv[i * (n + 1)] = *dv; \ \ UNPROTECT(1); \ return ret SEXP dtrMatrix_setDiag(SEXP x, SEXP d) { SET_trMatrix_Diag(double, REAL); } SEXP ltrMatrix_setDiag(SEXP x, SEXP d) { SET_trMatrix_Diag( int, LOGICAL); } SEXP dtrMatrix_addDiag(SEXP x, SEXP d) { int n = INTEGER(GET_SLOT(x, Matrix_DimSym))[0]; SEXP ret = PROTECT(duplicate(x)), r_x = GET_SLOT(ret, Matrix_xSym); double *dv = REAL(d), *rv = REAL(r_x); if ('U' == diag_P(x)[0]) error(_("cannot add diag() as long as 'diag = \"U\"'")); for (int i = 0; i < n; i++) rv[i * (n + 1)] += dv[i]; UNPROTECT(1); return ret; } SEXP dtrMatrix_as_dtpMatrix(SEXP from) { SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("dtpMatrix")), uplo = GET_SLOT(from, Matrix_uploSym), diag = GET_SLOT(from, Matrix_diagSym), dimP = GET_SLOT(from, Matrix_DimSym); int n = *INTEGER(dimP); SET_SLOT(val, Matrix_DimSym, duplicate(dimP)); SET_SLOT(val, Matrix_diagSym, duplicate(diag)); SET_SLOT(val, Matrix_uploSym, duplicate(uplo)); full_to_packed_double( REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, (n*(n+1))/2)), REAL(GET_SLOT(from, Matrix_xSym)), n, *CHAR(STRING_ELT(uplo, 0)) == 'U' ? UPP : LOW, *CHAR(STRING_ELT(diag, 0)) == 'U' ? UNT : NUN); SET_SLOT(val, Matrix_DimNamesSym, duplicate(GET_SLOT(from, Matrix_DimNamesSym))); UNPROTECT(1); return val; } Matrix/src/dppMatrix.h0000644000176200001440000000055113774624325014444 0ustar liggesusers#ifndef MATRIX_PPMATRIX_H #define MATRIX_PPMATRIX_H #include "Lapack-etc.h" #include "Mutils.h" #include "dspMatrix.h" SEXP dppMatrix_rcond(SEXP obj, SEXP type); SEXP dppMatrix_validate(SEXP obj); SEXP dppMatrix_solve(SEXP a); SEXP dppMatrix_matrix_solve(SEXP a, SEXP b); SEXP dppMatrix_chol(SEXP x); double get_norm_sp(SEXP obj, const char *typstr); #endif Matrix/src/dgeMatrix.c0000644000176200001440000007150014060416534014403 0ustar liggesusers#include "dgeMatrix.h" // -> Mutils.h etc SEXP dMatrix_validate(SEXP obj) { SEXP x = GET_SLOT(obj, Matrix_xSym), Dim = GET_SLOT(obj, Matrix_DimSym); if (!isReal(x)) return mkString(_("x slot must be numeric \"double\"")); SEXP val; if (isString(val = dim_validate(Dim, "Matrix"))) return val; return ScalarLogical(1); } SEXP dgeMatrix_validate(SEXP obj) { SEXP val; if (isString(val = dim_validate(GET_SLOT(obj, Matrix_DimSym), "dgeMatrix"))) return(val); if (isString(val = dense_nonpacked_validate(obj))) return(val); SEXP fact = GET_SLOT(obj, Matrix_factorSym); if (length(fact) > 0 && getAttrib(fact, R_NamesSymbol) == R_NilValue) return mkString(_("factors slot must be named list")); return ScalarLogical(1); } static double get_norm(SEXP obj, const char *typstr) { if(any_NA_in_x(obj)) return NA_REAL; else { char typnm[] = {'\0', '\0'}; int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)); double *work = (double *) NULL; typnm[0] = La_norm_type(typstr); if (*typnm == 'I') { work = (double *) R_alloc(dims[0], sizeof(double)); } return F77_CALL(dlange)(typstr, dims, dims+1, REAL(GET_SLOT(obj, Matrix_xSym)), dims, work FCONE); } } SEXP dgeMatrix_norm(SEXP obj, SEXP type) { return ScalarReal(get_norm(obj, CHAR(asChar(type)))); } SEXP dgeMatrix_rcond(SEXP obj, SEXP type) { SEXP LU = PROTECT(dgeMatrix_LU_(obj, FALSE));/* <- not warning about singularity */ char typnm[] = {'\0', '\0'}; int *dims = INTEGER(GET_SLOT(LU, Matrix_DimSym)), info; double anorm, rcond; if (dims[0] != dims[1] || dims[0] < 1) { UNPROTECT(1); error(_("rcond requires a square, non-empty matrix")); } typnm[0] = La_rcond_type(CHAR(asChar(type))); anorm = get_norm(obj, typnm); F77_CALL(dgecon)(typnm, dims, REAL(GET_SLOT(LU, Matrix_xSym)), dims, &anorm, &rcond, (double *) R_alloc(4*dims[0], sizeof(double)), (int *) R_alloc(dims[0], sizeof(int)), &info FCONE); UNPROTECT(1); return ScalarReal(rcond); } SEXP dgeMatrix_crossprod(SEXP x, SEXP trans) { #define DGE_CROSS_1 \ int tr = asLogical(trans);/* trans=TRUE: tcrossprod(x) */ \ SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("dpoMatrix")), \ vDnms = PROTECT(ALLOC_SLOT(val, Matrix_DimNamesSym, VECSXP, 2)),\ nms = VECTOR_ELT(GET_SLOT(x, Matrix_DimNamesSym), tr ? 0 : 1); \ int *Dims = INTEGER(GET_SLOT(x, Matrix_DimSym)), \ *vDims = INTEGER(ALLOC_SLOT(val, Matrix_DimSym, INTSXP, 2)); \ int k = tr ? Dims[1] : Dims[0], \ n = tr ? Dims[0] : Dims[1]; \ R_xlen_t n_ = n, n2 = n_ * n_; \ double *vx = REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, n2)), \ one = 1.0, zero = 0.0; \ \ Memzero(vx, n2); \ SET_SLOT(val, Matrix_uploSym, mkString("U")); \ ALLOC_SLOT(val, Matrix_factorSym, VECSXP, 0); \ vDims[0] = vDims[1] = n; \ SET_VECTOR_ELT(vDnms, 0, duplicate(nms)); \ SET_VECTOR_ELT(vDnms, 1, duplicate(nms)) #define DGE_CROSS_DO(_X_X_) \ if(n) \ F77_CALL(dsyrk)("U", tr ? "N" : "T", &n, &k, &one, \ _X_X_, Dims, &zero, vx, &n FCONE FCONE); \ UNPROTECT(2); \ return val DGE_CROSS_1; DGE_CROSS_DO(REAL(GET_SLOT(x, Matrix_xSym))); } double* gematrix_real_x(SEXP x, int nn) { if(class_P(x)[0] == 'd') // <<- FIXME: use R_check_class_etc(x, valid) !!! return REAL(GET_SLOT(x, Matrix_xSym)); #ifdef _potentically_more_efficient_but_not_working // else : 'l' or 'n' (for now !!) int *xi = INTEGER(GET_SLOT(x, Matrix_xSym)); double *x_x; C_or_Alloca_TO(x_x, nn, double); for(int i=0; i < nn; i++) x_x[i] = (double) xi[i]; // FIXME: this is not possible either; the *caller* would have to Free(.) if(nn >= SMALL_4_Alloca) Free(x_x); #else // ideally should be PROTECT()ed ==> make sure R does not run gc() now! double *x_x = REAL(coerceVector(GET_SLOT(x, Matrix_xSym), REALSXP)); #endif return x_x; } //! As dgeMatrix_crossprod(), but x can be [dln]geMatrix SEXP _geMatrix_crossprod(SEXP x, SEXP trans) { DGE_CROSS_1; double *x_x = gematrix_real_x(x, k * n_); DGE_CROSS_DO(x_x); } SEXP geMatrix_crossprod(SEXP x, SEXP trans) { SEXP y = PROTECT(dup_mMatrix_as_geMatrix(x)), val = _geMatrix_crossprod(y, trans); UNPROTECT(1); return val; } SEXP dgeMatrix_dgeMatrix_crossprod(SEXP x, SEXP y, SEXP trans) { #define DGE_DGE_CROSS_1 \ int tr = asLogical(trans);/* trans=TRUE: tcrossprod(x,y) */ \ SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("dgeMatrix")), \ dn = PROTECT(allocVector(VECSXP, 2)); \ int *xDims = INTEGER(GET_SLOT(x, Matrix_DimSym)), \ *yDims = INTEGER(GET_SLOT(y, Matrix_DimSym)), \ *vDims; \ int m = xDims[!tr], n = yDims[!tr];/* -> result dim */ \ int xd = xDims[ tr], yd = yDims[ tr];/* the conformable dims */ \ double one = 1.0, zero = 0.0; \ \ if (xd != yd) \ error(_("Dimensions of x and y are not compatible for %s"), \ tr ? "tcrossprod" : "crossprod"); \ SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0)); \ /* establish dimnames */ \ SET_VECTOR_ELT(dn, 0, \ duplicate(VECTOR_ELT(GET_SLOT(x, Matrix_DimNamesSym), \ tr ? 0 : 1))); \ SET_VECTOR_ELT(dn, 1, \ duplicate(VECTOR_ELT(GET_SLOT(y, Matrix_DimNamesSym), \ tr ? 0 : 1))); \ SET_SLOT(val, Matrix_DimNamesSym, dn); \ vDims = INTEGER(ALLOC_SLOT(val, Matrix_DimSym, INTSXP, 2)); \ vDims[0] = m; vDims[1] = n; \ double *v = REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, m * (R_xlen_t) n)) #define DGE_DGE_CROSS_DO(_X_X_, _Y_Y_) \ if (xd > 0 && n > 0 && m > 0) \ F77_CALL(dgemm)(tr ? "N" : "T", tr ? "T" : "N", &m, &n, &xd, &one, \ _X_X_, xDims, \ _Y_Y_, yDims, &zero, v, &m FCONE FCONE); \ else \ Memzero(v, m * (R_xlen_t) n); \ UNPROTECT(2); \ return val DGE_DGE_CROSS_1; DGE_DGE_CROSS_DO(REAL(GET_SLOT(x, Matrix_xSym)), REAL(GET_SLOT(y, Matrix_xSym))); } //! As dgeMatrix_dgeMatrix_crossprod(), but x and y can be [dln]geMatrix SEXP _geMatrix__geMatrix_crossprod(SEXP x, SEXP y, SEXP trans) { DGE_DGE_CROSS_1; double *x_x = gematrix_real_x(x, m * (R_xlen_t) xd); double *y_x = gematrix_real_x(y, n * (R_xlen_t) yd); DGE_DGE_CROSS_DO(x_x, y_x); } #undef DGE_DGE_CROSS_1 #undef DGE_DGE_CROSS_DO SEXP geMatrix_geMatrix_crossprod(SEXP x, SEXP y, SEXP trans) { SEXP gx = PROTECT(dup_mMatrix_as_geMatrix(x)), gy = PROTECT(dup_mMatrix_as_geMatrix(y)), val = _geMatrix__geMatrix_crossprod(gx, gy, trans); UNPROTECT(2); return val; } SEXP dgeMatrix_matrix_crossprod(SEXP x, SEXP y, SEXP trans) { #define DGE_MAT_CROSS_1 \ int tr = asLogical(trans);/* trans=TRUE: tcrossprod(x,y) */ \ SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("dgeMatrix")), \ dn = PROTECT(allocVector(VECSXP, 2)), \ yDnms = R_NilValue, yD; \ int *xDims = INTEGER(GET_SLOT(x, Matrix_DimSym)), \ *yDims, *vDims, nprot = 2; \ int m = xDims[!tr], \ xd = xDims[ tr]; \ double one = 1.0, zero = 0.0; \ Rboolean y_has_dimNames; \ \ if (!isReal(y)) { \ if(isInteger(y) || isLogical(y)) { \ y = PROTECT(coerceVector(y, REALSXP)); \ nprot++; \ } \ else \ error(_("Argument y must be numeric, integer or logical")); \ } \ if(isMatrix(y)) { \ yDims = INTEGER(getAttrib(y, R_DimSymbol)); \ yDnms = getAttrib(y, R_DimNamesSymbol); \ y_has_dimNames = yDnms != R_NilValue; \ } else { /* ! matrix */ \ yDims = INTEGER(yD = PROTECT(allocVector(INTSXP, 2))); nprot++; \ if(xDims[0] == 1) { \ /* "new" (2014-10-10): "be tolerant" as for R 3.2.0*/ \ yDims[0] = 1; \ yDims[1] = LENGTH(y); \ } else { \ yDims[0] = LENGTH(y); \ yDims[1] = 1; \ } \ y_has_dimNames = FALSE; \ } \ int n = yDims[!tr],/* (m,n) -> result dim */ \ yd = yDims[ tr];/* (xd,yd): the conformable dims */ \ if (xd != yd) \ error(_("Dimensions of x and y are not compatible for %s"), \ tr ? "tcrossprod" : "crossprod"); \ SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0)); \ vDims = INTEGER(ALLOC_SLOT(val, Matrix_DimSym, INTSXP, 2)); \ vDims[0] = m; vDims[1] = n; \ /* establish dimnames */ \ SET_VECTOR_ELT(dn, 0, \ duplicate(VECTOR_ELT(GET_SLOT(x, Matrix_DimNamesSym), \ tr ? 0 : 1))); \ if(y_has_dimNames) \ SET_VECTOR_ELT(dn, 1, \ duplicate(VECTOR_ELT(yDnms, tr ? 0 : 1))); \ SET_SLOT(val, Matrix_DimNamesSym, dn); \ \ double *v = REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, m * (R_xlen_t) n)) #define DGE_MAT_CROSS_DO(_X_X_) \ if (xd > 0 && n > 0 && m > 0) \ F77_CALL(dgemm)(tr ? "N" : "T", tr ? "T" : "N", &m, &n, &xd, &one, \ _X_X_, xDims, REAL(y), yDims, \ &zero, v, &m FCONE FCONE); \ else \ Memzero(v, m * (R_xlen_t) n); \ UNPROTECT(nprot); \ return val DGE_MAT_CROSS_1; DGE_MAT_CROSS_DO(REAL(GET_SLOT(x, Matrix_xSym))); } //! as dgeMatrix_matrix_crossprod() but x can be [dln]geMatrix SEXP _geMatrix_matrix_crossprod(SEXP x, SEXP y, SEXP trans) { DGE_MAT_CROSS_1; double *x_x = gematrix_real_x(x, m * (R_xlen_t) xd); DGE_MAT_CROSS_DO(x_x); } SEXP geMatrix_matrix_crossprod(SEXP x, SEXP y, SEXP trans) { SEXP dx = PROTECT(dup_mMatrix_as_geMatrix(x)), val = _geMatrix_matrix_crossprod(dx, y, trans); UNPROTECT(1); return val; } // right = TRUE: %*% is called as *(y, x, right=TRUE) SEXP dgeMatrix_matrix_mm(SEXP a, SEXP bP, SEXP right) { #define DGE_MAT_MM_1(N_PROT) \ SEXP val= PROTECT(NEW_OBJECT_OF_CLASS("dgeMatrix")), \ dn = PROTECT(allocVector(VECSXP, 2)); \ int nprot = N_PROT + 2, \ *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)), \ *bdims = INTEGER(GET_SLOT(b, Matrix_DimSym)), \ *cdims = INTEGER(ALLOC_SLOT(val, Matrix_DimSym, INTSXP, 2)), \ Rt = asLogical(right), m, k, n; \ double one = 1., zero = 0.; \ \ if (Rt) { /* b %*% a : (m x k) (k x n) -> (m x n) */ \ m = bdims[0]; k = bdims[1]; n = adims[1]; \ if (adims[0] != k) \ error(_("Matrices are not conformable for multiplication")); \ } else { /* a %*% b : (m x k) (k x n) -> (m x n) */ \ m = adims[0]; k = adims[1]; n = bdims[1]; \ if (bdims[0] != k) \ error(_("Matrices are not conformable for multiplication")); \ } \ \ cdims[0] = m; cdims[1] = n; \ /* establish dimnames */ \ SET_VECTOR_ELT(dn, 0, duplicate( \ VECTOR_ELT(GET_SLOT(Rt ? b : a, \ Matrix_DimNamesSym), 0))); \ SET_VECTOR_ELT(dn, 1, \ duplicate( \ VECTOR_ELT(GET_SLOT(Rt ? a : b, \ Matrix_DimNamesSym), 1))); \ SET_SLOT(val, Matrix_DimNamesSym, dn); \ double *v = REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, m * (R_xlen_t) n)) #define DGE_MAT_MM_DO(_A_X_, _B_X_) \ if (m < 1 || n < 1 || k < 1) {/* zero extent matrices should work */ \ Memzero(v, m * (R_xlen_t) n); \ } else { \ if (Rt) { /* b %*% a */ \ F77_CALL(dgemm) ("N", "N", &m, &n, &k, &one, \ _B_X_, &m, _A_X_, &k, &zero, v, &m FCONE FCONE); \ } else { /* a %*% b */ \ F77_CALL(dgemm) ("N", "N", &m, &n, &k, &one, \ _A_X_, &m, _B_X_, &k, &zero, v, &m FCONE FCONE); \ } \ } \ UNPROTECT(nprot); \ return val SEXP b = PROTECT(mMatrix_as_dgeMatrix(bP)); DGE_MAT_MM_1(1); DGE_MAT_MM_DO(REAL(GET_SLOT(a, Matrix_xSym)), REAL(GET_SLOT(b, Matrix_xSym))); } //! as dgeMatrix_matrix_mm() but a can be [dln]geMatrix SEXP _geMatrix_matrix_mm(SEXP a, SEXP b, SEXP right) { DGE_MAT_MM_1(0); double *a_x = gematrix_real_x(a, k * (R_xlen_t)(Rt ? n : m)); double *b_x = gematrix_real_x(b, k * (R_xlen_t)(Rt ? m : n)); DGE_MAT_MM_DO(a_x, b_x); } //! %*% -- generalized from dge to *ge(): SEXP geMatrix_matrix_mm(SEXP a, SEXP b, SEXP right) { SEXP da = PROTECT(dup_mMatrix_as_geMatrix(a)), db = PROTECT(dup_mMatrix_as_geMatrix(b)), val = _geMatrix_matrix_mm(da, db, right); UNPROTECT(2); return val; } //--------------------------------------------------------------------- SEXP dgeMatrix_getDiag(SEXP x) { #define geMatrix_getDiag_1 \ int *dims = INTEGER(GET_SLOT(x, Matrix_DimSym)); \ int i, m = dims[0], nret = (m < dims[1]) ? m : dims[1]; \ R_xlen_t m1 = m + 1; \ SEXP x_x = GET_SLOT(x, Matrix_xSym) geMatrix_getDiag_1; SEXP ret = PROTECT(allocVector(REALSXP, nret)); double *rv = REAL(ret), *xv = REAL(x_x); #define geMatrix_getDiag_2 \ for (i = 0; i < nret; i++) { \ rv[i] = xv[i * m1]; \ } \ UNPROTECT(1); \ return ret geMatrix_getDiag_2; } SEXP lgeMatrix_getDiag(SEXP x) { geMatrix_getDiag_1; SEXP ret = PROTECT(allocVector(LGLSXP, nret)); int *rv = LOGICAL(ret), *xv = LOGICAL(x_x); geMatrix_getDiag_2; } #undef geMatrix_getDiag_1 #undef geMatrix_getDiag_2 SEXP dgeMatrix_setDiag(SEXP x, SEXP d) { #define geMatrix_setDiag_1 \ int *dims = INTEGER(GET_SLOT(x, Matrix_DimSym)); \ int m = dims[0], nret = (m < dims[1]) ? m : dims[1]; \ SEXP ret = PROTECT(duplicate(x)); \ SEXP r_x = GET_SLOT(ret, Matrix_xSym); \ int l_d = LENGTH(d); Rboolean d_full = (l_d == nret); \ if (!d_full && l_d != 1) \ error(_("replacement diagonal has wrong length")) geMatrix_setDiag_1; double *dv = REAL(d), *rv = REAL(r_x); #define geMatrix_setDiag_2 \ R_xlen_t m1 = m + 1; \ if(d_full) for (int i = 0; i < nret; i++) \ rv[i * m1] = dv[i]; \ else for (int i = 0; i < nret; i++) \ rv[i * m1] = *dv; \ UNPROTECT(1); \ return ret geMatrix_setDiag_2; } SEXP lgeMatrix_setDiag(SEXP x, SEXP d) { geMatrix_setDiag_1; int *dv = INTEGER(d), *rv = INTEGER(r_x); geMatrix_setDiag_2; } #undef geMatrix_setDiag_1 #undef geMatrix_setDiag_2 SEXP dgeMatrix_addDiag(SEXP x, SEXP d) { int *dims = INTEGER(GET_SLOT(x, Matrix_DimSym)), m = dims[0], nret = (m < dims[1]) ? m : dims[1]; R_xlen_t m1 = m + 1; SEXP ret = PROTECT(duplicate(x)), r_x = GET_SLOT(ret, Matrix_xSym); double *dv = REAL(d), *rv = REAL(r_x); int l_d = LENGTH(d); Rboolean d_full = (l_d == nret); if (!d_full && l_d != 1) error(_("diagonal to be added has wrong length")); if(d_full) for (int i = 0; i < nret; i++) rv[i * m1] += dv[i]; else for (int i = 0; i < nret; i++) rv[i * m1] += *dv; UNPROTECT(1); return ret; } SEXP dgeMatrix_LU_(SEXP x, Rboolean warn_sing) { SEXP val = get_factors(x, "LU"); int *dims, npiv, info; if (val != R_NilValue) /* nothing to do if it's there in 'factors' slot */ return val; dims = INTEGER(GET_SLOT(x, Matrix_DimSym)); if (dims[0] < 1 || dims[1] < 1) error(_("Cannot factor a matrix with zero extents")); npiv = (dims[0] < dims[1]) ? dims[0] : dims[1]; val = PROTECT(NEW_OBJECT_OF_CLASS("denseLU")); slot_dup(val, x, Matrix_xSym); slot_dup(val, x, Matrix_DimSym); slot_dup(val, x, Matrix_DimNamesSym); F77_CALL(dgetrf)(dims, dims + 1, REAL(GET_SLOT(val, Matrix_xSym)), dims, INTEGER(ALLOC_SLOT(val, Matrix_permSym, INTSXP, npiv)), &info); if (info < 0) error(_("Lapack routine %s returned error code %d"), "dgetrf", info); else if (info > 0 && warn_sing) warning(_("Exact singularity detected during LU decomposition: %s, i=%d."), "U[i,i]=0", info); UNPROTECT(1); return set_factors(x, val, "LU"); } // FIXME: also allow an interface to LAPACK's dgesvx() which uses LU fact. // and then optionally does "equilibration" (row and column scaling) // maybe also allow low-level interface to dgeEQU() ... SEXP dgeMatrix_LU(SEXP x, SEXP warn_singularity) { return dgeMatrix_LU_(x, asLogical(warn_singularity)); } SEXP dgeMatrix_determinant(SEXP x, SEXP logarithm) { int lg = asLogical(logarithm); int *dims = INTEGER(GET_SLOT(x, Matrix_DimSym)), n = dims[0], sign = 1; double modulus = lg ? 0. : 1; /* initialize; = result for n == 0 */ if (n != dims[1]) error(_("Determinant requires a square matrix")); if (n > 0) { SEXP lu = dgeMatrix_LU_(x, /* do not warn about singular LU: */ FALSE); int i, *jpvt = INTEGER(GET_SLOT(lu, Matrix_permSym)); double *luvals = REAL(GET_SLOT(lu, Matrix_xSym)); for (i = 0; i < n; i++) if (jpvt[i] != (i + 1)) sign = -sign; if (lg) { for (i = 0; i < n; i++) { double dii = luvals[i*(n + 1)]; /* ith diagonal element */ modulus += log(dii < 0 ? -dii : dii); if (dii < 0) sign = -sign; } } else { for (i = 0; i < n; i++) modulus *= luvals[i*(n + 1)]; if (modulus < 0) { modulus = -modulus; sign = -sign; } } } return as_det_obj(modulus, lg, sign); } SEXP dgeMatrix_solve(SEXP a) { /* compute the 1-norm of the matrix, which is needed later for the computation of the reciprocal condition number. */ double aNorm = get_norm(a, "1"); /* the LU decomposition : */ SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("dgeMatrix")), lu = dgeMatrix_LU_(a, TRUE); int *dims = INTEGER(GET_SLOT(lu, Matrix_DimSym)), *pivot = INTEGER(GET_SLOT(lu, Matrix_permSym)); /* prepare variables for the dgetri calls */ double *x, tmp; int info, lwork = -1; if (dims[0] != dims[1]) error(_("Solve requires a square matrix")); slot_dup(val, lu, Matrix_xSym); x = REAL(GET_SLOT(val, Matrix_xSym)); slot_dup(val, lu, Matrix_DimSym); if(dims[0]) /* the dimension is not zero */ { /* is the matrix is *computationally* singular ? */ double rcond; F77_CALL(dgecon)("1", dims, x, dims, &aNorm, &rcond, (double *) R_alloc(4*dims[0], sizeof(double)), (int *) R_alloc(dims[0], sizeof(int)), &info FCONE); if (info) error(_("error [%d] from Lapack 'dgecon()'"), info); if(rcond < DOUBLE_EPS) error(_("Lapack dgecon(): system computationally singular, reciprocal condition number = %g"), rcond); /* only now try the inversion and check if the matrix is *exactly* singular: */ F77_CALL(dgetri)(dims, x, dims, pivot, &tmp, &lwork, &info); lwork = (int) tmp; F77_CALL(dgetri)(dims, x, dims, pivot, (double *) R_alloc((size_t) lwork, sizeof(double)), &lwork, &info); if (info) error(_("Lapack routine dgetri: system is exactly singular")); } UNPROTECT(1); return val; } SEXP dgeMatrix_matrix_solve(SEXP a, SEXP b) { SEXP val = PROTECT(dup_mMatrix_as_dgeMatrix(b)), lu = PROTECT(dgeMatrix_LU_(a, TRUE)); int *adims = INTEGER(GET_SLOT(lu, Matrix_DimSym)), *bdims = INTEGER(GET_SLOT(val, Matrix_DimSym)); int info, n = bdims[0], nrhs = bdims[1]; if (adims[0] != n || adims[1] != n) error(_("Dimensions of system to be solved are inconsistent")); if(nrhs >= 1 && n >= 1) { F77_CALL(dgetrs)("N", &n, &nrhs, REAL(GET_SLOT(lu, Matrix_xSym)), &n, INTEGER(GET_SLOT(lu, Matrix_permSym)), REAL(GET_SLOT(val, Matrix_xSym)), &n, &info FCONE); if (info) error(_("Lapack routine dgetrs: system is exactly singular")); } UNPROTECT(2); return val; } SEXP dgeMatrix_svd(SEXP x, SEXP nnu, SEXP nnv) { int /* nu = asInteger(nnu), nv = asInteger(nnv), */ *dims = INTEGER(GET_SLOT(x, Matrix_DimSym)); double *xx = REAL(GET_SLOT(x, Matrix_xSym)); SEXP val = PROTECT(allocVector(VECSXP, 3)); if (dims[0] && dims[1]) { int m = dims[0], n = dims[1], mm = (m < n)?m:n, lwork = -1, info; double tmp, *work; int *iwork, n_iw = 8 * mm; if(8 * (double)mm != n_iw) // integer overflow error(_("dgeMatrix_svd(x,*): dim(x)[j] = %d is too large"), mm); C_or_Alloca_TO(iwork, n_iw, int); SET_VECTOR_ELT(val, 0, allocVector(REALSXP, mm)); SET_VECTOR_ELT(val, 1, allocMatrix(REALSXP, m, mm)); SET_VECTOR_ELT(val, 2, allocMatrix(REALSXP, mm, n)); F77_CALL(dgesdd)("S", &m, &n, xx, &m, REAL(VECTOR_ELT(val, 0)), REAL(VECTOR_ELT(val, 1)), &m, REAL(VECTOR_ELT(val, 2)), &mm, &tmp, &lwork, iwork, &info FCONE); lwork = (int) tmp; C_or_Alloca_TO(work, lwork, double); F77_CALL(dgesdd)("S", &m, &n, xx, &m, REAL(VECTOR_ELT(val, 0)), REAL(VECTOR_ELT(val, 1)), &m, REAL(VECTOR_ELT(val, 2)), &mm, work, &lwork, iwork, &info FCONE); if(n_iw >= SMALL_4_Alloca) Free(iwork); if(lwork >= SMALL_4_Alloca) Free(work); } UNPROTECT(1); return val; } const static double padec [] = /* for matrix exponential calculation. */ { 5.0000000000000000e-1, 1.1666666666666667e-1, 1.6666666666666667e-2, 1.6025641025641026e-3, 1.0683760683760684e-4, 4.8562548562548563e-6, 1.3875013875013875e-7, 1.9270852604185938e-9, }; /** * Matrix exponential - based on the _corrected_ code for Octave's expm function. * * @param x real square matrix to exponentiate * * @return matrix exponential of x */ SEXP dgeMatrix_exp(SEXP x) { const double one = 1.0, zero = 0.0; const int i1 = 1; int *Dims = INTEGER(GET_SLOT(x, Matrix_DimSym)); const int n = Dims[1]; const R_xlen_t n_ = n, np1 = n + 1, nsqr = n_ * n_; // nsqr = n^2 SEXP val = PROTECT(duplicate(x)); int i, ilo, ilos, ihi, ihis, j, sqpow; int *pivot = Calloc(n, int); double *dpp = Calloc(nsqr, double), /* denominator power Pade' */ *npp = Calloc(nsqr, double), /* numerator power Pade' */ *perm = Calloc(n, double), *scale = Calloc(n, double), *v = REAL(GET_SLOT(val, Matrix_xSym)), *work = Calloc(nsqr, double), inf_norm, m1_j/*= (-1)^j */, trshift; R_CheckStack(); if (n < 1 || Dims[0] != n) error(_("Matrix exponential requires square, non-null matrix")); if(n == 1) { v[0] = exp(v[0]); UNPROTECT(1); return val; } /* Preconditioning 1. Shift diagonal by average diagonal if positive. */ trshift = 0; /* determine average diagonal element */ for (i = 0; i < n; i++) trshift += v[i * np1]; trshift /= n; if (trshift > 0.) { /* shift diagonal by -trshift */ for (i = 0; i < n; i++) v[i * np1] -= trshift; } /* Preconditioning 2. Balancing with dgebal. */ F77_CALL(dgebal)("P", &n, v, &n, &ilo, &ihi, perm, &j FCONE); if (j) error(_("dgeMatrix_exp: LAPACK routine dgebal returned %d"), j); F77_CALL(dgebal)("S", &n, v, &n, &ilos, &ihis, scale, &j FCONE); if (j) error(_("dgeMatrix_exp: LAPACK routine dgebal returned %d"), j); /* Preconditioning 3. Scaling according to infinity norm */ inf_norm = F77_CALL(dlange)("I", &n, &n, v, &n, work FCONE); sqpow = (inf_norm > 0) ? (int) (1 + log(inf_norm)/log(2.)) : 0; if (sqpow < 0) sqpow = 0; if (sqpow > 0) { double scale_factor = 1.0; for (i = 0; i < sqpow; i++) scale_factor *= 2.; for (R_xlen_t i = 0; i < nsqr; i++) v[i] /= scale_factor; } /* Pade' approximation. Powers v^8, v^7, ..., v^1 */ AZERO(npp, nsqr); AZERO(dpp, nsqr); m1_j = -1; for (j = 7; j >=0; j--) { double mult = padec[j]; /* npp = m * npp + padec[j] *m */ F77_CALL(dgemm)("N", "N", &n, &n, &n, &one, v, &n, npp, &n, &zero, work, &n FCONE FCONE); for (R_xlen_t i = 0; i < nsqr; i++) npp[i] = work[i] + mult * v[i]; /* dpp = m * dpp + (m1_j * padec[j]) * m */ mult *= m1_j; F77_CALL(dgemm)("N", "N", &n, &n, &n, &one, v, &n, dpp, &n, &zero, work, &n FCONE FCONE); for (R_xlen_t i = 0; i < nsqr; i++) dpp[i] = work[i] + mult * v[i]; m1_j *= -1; } /* Zero power */ for (R_xlen_t i = 0; i < nsqr; i++) dpp[i] *= -1.; for (j = 0; j < n; j++) { npp[j * np1] += 1.; dpp[j * np1] += 1.; } /* Pade' approximation is solve(dpp, npp) */ F77_CALL(dgetrf)(&n, &n, dpp, &n, pivot, &j); if (j) error(_("dgeMatrix_exp: dgetrf returned error code %d"), j); F77_CALL(dgetrs)("N", &n, &n, dpp, &n, pivot, npp, &n, &j FCONE); if (j) error(_("dgeMatrix_exp: dgetrs returned error code %d"), j); Memcpy(v, npp, nsqr); /* Now undo all of the preconditioning */ /* Preconditioning 3: square the result for every power of 2 */ while (sqpow--) { F77_CALL(dgemm)("N", "N", &n, &n, &n, &one, v, &n, v, &n, &zero, work, &n FCONE FCONE); Memcpy(v, work, nsqr); } /* Preconditioning 2: apply inverse scaling */ for (j = 0; j < n; j++) { R_xlen_t jn = j * n_; for (i = 0; i < n; i++) v[i + jn] *= scale[i]/scale[j]; } /* 2 b) Inverse permutation (if not the identity permutation) */ if (ilo != 1 || ihi != n) { /* Martin Maechler's code */ #define SWAP_ROW(I,J) F77_CALL(dswap)(&n, &v[(I)], &n, &v[(J)], &n) #define SWAP_COL(I,J) F77_CALL(dswap)(&n, &v[(I)*n_], &i1, &v[(J)*n_], &i1) #define RE_PERMUTE(I) \ int p_I = (int) (perm[I]) - 1; \ SWAP_COL(I, p_I); \ SWAP_ROW(I, p_I) /* reversion of "leading permutations" : in reverse order */ for (i = (ilo - 1) - 1; i >= 0; i--) { RE_PERMUTE(i); } /* reversion of "trailing permutations" : applied in forward order */ for (i = (ihi + 1) - 1; i < n; i++) { RE_PERMUTE(i); } } /* Preconditioning 1: Trace normalization */ if (trshift > 0.) { double mult = exp(trshift); for (R_xlen_t i = 0; i < nsqr; i++) v[i] *= mult; } /* Clean up */ Free(work); Free(scale); Free(perm); Free(npp); Free(dpp); Free(pivot); UNPROTECT(1); return val; } SEXP dgeMatrix_Schur(SEXP x, SEXP vectors, SEXP isDGE) { // 'x' is either a traditional matrix or a dgeMatrix, as indicated by isDGE. int *dims, n, vecs = asLogical(vectors), is_dge = asLogical(isDGE), info, izero = 0, lwork = -1, nprot = 1; if(is_dge) { dims = INTEGER(GET_SLOT(x, Matrix_DimSym)); } else { // traditional matrix dims = INTEGER(getAttrib(x, R_DimSymbol)); if(!isReal(x)) { // may not be "numeric" .. x = PROTECT(coerceVector(x, REALSXP)); // -> maybe error nprot++; } } double *work, tmp; const char *nms[] = {"WR", "WI", "T", "Z", ""}; SEXP val = PROTECT(Rf_mkNamed(VECSXP, nms)); n = dims[0]; if (n != dims[1] || n < 1) error(_("dgeMatrix_Schur: argument x must be a non-null square matrix")); const R_xlen_t n2 = ((R_xlen_t)n) * n; // = n^2 SET_VECTOR_ELT(val, 0, allocVector(REALSXP, n)); SET_VECTOR_ELT(val, 1, allocVector(REALSXP, n)); SET_VECTOR_ELT(val, 2, allocMatrix(REALSXP, n, n)); Memcpy(REAL(VECTOR_ELT(val, 2)), REAL(is_dge ? GET_SLOT(x, Matrix_xSym) : x), n2); SET_VECTOR_ELT(val, 3, allocMatrix(REALSXP, vecs ? n : 0, vecs ? n : 0)); F77_CALL(dgees)(vecs ? "V" : "N", "N", NULL, dims, (double *) NULL, dims, &izero, (double *) NULL, (double *) NULL, (double *) NULL, dims, &tmp, &lwork, (int *) NULL, &info FCONE FCONE); if (info) error(_("dgeMatrix_Schur: first call to dgees failed")); lwork = (int) tmp; C_or_Alloca_TO(work, lwork, double); F77_CALL(dgees)(vecs ? "V" : "N", "N", NULL, dims, REAL(VECTOR_ELT(val, 2)), dims, &izero, REAL(VECTOR_ELT(val, 0)), REAL(VECTOR_ELT(val, 1)), REAL(VECTOR_ELT(val, 3)), dims, work, &lwork, (int *) NULL, &info FCONE FCONE); if(lwork >= SMALL_4_Alloca) Free(work); if (info) error(_("dgeMatrix_Schur: dgees returned code %d"), info); UNPROTECT(nprot); return val; } // dgeMatrix_Schur // colSums(), colMeans(), rowSums() and rowMeans() -- called from ../R/colSums.R SEXP dgeMatrix_colsums(SEXP x, SEXP naRmP, SEXP cols, SEXP mean) { int keepNA = !asLogical(naRmP); // <==> na.rm = FALSE, the default int doMean = asLogical(mean); int useCols = asLogical(cols); int *dims = INTEGER(GET_SLOT(x, Matrix_DimSym)); int i, j, m = dims[0], n = dims[1]; R_xlen_t m_ = (R_xlen_t) m; // ==> use "long-integer" arithmetic for indices SEXP ans = PROTECT(allocVector(REALSXP, (useCols) ? n : m)); double *aa = REAL(ans), *xx = REAL(GET_SLOT(x, Matrix_xSym)); if (useCols) { /* col(Sums|Means) : */ R_xlen_t cnt = m_; // := number of 'valid' entries in current column for (j = 0; j < n; j++) { // column j : double *x_j = xx + m_ * j, s = 0.; if (keepNA) for (i = 0; i < m; i++) s += x_j[i]; else { cnt = 0; for (i = 0; i < m; i++) if (!ISNAN(x_j[i])) {cnt++; s += x_j[i];} } if (doMean) { if (cnt > 0) s /= cnt; else s = NA_REAL; } aa[j] = s; } } else { /* row(Sums|Means) : */ Rboolean do_count = (!keepNA) && doMean; int *cnt = (int*) NULL; if(do_count) { C_or_Alloca_TO(cnt, m, int); } // (taking care to access x contiguously: vary i inside j) for (i = 0; i < m; i++) { aa[i] = 0.; if(do_count) cnt[i] = 0; } for (j = 0; j < n; j++) { if (keepNA) for (i = 0; i < m; i++) aa[i] += xx[i + j * m_]; else for (i = 0; i < m; i++) { double el = xx[i + j * m_]; if (!ISNAN(el)) { aa[i] += el; if (doMean) cnt[i]++; } } } if (doMean) { if (keepNA) for (i = 0; i < m; i++) aa[i] /= n; else for (i = 0; i < m; i++) aa[i] = (cnt[i] > 0) ? aa[i]/cnt[i] : NA_REAL; } if(do_count && m >= SMALL_4_Alloca) Free(cnt); } SEXP nms = VECTOR_ELT(GET_SLOT(x, Matrix_DimNamesSym), useCols ? 1 : 0); if(!isNull(nms)) setAttrib(ans, R_NamesSymbol, duplicate(nms)); UNPROTECT(1); return ans; } Matrix/src/dpoMatrix.c0000644000176200001440000001007014060416534014421 0ustar liggesusers#include "dpoMatrix.h" SEXP dpoMatrix_validate(SEXP obj) { SEXP val; if (isString(val = dense_nonpacked_validate(obj))) return(val); int n = INTEGER(GET_SLOT(obj, Matrix_DimSym))[0]; R_xlen_t np1 = n + 1; double *x = REAL(GET_SLOT(obj, Matrix_xSym)); /* quick but nondefinitive check on positive definiteness */ for (int i = 0; i < n; i++) if (x[i * np1] < 0) return mkString(_("dpoMatrix is not positive definite")); return ScalarLogical(1); } SEXP dpoMatrix_chol(SEXP x) { SEXP val = get_factors(x, "Cholesky"), dimP = GET_SLOT(x, Matrix_DimSym), uploP = GET_SLOT(x, Matrix_uploSym); const char *uplo = CHAR(STRING_ELT(uploP, 0)); int *dims = INTEGER(dimP), info; int n = dims[0]; const R_xlen_t n2 = ((R_xlen_t)n) * n; // = n^2 double *vx; if (val != R_NilValue) return val;// use x@factors$Cholesky if available dims = INTEGER(dimP); val = PROTECT(NEW_OBJECT_OF_CLASS("Cholesky")); SET_SLOT(val, Matrix_uploSym, duplicate(uploP)); SET_SLOT(val, Matrix_diagSym, mkString("N")); SET_SLOT(val, Matrix_DimSym, duplicate(dimP)); vx = REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, n2)); AZERO(vx, n2); F77_CALL(dlacpy)(uplo, &n, &n, REAL(GET_SLOT(x, Matrix_xSym)), &n, vx, &n FCONE); if (n > 0) { F77_CALL(dpotrf)(uplo, &n, vx, &n, &info FCONE); if (info) { if(info > 0) error(_("the leading minor of order %d is not positive definite"), info); else /* should never happen! */ error(_("Lapack routine %s returned error code %d"), "dpotrf", info); } } UNPROTECT(1); return set_factors(x, val, "Cholesky"); } SEXP dpoMatrix_rcond(SEXP obj, SEXP type) { SEXP Chol = dpoMatrix_chol(obj); const char typnm[] = {'O', '\0'}; /* always use the one norm */ int *dims = INTEGER(GET_SLOT(Chol, Matrix_DimSym)), info; double anorm = get_norm_sy(obj, typnm), rcond; F77_CALL(dpocon)(uplo_P(Chol), dims, REAL(GET_SLOT(Chol, Matrix_xSym)), dims, &anorm, &rcond, (double *) R_alloc(3*dims[0], sizeof(double)), (int *) R_alloc(dims[0], sizeof(int)), &info FCONE); return ScalarReal(rcond); } SEXP dpoMatrix_solve(SEXP x) { SEXP Chol = dpoMatrix_chol(x); SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("dpoMatrix")); int *dims = INTEGER(GET_SLOT(x, Matrix_DimSym)), info; SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0)); slot_dup(val, Chol, Matrix_uploSym); slot_dup(val, Chol, Matrix_xSym); slot_dup(val, Chol, Matrix_DimSym); SET_SLOT(val, Matrix_DimNamesSym, duplicate(GET_SLOT(x, Matrix_DimNamesSym))); F77_CALL(dpotri)(uplo_P(val), dims, REAL(GET_SLOT(val, Matrix_xSym)), dims, &info FCONE); UNPROTECT(1); return val; } SEXP dpoMatrix_dgeMatrix_solve(SEXP a, SEXP b) { SEXP Chol = dpoMatrix_chol(a), val = PROTECT(NEW_OBJECT_OF_CLASS("dgeMatrix")); int *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)), *bdims = INTEGER(GET_SLOT(b, Matrix_DimSym)), info; if (adims[1] != bdims[0]) error(_("Dimensions of system to be solved are inconsistent")); if (adims[0] < 1 || bdims[1] < 1) error(_("Cannot solve() for matrices with zero extents")); SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0)); slot_dup(val, b, Matrix_DimSym); slot_dup(val, b, Matrix_xSym); F77_CALL(dpotrs)(uplo_P(Chol), adims, bdims + 1, REAL(GET_SLOT(Chol, Matrix_xSym)), adims, REAL(GET_SLOT(val, Matrix_xSym)), bdims, &info FCONE); UNPROTECT(1); return val; } SEXP dpoMatrix_matrix_solve(SEXP a, SEXP b) { SEXP Chol = dpoMatrix_chol(a), val = PROTECT(duplicate(b)); int *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)), *bdims = INTEGER(getAttrib(b, R_DimSymbol)), info; if (!(isReal(b) && isMatrix(b))) error(_("Argument b must be a numeric matrix")); if (*adims != *bdims || bdims[1] < 1 || *adims < 1) error(_("Dimensions of system to be solved are inconsistent")); F77_CALL(dpotrs)(uplo_P(Chol), adims, bdims + 1, REAL(GET_SLOT(Chol, Matrix_xSym)), adims, REAL(val), bdims, &info FCONE); UNPROTECT(1); return val; } Matrix/src/Lapack-etc.h0000644000176200001440000000020713774624325014436 0ustar liggesusers#ifndef USE_FC_LEN_T # define USE_FC_LEN_T #endif #include #include #ifndef FCONE # define FCONE #endif Matrix/src/Csparse.c0000644000176200001440000014063614154104143014060 0ustar liggesusers/** @file Csparse.c * The "CsparseMatrix" class from R package Matrix: * * Sparse matrices in compressed column-oriented form */ #include "Csparse.h" #include "Tsparse.h" #include "chm_common.h" /** "Cheap" C version of Csparse_validate() - *not* sorting : */ Rboolean isValid_Csparse(SEXP x) { /* NB: we do *NOT* check a potential 'x' slot here, at all */ SEXP pslot = GET_SLOT(x, Matrix_pSym), islot = GET_SLOT(x, Matrix_iSym); int *dims = INTEGER(GET_SLOT(x, Matrix_DimSym)), j, nrow = dims[0], ncol = dims[1], *xp = INTEGER(pslot), *xi = INTEGER(islot); if (length(pslot) != dims[1] + 1) return FALSE; if (xp[0] != 0) return FALSE; if (length(islot) < xp[ncol]) /* allow larger slots from over-allocation!*/ return FALSE; for (j = 0; j < xp[ncol]; j++) { if (xi[j] < 0 || xi[j] >= nrow) return FALSE; } for (j = 0; j < ncol; j++) { if (xp[j] > xp[j + 1]) return FALSE; } return TRUE; } SEXP Csparse_validate(SEXP x) { return Csparse_validate_(x, FALSE); } #define _t_Csparse_validate #include "t_Csparse_validate.c" #define _t_Csparse_sort #include "t_Csparse_validate.c" // R: .validateCsparse(x, sort.if.needed = FALSE) : SEXP Csparse_validate2(SEXP x, SEXP maybe_modify) { return Csparse_validate_(x, asLogical(maybe_modify)); } // R: Matrix:::.sortCsparse(x) : SEXP Csparse_sort (SEXP x) { int ok = Csparse_sort_2(x, TRUE); // modifying x directly if(!ok) warning(_("Csparse_sort(x): x is not a valid (apart from sorting) CsparseMatrix")); return x; } SEXP Rsparse_validate(SEXP x) { /* NB: we do *NOT* check a potential 'x' slot here, at all */ SEXP pslot = GET_SLOT(x, Matrix_pSym), jslot = GET_SLOT(x, Matrix_jSym); Rboolean sorted, strictly; int i, k, *dims = INTEGER(GET_SLOT(x, Matrix_DimSym)), nrow = dims[0], ncol = dims[1], *xp = INTEGER(pslot), *xj = INTEGER(jslot); if (length(pslot) != dims[0] + 1) return mkString(_("slot p must have length = nrow(.) + 1")); if (xp[0] != 0) return mkString(_("first element of slot p must be zero")); if (length(jslot) < xp[nrow]) /* allow larger slots from over-allocation!*/ return mkString(_("last element of slot p must match length of slots j and x")); for (i = 0; i < length(jslot); i++) { if (xj[i] < 0 || xj[i] >= ncol) return mkString(_("all column indices must be between 0 and ncol-1")); } sorted = TRUE; strictly = TRUE; for (i = 0; i < nrow; i++) { if (xp[i] > xp[i+1]) return mkString(_("slot p must be non-decreasing")); if(sorted) for (k = xp[i] + 1; k < xp[i + 1]; k++) { if (xj[k] < xj[k - 1]) sorted = FALSE; else if (xj[k] == xj[k - 1]) strictly = FALSE; } } if (!sorted) /* cannot easily use cholmod_sort(.) ... -> "error out" :*/ return mkString(_("slot j is not increasing inside a column")); else if(!strictly) /* sorted, but not strictly */ return mkString(_("slot j is not *strictly* increasing inside a column")); return ScalarLogical(1); } /** @brief From a CsparseMatrix, produce a dense one. * * Directly deals with symmetric, triangular and general. * Called from ../R/Csparse.R's C2dense() * * @param x a CsparseMatrix: currently all 9 of "[dln][gst]CMatrix" * @param symm_or_tri integer (NA, < 0, > 0, = 0) specifying the knowledge of the caller about x: * NA : unknown => will be determined * = 0 : "generalMatrix" (not symm or tri); * < 0 : "triangularMatrix" * > 0 : "symmetricMatrix" * * @return a "denseMatrix" */ SEXP Csparse_to_dense(SEXP x, SEXP symm_or_tri) { Rboolean is_sym, is_tri; int is_sym_or_tri = asInteger(symm_or_tri), ctype = 0; // <- default = "dgC" static const char *valid[] = { MATRIX_VALID_Csparse, ""}; if(is_sym_or_tri == NA_INTEGER) { // find if is(x, "symmetricMatrix") : ctype = R_check_class_etc(x, valid); is_sym = (ctype % 3 == 1); is_tri = (ctype % 3 == 2); } else { is_sym = is_sym_or_tri > 0; is_tri = is_sym_or_tri < 0; // => both are FALSE iff is_.. == 0 if(is_sym || is_tri) ctype = R_check_class_etc(x, valid); } CHM_SP chxs = AS_CHM_SP__(x);// -> chxs->stype = +- 1 <==> symmetric // allocated with alloca() R_CheckStack(); Rboolean is_U_tri = is_tri && *diag_P(x) == 'U'; if(is_U_tri) { // ==> x := diagU2N(x), directly for chxs; further: must free chxs CHM_SP eye = cholmod_speye(chxs->nrow, chxs->ncol, chxs->xtype, &c); double one[] = {1, 0}; CHM_SP ans = cholmod_add(chxs, eye, one, one, /* values: */ ((ctype / 3) != 2), // TRUE iff not "nMatrix" TRUE, &c); cholmod_free_sparse(&eye, &c); chxs = cholmod_copy_sparse(ans, &c); // replacing alloca'd chxs with malloc'ed one, which must be freed cholmod_free_sparse(&ans, &c); } /* The following loses the symmetry property, since cholmod_dense has none, * BUT, much worse (FIXME!), it also transforms CHOLMOD_PATTERN ("n") matrices * to numeric (CHOLMOD_REAL) ones {and we "revert" via chm_dense_to_SEXP()}: */ CHM_DN chxd = cholmod_sparse_to_dense(chxs, &c); /* FIXME: The above FAILS for prod(dim(.)) > INT_MAX * ---- * TODO: use cholmod_l_* but also the 'cl' global ==> many changes in chm_common.[ch] * >>>>>>>>>>> TODO <<<<<<<<<<<< * CHM_DN chxd = cholmod_l_sparse_to_dense(chxs, &cl); */ // ^^^ important when prod(dim(.)) > INT_MAX int chxs_xtype = chxs->xtype; int chxs_stype = chxs->stype; if(is_U_tri) cholmod_free_sparse(&chxs, &c); int Rkind = (chxs_xtype == CHOLMOD_PATTERN)? -1 : Real_kind(x); SEXP ans = chm_dense_to_SEXP(chxd, 1, Rkind, GET_SLOT(x, Matrix_DimNamesSym), /* transp: */ FALSE); // -> a [dln]geMatrix if(is_sym) { // ==> want [dln]syMatrix PROTECT(ans); const char cl1 = class_P(ans)[0]; SEXP aa = PROTECT(NEW_OBJECT_OF_CLASS((cl1 == 'd') ? "dsyMatrix" : ((cl1 == 'l') ? "lsyMatrix" : "nsyMatrix"))); // No need to duplicate() as slots of ans are freshly allocated and ans will not be used SET_SLOT(aa, Matrix_xSym, GET_SLOT(ans, Matrix_xSym)); SET_SLOT(aa, Matrix_DimSym, GET_SLOT(ans, Matrix_DimSym)); SET_SLOT(aa, Matrix_DimNamesSym,GET_SLOT(ans, Matrix_DimNamesSym)); SET_SLOT(aa, Matrix_uploSym, mkString((chxs_stype > 0) ? "U" : "L")); UNPROTECT(2); return aa; } else if(is_tri) { // ==> want [dln]trMatrix PROTECT(ans); const char cl1 = class_P(ans)[0]; SEXP aa = PROTECT(NEW_OBJECT_OF_CLASS((cl1 == 'd') ? "dtrMatrix" : ((cl1 == 'l') ? "ltrMatrix" : "ntrMatrix"))); // No need to duplicate() as slots of ans are freshly allocated and ans will not be used SET_SLOT(aa, Matrix_xSym, GET_SLOT(ans, Matrix_xSym)); SET_SLOT(aa, Matrix_DimSym, GET_SLOT(ans, Matrix_DimSym)); SET_SLOT(aa, Matrix_DimNamesSym,GET_SLOT(ans, Matrix_DimNamesSym)); slot_dup(aa, x, Matrix_uploSym); /* already by NEW_OBJECT(..) above: SET_SLOT(aa, Matrix_diagSym, mkString("N")); */ UNPROTECT(2); return aa; } else return ans; } // FIXME: do not go via CHM (should not be too hard, to just *drop* the x-slot, right? SEXP Csparse2nz(SEXP x, Rboolean tri) { CHM_SP chxs = AS_CHM_SP__(x); CHM_SP chxcp = cholmod_copy(chxs, chxs->stype, CHOLMOD_PATTERN, &c); R_CheckStack(); return chm_sparse_to_SEXP(chxcp, 1/*do_free*/, tri ? ((*uplo_P(x) == 'U') ? 1 : -1) : 0, /* Rkind: pattern */ 0, /* diag = */ tri ? diag_P(x) : "", GET_SLOT(x, Matrix_DimNamesSym)); } SEXP Csparse_to_nz_pattern(SEXP x, SEXP tri) { int tr_ = asLogical(tri); if(tr_ == NA_LOGICAL) { warning(_("Csparse_to_nz_pattern(x, tri = NA): 'tri' is taken as TRUE")); tr_ = TRUE; } return Csparse2nz(x, (Rboolean) tr_); } // n.CMatrix --> [dli].CMatrix (not going through CHM!) SEXP nz_pattern_to_Csparse(SEXP x, SEXP res_kind) { return nz2Csparse(x, asInteger(res_kind)); } // n.CMatrix --> [dli].CMatrix (not going through CHM!) // NOTE: use chm_MOD_xtype(() to change type of 'cholmod_sparse' matrix SEXP nz2Csparse(SEXP x, enum x_slot_kind r_kind) { const char *cl_x = class_P(x); // quick check - if ok, fast if(cl_x[0] != 'n' || cl_x[2] != 'C') { // e.g. class = "A", from setClass("A", contains = "ngCMatrix") static const char *valid[] = { MATRIX_VALID_nCsparse, ""}; int ctype = R_check_class_etc(x, valid); if(ctype < 0) error(_("not a 'n.CMatrix'")); else // fine : get a valid cl_x class_P()-like string : cl_x = valid[ctype]; } int nnz = LENGTH(GET_SLOT(x, Matrix_iSym)); SEXP ans; char *ncl = alloca(strlen(cl_x) + 1); /* not much memory required */ strcpy(ncl, cl_x); double *dx_x; int *ix_x; ncl[0] = (r_kind == x_double ? 'd' : (r_kind == x_logical ? 'l' : /* else (for now): r_kind == x_integer : */ 'i')); PROTECT(ans = NEW_OBJECT_OF_CLASS(ncl)); // create a correct 'x' slot: switch(r_kind) { int i; case x_double: // 'd' dx_x = REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, nnz)); for (i=0; i < nnz; i++) dx_x[i] = 1.; break; case x_logical: // 'l' ix_x = LOGICAL(ALLOC_SLOT(ans, Matrix_xSym, LGLSXP, nnz)); for (i=0; i < nnz; i++) ix_x[i] = TRUE; break; case x_integer: // 'i' ix_x = INTEGER(ALLOC_SLOT(ans, Matrix_xSym, INTSXP, nnz)); for (i=0; i < nnz; i++) ix_x[i] = 1; break; default: error(_("nz2Csparse(): invalid/non-implemented r_kind = %d"), r_kind); } // now copy all other slots : slot_dup(ans, x, Matrix_iSym); slot_dup(ans, x, Matrix_pSym); slot_dup(ans, x, Matrix_DimSym); slot_dup(ans, x, Matrix_DimNamesSym); if(ncl[1] != 'g') { // symmetric or triangular ... slot_dup_if_has(ans, x, Matrix_uploSym); slot_dup_if_has(ans, x, Matrix_diagSym); } UNPROTECT(1); return ans; } SEXP Csparse_to_matrix(SEXP x, SEXP chk, SEXP symm) { int is_sym = asLogical(symm); if(is_sym == NA_LOGICAL) { // find if is(x, "symmetricMatrix") : static const char *valid[] = { MATRIX_VALID_Csparse, ""}; int ctype = R_check_class_etc(x, valid); is_sym = (ctype % 3 == 1); } return chm_dense_to_matrix( cholmod_sparse_to_dense(AS_CHM_SP2(x, asLogical(chk)), &c), 1 /*do_free*/, (is_sym ? symmetric_DimNames(GET_SLOT(x, Matrix_DimNamesSym)) : GET_SLOT(x, Matrix_DimNamesSym))); } SEXP Csparse_to_vector(SEXP x) { return chm_dense_to_vector(cholmod_sparse_to_dense(AS_CHM_SP__(x), &c), 1); } SEXP Csparse_to_Tsparse(SEXP x, SEXP tri) { CHM_SP chxs = AS_CHM_SP__(x); CHM_TR chxt = cholmod_sparse_to_triplet(chxs, &c); int tr = asLogical(tri); int Rkind = (chxs->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0; R_CheckStack(); return chm_triplet_to_SEXP(chxt, 1, tr ? ((*uplo_P(x) == 'U') ? 1 : -1) : 0, Rkind, tr ? diag_P(x) : "", GET_SLOT(x, Matrix_DimNamesSym)); } SEXP Csparse_to_tCsparse(SEXP x, SEXP uplo, SEXP diag) { CHM_SP chxs = AS_CHM_SP__(x); int Rkind = (chxs->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0; R_CheckStack(); return chm_sparse_to_SEXP(chxs, /* dofree = */ 0, /* uploT = */ (*CHAR(asChar(uplo)) == 'U')? 1: -1, Rkind, /* diag = */ CHAR(STRING_ELT(diag, 0)), GET_SLOT(x, Matrix_DimNamesSym)); } SEXP Csparse_to_tTsparse(SEXP x, SEXP uplo, SEXP diag) { CHM_SP chxs = AS_CHM_SP__(x); CHM_TR chxt = cholmod_sparse_to_triplet(chxs, &c); int Rkind = (chxs->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0; R_CheckStack(); return chm_triplet_to_SEXP(chxt, 1, /* uploT = */ (*CHAR(asChar(uplo)) == 'U')? 1: -1, Rkind, /* diag = */ CHAR(STRING_ELT(diag, 0)), GET_SLOT(x, Matrix_DimNamesSym)); } SEXP Csparse_symmetric_to_general(SEXP x) { CHM_SP chx = AS_CHM_SP__(x), chgx; int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0; R_CheckStack(); if (!(chx->stype)) error(_("Nonsymmetric matrix in Csparse_symmetric_to_general")); chgx = cholmod_copy(chx, /* stype: */ 0, chx->xtype, &c); return chm_sparse_to_SEXP(chgx, 1, 0, Rkind, "", symmetric_DimNames(GET_SLOT(x, Matrix_DimNamesSym))); } // Called from R's forceCspSymmetric() , .gC2sym() SEXP Csparse_general_to_symmetric(SEXP x, SEXP uplo, SEXP sym_dmns) { int *adims = INTEGER(GET_SLOT(x, Matrix_DimSym)), n = adims[0]; if(n != adims[1]) { error(_("Csparse_general_to_symmetric(): matrix is not square!")); return R_NilValue; /* -Wall */ } CHM_SP chx = AS_CHM_SP__(x), chgx; int uploT = (*CHAR(asChar(uplo)) == 'U') ? 1 : -1; int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0; R_CheckStack(); chgx = cholmod_copy(chx, /* stype: */ uploT, chx->xtype, &c); SEXP dns = GET_SLOT(x, Matrix_DimNamesSym); int symDmns = asLogical(sym_dmns); /* 1, NA_LOGICAL or 0 */ /* 3 cases: FALSE: keep as is; TRUE : symmetric dimnames in any case NA : symmetrize if(...) */ if(symDmns == FALSE) { } // *keep* asymmetric dimnames: do nothing /// FIXME: TRUE: *should* do symmetric dimnames in any case, but does *NOT* --> symmetric_Dimnames() else if(symDmns == TRUE) dns = symmetric_DimNames(dns); else // NA_LOGICAL (was 'FALSE' case) : if((!isNull(VECTOR_ELT(dns, 0)) && !isNull(VECTOR_ELT(dns, 1))) || !isNull(getAttrib(dns, R_NamesSymbol))) { /* symmetrize them if both are not NULL * or names(dimnames(.)) is asymmetric : */ /// FIXME --- this is partly *MORE* than what 'TRUE' case above does !!!! dns = PROTECT(duplicate(dns)); if(!equal_string_vectors(VECTOR_ELT(dns, 0), VECTOR_ELT(dns, 1))) { if(uploT == 1) SET_VECTOR_ELT(dns, 0, VECTOR_ELT(dns,1)); else SET_VECTOR_ELT(dns, 1, VECTOR_ELT(dns,0)); } SEXP nms_dns = getAttrib(dns, R_NamesSymbol); if(!isNull(nms_dns) && // names(dimnames(.)) : !R_compute_identical(STRING_ELT(nms_dns, 0), STRING_ELT(nms_dns, 1), 16)) { if(uploT == 1) SET_STRING_ELT(nms_dns, 0, STRING_ELT(nms_dns,1)); else SET_STRING_ELT(nms_dns, 1, STRING_ELT(nms_dns,0)); setAttrib(dns, R_NamesSymbol, nms_dns); } UNPROTECT(1); } /* Rkind: pattern, "real", complex or .. */ return chm_sparse_to_SEXP(chgx, 1, 0, Rkind, "", dns); } SEXP Csparse_transpose(SEXP x, SEXP tri) { /* TODO: lgCMatrix & igC* currently go via double prec. cholmod - * since cholmod (& cs) lacks sparse 'int' matrices */ CHM_SP chx = AS_CHM_SP__(x); int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0; CHM_SP chxt = cholmod_transpose(chx, chx->xtype, &c); SEXP dn = PROTECT(duplicate(GET_SLOT(x, Matrix_DimNamesSym))), tmp; int tr = asLogical(tri); R_CheckStack(); tmp = VECTOR_ELT(dn, 0); /* swap the dimnames */ SET_VECTOR_ELT(dn, 0, VECTOR_ELT(dn, 1)); SET_VECTOR_ELT(dn, 1, tmp); tmp = PROTECT(getAttrib(dn, R_NamesSymbol)); if(!isNull(tmp)) { // swap names(dimnames(.)): SEXP nms_dns = PROTECT(allocVector(VECSXP, 2)); SET_VECTOR_ELT(nms_dns, 1, STRING_ELT(tmp, 0)); SET_VECTOR_ELT(nms_dns, 0, STRING_ELT(tmp, 1)); setAttrib(dn, R_NamesSymbol, nms_dns); UNPROTECT(1); } SEXP ans = chm_sparse_to_SEXP(chxt, 1, /* SWAP 'uplo' for triangular */ tr ? ((*uplo_P(x) == 'U') ? -1 : 1) : 0, Rkind, tr ? diag_P(x) : "", dn); UNPROTECT(2); return ans; } /** @brief A %*% B - for matrices of class CsparseMatrix (R package "Matrix") * * @param a * @param b * @param bool_arith * * @return * * NOTA BENE: cholmod_ssmult(A,B, ...) -> ./CHOLMOD/MatrixOps/cholmod_ssmult.c * --------- computes a patter*n* matrix __always_ when * *one* of A or B is pattern*n*, because of this (line 73-74): --------------------------------------------------------------------------- values = values && (A->xtype != CHOLMOD_PATTERN) && (B->xtype != CHOLMOD_PATTERN) ; --------------------------------------------------------------------------- * ==> Often need to copy the patter*n* to a *l*ogical matrix first !!! */ SEXP Csparse_Csparse_prod(SEXP a, SEXP b, SEXP bool_arith) { CHM_SP cha = AS_CHM_SP(a), chb = AS_CHM_SP(b), chc; R_CheckStack(); static const char *valid_tri[] = { MATRIX_VALID_tri_Csparse, "" }; char diag[] = {'\0', '\0'}; int uploT = 0, nprot = 1, do_bool = asLogical(bool_arith); // TRUE / NA / FALSE Rboolean a_is_n = (cha->xtype == CHOLMOD_PATTERN), b_is_n = (chb->xtype == CHOLMOD_PATTERN), force_num = (do_bool == FALSE), maybe_bool= (do_bool == NA_LOGICAL); #ifdef DEBUG_Matrix_verbose Rprintf("DBG Csparse_C*_prod(%s, %s)\n", class_P(a), class_P(b)); #endif if(a_is_n && (force_num || (maybe_bool && !b_is_n))) { /* coerce 'a' to double; * have no CHOLMOD function (pattern -> logical) --> use "our" code */ SEXP da = PROTECT(nz2Csparse(a, x_double)); nprot++; cha = AS_CHM_SP(da); R_CheckStack(); a_is_n = FALSE; } else if(b_is_n && (force_num || (maybe_bool && !a_is_n))) { // coerce 'b' to double SEXP db = PROTECT(nz2Csparse(b, x_double)); nprot++; chb = AS_CHM_SP(db); R_CheckStack(); b_is_n = FALSE; } chc = cholmod_ssmult(cha, chb, /*out_stype:*/ 0, /* values : */ do_bool != TRUE, /* sorted = TRUE: */ 1, &c); /* Preserve triangularity and even unit-triangularity if appropriate. * Note that in that case, the multiplication itself should happen * faster. But there's no support for that in CHOLMOD */ if(R_check_class_etc(a, valid_tri) >= 0 && R_check_class_etc(b, valid_tri) >= 0) if(*uplo_P(a) == *uplo_P(b)) { /* both upper, or both lower tri. */ uploT = (*uplo_P(a) == 'U') ? 1 : -1; if(*diag_P(a) == 'U' && *diag_P(b) == 'U') { /* return UNIT-triag. */ /* "remove the diagonal entries": */ chm_diagN2U(chc, uploT, /* do_realloc */ FALSE); diag[0]= 'U'; } else diag[0]= 'N'; } // establish dimnames -- extra care for *symmetric* Csparse: static const char *valid_sym[] = { MATRIX_VALID_sym_Csparse, "" }; Rboolean a_symm = R_check_class_etc(a, valid_sym) >= 0, b_symm = R_check_class_etc(b, valid_sym) >= 0; SEXP dn = PROTECT(allocVector(VECSXP, 2)); SET_VECTOR_ELT(dn, 0, duplicate(VECTOR_ELT(a_symm ? R_symmetric_Dimnames(a) : GET_SLOT(a, Matrix_DimNamesSym), 0))); SET_VECTOR_ELT(dn, 1, duplicate(VECTOR_ELT(b_symm ? R_symmetric_Dimnames(b) : GET_SLOT(b, Matrix_DimNamesSym), 1))); UNPROTECT(nprot); return chm_sparse_to_SEXP(chc, 1, uploT, /*Rkind*/0, diag, dn); } /** @brief [t]crossprod (, ) * * @param a a "CsparseMatrix" object * @param b a "CsparseMatrix" object * @param trans trans = FALSE: crossprod(a,b) * trans = TRUE : tcrossprod(a,b) * @param bool_arith logical (TRUE / NA / FALSE): Should boolean arithmetic be used. * * @return a CsparseMatrix, the (t)cross product of a and b. */ SEXP Csparse_Csparse_crossprod(SEXP a, SEXP b, SEXP trans, SEXP bool_arith) { int tr = asLogical(trans), nprot = 1, do_bool = asLogical(bool_arith); // TRUE / NA / FALSE CHM_SP cha = AS_CHM_SP(a), chb = AS_CHM_SP(b), chTr, chc; R_CheckStack(); static const char *valid_tri[] = { MATRIX_VALID_tri_Csparse, "" }; char diag[] = {'\0', '\0'}; int uploT = 0; Rboolean a_is_n = (cha->xtype == CHOLMOD_PATTERN), b_is_n = (chb->xtype == CHOLMOD_PATTERN), force_num = (do_bool == FALSE), maybe_bool= (do_bool == NA_LOGICAL); if(a_is_n && (force_num || (maybe_bool && !b_is_n))) { // coerce 'a' to double SEXP da = PROTECT(nz2Csparse(a, x_double)); nprot++; cha = AS_CHM_SP(da); R_CheckStack(); // a_is_n = FALSE; } else if(b_is_n && (force_num || (maybe_bool && !a_is_n))) { // coerce 'b' to double SEXP db = PROTECT(nz2Csparse(b, x_double)); nprot++; chb = AS_CHM_SP(db); R_CheckStack(); // b_is_n = FALSE; } else if(do_bool == TRUE) { // Want boolean arithmetic: sufficient if *one* is pattern: if(!a_is_n && !b_is_n) { // coerce 'a' to pattern SEXP da = PROTECT(Csparse2nz(a, /* tri = */ R_check_class_etc(a, valid_tri) >= 0)); nprot++; cha = AS_CHM_SP(da); R_CheckStack(); // a_is_n = TRUE; } } chTr = cholmod_transpose((tr) ? chb : cha, chb->xtype, &c); chc = cholmod_ssmult((tr) ? cha : chTr, (tr) ? chTr : chb, /*out_stype:*/ 0, /* values : */ do_bool != TRUE, /* sorted = TRUE: */ 1, &c); cholmod_free_sparse(&chTr, &c); /* Preserve triangularity and unit-triangularity if appropriate; * see Csparse_Csparse_prod() for comments */ if(R_check_class_etc(a, valid_tri) >= 0 && R_check_class_etc(b, valid_tri) >= 0) if(*uplo_P(a) != *uplo_P(b)) { /* one 'U', the other 'L' */ uploT = (*uplo_P(b) == 'U') ? 1 : -1; if(*diag_P(a) == 'U' && *diag_P(b) == 'U') { /* return UNIT-triag. */ chm_diagN2U(chc, uploT, /* do_realloc */ FALSE); diag[0]= 'U'; } else diag[0]= 'N'; } SEXP dn = PROTECT(allocVector(VECSXP, 2)); SET_VECTOR_ELT(dn, 0, /* establish dimnames */ duplicate(VECTOR_ELT(GET_SLOT(a, Matrix_DimNamesSym), (tr) ? 0 : 1))); SET_VECTOR_ELT(dn, 1, duplicate(VECTOR_ELT(GET_SLOT(b, Matrix_DimNamesSym), (tr) ? 0 : 1))); UNPROTECT(nprot); return chm_sparse_to_SEXP(chc, 1, uploT, /*Rkind*/0, diag, dn); } /** * All (dense * sparse) Matrix products and cross products * * f( f() %*% f() ) where f () is either t () [tranpose] or the identity. * * @param a CsparseMatrix (n x m) * @param b numeric vector, matrix, or denseMatrix (m x k) or (k x m) if `transp` is '2' or 'B' * @param transp character. * = " " : nothing transposed {apart from a} * = "2" : "transpose 2nd arg": use t(b) instead of b (= 2nd argument) * = "c" : "transpose c": Return t(c) instead of c * = "B" : "transpose both": use t(b) and return t(c) instead of c * NB: For "2", "c", "B", need to transpose a *dense* matrix, B or C --> chm_transpose_dense() * * @return a dense matrix, the matrix product c = g(a,b) : * * Condition (R) Condition (C) * R notation Math notation cross transp t.a t.b t.ans * ~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~ ~~~~~~~~~~~~~ * c <- a %*% b C := A B . " " . . . * c <- a %*% t(b) C := A B' . "2" . | . * c <- t(a %*% b) C := (A B)' = B'A' . "c" . . | * c <- t(a %*% t(b)) C := (A B')' = B A' . "B" . | | * * c <- t(a) %*% b C := A'B TRUE " " | . . * c <- t(a) %*% t(b) C := A'B' TRUE "2" | | . * c <- t(t(a) %*% b) C := (A'B)' = B'A TRUE "c" | . | * c <- t(t(a) %*% t(b)) C := (A'B')' = B A TRUE "B" | | | */ SEXP Csp_dense_products(SEXP a, SEXP b, Rboolean transp_a, Rboolean transp_b, Rboolean transp_ans) { CHM_SP cha = AS_CHM_SP(a); int a_nc = transp_a ? cha->nrow : cha->ncol, a_nr = transp_a ? cha->ncol : cha->nrow; Rboolean maybe_transp_b = (a_nc == 1), b_is_vector = FALSE; /* NOTE: trans_b {<--> "use t(b) instead of b" } ---- "interferes" with the case automatic treatment of *vector* b. In that case, t(b) or b is used "whatever make more sense", according to the general R philosophy of treating vectors in matrix products. */ /* repeating a "cheap part" of mMatrix_as_dgeMatrix2(b, .) to see if * we have a vector that we might 'transpose_if_vector' : */ static const char *valid[] = {"_NOT_A_CLASS_", MATRIX_VALID_ddense, ""}; /* int ctype = R_check_class_etc(b, valid); * if (ctype > 0) /.* a ddenseMatrix object */ if (R_check_class_etc(b, valid) < 0) { // not a ddenseM*: is.matrix() or vector: b_is_vector = !isMatrix(b); } if(b_is_vector) { /* determine *if* we want/need to transpose at all: * if (length(b) == ncol(A)) have match: use dim = c(n, 1) (<=> do *not* transp); * otherwise, try to transpose: ok if (ncol(A) == 1) [see also above]: */ maybe_transp_b = (LENGTH(b) != a_nc); // Here, we transpose already in mMatrix_as_dge*() ==> don't do it later: transp_b = FALSE; } SEXP b_M = PROTECT(mMatrix_as_dgeMatrix2(b, maybe_transp_b)); CHM_DN chb = AS_CHM_DN(b_M), b_t; R_CheckStack(); int ncol_b; if(transp_b) { // transpose b: b_t = cholmod_allocate_dense(chb->ncol, chb->nrow, chb->ncol, chb->xtype, &c); chm_transpose_dense(b_t, chb); ncol_b = b_t->ncol; } else ncol_b = chb->ncol; // Result C {with dim() before it may be transposed}: CHM_DN chc = cholmod_allocate_dense(a_nr, ncol_b, a_nr, chb->xtype, &c); double one[] = {1,0}, zero[] = {0,0}; int nprot = 2; /* Tim Davis, please FIXME: currently (2010-11) *fails* when a is a pattern matrix:*/ if(cha->xtype == CHOLMOD_PATTERN) { /* warning(_("Csparse_dense_prod(): cholmod_sdmult() not yet implemented for pattern./ ngCMatrix" */ /* " --> slightly inefficient coercion")); */ // This *fails* to produce a CHOLMOD_REAL .. // CHM_SP chd = cholmod_l_copy(cha, cha->stype, CHOLMOD_REAL, &cl); // --> use our Matrix-classes: they work: SEXP da = PROTECT(nz2Csparse(a, x_double)); nprot++; cha = AS_CHM_SP(da); } /* cholmod_sdmult(A, transp, alpha, beta, X, Y, &c): depending on transp == 0 / != 0: * Y := alpha*(A*X) + beta*Y or alpha*(A'*X) + beta*Y; here, alpha = 1, beta = 0: * Y := A*X or A'*X * NB: always %*% ! */ cholmod_sdmult(cha, transp_a, one, zero, (transp_b ? b_t : chb), /* -> */ chc, &c); SEXP dn = PROTECT(allocVector(VECSXP, 2)); /* establish dimnames */ SET_VECTOR_ELT(dn, transp_ans ? 1 : 0, duplicate(VECTOR_ELT(GET_SLOT(a, Matrix_DimNamesSym), transp_a ? 1 : 0))); SET_VECTOR_ELT(dn, transp_ans ? 0 : 1, duplicate(VECTOR_ELT(GET_SLOT(b_M, Matrix_DimNamesSym), transp_b ? 0 : 1))); if(transp_b) cholmod_free_dense(&b_t, &c); UNPROTECT(nprot); return chm_dense_to_SEXP(chc, 1, 0, dn, transp_ans); } SEXP Csparse_dense_prod(SEXP a, SEXP b, SEXP transp) { return Csp_dense_products(a, b, /* transp_a = */ FALSE, /* transp_b = */ (*CHAR(asChar(transp)) == '2' || *CHAR(asChar(transp)) == 'B'), /* transp_ans = */ (*CHAR(asChar(transp)) == 'c' || *CHAR(asChar(transp)) == 'B')); } SEXP Csparse_dense_crossprod(SEXP a, SEXP b, SEXP transp) { return Csp_dense_products(a, b, /* transp_a = */ TRUE, /* transp_b = */ (*CHAR(asChar(transp)) == '2' || *CHAR(asChar(transp)) == 'B'), /* transp_ans = */ (*CHAR(asChar(transp)) == 'c' || *CHAR(asChar(transp)) == 'B')); } /** @brief Computes x'x or x x' -- *also* for Tsparse (triplet = TRUE) see Csparse_Csparse_crossprod above for x'y and x y' */ SEXP Csparse_crossprod(SEXP x, SEXP trans, SEXP triplet, SEXP bool_arith) { int tripl = asLogical(triplet), tr = asLogical(trans), /* gets reversed because _aat is tcrossprod */ do_bool = asLogical(bool_arith); // TRUE / NA / FALSE #ifdef AS_CHM_DIAGU2N_FIXED_FINALLY CHM_TR cht = tripl ? AS_CHM_TR(x) : (CHM_TR) NULL; int nprot = 1; #else /* workaround needed:*/ SEXP xx = PROTECT(Tsparse_diagU2N(x)); CHM_TR cht = tripl ? AS_CHM_TR__(xx) : (CHM_TR) NULL; int nprot = 2; #endif CHM_SP chcp, chxt, chxc, chx = (tripl ? cholmod_triplet_to_sparse(cht, cht->nnz, &c) : AS_CHM_SP(x)); SEXP dn = PROTECT(allocVector(VECSXP, 2)); R_CheckStack(); Rboolean x_is_n = (chx->xtype == CHOLMOD_PATTERN), x_is_sym = chx->stype != 0, force_num = (do_bool == FALSE); if(x_is_n && force_num) { // coerce 'x' to double SEXP dx = PROTECT(nz2Csparse(x, x_double)); nprot++; chx = AS_CHM_SP(dx); R_CheckStack(); } else if(do_bool == TRUE && !x_is_n) { // Want boolean arithmetic; need patter[n] // coerce 'x' to pattern static const char *valid_tri[] = { MATRIX_VALID_tri_Csparse, "" }; SEXP dx = PROTECT(Csparse2nz(x, /* tri = */ R_check_class_etc(x, valid_tri) >= 0)); nprot++; chx = AS_CHM_SP(dx); R_CheckStack(); } if (!tr) chxt = cholmod_transpose(chx, chx->xtype, &c); // cholmod_aat() does not like symmetric chxc = x_is_sym ? cholmod_copy(tr ? chx : chxt, /* stype: */ 0, chx->xtype, &c) : NULL; // CHOLMOD/Core/cholmod_aat.c : chcp = cholmod_aat(x_is_sym ? chxc : (tr ? chx : chxt), (int *) NULL, 0, /* mode: */ chx->xtype, &c); if (chxc) cholmod_free_sparse(&chxc, &c); if(!chcp) { UNPROTECT(1); error(_("Csparse_crossprod(): error return from cholmod_aat()")); } cholmod_band_inplace(0, chcp->ncol, chcp->xtype, chcp, &c); chcp->stype = 1; // symmetric if (tripl) cholmod_free_sparse(&chx, &c); if (!tr) cholmod_free_sparse(&chxt, &c); SET_VECTOR_ELT(dn, 0, /* establish dimnames */ duplicate(VECTOR_ELT(GET_SLOT(x, Matrix_DimNamesSym), (tr) ? 0 : 1))); SET_VECTOR_ELT(dn, 1, duplicate(VECTOR_ELT(dn, 0))); UNPROTECT(nprot); // FIXME: uploT for symmetric ? return chm_sparse_to_SEXP(chcp, 1, 0, 0, "", dn); } /** @brief Csparse_drop(x, tol): drop entries with absolute value < tol, i.e, * at least all "explicit" zeros. */ SEXP Csparse_drop(SEXP x, SEXP tol) { const char *cl = class_P(x); /* dtCMatrix, etc; [1] = the second character =?= 't' for triangular */ int tr = (cl[1] == 't'); // FIXME - rather R_check_class_etc(..) CHM_SP chx = AS_CHM_SP__(x); CHM_SP ans = cholmod_copy(chx, chx->stype, chx->xtype, &c); double dtol = asReal(tol); int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0; R_CheckStack(); if(!cholmod_drop(dtol, ans, &c)) error(_("cholmod_drop() failed")); return chm_sparse_to_SEXP(ans, 1, tr ? ((*uplo_P(x) == 'U') ? 1 : -1) : 0, Rkind, tr ? diag_P(x) : "", GET_SLOT(x, Matrix_DimNamesSym)); } /** @brief Horizontal Concatenation - cbind( , ) */ SEXP Csparse_horzcat(SEXP x, SEXP y) { #define CSPARSE_CAT(_KIND_) \ CHM_SP chx = AS_CHM_SP__(x), chy = AS_CHM_SP__(y); \ R_CheckStack(); \ void* chx_x = chx->x; \ void* chx_z = chx->z; \ void* chy_x = chy->x; \ void* chy_z = chy->z; \ int Rk_x = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : x_pattern, \ Rk_y = (chy->xtype != CHOLMOD_PATTERN) ? Real_kind(y) : x_pattern, Rkind; \ if(Rk_x == x_pattern || Rk_y == x_pattern) { /* at least one of them is patter"n" */ \ if(Rk_x == x_pattern && Rk_y == x_pattern) { /* fine */ \ } else { /* only one is a patter"n" \ * "Bug" in cholmod_horzcat()/vertcat(): \ * returns patter"n" matrix if one of them is */ \ Rboolean ok; \ if(Rk_x == x_pattern) { \ ok = chm_MOD_xtype(CHOLMOD_REAL, chx, &c); Rk_x = 0; \ } else if(Rk_y == x_pattern) { \ ok = chm_MOD_xtype(CHOLMOD_REAL, chy, &c); Rk_y = 0; \ } else \ error(_("Impossible Rk_x/Rk_y in Csparse_%s(), please report"), _KIND_); \ if(!ok) \ error(_("chm_MOD_xtype() was not successful in Csparse_%s(), please report"), \ _KIND_); \ } \ } \ Rkind = /* logical if both x and y are */ (Rk_x == 1 && Rk_y == 1) ? 1 : 0 CSPARSE_CAT("horzcat"); // TODO: currently drops dimnames - and we fix at R level; SEXP retval = chm_sparse_to_SEXP(cholmod_horzcat(chx, chy, 1, &c), 1, 0, Rkind, "", R_NilValue); /* AS_CHM_SP(x) fills result with points to R-allocated memory but chm_MOD_xtype can change ->x and ->z to cholmod_alloc'ed memory. The former needs no freeing but the latter does. The first 2 arguments to cholmod_free should contain the number and size of things being freed, but lying about that is sort of ok. */ #define CSPARSE_CAT_CLEANUP \ if (chx_x != chx->x) cholmod_free(0, 0, chx->x, &c); \ if (chx_z != chx->z) cholmod_free(0, 0, chx->z, &c); \ if (chy_x != chy->x) cholmod_free(0, 0, chy->x, &c); \ if (chy_z != chy->z) cholmod_free(0, 0, chy->z, &c) CSPARSE_CAT_CLEANUP; return retval; } /** @brief Vertical Concatenation - rbind( , ) */ SEXP Csparse_vertcat(SEXP x, SEXP y) { CSPARSE_CAT("vertcat"); // TODO: currently drops dimnames - and we fix at R level; SEXP retval = chm_sparse_to_SEXP(cholmod_vertcat(chx, chy, 1, &c), 1, 0, Rkind, "", R_NilValue); CSPARSE_CAT_CLEANUP; return retval; } SEXP Csparse_band(SEXP x, SEXP k1, SEXP k2) { CHM_SP chx = AS_CHM_SP__(x); int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0; CHM_SP ans = cholmod_band(chx, asInteger(k1), asInteger(k2), chx->xtype, &c); R_CheckStack(); return chm_sparse_to_SEXP(ans, 1, /* uploT = */ 0, Rkind, "", GET_SLOT(x, Matrix_DimNamesSym)); } SEXP Csparse_diagU2N(SEXP x) { const char *cl = class_P(x); /* dtCMatrix, etc; [1] = the second character =?= 't' for triangular */ if (cl[1] != 't' || *diag_P(x) != 'U') { /* "trivially fast" when not triangular (<==> no 'diag' slot), or not *unit* triangular */ return (x); } else { /* unit triangular (diag='U'): "fill the diagonal" & diag:= "N" */ CHM_SP chx = AS_CHM_SP__(x); CHM_SP eye = cholmod_speye(chx->nrow, chx->ncol, chx->xtype, &c); double one[] = {1, 0}; CHM_SP ans = cholmod_add(chx, eye, one, one, TRUE, TRUE, &c); int uploT = (*uplo_P(x) == 'U') ? 1 : -1; int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0; R_CheckStack(); cholmod_free_sparse(&eye, &c); return chm_sparse_to_SEXP(ans, 1, uploT, Rkind, "N", GET_SLOT(x, Matrix_DimNamesSym)); } } SEXP Csparse_diagN2U(SEXP x) { const char *cl = class_P(x); /* dtCMatrix, etc; [1] = the second character =?= 't' for triangular */ if (cl[1] != 't' || *diag_P(x) != 'N') { /* "trivially fast" when not triangular (<==> no 'diag' slot), or already *unit* triangular */ return (x); } else { /* triangular with diag='N'): now drop the diagonal */ /* duplicate, since chx will be modified: */ SEXP xx = PROTECT(duplicate(x)); CHM_SP chx = AS_CHM_SP__(xx); int uploT = (*uplo_P(x) == 'U') ? 1 : -1, Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0; R_CheckStack(); chm_diagN2U(chx, uploT, /* do_realloc */ FALSE); SEXP ans = chm_sparse_to_SEXP(chx, /*dofree*/ 0/* or 1 ?? */, uploT, Rkind, "U", GET_SLOT(x, Matrix_DimNamesSym)); UNPROTECT(1);// only now ! return ans; } } /** * Indexing aka subsetting : Compute x[i,j], also for vectors i and j * Working via CHOLMOD_submatrix, see ./CHOLMOD/MatrixOps/cholmod_submatrix.c * @param x CsparseMatrix * @param i row indices (0-origin), or NULL (R, not C) * @param j columns indices (0-origin), or NULL * * @return x[i,j] still CsparseMatrix --- currently, this loses dimnames */ SEXP Csparse_submatrix(SEXP x, SEXP i, SEXP j) { CHM_SP chx = AS_CHM_SP(x); /* << does diagU2N() when needed */ int rsize = (isNull(i)) ? -1 : LENGTH(i), csize = (isNull(j)) ? -1 : LENGTH(j); int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0; R_CheckStack(); if (rsize >= 0 && !isInteger(i)) error(_("Index i must be NULL or integer")); if (csize >= 0 && !isInteger(j)) error(_("Index j must be NULL or integer")); /* Must treat 'NA's in i[] and j[] here -- they are *not* treated by Cholmod! * haveNA := ... if(haveNA) { a. i = removeNA(i); j =removeNA(j), and remember where they were b. ans = CHM_SUB(.., i, j) c. add NA rows and/or columns to 'ans' according to place of NA's in i and/or j. } else { ans = CHM_SUB(.....) // == current code } */ #define CHM_SUB(_M_, _i_, _j_) \ cholmod_submatrix(_M_, \ (rsize < 0) ? NULL : INTEGER(_i_), rsize, \ (csize < 0) ? NULL : INTEGER(_j_), csize, \ TRUE, TRUE, &c) CHM_SP ans; if (!chx->stype) {/* non-symmetric Matrix */ ans = CHM_SUB(chx, i, j); } else { /* symmetric : "dsCMatrix"; currently, cholmod_submatrix() only accepts "generalMatrix" */ CHM_SP tmp = cholmod_copy(chx, /* stype: */ 0, chx->xtype, &c); ans = CHM_SUB(tmp, i, j); cholmod_free_sparse(&tmp, &c); } // "FIXME": currently dropping dimnames, and adding them afterwards in R : /* // dimnames: */ /* SEXP x_dns = GET_SLOT(x, Matrix_DimNamesSym), */ /* dn = PROTECT(allocVector(VECSXP, 2)); */ return chm_sparse_to_SEXP(ans, 1, 0, Rkind, "", /* dimnames: */ R_NilValue); } #undef CHM_SUB #define _d_Csp_ #include "t_Csparse_subassign.c" #define _l_Csp_ #include "t_Csparse_subassign.c" #define _i_Csp_ #include "t_Csparse_subassign.c" #define _n_Csp_ #include "t_Csparse_subassign.c" #define _z_Csp_ #include "t_Csparse_subassign.c" SEXP Csparse_MatrixMarket(SEXP x, SEXP fname) { FILE *f = fopen(CHAR(asChar(fname)), "w"); if (!f) error(_("failure to open file \"%s\" for writing"), CHAR(asChar(fname))); if (!cholmod_write_sparse(f, AS_CHM_SP(x), (CHM_SP)NULL, (char*) NULL, &c)) error(_("cholmod_write_sparse returned error code")); fclose(f); return R_NilValue; } /** * Extract the diagonal entries from *triangular* Csparse matrix __or__ a * cholmod_sparse factor (LDL = TRUE). * * @param n dimension of the matrix. * @param x_p 'p' (column pointer) slot contents * @param x_x 'x' (non-zero entries) slot contents * @param perm 'perm' (= permutation vector) slot contents; only used for "diagBack" * @param resultKind a (SEXP) string indicating which kind of result is desired. * * @return a SEXP, either a (double) number or a length n-vector of diagonal entries */ SEXP diag_tC_ptr(int n, int *x_p, double *x_x, Rboolean is_U, int *perm, /* ^^^^^^ FIXME[Generalize] to int / ... */ SEXP resultKind) { const char* res_ch = CHAR(STRING_ELT(resultKind,0)); enum diag_kind { diag, diag_backpermuted, trace, prod, sum_log, min, max, range } res_kind = ((!strcmp(res_ch, "trace")) ? trace : ((!strcmp(res_ch, "sumLog")) ? sum_log : ((!strcmp(res_ch, "prod")) ? prod : ((!strcmp(res_ch, "min")) ? min : ((!strcmp(res_ch, "max")) ? max : ((!strcmp(res_ch, "range")) ? range : ((!strcmp(res_ch, "diag")) ? diag : ((!strcmp(res_ch, "diagBack")) ? diag_backpermuted : -1)))))))); int i, n_x, i_from; SEXP ans = PROTECT(allocVector(REALSXP, /* ^^^^ FIXME[Generalize] */ (res_kind == diag || res_kind == diag_backpermuted) ? n : (res_kind == range ? 2 : 1))); double *v = REAL(ans); /* ^^^^^^ ^^^^ FIXME[Generalize] */ i_from = (is_U ? -1 : 0); #define for_DIAG(v_ASSIGN) \ for(i = 0; i < n; i++) { \ /* looking at i-th column */ \ n_x = x_p[i+1] - x_p[i];/* #{entries} in this column */ \ if( is_U) i_from += n_x; \ v_ASSIGN; \ if(!is_U) i_from += n_x; \ } /* NOTA BENE: we assume -- uplo = "L" i.e. lower triangular matrix * for uplo = "U" (makes sense with a "dtCMatrix" !), * should use x_x[i_from + (n_x - 1)] instead of x_x[i_from], * where n_x = (x_p[i+1] - x_p[i]) */ switch(res_kind) { case trace: // = sum v[0] = 0.; for_DIAG(v[0] += x_x[i_from]); break; case sum_log: v[0] = 0.; for_DIAG(v[0] += log(x_x[i_from])); break; case prod: v[0] = 1.; for_DIAG(v[0] *= x_x[i_from]); break; case min: v[0] = R_PosInf; for_DIAG(if(v[0] > x_x[i_from]) v[0] = x_x[i_from]); break; case max: v[0] = R_NegInf; for_DIAG(if(v[0] < x_x[i_from]) v[0] = x_x[i_from]); break; case range: v[0] = R_PosInf; v[1] = R_NegInf; for_DIAG(if(v[0] > x_x[i_from]) v[0] = x_x[i_from]; if(v[1] < x_x[i_from]) v[1] = x_x[i_from]); break; case diag: for_DIAG(v[i] = x_x[i_from]); break; case diag_backpermuted: for_DIAG(v[i] = x_x[i_from]); warning(_("%s = '%s' (back-permuted) is experimental"), "resultKind", "diagBack"); /* now back_permute : */ for(i = 0; i < n; i++) { double tmp = v[i]; v[i] = v[perm[i]]; v[perm[i]] = tmp; /*^^^^ FIXME[Generalize] */ } break; default: /* -1 from above */ error(_("diag_tC(): invalid 'resultKind'")); /* Wall: */ ans = R_NilValue; v = REAL(ans); } UNPROTECT(1); return ans; } /** * Extract the diagonal entries from *triangular* Csparse matrix __or__ a * cholmod_sparse factor (LDL = TRUE). * * @param obj -- now a cholmod_sparse factor or a dtCMatrix * @param pslot 'p' (column pointer) slot of Csparse matrix/factor * @param xslot 'x' (non-zero entries) slot of Csparse matrix/factor * @param perm_slot 'perm' (= permutation vector) slot of corresponding CHMfactor; * only used for "diagBack" * @param resultKind a (SEXP) string indicating which kind of result is desired. * * @return a SEXP, either a (double) number or a length n-vector of diagonal entries */ SEXP diag_tC(SEXP obj, SEXP resultKind) { SEXP pslot = GET_SLOT(obj, Matrix_pSym), xslot = GET_SLOT(obj, Matrix_xSym); Rboolean is_U = (R_has_slot(obj, Matrix_uploSym) && *CHAR(asChar(GET_SLOT(obj, Matrix_uploSym))) == 'U'); int n = length(pslot) - 1, /* n = ncol(.) = nrow(.) */ *x_p = INTEGER(pslot), pp = -1, *perm; double *x_x = REAL(xslot); /* ^^^^^^ ^^^^ FIXME[Generalize] to INTEGER(.) / LOGICAL(.) / ... xslot !*/ if(R_has_slot(obj, Matrix_permSym)) perm = INTEGER(GET_SLOT(obj, Matrix_permSym)); else perm = &pp; return diag_tC_ptr(n, x_p, x_x, is_U, perm, resultKind); } /** * Create a Csparse matrix object from indices and/or pointers. * * @param cls name of actual class of object to create * @param i optional integer vector of length nnz of row indices * @param j optional integer vector of length nnz of column indices * @param p optional integer vector of length np of row or column pointers * @param np length of integer vector p. Must be zero if p == (int*)NULL * @param x optional vector of values * @param nnz length of vectors i, j and/or x, whichever is to be used * @param dims optional integer vector of length 2 to be used as * dimensions. If dims == (int*)NULL then the maximum row and column * index are used as the dimensions. * @param dimnames optional list of length 2 to be used as dimnames * @param index1 indicator of 1-based indices * * @return an SEXP of class cls inheriting from CsparseMatrix. */ SEXP create_Csparse(char* cls, int* i, int* j, int* p, int np, void* x, int nnz, int* dims, SEXP dimnames, int index1) { SEXP ans; int *ij = (int*)NULL, *tri, *trj, nrow = -1, ncol = -1; int xtype = -1; /* -Wall */ CHM_TR T; CHM_SP A; if (np < 0 || nnz < 0) error(_("negative vector lengths not allowed: np = %d, nnz = %d"), np, nnz); int mi = (i == (int*)NULL), // := missing 'i' mj = (j == (int*)NULL), // := missing 'j' mp = (p == (int*)NULL); // := missing 'p' if ((mi + mj + mp) != 1) error(_("exactly 1 of 'i', 'j' or 'p' must be NULL")); if (mp) { if (np) error(_("np = %d, must be zero when p is NULL"), np); } else { if (np) { /* Expand p to form i or j */ if (!(p[0])) error(_("p[0] = %d, should be zero"), p[0]); for (int ii = 0; ii < np; ii++) if (p[ii] > p[ii + 1]) error(_("p must be non-decreasing")); if (p[np] != nnz) error("p[np] = %d != nnz = %d", p[np], nnz); ij = Calloc(nnz, int); if (mi) { i = ij; nrow = np; } else { j = ij; ncol = np; } /* Expand p to 0-based indices */ for (int ii = 0; ii < np; ii++) for (int jj = p[ii]; jj < p[ii + 1]; jj++) ij[jj] = ii; } else { if (nnz) error(_("Inconsistent dimensions: np = 0 and nnz = %d"), nnz); } } /* calculate nrow and ncol */ if (nrow < 0) { for (int ii = 0; ii < nnz; ii++) { int i1 = i[ii] + (index1 ? 0 : 1); /* 1-based index */ if (i1 < 1) error(_("invalid row index at position %d"), ii); if (i1 > nrow) nrow = i1; } } if (ncol < 0) { for (int jj = 0; jj < nnz; jj++) { int j1 = j[jj] + (index1 ? 0 : 1); if (j1 < 1) error(_("invalid column index at position %d"), jj); if (j1 > ncol) ncol = j1; } } if (dims != (int*)NULL) { if (dims[0] > nrow) nrow = dims[0]; if (dims[1] > ncol) ncol = dims[1]; } /* check the class name */ if (strlen(cls) != 8) error(_("strlen of cls argument = %d, should be 8"), strlen(cls)); if (strcmp(cls + 2, "CMatrix")) error(_("cls = \"%s\" does not end in \"CMatrix\""), cls); switch(cls[0]) { case 'd': case 'l': xtype = CHOLMOD_REAL; break; case 'n': xtype = CHOLMOD_PATTERN; break; default: error(_("cls = \"%s\" must begin with 'd', 'l' or 'n'"), cls); } if (cls[1] != 'g') error(_("Only 'g'eneral sparse matrix types allowed")); /* allocate and populate the triplet */ T = cholmod_allocate_triplet((size_t)nrow, (size_t)ncol, (size_t)nnz, 0, xtype, &c); T->x = x; tri = (int*)T->i; trj = (int*)T->j; for (int ii = 0; ii < nnz; ii++) { tri[ii] = i[ii] - ((!mi && index1) ? 1 : 0); trj[ii] = j[ii] - ((!mj && index1) ? 1 : 0); } /* create the cholmod_sparse structure */ A = cholmod_triplet_to_sparse(T, nnz, &c); cholmod_free_triplet(&T, &c); /* copy the information to the SEXP */ ans = PROTECT(NEW_OBJECT_OF_CLASS(cls)); // FIXME: This has been copied from chm_sparse_to_SEXP in chm_common.c /* allocate and copy common slots */ nnz = cholmod_nnz(A, &c); dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2)); dims[0] = A->nrow; dims[1] = A->ncol; Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_pSym, INTSXP, A->ncol + 1)), (int*)A->p, A->ncol + 1); Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, nnz)), (int*)A->i, nnz); switch(cls[0]) { case 'd': Memcpy(REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, nnz)), (double*)A->x, nnz); break; case 'l': error(_("code not yet written for cls = \"lgCMatrix\"")); } /* FIXME: dimnames are *NOT* put there yet (if non-NULL) */ cholmod_free_sparse(&A, &c); UNPROTECT(1); return ans; } /** * Create a Csparse matrix object from a traditional R matrix * * @param x traditional R matrix (numeric, logical, ...) * @param cls class (a string), currently must be "..CMatrix" * * @return an SEXP of a class inheriting from CsparseMatrix. */ SEXP matrix_to_Csparse(SEXP x, SEXP cls) { if (!isMatrix(x)) error(_("%s must be (traditional R) matrix"), "'x'"); SEXP d_x = getAttrib(x, R_DimSymbol), dn_x = getAttrib(x, R_DimNamesSymbol); int nr = INTEGER(d_x)[0], nc = INTEGER(d_x)[1]; if (!(isString(cls) && LENGTH(cls) == 1)) error(_("%s must be character string"), "'cls'"); R_xlen_t ii, n = XLENGTH(x); int xtype = -1; if (n != ((R_xlen_t) nr) * nc) error(_("nrow * ncol = %d * %d must equal length(x) = %ld"), nr, nc, n); const char *ccls = CHAR(STRING_ELT(cls, 0)); if (strlen(ccls) != 9) error(_("strlen of cls argument = %d, should be 9"), strlen(ccls)); if (strcmp(ccls + 2, "CMatrix")) error(_("cls = \"%s\" does not end in \"CMatrix\""), ccls); switch(ccls[0]) { case 'd': case 'l': xtype = CHOLMOD_REAL; break; case 'n': xtype = CHOLMOD_PATTERN; break; default: error(_("cls = \"%s\" must begin with 'd', 'l' or 'n' for now"), ccls); } /* if (ccls[1] != 'g') */ /* error(_("Only 'g'eneral sparse matrix types allowed")); */ SEXP ans = PROTECT(NEW_OBJECT_OF_CLASS(ccls)); SET_SLOT(ans, Matrix_DimSym, d_x); SET_SLOT(ans, Matrix_DimNamesSym, (!isNull(dn_x) && LENGTH(dn_x) == 2) ? duplicate(dn_x) : allocVector(VECSXP, 2)); int nz = 0, // current number of nonzero entries nnz = imax2(256, imax2(nr,nc));/* nnz := final number of nonzero entries, yet unknown; -- must start with guess and then grow */ int *rp = INTEGER(ALLOC_SLOT(ans, Matrix_pSym, INTSXP, nc + 1)), *ri = Calloc(nnz, int); // to become i slot -- of not-yet-known length nnz rp[0] = 0; // always switch(TYPEOF(x)) { case LGLSXP: { if(xtype == CHOLMOD_PATTERN) { # define _PATTERN_x # include "t_matrix_to_Csp.c" } else { # define _LOGICAL_x # include "t_matrix_to_Csp.c" } break; } case REALSXP: { # define _DOUBLE_x # include "t_matrix_to_Csp.c" break; } /* case INTSXP: we would have to use x = coerceVector(x, REALSXP)); and then fall through to REALSXP case, but we must *not* modify 'x' here FIXME: use a macro or (inline?) function with argument (y), where ----- SEXP y = PROTECT(coerceVector(x, REALSXP)) ==> give error in INTSXP case, so caller (in R) must set storage.mode(x) <- "double" */ #ifdef _USING_INTEGER_NOT_READY__ case INTSXP: { # define _INTEGER_x # include "t_matrix_to_Csp.c" break; } #endif #ifdef _USING_COMPLEX_NOT_READY__ case CPLXSXP: { # define _COMPLEX_x # include "t_matrix_to_Csp.c" break; } #endif default: error(_("%s must be a logical or double vector"), "'x'"); break; } Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, nnz)), ri, nnz); Free(ri); UNPROTECT(1); return ans; } Matrix/src/Makevars0000644000176200001440000000214713622027022014001 0ustar liggesusers# -*- Makefile -*- PKG_CPPFLAGS = -DNTIMER -I./SuiteSparse_config -DUSE_FC_LEN_T ## we use the BLAS and the LAPACK library: PKG_LIBS = $(SUBLIBS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) MkInclude = $(R_HOME)/etc${R_ARCH}/Makeconf include scripts/SOURCES_C.mkf OBJECTS = $(SOURCES_C:.c=.o) SUBDIRS = CHOLMOD COLAMD AMD SuiteSparse_config SUBLIBS = $(SUBDIRS:=.a) all: $(SHLIB) ## making src/*.o and in sublibs can be done simultaneously # for development: #$(SHLIB): $(OBJECTS) sublibraries # for real: $(SHLIB): $(OBJECTS) sublibs ## We have to clean here, to clean up between architectures: ## INSTALL only cleans src/*.o src/*$(SHLIB_EXT) for each arch sublibs: subclean sublibraries sublibraries: subclean @for d in $(SUBDIRS); do \ (cd $${d} && CFLAGS="$(CFLAGS)" CXXFLAGS="$(CXXFLAGS)" MAKE="$(MAKE) -f \"$(MkInclude)\" -f Makefile" $(MAKE) -f "$(MkInclude)" -f Makefile library) || exit 1; \ done clean: subclean @-rm -rf .libs _libs @-rm -f *.o $(SHLIB) subclean: @-rm -f *.a @for d in $(SUBDIRS); do \ (cd $${d} && MkInclude="$(MkInclude)" $(MAKE) clean) || exit 1; \ done include scripts/DEPS.mkf Matrix/src/abIndex.h0000644000176200001440000000025111314233025014020 0ustar liggesusers#ifndef MATRIX_AbstrINDEX_H #define MATRIX_AbstrINDEX_H #include "Mutils.h" SEXP Matrix_rle_i(SEXP x_, SEXP force_); SEXP Matrix_rle_d(SEXP x_, SEXP force_); #endif Matrix/src/t_Csparse_validate.c0000644000176200001440000000557412201004116016243 0ustar liggesusers/* Included from ./Csparse.c * ---------- */ #ifdef _t_Csparse_sort # define CSPARSE_VAL_RES_TYPE static int # define CSPARSE_VAL_FN_NAME Csparse_sort_2 # define CSPARSE_VAL_RETURN_TRUE return 1 # define CSPARSE_VAL_RETURN_STRING(STR) return 0 # undef _t_Csparse_sort #elif defined (_t_Csparse_validate) # define CSPARSE_VAL_RES_TYPE SEXP # define CSPARSE_VAL_FN_NAME Csparse_validate_ # define CSPARSE_VAL_RETURN_TRUE return ScalarLogical(1) # define CSPARSE_VAL_RETURN_STRING(STR) return mkString(_(STR)) # undef _t_Csparse_validate #else # error "no valid _t_Csparse_* option" #endif CSPARSE_VAL_RES_TYPE CSPARSE_VAL_FN_NAME(SEXP x, Rboolean maybe_modify) { /* NB: we do *NOT* check a potential 'x' slot here, at all */ SEXP pslot = GET_SLOT(x, Matrix_pSym), islot = GET_SLOT(x, Matrix_iSym); Rboolean sorted, strictly; int j, k, *dims = INTEGER(GET_SLOT(x, Matrix_DimSym)), nrow = dims[0], ncol = dims[1], *xp = INTEGER(pslot), *xi = INTEGER(islot); if (length(pslot) != dims[1] + 1) CSPARSE_VAL_RETURN_STRING("slot p must have length = ncol(.) + 1"); if (xp[0] != 0) CSPARSE_VAL_RETURN_STRING("first element of slot p must be zero"); if (length(islot) < xp[ncol]) /* allow larger slots from over-allocation!*/ CSPARSE_VAL_RETURN_STRING("last element of slot p must match length of slots i and x"); for (j = 0; j < xp[ncol]; j++) { if (xi[j] < 0 || xi[j] >= nrow) CSPARSE_VAL_RETURN_STRING("all row indices must be between 0 and nrow-1"); } sorted = TRUE; strictly = TRUE; for (j = 0; j < ncol; j++) { if (xp[j] > xp[j + 1]) CSPARSE_VAL_RETURN_STRING("slot p must be non-decreasing"); if(sorted) /* only act if >= 2 entries in column j : */ for (k = xp[j] + 1; k < xp[j + 1]; k++) { if (xi[k] < xi[k - 1]) sorted = FALSE; else if (xi[k] == xi[k - 1]) strictly = FALSE; } } if (!sorted) { if(maybe_modify) { CHM_SP chx = (CHM_SP) alloca(sizeof(cholmod_sparse)); R_CheckStack(); as_cholmod_sparse(chx, x, FALSE, TRUE);/*-> cholmod_l_sort() ! */ /* as chx = AS_CHM_SP__(x) but ^^^^ sorting x in_place !!! */ /* Now re-check that row indices are *strictly* increasing * (and not just increasing) within each column : */ for (j = 0; j < ncol; j++) { for (k = xp[j] + 1; k < xp[j + 1]; k++) if (xi[k] == xi[k - 1]) CSPARSE_VAL_RETURN_STRING("slot i is not *strictly* increasing inside a column (even after cholmod_l_sort)"); } } else { /* no modifying sorting : */ CSPARSE_VAL_RETURN_STRING("row indices are not sorted within columns"); } } else if(!strictly) { /* sorted, but not strictly */ CSPARSE_VAL_RETURN_STRING("slot i is not *strictly* increasing inside a column"); } CSPARSE_VAL_RETURN_TRUE; } #undef CSPARSE_VAL_RES_TYPE #undef CSPARSE_VAL_FN_NAME #undef CSPARSE_VAL_RETURN_TRUE #undef CSPARSE_VAL_RETURN_STRING Matrix/src/dspMatrix.h0000644000176200001440000000122113774624325014442 0ustar liggesusers#ifndef MATRIX_SPMATRIX_H #define MATRIX_SPMATRIX_H #include "Lapack-etc.h" #include "Mutils.h" //was #include "dgeMatrix.h" -- seems much too much SEXP dspMatrix_validate(SEXP obj); double get_norm_sp(SEXP obj, const char *typstr); SEXP dspMatrix_norm(SEXP obj, SEXP type); SEXP dspMatrix_rcond(SEXP obj, SEXP type); SEXP dspMatrix_solve(SEXP a); SEXP dspMatrix_matrix_solve(SEXP a, SEXP b); SEXP dspMatrix_getDiag(SEXP x); SEXP lspMatrix_getDiag(SEXP x); SEXP dspMatrix_setDiag(SEXP x, SEXP d); SEXP lspMatrix_setDiag(SEXP x, SEXP d); SEXP dspMatrix_as_dsyMatrix(SEXP from); SEXP dspMatrix_matrix_mm(SEXP a, SEXP b); SEXP dspMatrix_trf(SEXP x); #endif Matrix/src/dpoMatrix.h0000644000176200001440000000060213774624325014440 0ustar liggesusers#ifndef MATRIX_POMATRIX_H #define MATRIX_POMATRIX_H #include "Lapack-etc.h" #include "Mutils.h" SEXP dpoMatrix_rcond(SEXP obj, SEXP type); SEXP dpoMatrix_validate(SEXP obj); SEXP dpoMatrix_solve(SEXP a); SEXP dpoMatrix_matrix_solve(SEXP a, SEXP b); SEXP dpoMatrix_dgeMatrix_solve(SEXP a, SEXP b); SEXP dpoMatrix_chol(SEXP x); double get_norm_sy(SEXP obj, const char *typstr); #endif Matrix/src/t_sparseVector.c0000644000176200001440000000672411643347276015502 0ustar liggesusers/*------ Definition of a template for [dilnz]sparseVector_sub(...) : * * -------- ~~~~~~~~~~~~~~~~~~~~~~ * i.e., included several times from ./Mutils.h * ~~~~~~~~ */ /* for all cases with an 'x' slot -- i.e. almost all cases ; * just redefine this in the other cases: */ #ifdef _dspV_ # define sparseVector_sub dsparseVector_sub # define _DOUBLE_ans # define _has_x_slot_ # undef _dspV_ #elif defined (_ispV_) # define sparseVector_sub isparseVector_sub # define _INT_ans # define _has_x_slot_ # undef _ispV_ #elif defined (_lspV_) # define sparseVector_sub lsparseVector_sub # define _LGL_ans # define _has_x_slot_ # undef _lspV_ #elif defined (_nspV_) # define sparseVector_sub nsparseVector_sub # define _LGL_ans /* withOUT 'x' slot */ # undef _nspV_ #elif defined (_zspV_) # define sparseVector_sub zsparseVector_sub # define _CPLX_ans # define _has_x_slot_ # undef _zspV_ #else # error "no valid _[dilnz]spV_ option" #endif /* - - - - - - - - - - - - - - - - - - - - */ #ifdef _DOUBLE_ans # define Type_ans double # define STYP_ans REAL # define NA_ans NA_REAL # define z_ans (0.) # define SXP_ans REALSXP #undef _DOUBLE_ans #elif defined (_INT_ans) # define Type_ans int # define STYP_ans INTEGER # define NA_ans NA_INTEGER # define z_ans (0) # define SXP_ans INTSXP #undef _INT_ans #elif defined (_LGL_ans) # define Type_ans int # define STYP_ans LOGICAL # define NA_ans NA_LOGICAL # define z_ans (0) # define SXP_ans LGLSXP #undef _LGL_ans #elif defined (_CPLX_ans) static Rcomplex cmplx_zero() { Rcomplex z; z.r = z.i = 0.; return z; } #ifdef _using_NA_ans // <-- get rid of "non-used" warning message static Rcomplex cmplx_NA() { Rcomplex z; z.r = z.i = NA_REAL; return z; } #endif # define Type_ans Rcomplex # define STYP_ans COMPLEX # define NA_ans cmplx_NA(); // "FIXME": NA_COMPLEX does not yet exist # define z_ans cmplx_zero(); # define SXP_ans CPLXSXP #undef _CPLX_ans #else # error "invalid macro logic" #endif /* - - - - - - - - - - - - - - - - - - - - */ #ifdef _has_x_slot_ /* currently have x slot always double (cholmod restriction): */ # define is_NA_x_(u) ISNAN(u) #endif /* Now the template which depends on the above macros : */ /** * Indexing a sparseVector 'vec', including recycling it (conceptually), i.e. * return vec[i] * * @param i index (0-based, contrary to the i-slot) * @param nnz_v the number of non-zero entries of 'vec' == length(vec@ i) * @param v_i (a int * pointer to) the 'i' slot of 'vec' * @param v_x (a ... * pointer to) the 'x' slot of 'vec' * @param len_v integer = the 'length' slot of 'vec * * @return */ static R_INLINE Type_ans sparseVector_sub(int64_t i, int nnz_v, double* v_i, Type_ans* v_x, int64_t len_v) { // double *v_i = INTEGER(GET_SLOT(vec, Matrix_iSym)); // double *v_x = REAL (GET_SLOT(vec, Matrix_xSym)); -- try to be agnostic about type // int64_t len_v = (int64_t) asReal(GET_SLOT(vec, Matrix_lengthSym)); int64_t i1 = (i % len_v) +1; // NB: Rely on the "validity": the i-slot v_i[] is strictly sorted increasingly for(int j=0; j < nnz_v; j++) { if(i1 > v_i[j]) continue; // else: i1 <= v_i[j] if(i1 == v_i[j]) // have a match #ifdef _has_x_slot_ return v_x[j]; #else return 1; #endif else // no match: the element is zero return z_ans; } return z_ans; } #undef Type_ans #undef STYP_ans #undef NA_ans #undef z_ans #undef SXP_ans #undef _has_x_slot_ #undef sparseVector_sub Matrix/src/dgCMatrix.c0000644000176200001440000005444014127302060014335 0ustar liggesusers#ifdef __GLIBC__ // to get strdup declared in glibc (when strict -std=c11 or -stdc99): #define _POSIX_C_SOURCE 200809L #endif #include #include "dgCMatrix.h" /* for Csparse_transpose() : */ #include "Csparse.h" #include "chm_common.h" /* -> Mutils.h / SPQR ... */ /* FIXME -- we "forget" about dimnames almost everywhere : */ /* for dgCMatrix _and_ lgCMatrix and others (but *not* ngC...) : */ SEXP xCMatrix_validate(SEXP x) { /* Almost everything now in Csparse_validate ( ./Csparse.c ) * *but* the checking of the 'x' slot : */ if (xlength(GET_SLOT(x, Matrix_iSym)) != xlength(GET_SLOT(x, Matrix_xSym))) return mkString(_("lengths of slots 'i' and 'x' must match")); return ScalarLogical(1); } /* for dgRMatrix _and_ lgRMatrix and others (but *not* ngC...) : */ SEXP xRMatrix_validate(SEXP x) { /* Almost everything now in Rsparse_validate ( ./Csparse.c ) * *but* the checking of the 'x' slot : */ if (xlength(GET_SLOT(x, Matrix_jSym)) != xlength(GET_SLOT(x, Matrix_xSym))) return mkString(_("lengths of slots 'j' and 'x' must match")); return ScalarLogical(1); } /* This and the following R_to_CMatrix() lead to memory-not-mapped seg.faults * only with {32bit + R-devel + enable-R-shlib} -- no idea why */ SEXP compressed_to_TMatrix(SEXP x, SEXP colP) { char *ncl = strdup(class_P(x)); static const char *valid[] = { MATRIX_VALID_Csparse, MATRIX_VALID_Rsparse, ""}; int ctype = R_check_class_etc(x, valid); if (ctype < 0) error(_("invalid class(x) '%s' in compressed_to_TMatrix(x)"), ncl); int col = asLogical(colP); /* 1 if "C"olumn compressed; 0 if "R"ow */ /* however, for Csparse, we now effectively use the cholmod-based * Csparse_to_Tsparse() in ./Csparse.c ; maybe should simply write * an as_cholmod_Rsparse() function and then do "as there" ...*/ SEXP indSym = col ? Matrix_iSym : Matrix_jSym, ans, indP = PROTECT(GET_SLOT(x, indSym)), pP = PROTECT(GET_SLOT(x, Matrix_pSym)); int npt = length(pP) - 1; /* replace 'C' or 'R' with 'T' :*/ ncl[2] = 'T'; ans = PROTECT(NEW_OBJECT_OF_CLASS(ncl)); slot_dup(ans, x, Matrix_DimSym); if((ctype / 3) % 4 != 2) /* not n..Matrix */ slot_dup(ans, x, Matrix_xSym); if(ctype % 3) { /* s(ymmetric) or t(riangular) : */ slot_dup(ans, x, Matrix_uploSym); if(ctype % 3 == 2) /* t(riangular) : */ slot_dup(ans, x, Matrix_diagSym); } SET_DimNames(ans, x); // possibly asymmetric for symmetricMatrix is ok SET_SLOT(ans, indSym, duplicate(indP)); expand_cmprPt(npt, INTEGER(pP), INTEGER(ALLOC_SLOT(ans, col ? Matrix_jSym : Matrix_iSym, INTSXP, length(indP)))); free(ncl); UNPROTECT(3); return ans; } SEXP R_to_CMatrix(SEXP x) { char *ncl = strdup(class_P(x)); static const char *valid[] = { MATRIX_VALID_Rsparse, ""}; int ctype = R_check_class_etc(x, valid); if (ctype < 0) error(_("invalid class(x) '%s' in R_to_CMatrix(x)"), ncl); SEXP ans, tri = PROTECT(allocVector(LGLSXP, 1)); int *x_dims = INTEGER(GET_SLOT(x, Matrix_DimSym)), *a_dims; PROTECT_INDEX ipx; /* replace 'R' with 'C' : */ ncl[2] = 'C'; PROTECT_WITH_INDEX(ans = NEW_OBJECT_OF_CLASS(ncl), &ipx); a_dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2)); /* reversed dim() since we will transpose: */ a_dims[0] = x_dims[1]; a_dims[1] = x_dims[0]; /* triangular: */ LOGICAL(tri)[0] = 0; if((ctype / 3) != 2) /* not n..Matrix */ slot_dup(ans, x, Matrix_xSym); if(ctype % 3) { /* s(ymmetric) or t(riangular) : */ SET_SLOT(ans, Matrix_uploSym, mkString((*uplo_P(x) == 'U') ? "L" : "U")); if(ctype % 3 == 2) { /* t(riangular) : */ LOGICAL(tri)[0] = 1; slot_dup(ans, x, Matrix_diagSym); } } SET_SLOT(ans, Matrix_iSym, duplicate(GET_SLOT(x, Matrix_jSym))); slot_dup(ans, x, Matrix_pSym); REPROTECT(ans = Csparse_transpose(ans, tri), ipx); SET_DimNames(ans, x); // possibly asymmetric for symmetricMatrix is ok free(ncl); UNPROTECT(2); return ans; } /** Return a 2 column matrix '' cbind(i, j) '' of 0-origin index vectors (i,j) * which entirely correspond to the (i,j) slots of * as(x, "TsparseMatrix") : */ SEXP compressed_non_0_ij(SEXP x, SEXP colP) { int col = asLogical(colP); /* 1 if "C"olumn compressed; 0 if "R"ow */ SEXP ans, indSym = col ? Matrix_iSym : Matrix_jSym; SEXP indP = PROTECT(GET_SLOT(x, indSym)), pP = PROTECT(GET_SLOT(x, Matrix_pSym)); int i, *ij; int nouter = INTEGER(GET_SLOT(x, Matrix_DimSym))[col ? 1 : 0], n_el = INTEGER(pP)[nouter]; /* is only == length(indP), if the inner slot is not over-allocated */ ij = INTEGER(ans = PROTECT(allocMatrix(INTSXP, n_el, 2))); /* expand the compressed margin to 'i' or 'j' : */ expand_cmprPt(nouter, INTEGER(pP), &ij[col ? n_el : 0]); /* and copy the other one: */ if (col) for(i = 0; i < n_el; i++) ij[i] = INTEGER(indP)[i]; else /* row compressed */ for(i = 0; i < n_el; i++) ij[i + n_el] = INTEGER(indP)[i]; UNPROTECT(3); return ans; } #if 0 /* unused */ SEXP dgCMatrix_lusol(SEXP x, SEXP y) { SEXP ycp = PROTECT((TYPEOF(y) == REALSXP) ? duplicate(y) : coerceVector(y, REALSXP)); CSP xc = AS_CSP__(x); R_CheckStack(); if (xc->m != xc->n || xc->m <= 0) error(_("dgCMatrix_lusol requires a square, non-empty matrix")); if (LENGTH(ycp) != xc->m) error(_("Dimensions of system to be solved are inconsistent")); if (!cs_lusol(/*order*/ 1, xc, REAL(ycp), /*tol*/ 1e-7)) error(_("cs_lusol failed")); UNPROTECT(1); return ycp; } #endif // called from package MatrixModels's R code SEXP dgCMatrix_qrsol(SEXP x, SEXP y, SEXP ord) { /* FIXME: extend this to work in multivariate case, i.e. y a matrix with > 1 column ! */ SEXP ycp = PROTECT((TYPEOF(y) == REALSXP) ? duplicate(y) : coerceVector(y, REALSXP)); CSP xc = AS_CSP(x); /* <--> x may be dgC* or dtC* */ int order = asInteger(ord); #ifdef _not_yet_do_FIXME__ const char *nms[] = {"L", "coef", "Xty", "resid", ""}; SEXP ans = PROTECT(Rf_mkNamed(VECSXP, nms)); #endif R_CheckStack(); if (order < 0 || order > 3) error(_("dgCMatrix_qrsol(., order) needs order in {0,..,3}")); /* --> cs_amd() --- order 0: natural, 1: Chol, 2: LU, 3: QR */ if (LENGTH(ycp) != xc->m) error(_("Dimensions of system to be solved are inconsistent")); /* FIXME? Note that qr_sol() would allow *under-determined systems; * In general, we'd need LENGTH(ycp) = max(n,m) * FIXME also: multivariate y (see above) */ if (xc->m < xc->n || xc->n <= 0) error(_("dgCMatrix_qrsol(<%d x %d>-matrix) requires a 'tall' rectangular matrix"), xc->m, xc->n); /* cs_qrsol(): Tim Davis (2006) .. "8.2 Using a QR factorization", p.136f , calling * ------- cs_sqr(order, ..), see p.76 */ /* MM: FIXME: write our *OWN* version of - the first case (m >= n) - of cs_qrsol() * --------- which will (1) work with a *multivariate* y * (2) compute coefficients properly, not overwriting RHS */ if (!cs_qrsol(order, xc, REAL(ycp))) /* return value really is 0 or 1 - no more info there */ error(_("cs_qrsol() failed inside dgCMatrix_qrsol()")); /* Solution is only in the first part of ycp -- cut its length back to n : */ ycp = lengthgets(ycp, (R_xlen_t) xc->n); UNPROTECT(1); return ycp; } // Modified version of Tim Davis's cs_qr_mex.c file for MATLAB (in CSparse) // Usage: [V,beta,p,R,q] = cs_qr(A) ; SEXP dgCMatrix_QR(SEXP Ap, SEXP order, SEXP keep_dimnames) { CSP A = AS_CSP__(Ap); int io = INTEGER(order)[0]; Rboolean verbose = (io < 0);// verbose=TRUE, encoded with negative 'order' int m0 = A->m, m = m0, n = A->n, ord = asLogical(order) ? 3 : 0, *p; R_CheckStack(); if (m < n) error(_("A must have #{rows} >= #{columns}")) ; SEXP ans = PROTECT(NEW_OBJECT_OF_CLASS("sparseQR")); int *dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2)); dims[0] = m; dims[1] = n; css *S = cs_sqr(ord, A, 1); /* symbolic QR ordering & analysis*/ if (!S) error(_("cs_sqr failed")); int keep_dimnms = asLogical(keep_dimnames); if(keep_dimnms == NA_LOGICAL) { keep_dimnms = TRUE; warning(_("dgcMatrix_QR(*, keep_dimnames = NA): NA taken as TRUE")); } if(verbose && S->m2 > m) // in ./cs.h , m2 := # of rows for QR, after adding fictitious rows Rprintf("Symbolic QR(): Matrix structurally rank deficient (m2-m = %d)\n", S->m2 - m); csn *N = cs_qr(A, S); /* numeric QR factorization */ if (!N) error(_("cs_qr failed")) ; cs_dropzeros(N->L); /* drop zeros from V and sort */ CSP D = cs_transpose(N->L, 1); cs_spfree(N->L); N->L = cs_transpose(D, 1); cs_spfree(D); cs_dropzeros(N->U); /* drop zeros from R and sort */ D = cs_transpose(N->U, 1); cs_spfree(N->U) ; N->U = cs_transpose(D, 1); cs_spfree(D); m = N->L->m; /* m may be larger now */ // MM: m := S->m2 also counting the ficticious rows (Tim Davis, p.72, 74f) p = cs_pinv(S->pinv, m); /* p = pinv' */ SEXP dn = R_NilValue; Rboolean do_dn = FALSE; if(keep_dimnms) { dn = GET_SLOT(Ap, Matrix_DimNamesSym); do_dn = !isNull(VECTOR_ELT(dn, 0)) && m == m0; // FIXME? also deal with case m > m0 ? if(do_dn) { // keep rownames dn = PROTECT(duplicate(dn)); SET_VECTOR_ELT(dn, 1, R_NilValue); } else dn = R_NilValue; } SET_SLOT(ans, Matrix_VSym, Matrix_cs_to_SEXP(N->L, "dgCMatrix", 0, dn)); // "V" Memcpy(REAL(ALLOC_SLOT(ans, Matrix_betaSym, REALSXP, n)), N->B, n); Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_pSym, INTSXP, m)), p, m); if(do_dn) { UNPROTECT(1); // dn dn = R_NilValue; do_dn = FALSE; } if (ord) { Memcpy(INTEGER(ALLOC_SLOT(ans, install("q"), INTSXP, n)), S->q, n); if(keep_dimnms) { dn = GET_SLOT(Ap, Matrix_DimNamesSym); do_dn = !isNull(VECTOR_ELT(dn, 1)); if(do_dn) { dn = PROTECT(duplicate(dn)); // permute colnames by S->q : cn <- cn[ S->q ] : SEXP cns = PROTECT(duplicate(VECTOR_ELT(dn, 1))); for(int j=0; j < n; j++) SET_STRING_ELT(VECTOR_ELT(dn, 1), j, STRING_ELT(cns, S->q[j])); UNPROTECT(1); SET_VECTOR_ELT(dn, 0, R_NilValue); } else dn = R_NilValue; } } else ALLOC_SLOT(ans, install("q"), INTSXP, 0); SEXP R = PROTECT(Matrix_cs_to_SEXP(N->U, "dgCMatrix", 0, dn)); SET_SLOT(ans, Matrix_RSym, R); UNPROTECT(1); // R if(do_dn) UNPROTECT(1); // dn cs_nfree(N); cs_sfree(S); cs_free(p); UNPROTECT(1); return ans; } #ifdef Matrix_with_SPQR /** * Return a SuiteSparse QR factorization of the sparse matrix A * * @param Ap (pointer to) a [m x n] dgCMatrix * @param ordering integer SEXP specifying the ordering strategy to be used * see SPQR/Include/SuiteSparseQR_definitions.h * @param econ integer SEXP ("economy"): number of rows of R and columns of Q * to return. The default is m. Using n gives the standard economy form. * A value less than the estimated rank r is set to r, so econ=0 gives the * "rank-sized" factorization, where nrow(R)==nnz(diag(R))==r. * @param tol double SEXP: if tol <= -2 use SPQR's default, * if -2 < tol < 0, then no tol is used; otherwise, * tol > 0, use as tolerance: columns with 2-norm <= tol treated as 0 * * * @return SEXP "SPQR" object with slots (Q, R, p, rank, Dim): * Q: dgCMatrix; R: dgCMatrix [subject to change to dtCMatrix FIXME ?] * p: integer: 0-based permutation (or length 0 <=> identity); * rank: integer, the "revealed" rank Dim: integer, original matrix dim. */ SEXP dgCMatrix_SPQR(SEXP Ap, SEXP ordering, SEXP econ, SEXP tol) { /* SEXP ans = PROTECT(allocVector(VECSXP, 4)); */ SEXP ans = PROTECT(NEW_OBJECT_OF_CLASS("SPQR")); CHM_SP A = AS_CHM_SP(Ap), Q, R; SuiteSparse_long *E, rank;/* not always = int FIXME (Windows_64 ?) */ if ((rank = SuiteSparseQR_C_QR(asInteger(ordering), asReal(tol),/* originally had SPQR_DEFAULT_TOL */ (SuiteSparse_long)asInteger(econ),/* originally had 0 */ A, &Q, &R, &E, &cl)) == -1) error(_("SuiteSparseQR_C_QR returned an error code")); slot_dup(ans, Ap, Matrix_DimSym); /* SET_VECTOR_ELT(ans, 0, */ /* chm_sparse_to_SEXP(Q, 0, 0, 0, "", R_NilValue)); */ SET_SLOT(ans, install("Q"), chm_sparse_to_SEXP(Q, 0, 0, 0, "", R_NilValue)); /* Also gives a dgCMatrix (not a dtC* *triangular*) : * may make sense if to be used in the "spqr_solve" routines .. ?? */ /* SET_VECTOR_ELT(ans, 1, */ /* chm_sparse_to_SEXP(R, 0, 0, 0, "", R_NilValue)); */ SET_SLOT(ans, Matrix_RSym, chm_sparse_to_SEXP(R, 0, 0, 0, "", R_NilValue)); cholmod_free_sparse(&Al, &cl); cholmod_free_sparse(&R, &cl); cholmod_free_sparse(&Q, &cl); if (E) { SET_VECTOR_ELT(ans, 2, allocVector(INTSXP, A->ncol)); int *Er = INTEGER(VECTOR_ELT(ans, 2)); for (int i = 0; i < A->ncol; i++) Er[i] = (int) E[i]; Free(E); } else SET_VECTOR_ELT(ans, 2, allocVector(INTSXP, 0)); SET_VECTOR_ELT(ans, 3, ScalarInteger((int)rank)); UNPROTECT(1); return ans; } #endif /* Matrix_with_SPQR */ /* Modified version of Tim Davis's cs_lu_mex.c file for MATLAB */ void install_lu(SEXP Ap, int order, double tol, Rboolean err_sing, Rboolean keep_dimnms) { // (order, tol) == (1, 1) by default, when called from R. CSP A = AS_CSP__(Ap); R_CheckStack(); int n = A->n; if (A->m != n) error(_("LU decomposition applies only to square matrices")); if (order) { /* not using natural order */ order = (tol == 1) ? 2 /* amd(S'*S) w/dense rows or I */ : 1; /* amd (A+A'), or natural */ } css *S = cs_sqr(order, A, /*qr = */ 0); /* symbolic ordering */ csn *N = cs_lu(A, S, tol); /* numeric factorization */ if (!N) { cs_sfree(S); if(err_sing) error(_("cs_lu(A) failed: near-singular A (or out of memory)")); else { /* No warning: The useR should be careful : * Put NA into "LU" factor */ set_factors(Ap, ScalarLogical(NA_LOGICAL), "LU"); return; } } cs_dropzeros(N->L); /* drop zeros from L and sort it */ CSP D = cs_transpose(N->L, 1); cs_spfree(N->L); N->L = cs_transpose(D, 1); cs_spfree(D); cs_dropzeros(N->U); /* drop zeros from U and sort it */ D = cs_transpose(N->U, 1); cs_spfree(N->U); N->U = cs_transpose(D, 1); cs_spfree(D); int *p = cs_pinv(N->pinv, n); /* p=pinv' */ SEXP ans = PROTECT(NEW_OBJECT_OF_CLASS("sparseLU")); int *dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2)); dims[0] = n; dims[1] = n; SEXP dn; Rboolean do_dn = FALSE; if(keep_dimnms) { dn = GET_SLOT(Ap, Matrix_DimNamesSym); do_dn = !isNull(VECTOR_ELT(dn, 0)); if(do_dn) { dn = PROTECT(duplicate(dn)); // permute rownames by p : rn <- rn[ p ] : SEXP rn = PROTECT(duplicate(VECTOR_ELT(dn, 0))); for(int i=0; i < n; i++) SET_STRING_ELT(VECTOR_ELT(dn, 0), i, STRING_ELT(rn, p[i])); UNPROTECT(1); // rn SET_VECTOR_ELT(dn, 1, R_NilValue); // colnames(.) := NULL } } SET_SLOT(ans, Matrix_LSym, Matrix_cs_to_SEXP(N->L, "dtCMatrix", 0, do_dn ? dn : R_NilValue)); if(keep_dimnms) { if(do_dn) { UNPROTECT(1); // dn dn = GET_SLOT(Ap, Matrix_DimNamesSym); } do_dn = !isNull(VECTOR_ELT(dn, 1)); if(do_dn) { dn = PROTECT(duplicate(dn)); if(order) { // permute colnames by S->q : cn <- cn[ S->q ] : SEXP cn = PROTECT(duplicate(VECTOR_ELT(dn, 1))); for(int j=0; j < n; j++) SET_STRING_ELT(VECTOR_ELT(dn, 1), j, STRING_ELT(cn, S->q[j])); UNPROTECT(1); // cn } SET_VECTOR_ELT(dn, 0, R_NilValue); // rownames(.) := NULL } } SET_SLOT(ans, Matrix_USym, Matrix_cs_to_SEXP(N->U, "dtCMatrix", 0, do_dn ? dn : R_NilValue)); if(do_dn) UNPROTECT(1); // dn Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_pSym, /* "p" */ INTSXP, n)), p, n); if (order) Memcpy(INTEGER(ALLOC_SLOT(ans, install("q"), INTSXP, n)), S->q, n); cs_nfree(N); cs_sfree(S); cs_free(p); UNPROTECT(1); set_factors(Ap, ans, "LU"); } SEXP dgCMatrix_LU(SEXP Ap, SEXP orderp, SEXP tolp, SEXP error_on_sing, SEXP keep_dimnames) { SEXP ans; Rboolean err_sing = asLogical(error_on_sing); /* FIXME: dgCMatrix_LU should check ans for consistency in * permutation type with the requested value - Should have two * classes or two different names in the factors list for LU with * permuted columns or not. * OTOH, currently (order, tol) === (1, 1) always. * It is true that length(LU@q) does flag the order argument. */ if (!isNull(ans = get_factors(Ap, "LU"))) return ans; int keep_dimnms = asLogical(keep_dimnames); if(keep_dimnms == NA_LOGICAL) { keep_dimnms = TRUE; warning(_("dgcMatrix_LU(*, keep_dimnames = NA): NA taken as TRUE")); } install_lu(Ap, asInteger(orderp), asReal(tolp), err_sing, keep_dimnms); return get_factors(Ap, "LU"); } SEXP dgCMatrix_matrix_solve(SEXP Ap, SEXP b, SEXP give_sparse) // FIXME: add 'keep_dimnames' as argument { Rboolean sparse = asLogical(give_sparse); if(sparse) { // FIXME: implement this error(_("dgCMatrix_matrix_solve(.., sparse=TRUE) not yet implemented")); /* Idea: in the for(j = 0; j < nrhs ..) loop below, build the *sparse* result matrix * ----- *column* wise -- which is perfect for dgCMatrix * --> build (i,p,x) slots "increasingly" [well, allocate in batches ..] * * --> maybe first a protoype in R */ } SEXP ans = PROTECT(dup_mMatrix_as_dgeMatrix(b)), lu, qslot; CSP L, U; int *bdims = INTEGER(GET_SLOT(ans, Matrix_DimSym)), *p, *q; int j, n = bdims[0], nrhs = bdims[1]; double *x, *ax = REAL(GET_SLOT(ans, Matrix_xSym)); C_or_Alloca_TO(x, n, double); if (isNull(lu = get_factors(Ap, "LU"))) { install_lu(Ap, /* order = */ 1, /* tol = */ 1.0, /* err_sing = */ TRUE, /* keep_dimnames = */ TRUE); lu = get_factors(Ap, "LU"); } qslot = GET_SLOT(lu, install("q")); L = AS_CSP__(GET_SLOT(lu, Matrix_LSym)); U = AS_CSP__(GET_SLOT(lu, Matrix_USym)); R_CheckStack(); if (U->n != n) error(_("Dimensions of system to be solved are inconsistent")); if(nrhs >= 1 && n >= 1) { R_xlen_t n_ = n; // <=> no overflow in j * n_ p = INTEGER(GET_SLOT(lu, Matrix_pSym)); q = LENGTH(qslot) ? INTEGER(qslot) : (int *) NULL; for (j = 0; j < nrhs; j++) { cs_pvec(p, ax + j * n_, x, n); /* x = b(p) */ cs_lsolve(L, x); /* x = L\x */ cs_usolve(U, x); /* x = U\x */ if (q) /* r(q) = x , hence r = Q' U{^-1} L{^-1} P b = A^{-1} b */ cs_ipvec(q, x, ax + j * n_, n); else Memcpy(ax + j * n_, x, n); } } if(n >= SMALL_4_Alloca) Free(x); UNPROTECT(1); return ans; } // called from package MatrixModels's R code: SEXP dgCMatrix_cholsol(SEXP x, SEXP y) { /* Solve Sparse Least Squares X %*% beta ~= y with dense RHS y, * where X = t(x) i.e. we pass x = t(X) as argument, * via "Cholesky(X'X)" .. well not really: * cholmod_factorize("x", ..) finds L in X'X = L'L directly */ CHM_SP cx = AS_CHM_SP(x); /* FIXME: extend this to work in multivariate case, i.e. y a matrix with > 1 column ! */ SEXP y_ = PROTECT(coerceVector(y, REALSXP)); CHM_DN cy = AS_CHM_DN(y_), rhs, cAns, resid; CHM_FR L; int n = cx->ncol;/* #{obs.} {x = t(X) !} */ double one[] = {1,0}, zero[] = {0,0}, neg1[] = {-1,0}; const char *nms[] = {"L", "coef", "Xty", "resid", ""}; SEXP ans = PROTECT(Rf_mkNamed(VECSXP, nms)); R_CheckStack(); if (n < cx->nrow || n <= 0) error(_("dgCMatrix_cholsol requires a 'short, wide' rectangular matrix")); if (cy->nrow != n) error(_("Dimensions of system to be solved are inconsistent")); rhs = cholmod_allocate_dense(cx->nrow, 1, cx->nrow, CHOLMOD_REAL, &c); /* cholmod_sdmult(A, transp, alpha, beta, X, Y, &c): * Y := alpha*(A*X) + beta*Y or alpha*(A'*X) + beta*Y ; * here: rhs := 1 * x %*% y + 0 = x %*% y = X'y */ if (!(cholmod_sdmult(cx, 0 /* trans */, one, zero, cy, rhs, &c))) error(_("cholmod_sdmult error (rhs)")); L = cholmod_analyze(cx, &c); if (!cholmod_factorize(cx, L, &c)) error(_("cholmod_factorize failed: status %d, minor %d from ncol %d"), c.status, L->minor, L->n); /* FIXME: Do this in stages so an "effects" vector can be calculated */ if (!(cAns = cholmod_solve(CHOLMOD_A, L, rhs, &c))) error(_("cholmod_solve (CHOLMOD_A) failed: status %d, minor %d from ncol %d"), c.status, L->minor, L->n); /* L : */ SET_VECTOR_ELT(ans, 0, chm_factor_to_SEXP(L, 0)); /* coef : */ SET_VECTOR_ELT(ans, 1, allocVector(REALSXP, cx->nrow)); Memcpy(REAL(VECTOR_ELT(ans, 1)), (double*)(cAns->x), cx->nrow); /* X'y : */ /* FIXME: Change this when the "effects" vector is available */ SET_VECTOR_ELT(ans, 2, allocVector(REALSXP, cx->nrow)); Memcpy(REAL(VECTOR_ELT(ans, 2)), (double*)(rhs->x), cx->nrow); /* resid := y */ resid = cholmod_copy_dense(cy, &c); /* cholmod_sdmult(A, transp, alp, bet, X, Y, &c): * Y := alp*(A*X) + bet*Y or alp*(A'*X) + beta*Y ; * here: resid := -1 * x' %*% coef + 1 * y = y - X %*% coef */ if (!(cholmod_sdmult(cx, 1/* trans */, neg1, one, cAns, resid, &c))) error(_("cholmod_sdmult error (resid)")); /* FIXME: for multivariate case, i.e. resid *matrix* with > 1 column ! */ SET_VECTOR_ELT(ans, 3, allocVector(REALSXP, n)); Memcpy(REAL(VECTOR_ELT(ans, 3)), (double*)(resid->x), n); cholmod_free_factor(&L, &c); cholmod_free_dense(&rhs, &c); cholmod_free_dense(&cAns, &c); UNPROTECT(2); return ans; } /* Define all of * dgCMatrix_colSums(....) * igCMatrix_colSums(....) * lgCMatrix_colSums_d(....) * lgCMatrix_colSums_i(....) * ngCMatrix_colSums_d(....) * ngCMatrix_colSums_i(....) */ #define _dgC_ #include "t_gCMatrix_colSums.c" #define _igC_ #include "t_gCMatrix_colSums.c" #define _lgC_ #include "t_gCMatrix_colSums.c" #define _ngC_ #include "t_gCMatrix_colSums.c" #define _lgC_mn #include "t_gCMatrix_colSums.c" #define _ngC_mn #include "t_gCMatrix_colSums.c" SEXP lgCMatrix_colSums(SEXP x, SEXP NArm, SEXP spRes, SEXP trans, SEXP means) { if(asLogical(means)) /* ==> result will be "double" / "dsparseVector" */ return lgCMatrix_colSums_d(x, NArm, spRes, trans, means); else return lgCMatrix_colSums_i(x, NArm, spRes, trans, means); } SEXP ngCMatrix_colSums(SEXP x, SEXP NArm, SEXP spRes, SEXP trans, SEXP means) { if(asLogical(means)) /* ==> result will be "double" / "dsparseVector" */ return ngCMatrix_colSums_d(x, NArm, spRes, trans, means); else return ngCMatrix_colSums_i(x, NArm, spRes, trans, means); } Matrix/src/dtTMatrix.h0000644000176200001440000000030510763341137014401 0ustar liggesusers#ifndef MATRIX_TRT_H #define MATRIX_TRT_H #include "Mutils.h" #include "chm_common.h" SEXP dtTMatrix_as_dtrMatrix(SEXP x); SEXP tTMatrix_validate(SEXP x); SEXP xTMatrix_validate(SEXP x); #endif Matrix/src/dsyMatrix.c0000644000176200001440000002052414154104143014435 0ustar liggesusers#include "dsyMatrix.h" SEXP symmetricMatrix_validate(SEXP obj) { SEXP val = GET_SLOT(obj, Matrix_DimSym); if (LENGTH(val) < 2) return mkString(_("'Dim' slot has length less than two")); if (INTEGER(val)[0] != INTEGER(val)[1]) return mkString(_("Matrix is not square")); if (isString(val = check_scalar_string(GET_SLOT(obj, Matrix_uploSym), "LU", "uplo"))) return val; /* FIXME: Check dimnames {with a modular separate function}: Allow 1 of 2 to be NULL, * ----- but otherwise may *NOT* differ !! * currently, I2 <- Diagonal(2) ; dimnames(I2) <- list(c("A","B"), c("x","y")); L2 <- !!I2 * produces such an "invalid" symmetric matrix: L2[1:2,1:2] then fails */ return ScalarLogical(1); } double get_norm_sy(SEXP obj, const char *typstr) { char typnm[] = {'\0', '\0'}; int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)); double *work = (double *) NULL; typnm[0] = La_norm_type(typstr); if (*typnm == 'I' || *typnm == 'O') { work = (double *) R_alloc(dims[0], sizeof(double)); } return F77_CALL(dlansy)(typnm, uplo_P(obj), dims, REAL(GET_SLOT(obj, Matrix_xSym)), dims, work FCONE FCONE); } SEXP dsyMatrix_norm(SEXP obj, SEXP type) { return ScalarReal(get_norm_sy(obj, CHAR(asChar(type)))); } SEXP dsyMatrix_rcond(SEXP obj, SEXP type) { SEXP trf = dsyMatrix_trf(obj); int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)), info; double anorm = get_norm_sy(obj, "O"); double rcond; F77_CALL(dsycon)(uplo_P(trf), dims, REAL (GET_SLOT(trf, Matrix_xSym)), dims, INTEGER(GET_SLOT(trf, Matrix_permSym)), &anorm, &rcond, (double *) R_alloc(2*dims[0], sizeof(double)), (int *) R_alloc(dims[0], sizeof(int)), &info FCONE); return ScalarReal(rcond); } SEXP dsyMatrix_solve(SEXP a) { SEXP trf = dsyMatrix_trf(a); SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("dsyMatrix")); int *dims = INTEGER(GET_SLOT(trf, Matrix_DimSym)), info; slot_dup(val, trf, Matrix_uploSym); slot_dup(val, trf, Matrix_xSym); slot_dup(val, trf, Matrix_DimSym); F77_CALL(dsytri)(uplo_P(val), dims, REAL(GET_SLOT(val, Matrix_xSym)), dims, INTEGER(GET_SLOT(trf, Matrix_permSym)), (double *) R_alloc((long) dims[0], sizeof(double)), &info FCONE); UNPROTECT(1); return val; } SEXP dsyMatrix_matrix_solve(SEXP a, SEXP b) { SEXP trf = dsyMatrix_trf(a), val = PROTECT(dup_mMatrix_as_dgeMatrix(b)); int *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)), *bdims = INTEGER(GET_SLOT(val, Matrix_DimSym)), info; if (*adims != *bdims || bdims[1] < 1 || *adims < 1) error(_("Dimensions of system to be solved are inconsistent")); F77_CALL(dsytrs)(uplo_P(trf), adims, bdims + 1, REAL(GET_SLOT(trf, Matrix_xSym)), adims, INTEGER(GET_SLOT(trf, Matrix_permSym)), REAL(GET_SLOT(val, Matrix_xSym)), bdims, &info FCONE); UNPROTECT(1); return val; } SEXP dsyMatrix_as_matrix(SEXP from, SEXP keep_dimnames) { int n = INTEGER(GET_SLOT(from, Matrix_DimSym))[0]; SEXP val = PROTECT(allocMatrix(REALSXP, n, n)); R_xlen_t nsqr = n; nsqr *= n; make_d_matrix_symmetric(Memcpy(REAL(val), REAL(GET_SLOT(from, Matrix_xSym)), nsqr), from); if(asLogical(keep_dimnames)) setAttrib(val, R_DimNamesSymbol, R_symmetric_Dimnames(from)); UNPROTECT(1); return val; } SEXP dsyMatrix_matrix_mm(SEXP a, SEXP b, SEXP rtP) { SEXP val = PROTECT(dup_mMatrix_as_dgeMatrix(b));// incl. its dimnames int rt = asLogical(rtP); /* if(rt), compute b %*% a, else a %*% b */ int *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)), *bdims = INTEGER(GET_SLOT(val, Matrix_DimSym)), m = bdims[0], n = bdims[1]; if ((rt && n != adims[0]) || (!rt && m != adims[0])) error(_("Matrices are not conformable for multiplication")); double one = 1., zero = 0.; R_xlen_t mn = m * (R_xlen_t)n; double *bcp, *vx = REAL(GET_SLOT(val, Matrix_xSym)); C_or_Alloca_TO(bcp, mn, double); Memcpy(bcp, vx, mn); if (m >=1 && n >= 1) F77_CALL(dsymm)(rt ? "R" :"L", uplo_P(a), &m, &n, &one, REAL(GET_SLOT(a, Matrix_xSym)), adims, bcp, &m, &zero, vx, &m FCONE FCONE); // add dimnames: int nd = rt ? 1 : // v <- b %*% a : rownames(v) == rownames(b) are already there 0; // v <- a %*% b : colnames(v) == colnames(b) are already there SEXP nms = PROTECT(VECTOR_ELT( symmetric_DimNames(GET_SLOT(a, Matrix_DimNamesSym)), nd)); SET_VECTOR_ELT(GET_SLOT(val, Matrix_DimNamesSym), nd, nms); if(mn >= SMALL_4_Alloca) Free(bcp); UNPROTECT(2); return val; } SEXP dsyMatrix_trf(SEXP x) { SEXP val = get_factors(x, "BunchKaufman"); if (val != R_NilValue) return val; SEXP dimP = GET_SLOT(x, Matrix_DimSym), uploP = GET_SLOT(x, Matrix_uploSym); int n = INTEGER(dimP)[0]; R_xlen_t nsqr = n; nsqr *= n; // nsqr = n^2 (w/o overflow !) const char *uplo = CHAR(STRING_ELT(uploP, 0)); val = PROTECT(NEW_OBJECT_OF_CLASS("BunchKaufman")); SET_SLOT(val, Matrix_uploSym, duplicate(uploP)); SET_SLOT(val, Matrix_diagSym, mkString("N")); SET_SLOT(val, Matrix_DimSym, duplicate(dimP)); double *vx = REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, nsqr)); AZERO(vx, nsqr); F77_CALL(dlacpy)(uplo, &n, &n, REAL(GET_SLOT(x, Matrix_xSym)), &n, vx, &n FCONE); int *perm = INTEGER(ALLOC_SLOT(val, Matrix_permSym, INTSXP, n)), info, lwork = -1; double tmp, *work; F77_CALL(dsytrf)(uplo, &n, vx, &n, perm, &tmp, &lwork, &info FCONE); lwork = (int) tmp; C_or_Alloca_TO(work, lwork, double); F77_CALL(dsytrf)(uplo, &n, vx, &n, perm, work, &lwork, &info FCONE); if(lwork >= SMALL_4_Alloca) Free(work); if (info) error(_("Lapack routine dsytrf returned error code %d"), info); UNPROTECT(1); return set_factors(x, val, "BunchKaufman"); } /** BunchKaufmann() */ SEXP matrix_trf(SEXP x, SEXP uploP) { if (!(isReal(x) & isMatrix(x))) error(_("x must be a \"double\" (numeric) matrix")); SEXP dimP = getAttrib(x, R_DimSymbol); if(TYPEOF(dimP) == INTSXP) dimP = duplicate(dimP); else dimP = coerceVector(dimP, INTSXP); PROTECT(dimP); int *dims = INTEGER(dimP), n = dims[0]; R_xlen_t nsqr = n; nsqr *= n; // nsqr = n^2 (w/o overflow !) if(n != dims[1]) error(_("matrix_trf(x, *): matrix is not square")); /* In principle, we "should" check that the matrix is symmetric, OTOH, we only use its lower or upper (depending on 'uploP') triangular part */ if(uploP == R_NilValue) { uploP = mkString("U"); // Default: if not specified, use "U" } else { if(TYPEOF(uploP) != STRSXP) error(_("matrix_trf(*, uplo): uplo must be string")); uploP = duplicate(uploP); // as we "add" it to the result } PROTECT(uploP); const char *uplo = CHAR(STRING_ELT(uploP, 0)); SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("BunchKaufman")); SET_SLOT(val, Matrix_uploSym, uploP); SET_SLOT(val, Matrix_diagSym, mkString("N")); SET_SLOT(val, Matrix_DimSym, dimP); double *vx = REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, nsqr)); // n x n result matrix AZERO(vx, nsqr); F77_CALL(dlacpy)(uplo, &n, &n, REAL(x), &n, vx, &n FCONE); int *perm = INTEGER(ALLOC_SLOT(val, Matrix_permSym, INTSXP, n)), info, lwork = -1; double tmp, *work; F77_CALL(dsytrf)(uplo, &n, vx, &n, perm, &tmp, &lwork, &info FCONE); lwork = (int) tmp; C_or_Alloca_TO(work, lwork, double); F77_CALL(dsytrf)(uplo, &n, vx, &n, perm, work, &lwork, &info FCONE); if(lwork >= SMALL_4_Alloca) Free(work); if (info) error(_("Lapack routine dsytrf returned error code %d"), info); UNPROTECT(3); return val; } // this is very close to lsyMatrix_as_lsp*() in ./ldense.c -- keep synced ! SEXP dsyMatrix_as_dspMatrix(SEXP from) { SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("dspMatrix")), uplo = GET_SLOT(from, Matrix_uploSym), dimP = GET_SLOT(from, Matrix_DimSym); int n = *INTEGER(dimP); SET_SLOT(val, Matrix_DimSym, duplicate(dimP)); SET_SLOT(val, Matrix_uploSym, duplicate(uplo)); full_to_packed_double( REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, (n*(n+1))/2)), REAL( GET_SLOT(from, Matrix_xSym)), n, *CHAR(STRING_ELT(uplo, 0)) == 'U' ? UPP : LOW, NUN); SET_SLOT(val, Matrix_DimNamesSym, duplicate(GET_SLOT(from, Matrix_DimNamesSym))); SET_SLOT(val, Matrix_factorSym, duplicate(GET_SLOT(from, Matrix_factorSym))); UNPROTECT(1); return val; } Matrix/src/t_matrix_to_Csp.c0000644000176200001440000000477113253771133015625 0ustar liggesusers/*------ Definition of a template for [diln]Csparse_subassign(...) : * * -------- ~~~~~~~~~~~~~~~~~~~~~~ * i.e., included several times from ./Csparse.c * ~~~~~~~~~~~ * _slot_kind : use the integer codes matching x_slot_kind in ./Mutils.h * ~~~~~~~~ */ #ifdef _DOUBLE_x # define has_x_slot # define Type_x double # define STYP_x REAL # define SXP_x REALSXP # define Zero_x 0. # undef _DOUBLE_x #elif defined _LOGICAL_x // --> lgCMatrix etc # define has_x_slot # define Type_x int # define STYP_x LOGICAL # define SXP_x LGLSXP # define Zero_x FALSE # undef _LOGICAL_x #elif defined _PATTERN_x // --> ngCMatrix etc // # undef has_x_slot # define Type_x int # define STYP_x LOGICAL # define SXP_x LGLSXP # define Zero_x FALSE # undef _PATTERN_x #elif defined _COMPLEX_x // not yet existing // --> igCMatrix etc # define has_x_slot # define Type_x Rcomplex # define STYP_x COMPLEX # define SXP_x CPLXSXP # define Zero_x {0., 0.} // FIXME ! # undef _COMPLEX_x #elif defined _INTEGER_x // not yet existing // --> igCMatrix etc # define has_x_slot # define Type_x int # define STYP_x INTEGER # define SXP_x INTSXP # define Zero_x 0 # undef _INTEGER_x #endif //--------------- The code, included inside a switch() case, ------------------ { Type_x* xx = STYP_x(x); #ifdef has_x_slot Type_x* rx = Calloc(nnz, Type_x); // to become x slot #endif ii = 0; // ii in 0..(n-1) for(int j=0; j < nc; ) { // look at 0-based column 'j' <=> 1-based R: x[, j+1] int nr_j = rp[j]; // cumulative number of non-zero entries in this column 'j' for(int i=0; i < nr; i++, ii++) { // look at 0-based row 'i' -- C's x[ii] == R's x[i+1, j+1] if(xx[ii] != Zero_x) { ri[nz] = i; // 0-based row number #ifdef has_x_slot rx[nz] = xx[ii]; #endif nr_j++; if(++nz >= nnz && ii < n-1) {// increase nnz and grow both 'rx' and 'ri' // current density ~= nz / ii == estim.final dens. ==> est. nnz = nz*n/ii nnz = imax2(nnz+256, imax2(5*nnz/4, (nz * n) / ii)); ri = Realloc(ri, nnz, int); #ifdef has_x_slot rx = Realloc(rx, nnz, Type_x); #endif } } } rp[++j] = nr_j; } // final number of non zeros: nz, almost always *smaller* than 'nnz': nnz = nz; #ifdef has_x_slot Memcpy( STYP_x(ALLOC_SLOT(ans, Matrix_xSym, SXP_x, nnz)), rx, nnz); Free(rx); #endif } // clean up remaining defines from header #ifdef has_x_slot # undef has_x_slot #endif #undef Type_x #undef STYP_x #undef SXP_x #undef Zero_x Matrix/src/dgeMatrix.h0000644000176200001440000000263013774624325014420 0ustar liggesusers#ifndef MATRIX_GEMATRIX_H #define MATRIX_GEMATRIX_H #include #include "Lapack-etc.h" #include "Mutils.h" SEXP dMatrix_validate(SEXP obj); SEXP dgeMatrix_validate(SEXP obj); SEXP dgeMatrix_norm(SEXP obj, SEXP norm); SEXP dgeMatrix_rcond(SEXP obj, SEXP type); /* for crossprod() and tcrossprod() -- dge*() and the generalized versions: */ SEXP dgeMatrix_crossprod(SEXP x, SEXP trans); SEXP geMatrix_crossprod(SEXP x, SEXP trans); SEXP dgeMatrix_dgeMatrix_crossprod(SEXP x, SEXP y, SEXP trans); SEXP geMatrix_geMatrix_crossprod(SEXP x, SEXP y, SEXP trans); SEXP dgeMatrix_matrix_crossprod(SEXP x, SEXP y, SEXP trans); SEXP geMatrix_matrix_crossprod(SEXP x, SEXP y, SEXP trans); // %*% : SEXP dgeMatrix_matrix_mm(SEXP a, SEXP b, SEXP right); SEXP geMatrix_matrix_mm(SEXP a, SEXP b, SEXP right); SEXP dgeMatrix_addDiag(SEXP x, SEXP d); SEXP dgeMatrix_getDiag(SEXP x); SEXP lgeMatrix_getDiag(SEXP x); SEXP dgeMatrix_setDiag(SEXP x, SEXP d); SEXP lgeMatrix_setDiag(SEXP x, SEXP d); SEXP dgeMatrix_LU (SEXP x, SEXP warn_singularity); SEXP dgeMatrix_LU_(SEXP x, Rboolean warn_sing); SEXP dgeMatrix_determinant(SEXP x, SEXP logarithm); SEXP dgeMatrix_Schur(SEXP x, SEXP vectors, SEXP isDGE); SEXP dgeMatrix_solve(SEXP a); SEXP dgeMatrix_matrix_solve(SEXP a, SEXP b); SEXP dgeMatrix_svd(SEXP x, SEXP nu, SEXP nv); SEXP dgeMatrix_exp(SEXP x); SEXP dgeMatrix_colsums(SEXP x, SEXP naRmP, SEXP cols, SEXP mean); #endif Matrix/src/Csparse.h0000644000176200001440000000561313253131430014056 0ustar liggesusers #ifndef MATRIX_CSPARSE_H #define MATRIX_CSPARSE_H #include "Mutils.h" Rboolean isValid_Csparse(SEXP x); SEXP Csp_dense_products(SEXP a, SEXP b, Rboolean transp_a, Rboolean transp_b, Rboolean transp_ans); SEXP Csparse_band(SEXP x, SEXP k1, SEXP k2); SEXP Csparse_Csparse_prod(SEXP a, SEXP b, SEXP bool_arith); SEXP Csparse_Csparse_crossprod(SEXP a, SEXP b, SEXP trans, SEXP bool_arith); SEXP Csparse_crossprod(SEXP x, SEXP trans, SEXP triplet, SEXP bool_arith); SEXP Csparse_dense_crossprod(SEXP a, SEXP b, SEXP transp); SEXP Csparse_dense_prod (SEXP a, SEXP b, SEXP transp); SEXP Csparse_diagU2N(SEXP x); SEXP Csparse_diagN2U(SEXP x); SEXP Csparse_drop(SEXP x, SEXP tol); SEXP Csparse_horzcat(SEXP x, SEXP y); SEXP Csparse_submatrix(SEXP x, SEXP i, SEXP j); SEXP dCsparse_subassign(SEXP x, SEXP i_, SEXP j_, SEXP value); SEXP lCsparse_subassign(SEXP x, SEXP i_, SEXP j_, SEXP value); SEXP iCsparse_subassign(SEXP x, SEXP i_, SEXP j_, SEXP value); SEXP nCsparse_subassign(SEXP x, SEXP i_, SEXP j_, SEXP value); SEXP zCsparse_subassign(SEXP x, SEXP i_, SEXP j_, SEXP value); SEXP Csparse_symmetric_to_general(SEXP x); SEXP Csparse_general_to_symmetric(SEXP x, SEXP uplo, SEXP sym_dmns); SEXP Csparse_MatrixMarket(SEXP x, SEXP fname); SEXP Csparse_sort (SEXP x); SEXP Csparse_to_Tsparse(SEXP x, SEXP tri); SEXP Csparse_to_tCsparse(SEXP x, SEXP uplo, SEXP diag); SEXP Csparse_to_tTsparse(SEXP x, SEXP uplo, SEXP diag); SEXP Csparse_to_dense(SEXP x, SEXP symm_or_tri); SEXP Csparse2nz (SEXP x, Rboolean tri); SEXP Csparse_to_nz_pattern(SEXP x, SEXP tri); SEXP nz_pattern_to_Csparse(SEXP x, SEXP res_kind); SEXP nz2Csparse (SEXP x, enum x_slot_kind r_kind); SEXP Csparse_to_matrix(SEXP x, SEXP chk, SEXP symm); SEXP Csparse_to_vector(SEXP x); SEXP Csparse_transpose(SEXP x, SEXP tri); SEXP Csparse_validate (SEXP x); SEXP Csparse_validate2(SEXP x, SEXP maybe_modify); SEXP Csparse_validate_(SEXP x, Rboolean maybe_modify); SEXP Csparse_vertcat(SEXP x, SEXP y); SEXP Rsparse_validate(SEXP x); SEXP diag_tC_ptr(int n, int *x_p, double *x_x, Rboolean is_U, int *perm, SEXP resultKind); SEXP diag_tC(SEXP obj, SEXP resultKind); // SEXP atomic_to_Csparse(SEXP cls, SEXP x, SEXP nrow, SEXP ncol, SEXP dimnames); SEXP matrix_to_Csparse(SEXP x, SEXP cls); // FIXME: these are nowhere used (are they?) SEXP create_Csparse(char* cls, int* i, int* j, int* p, int np, void* x, int nnz, int* dims, SEXP dimnames, int index1); #define DG_I_J(i, j, x, nnz) create_Csparse("dgCMatrix", i, j, (int*)NULL, 0, (void*)x, nnz, (int*)NULL, R_NilValue, 1) #define NG_I_J(i, j, nnz) create_Csparse("ngCMatrix", i, j, (int*)NULL, 0, (void*)NULL, nnz, (int*)NULL, R_NilValue, 1) #define DG_I_P(i, p, np, x, nnz) create_Csparse("dgCMatrix", i, (int*)NULL, p, np, (void*)x, nnz, (int*)NULL, R_NilValue, 1) #define NG_I_P(i, p, np, nnz) create_Csparse("ngCMatrix", i, (int*)NULL, p, np, (void*)NULL, nnz, (int*)NULL, R_NilValue, 1) #endif Matrix/src/AMD/0000755000176200001440000000000014154165363012716 5ustar liggesusersMatrix/src/AMD/Include/0000755000176200001440000000000014154165363014301 5ustar liggesusersMatrix/src/AMD/Include/amd.h0000644000176200001440000004263513652535054015225 0ustar liggesusers/* ========================================================================= */ /* === AMD: approximate minimum degree ordering =========================== */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD Version 2.4, Copyright (c) 1996-2013 by Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: DrTimothyAldenDavis@gmail.com */ /* ------------------------------------------------------------------------- */ /* AMD finds a symmetric ordering P of a matrix A so that the Cholesky * factorization of P*A*P' has fewer nonzeros and takes less work than the * Cholesky factorization of A. If A is not symmetric, then it performs its * ordering on the matrix A+A'. Two sets of user-callable routines are * provided, one for int integers and the other for SuiteSparse_long integers. * * The method is based on the approximate minimum degree algorithm, discussed * in Amestoy, Davis, and Duff, "An approximate degree ordering algorithm", * SIAM Journal of Matrix Analysis and Applications, vol. 17, no. 4, pp. * 886-905, 1996. This package can perform both the AMD ordering (with * aggressive absorption), and the AMDBAR ordering (without aggressive * absorption) discussed in the above paper. This package differs from the * Fortran codes discussed in the paper: * * (1) it can ignore "dense" rows and columns, leading to faster run times * (2) it computes the ordering of A+A' if A is not symmetric * (3) it is followed by a depth-first post-ordering of the assembly tree * (or supernodal elimination tree) * * For historical reasons, the Fortran versions, amd.f and amdbar.f, have * been left (nearly) unchanged. They compute the identical ordering as * described in the above paper. */ #ifndef AMD_H #define AMD_H /* make it easy for C++ programs to include AMD */ #ifdef __cplusplus extern "C" { #endif /* get the definition of size_t: */ #include #include "SuiteSparse_config.h" int amd_order /* returns AMD_OK, AMD_OK_BUT_JUMBLED, * AMD_INVALID, or AMD_OUT_OF_MEMORY */ ( int n, /* A is n-by-n. n must be >= 0. */ const int Ap [ ], /* column pointers for A, of size n+1 */ const int Ai [ ], /* row indices of A, of size nz = Ap [n] */ int P [ ], /* output permutation, of size n */ double Control [ ], /* input Control settings, of size AMD_CONTROL */ double Info [ ] /* output Info statistics, of size AMD_INFO */ ) ; SuiteSparse_long amd_l_order /* see above for description of arguments */ ( SuiteSparse_long n, const SuiteSparse_long Ap [ ], const SuiteSparse_long Ai [ ], SuiteSparse_long P [ ], double Control [ ], double Info [ ] ) ; /* Input arguments (not modified): * * n: the matrix A is n-by-n. * Ap: an int/SuiteSparse_long array of size n+1, containing column * pointers of A. * Ai: an int/SuiteSparse_long array of size nz, containing the row * indices of A, where nz = Ap [n]. * Control: a double array of size AMD_CONTROL, containing control * parameters. Defaults are used if Control is NULL. * * Output arguments (not defined on input): * * P: an int/SuiteSparse_long array of size n, containing the output * permutation. If row i is the kth pivot row, then P [k] = i. In * MATLAB notation, the reordered matrix is A (P,P). * Info: a double array of size AMD_INFO, containing statistical * information. Ignored if Info is NULL. * * On input, the matrix A is stored in column-oriented form. The row indices * of nonzero entries in column j are stored in Ai [Ap [j] ... Ap [j+1]-1]. * * If the row indices appear in ascending order in each column, and there * are no duplicate entries, then amd_order is slightly more efficient in * terms of time and memory usage. If this condition does not hold, a copy * of the matrix is created (where these conditions do hold), and the copy is * ordered. This feature is new to v2.0 (v1.2 and earlier required this * condition to hold for the input matrix). * * Row indices must be in the range 0 to * n-1. Ap [0] must be zero, and thus nz = Ap [n] is the number of nonzeros * in A. The array Ap is of size n+1, and the array Ai is of size nz = Ap [n]. * The matrix does not need to be symmetric, and the diagonal does not need to * be present (if diagonal entries are present, they are ignored except for * the output statistic Info [AMD_NZDIAG]). The arrays Ai and Ap are not * modified. This form of the Ap and Ai arrays to represent the nonzero * pattern of the matrix A is the same as that used internally by MATLAB. * If you wish to use a more flexible input structure, please see the * umfpack_*_triplet_to_col routines in the UMFPACK package, at * http://www.suitesparse.com. * * Restrictions: n >= 0. Ap [0] = 0. Ap [j] <= Ap [j+1] for all j in the * range 0 to n-1. nz = Ap [n] >= 0. Ai [0..nz-1] must be in the range 0 * to n-1. Finally, Ai, Ap, and P must not be NULL. If any of these * restrictions are not met, AMD returns AMD_INVALID. * * AMD returns: * * AMD_OK if the matrix is valid and sufficient memory can be allocated to * perform the ordering. * * AMD_OUT_OF_MEMORY if not enough memory can be allocated. * * AMD_INVALID if the input arguments n, Ap, Ai are invalid, or if P is * NULL. * * AMD_OK_BUT_JUMBLED if the matrix had unsorted columns, and/or duplicate * entries, but was otherwise valid. * * The AMD routine first forms the pattern of the matrix A+A', and then * computes a fill-reducing ordering, P. If P [k] = i, then row/column i of * the original is the kth pivotal row. In MATLAB notation, the permuted * matrix is A (P,P), except that 0-based indexing is used instead of the * 1-based indexing in MATLAB. * * The Control array is used to set various parameters for AMD. If a NULL * pointer is passed, default values are used. The Control array is not * modified. * * Control [AMD_DENSE]: controls the threshold for "dense" rows/columns. * A dense row/column in A+A' can cause AMD to spend a lot of time in * ordering the matrix. If Control [AMD_DENSE] >= 0, rows/columns * with more than Control [AMD_DENSE] * sqrt (n) entries are ignored * during the ordering, and placed last in the output order. The * default value of Control [AMD_DENSE] is 10. If negative, no * rows/columns are treated as "dense". Rows/columns with 16 or * fewer off-diagonal entries are never considered "dense". * * Control [AMD_AGGRESSIVE]: controls whether or not to use aggressive * absorption, in which a prior element is absorbed into the current * element if is a subset of the current element, even if it is not * adjacent to the current pivot element (refer to Amestoy, Davis, * & Duff, 1996, for more details). The default value is nonzero, * which means to perform aggressive absorption. This nearly always * leads to a better ordering (because the approximate degrees are * more accurate) and a lower execution time. There are cases where * it can lead to a slightly worse ordering, however. To turn it off, * set Control [AMD_AGGRESSIVE] to 0. * * Control [2..4] are not used in the current version, but may be used in * future versions. * * The Info array provides statistics about the ordering on output. If it is * not present, the statistics are not returned. This is not an error * condition. * * Info [AMD_STATUS]: the return value of AMD, either AMD_OK, * AMD_OK_BUT_JUMBLED, AMD_OUT_OF_MEMORY, or AMD_INVALID. * * Info [AMD_N]: n, the size of the input matrix * * Info [AMD_NZ]: the number of nonzeros in A, nz = Ap [n] * * Info [AMD_SYMMETRY]: the symmetry of the matrix A. It is the number * of "matched" off-diagonal entries divided by the total number of * off-diagonal entries. An entry A(i,j) is matched if A(j,i) is also * an entry, for any pair (i,j) for which i != j. In MATLAB notation, * S = spones (A) ; * B = tril (S, -1) + triu (S, 1) ; * symmetry = nnz (B & B') / nnz (B) ; * * Info [AMD_NZDIAG]: the number of entries on the diagonal of A. * * Info [AMD_NZ_A_PLUS_AT]: the number of nonzeros in A+A', excluding the * diagonal. If A is perfectly symmetric (Info [AMD_SYMMETRY] = 1) * with a fully nonzero diagonal, then Info [AMD_NZ_A_PLUS_AT] = nz-n * (the smallest possible value). If A is perfectly unsymmetric * (Info [AMD_SYMMETRY] = 0, for an upper triangular matrix, for * example) with no diagonal, then Info [AMD_NZ_A_PLUS_AT] = 2*nz * (the largest possible value). * * Info [AMD_NDENSE]: the number of "dense" rows/columns of A+A' that were * removed from A prior to ordering. These are placed last in the * output order P. * * Info [AMD_MEMORY]: the amount of memory used by AMD, in bytes. In the * current version, this is 1.2 * Info [AMD_NZ_A_PLUS_AT] + 9*n * times the size of an integer. This is at most 2.4nz + 9n. This * excludes the size of the input arguments Ai, Ap, and P, which have * a total size of nz + 2*n + 1 integers. * * Info [AMD_NCMPA]: the number of garbage collections performed. * * Info [AMD_LNZ]: the number of nonzeros in L (excluding the diagonal). * This is a slight upper bound because mass elimination is combined * with the approximate degree update. It is a rough upper bound if * there are many "dense" rows/columns. The rest of the statistics, * below, are also slight or rough upper bounds, for the same reasons. * The post-ordering of the assembly tree might also not exactly * correspond to a true elimination tree postordering. * * Info [AMD_NDIV]: the number of divide operations for a subsequent LDL' * or LU factorization of the permuted matrix A (P,P). * * Info [AMD_NMULTSUBS_LDL]: the number of multiply-subtract pairs for a * subsequent LDL' factorization of A (P,P). * * Info [AMD_NMULTSUBS_LU]: the number of multiply-subtract pairs for a * subsequent LU factorization of A (P,P), assuming that no numerical * pivoting is required. * * Info [AMD_DMAX]: the maximum number of nonzeros in any column of L, * including the diagonal. * * Info [14..19] are not used in the current version, but may be used in * future versions. */ /* ------------------------------------------------------------------------- */ /* direct interface to AMD */ /* ------------------------------------------------------------------------- */ /* amd_2 is the primary AMD ordering routine. It is not meant to be * user-callable because of its restrictive inputs and because it destroys * the user's input matrix. It does not check its inputs for errors, either. * However, if you can work with these restrictions it can be faster than * amd_order and use less memory (assuming that you can create your own copy * of the matrix for AMD to destroy). Refer to AMD/Source/amd_2.c for a * description of each parameter. */ void amd_2 ( int n, int Pe [ ], int Iw [ ], int Len [ ], int iwlen, int pfree, int Nv [ ], int Next [ ], int Last [ ], int Head [ ], int Elen [ ], int Degree [ ], int W [ ], double Control [ ], double Info [ ] ) ; void amd_l2 ( SuiteSparse_long n, SuiteSparse_long Pe [ ], SuiteSparse_long Iw [ ], SuiteSparse_long Len [ ], SuiteSparse_long iwlen, SuiteSparse_long pfree, SuiteSparse_long Nv [ ], SuiteSparse_long Next [ ], SuiteSparse_long Last [ ], SuiteSparse_long Head [ ], SuiteSparse_long Elen [ ], SuiteSparse_long Degree [ ], SuiteSparse_long W [ ], double Control [ ], double Info [ ] ) ; /* ------------------------------------------------------------------------- */ /* amd_valid */ /* ------------------------------------------------------------------------- */ /* Returns AMD_OK or AMD_OK_BUT_JUMBLED if the matrix is valid as input to * amd_order; the latter is returned if the matrix has unsorted and/or * duplicate row indices in one or more columns. Returns AMD_INVALID if the * matrix cannot be passed to amd_order. For amd_order, the matrix must also * be square. The first two arguments are the number of rows and the number * of columns of the matrix. For its use in AMD, these must both equal n. * * NOTE: this routine returned TRUE/FALSE in v1.2 and earlier. */ int amd_valid ( int n_row, /* # of rows */ int n_col, /* # of columns */ const int Ap [ ], /* column pointers, of size n_col+1 */ const int Ai [ ] /* row indices, of size Ap [n_col] */ ) ; SuiteSparse_long amd_l_valid ( SuiteSparse_long n_row, SuiteSparse_long n_col, const SuiteSparse_long Ap [ ], const SuiteSparse_long Ai [ ] ) ; /* ------------------------------------------------------------------------- */ /* AMD memory manager and printf routines */ /* ------------------------------------------------------------------------- */ /* moved to SuiteSparse_config.c */ /* ------------------------------------------------------------------------- */ /* AMD Control and Info arrays */ /* ------------------------------------------------------------------------- */ /* amd_defaults: sets the default control settings */ void amd_defaults (double Control [ ]) ; void amd_l_defaults (double Control [ ]) ; /* amd_control: prints the control settings */ void amd_control (double Control [ ]) ; void amd_l_control (double Control [ ]) ; /* amd_info: prints the statistics */ void amd_info (double Info [ ]) ; void amd_l_info (double Info [ ]) ; #define AMD_CONTROL 5 /* size of Control array */ #define AMD_INFO 20 /* size of Info array */ /* contents of Control */ #define AMD_DENSE 0 /* "dense" if degree > Control [0] * sqrt (n) */ #define AMD_AGGRESSIVE 1 /* do aggressive absorption if Control [1] != 0 */ /* default Control settings */ #define AMD_DEFAULT_DENSE 10.0 /* default "dense" degree 10*sqrt(n) */ #define AMD_DEFAULT_AGGRESSIVE 1 /* do aggressive absorption by default */ /* contents of Info */ #define AMD_STATUS 0 /* return value of amd_order and amd_l_order */ #define AMD_N 1 /* A is n-by-n */ #define AMD_NZ 2 /* number of nonzeros in A */ #define AMD_SYMMETRY 3 /* symmetry of pattern (1 is sym., 0 is unsym.) */ #define AMD_NZDIAG 4 /* # of entries on diagonal */ #define AMD_NZ_A_PLUS_AT 5 /* nz in A+A' */ #define AMD_NDENSE 6 /* number of "dense" rows/columns in A */ #define AMD_MEMORY 7 /* amount of memory used by AMD */ #define AMD_NCMPA 8 /* number of garbage collections in AMD */ #define AMD_LNZ 9 /* approx. nz in L, excluding the diagonal */ #define AMD_NDIV 10 /* number of fl. point divides for LU and LDL' */ #define AMD_NMULTSUBS_LDL 11 /* number of fl. point (*,-) pairs for LDL' */ #define AMD_NMULTSUBS_LU 12 /* number of fl. point (*,-) pairs for LU */ #define AMD_DMAX 13 /* max nz. in any column of L, incl. diagonal */ /* ------------------------------------------------------------------------- */ /* return values of AMD */ /* ------------------------------------------------------------------------- */ #define AMD_OK 0 /* success */ #define AMD_OUT_OF_MEMORY -1 /* malloc failed, or problem too large */ #define AMD_INVALID -2 /* input arguments are not valid */ #define AMD_OK_BUT_JUMBLED 1 /* input matrix is OK for amd_order, but * columns were not sorted, and/or duplicate entries were present. AMD had * to do extra work before ordering the matrix. This is a warning, not an * error. */ /* ========================================================================== */ /* === AMD version ========================================================== */ /* ========================================================================== */ /* AMD Version 1.2 and later include the following definitions. * As an example, to test if the version you are using is 1.2 or later: * * #ifdef AMD_VERSION * if (AMD_VERSION >= AMD_VERSION_CODE (1,2)) ... * #endif * * This also works during compile-time: * * #if defined(AMD_VERSION) && (AMD_VERSION >= AMD_VERSION_CODE (1,2)) * printf ("This is version 1.2 or later\n") ; * #else * printf ("This is an early version\n") ; * #endif * * Versions 1.1 and earlier of AMD do not include a #define'd version number. */ #define AMD_DATE "May 4, 2016" #define AMD_VERSION_CODE(main,sub) ((main) * 1000 + (sub)) #define AMD_MAIN_VERSION 2 #define AMD_SUB_VERSION 4 #define AMD_SUBSUB_VERSION 6 #define AMD_VERSION AMD_VERSION_CODE(AMD_MAIN_VERSION,AMD_SUB_VERSION) #ifdef __cplusplus } #endif #endif Matrix/src/AMD/Include/amd_internal.h0000644000176200001440000002121013652535054017103 0ustar liggesusers/* ========================================================================= */ /* === amd_internal.h ====================================================== */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: DrTimothyAldenDavis@gmail.com */ /* ------------------------------------------------------------------------- */ /* This file is for internal use in AMD itself, and does not normally need to * be included in user code (it is included in UMFPACK, however). All others * should use amd.h instead. * * The following compile-time definitions affect how AMD is compiled. * * -DNPRINT * * Disable all printing. stdio.h will not be included. Printing can * be re-enabled at run-time by setting the global pointer amd_printf * to printf (or mexPrintf for a MATLAB mexFunction). * * -DNMALLOC * * No memory manager is defined at compile-time. You MUST define the * function pointers amd_malloc, amd_free, amd_realloc, and * amd_calloc at run-time for AMD to work properly. */ // For use with R package 'Matrix': #define NPRINT /* ========================================================================= */ /* === NDEBUG ============================================================== */ /* ========================================================================= */ /* * Turning on debugging takes some work (see below). If you do not edit this * file, then debugging is always turned off, regardless of whether or not * -DNDEBUG is specified in your compiler options. * * If AMD is being compiled as a mexFunction, then MATLAB_MEX_FILE is defined, * and mxAssert is used instead of assert. If debugging is not enabled, no * MATLAB include files or functions are used. Thus, the AMD library libamd.a * can be safely used in either a stand-alone C program or in another * mexFunction, without any change. */ /* AMD will be exceedingly slow when running in debug mode. The next three lines ensure that debugging is turned off. */ #ifndef NDEBUG #define NDEBUG #endif /* To enable debugging, uncomment the following line: #undef NDEBUG */ /* ------------------------------------------------------------------------- */ /* ANSI include files */ /* ------------------------------------------------------------------------- */ /* from stdlib.h: size_t, malloc, free, realloc, and calloc */ #include #if !defined(NPRINT) || !defined(NDEBUG) /* from stdio.h: printf. Not included if NPRINT is defined at compile time. * fopen and fscanf are used when debugging. */ #include #endif /* from limits.h: INT_MAX and LONG_MAX */ #include /* from math.h: sqrt */ #include /* ------------------------------------------------------------------------- */ /* MATLAB include files (only if being used in or via MATLAB) */ /* ------------------------------------------------------------------------- */ #ifdef MATLAB_MEX_FILE #include "matrix.h" #include "mex.h" #endif /* ------------------------------------------------------------------------- */ /* basic definitions */ /* ------------------------------------------------------------------------- */ #ifdef FLIP #undef FLIP #endif #ifdef MAX #undef MAX #endif #ifdef MIN #undef MIN #endif #ifdef EMPTY #undef EMPTY #endif #ifdef GLOBAL #undef GLOBAL #endif #ifdef PRIVATE #undef PRIVATE #endif /* FLIP is a "negation about -1", and is used to mark an integer i that is * normally non-negative. FLIP (EMPTY) is EMPTY. FLIP of a number > EMPTY * is negative, and FLIP of a number < EMTPY is positive. FLIP (FLIP (i)) = i * for all integers i. UNFLIP (i) is >= EMPTY. */ #define EMPTY (-1) #define FLIP(i) (-(i)-2) #define UNFLIP(i) ((i < EMPTY) ? FLIP (i) : (i)) /* for integer MAX/MIN, or for doubles when we don't care how NaN's behave: */ #define MAX(a,b) (((a) > (b)) ? (a) : (b)) #define MIN(a,b) (((a) < (b)) ? (a) : (b)) /* logical expression of p implies q: */ #define IMPLIES(p,q) (!(p) || (q)) /* Note that the IBM RS 6000 xlc predefines TRUE and FALSE in . */ /* The Compaq Alpha also predefines TRUE and FALSE. */ #ifdef TRUE #undef TRUE #endif #ifdef FALSE #undef FALSE #endif #define TRUE (1) #define FALSE (0) #define PRIVATE static #define GLOBAL #define EMPTY (-1) /* Note that Linux's gcc 2.96 defines NULL as ((void *) 0), but other */ /* compilers (even gcc 2.95.2 on Solaris) define NULL as 0 or (0). We */ /* need to use the ANSI standard value of 0. */ #ifdef NULL #undef NULL #endif #define NULL 0 /* largest value of size_t */ #ifndef SIZE_T_MAX #ifdef SIZE_MAX /* C99 only */ #define SIZE_T_MAX SIZE_MAX #else #define SIZE_T_MAX ((size_t) (-1)) #endif #endif /* ------------------------------------------------------------------------- */ /* integer type for AMD: int or SuiteSparse_long */ /* ------------------------------------------------------------------------- */ #include "amd.h" #if defined (DLONG) || defined (ZLONG) #define Int SuiteSparse_long #define ID SuiteSparse_long_id #define Int_MAX SuiteSparse_long_max #define AMD_order amd_l_order #define AMD_defaults amd_l_defaults #define AMD_control amd_l_control #define AMD_info amd_l_info #define AMD_1 amd_l1 #define AMD_2 amd_l2 #define AMD_valid amd_l_valid #define AMD_aat amd_l_aat #define AMD_postorder amd_l_postorder #define AMD_post_tree amd_l_post_tree #define AMD_dump amd_l_dump #define AMD_debug amd_l_debug #define AMD_debug_init amd_l_debug_init #define AMD_preprocess amd_l_preprocess #else #define Int int #define ID "%d" #define Int_MAX INT_MAX #define AMD_order amd_order #define AMD_defaults amd_defaults #define AMD_control amd_control #define AMD_info amd_info #define AMD_1 amd_1 #define AMD_2 amd_2 #define AMD_valid amd_valid #define AMD_aat amd_aat #define AMD_postorder amd_postorder #define AMD_post_tree amd_post_tree #define AMD_dump amd_dump #define AMD_debug amd_debug #define AMD_debug_init amd_debug_init #define AMD_preprocess amd_preprocess #endif /* ------------------------------------------------------------------------- */ /* AMD routine definitions (not user-callable) */ /* ------------------------------------------------------------------------- */ GLOBAL size_t AMD_aat ( Int n, const Int Ap [ ], const Int Ai [ ], Int Len [ ], Int Tp [ ], double Info [ ] ) ; GLOBAL void AMD_1 ( Int n, const Int Ap [ ], const Int Ai [ ], Int P [ ], Int Pinv [ ], Int Len [ ], Int slen, Int S [ ], double Control [ ], double Info [ ] ) ; GLOBAL void AMD_postorder ( Int nn, Int Parent [ ], Int Npiv [ ], Int Fsize [ ], Int Order [ ], Int Child [ ], Int Sibling [ ], Int Stack [ ] ) ; GLOBAL Int AMD_post_tree ( Int root, Int k, Int Child [ ], const Int Sibling [ ], Int Order [ ], Int Stack [ ] #ifndef NDEBUG , Int nn #endif ) ; GLOBAL void AMD_preprocess ( Int n, const Int Ap [ ], const Int Ai [ ], Int Rp [ ], Int Ri [ ], Int W [ ], Int Flag [ ] ) ; /* ------------------------------------------------------------------------- */ /* debugging definitions */ /* ------------------------------------------------------------------------- */ #ifndef NDEBUG /* from assert.h: assert macro */ #include #ifndef EXTERN #define EXTERN extern #endif EXTERN Int AMD_debug ; GLOBAL void AMD_debug_init ( char *s ) ; GLOBAL void AMD_dump ( Int n, Int Pe [ ], Int Iw [ ], Int Len [ ], Int iwlen, Int pfree, Int Nv [ ], Int Next [ ], Int Last [ ], Int Head [ ], Int Elen [ ], Int Degree [ ], Int W [ ], Int nel ) ; #ifdef ASSERT #undef ASSERT #endif /* Use mxAssert if AMD is compiled into a mexFunction */ #ifdef MATLAB_MEX_FILE #define ASSERT(expression) (mxAssert ((expression), "")) #else #define ASSERT(expression) (assert (expression)) #endif #define AMD_DEBUG0(params) { SUITESPARSE_PRINTF (params) ; } #define AMD_DEBUG1(params) { if (AMD_debug >= 1) SUITESPARSE_PRINTF (params) ; } #define AMD_DEBUG2(params) { if (AMD_debug >= 2) SUITESPARSE_PRINTF (params) ; } #define AMD_DEBUG3(params) { if (AMD_debug >= 3) SUITESPARSE_PRINTF (params) ; } #define AMD_DEBUG4(params) { if (AMD_debug >= 4) SUITESPARSE_PRINTF (params) ; } #else /* no debugging */ #define ASSERT(expression) #define AMD_DEBUG0(params) #define AMD_DEBUG1(params) #define AMD_DEBUG2(params) #define AMD_DEBUG3(params) #define AMD_DEBUG4(params) #endif Matrix/src/AMD/Makefile0000644000176200001440000000027614154165630014360 0ustar liggesusers# compile just the C-callable library library: ( cd Source ; $(MAKE) lib ) # remove object files, but keep the compiled programs and library archives clean: ( cd Source ; $(MAKE) clean ) Matrix/src/AMD/Source/0000755000176200001440000000000014154165627014161 5ustar liggesusersMatrix/src/AMD/Source/amd_postorder.c0000644000176200001440000001260511770402705017163 0ustar liggesusers/* ========================================================================= */ /* === AMD_postorder ======================================================= */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: DrTimothyAldenDavis@gmail.com */ /* ------------------------------------------------------------------------- */ /* Perform a postordering (via depth-first search) of an assembly tree. */ #include "amd_internal.h" GLOBAL void AMD_postorder ( /* inputs, not modified on output: */ Int nn, /* nodes are in the range 0..nn-1 */ Int Parent [ ], /* Parent [j] is the parent of j, or EMPTY if root */ Int Nv [ ], /* Nv [j] > 0 number of pivots represented by node j, * or zero if j is not a node. */ Int Fsize [ ], /* Fsize [j]: size of node j */ /* output, not defined on input: */ Int Order [ ], /* output post-order */ /* workspaces of size nn: */ Int Child [ ], Int Sibling [ ], Int Stack [ ] ) { Int i, j, k, parent, frsize, f, fprev, maxfrsize, bigfprev, bigf, fnext ; for (j = 0 ; j < nn ; j++) { Child [j] = EMPTY ; Sibling [j] = EMPTY ; } /* --------------------------------------------------------------------- */ /* place the children in link lists - bigger elements tend to be last */ /* --------------------------------------------------------------------- */ for (j = nn-1 ; j >= 0 ; j--) { if (Nv [j] > 0) { /* this is an element */ parent = Parent [j] ; if (parent != EMPTY) { /* place the element in link list of the children its parent */ /* bigger elements will tend to be at the end of the list */ Sibling [j] = Child [parent] ; Child [parent] = j ; } } } #ifndef NDEBUG { Int nels, ff, nchild ; AMD_DEBUG1 (("\n\n================================ AMD_postorder:\n")); nels = 0 ; for (j = 0 ; j < nn ; j++) { if (Nv [j] > 0) { AMD_DEBUG1 (( ""ID" : nels "ID" npiv "ID" size "ID " parent "ID" maxfr "ID"\n", j, nels, Nv [j], Fsize [j], Parent [j], Fsize [j])) ; /* this is an element */ /* dump the link list of children */ nchild = 0 ; AMD_DEBUG1 ((" Children: ")) ; for (ff = Child [j] ; ff != EMPTY ; ff = Sibling [ff]) { AMD_DEBUG1 ((ID" ", ff)) ; ASSERT (Parent [ff] == j) ; nchild++ ; ASSERT (nchild < nn) ; } AMD_DEBUG1 (("\n")) ; parent = Parent [j] ; if (parent != EMPTY) { ASSERT (Nv [parent] > 0) ; } nels++ ; } } } AMD_DEBUG1 (("\n\nGo through the children of each node, and put\n" "the biggest child last in each list:\n")) ; #endif /* --------------------------------------------------------------------- */ /* place the largest child last in the list of children for each node */ /* --------------------------------------------------------------------- */ for (i = 0 ; i < nn ; i++) { if (Nv [i] > 0 && Child [i] != EMPTY) { #ifndef NDEBUG Int nchild ; AMD_DEBUG1 (("Before partial sort, element "ID"\n", i)) ; nchild = 0 ; for (f = Child [i] ; f != EMPTY ; f = Sibling [f]) { ASSERT (f >= 0 && f < nn) ; AMD_DEBUG1 ((" f: "ID" size: "ID"\n", f, Fsize [f])) ; nchild++ ; ASSERT (nchild <= nn) ; } #endif /* find the biggest element in the child list */ fprev = EMPTY ; maxfrsize = EMPTY ; bigfprev = EMPTY ; bigf = EMPTY ; for (f = Child [i] ; f != EMPTY ; f = Sibling [f]) { ASSERT (f >= 0 && f < nn) ; frsize = Fsize [f] ; if (frsize >= maxfrsize) { /* this is the biggest seen so far */ maxfrsize = frsize ; bigfprev = fprev ; bigf = f ; } fprev = f ; } ASSERT (bigf != EMPTY) ; fnext = Sibling [bigf] ; AMD_DEBUG1 (("bigf "ID" maxfrsize "ID" bigfprev "ID" fnext "ID " fprev " ID"\n", bigf, maxfrsize, bigfprev, fnext, fprev)) ; if (fnext != EMPTY) { /* if fnext is EMPTY then bigf is already at the end of list */ if (bigfprev == EMPTY) { /* delete bigf from the element of the list */ Child [i] = fnext ; } else { /* delete bigf from the middle of the list */ Sibling [bigfprev] = fnext ; } /* put bigf at the end of the list */ Sibling [bigf] = EMPTY ; ASSERT (Child [i] != EMPTY) ; ASSERT (fprev != bigf) ; ASSERT (fprev != EMPTY) ; Sibling [fprev] = bigf ; } #ifndef NDEBUG AMD_DEBUG1 (("After partial sort, element "ID"\n", i)) ; for (f = Child [i] ; f != EMPTY ; f = Sibling [f]) { ASSERT (f >= 0 && f < nn) ; AMD_DEBUG1 ((" "ID" "ID"\n", f, Fsize [f])) ; ASSERT (Nv [f] > 0) ; nchild-- ; } ASSERT (nchild == 0) ; #endif } } /* --------------------------------------------------------------------- */ /* postorder the assembly tree */ /* --------------------------------------------------------------------- */ for (i = 0 ; i < nn ; i++) { Order [i] = EMPTY ; } k = 0 ; for (i = 0 ; i < nn ; i++) { if (Parent [i] == EMPTY && Nv [i] > 0) { AMD_DEBUG1 (("Root of assembly tree "ID"\n", i)) ; k = AMD_post_tree (i, k, Child, Sibling, Order, Stack #ifndef NDEBUG , nn #endif ) ; } } } Matrix/src/AMD/Source/amd_valid.c0000644000176200001440000000564411770402705016246 0ustar liggesusers/* ========================================================================= */ /* === AMD_valid =========================================================== */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: DrTimothyAldenDavis@gmail.com */ /* ------------------------------------------------------------------------- */ /* Check if a column-form matrix is valid or not. The matrix A is * n_row-by-n_col. The row indices of entries in column j are in * Ai [Ap [j] ... Ap [j+1]-1]. Required conditions are: * * n_row >= 0 * n_col >= 0 * nz = Ap [n_col] >= 0 number of entries in the matrix * Ap [0] == 0 * Ap [j] <= Ap [j+1] for all j in the range 0 to n_col. * Ai [0 ... nz-1] must be in the range 0 to n_row-1. * * If any of the above conditions hold, AMD_INVALID is returned. If the * following condition holds, AMD_OK_BUT_JUMBLED is returned (a warning, * not an error): * * row indices in Ai [Ap [j] ... Ap [j+1]-1] are not sorted in ascending * order, and/or duplicate entries exist. * * Otherwise, AMD_OK is returned. * * In v1.2 and earlier, this function returned TRUE if the matrix was valid * (now returns AMD_OK), or FALSE otherwise (now returns AMD_INVALID or * AMD_OK_BUT_JUMBLED). */ #include "amd_internal.h" GLOBAL Int AMD_valid ( /* inputs, not modified on output: */ Int n_row, /* A is n_row-by-n_col */ Int n_col, const Int Ap [ ], /* column pointers of A, of size n_col+1 */ const Int Ai [ ] /* row indices of A, of size nz = Ap [n_col] */ ) { Int nz, j, p1, p2, ilast, i, p, result = AMD_OK ; if (n_row < 0 || n_col < 0 || Ap == NULL || Ai == NULL) { return (AMD_INVALID) ; } nz = Ap [n_col] ; if (Ap [0] != 0 || nz < 0) { /* column pointers must start at Ap [0] = 0, and Ap [n] must be >= 0 */ AMD_DEBUG0 (("column 0 pointer bad or nz < 0\n")) ; return (AMD_INVALID) ; } for (j = 0 ; j < n_col ; j++) { p1 = Ap [j] ; p2 = Ap [j+1] ; AMD_DEBUG2 (("\nColumn: "ID" p1: "ID" p2: "ID"\n", j, p1, p2)) ; if (p1 > p2) { /* column pointers must be ascending */ AMD_DEBUG0 (("column "ID" pointer bad\n", j)) ; return (AMD_INVALID) ; } ilast = EMPTY ; for (p = p1 ; p < p2 ; p++) { i = Ai [p] ; AMD_DEBUG3 (("row: "ID"\n", i)) ; if (i < 0 || i >= n_row) { /* row index out of range */ AMD_DEBUG0 (("index out of range, col "ID" row "ID"\n", j, i)); return (AMD_INVALID) ; } if (i <= ilast) { /* row index unsorted, or duplicate entry present */ AMD_DEBUG1 (("index unsorted/dupl col "ID" row "ID"\n", j, i)); result = AMD_OK_BUT_JUMBLED ; } ilast = i ; } } return (result) ; } Matrix/src/AMD/Source/amd_2.c0000644000176200001440000017647113652535054015324 0ustar liggesusers/* ========================================================================= */ /* === AMD_2 =============================================================== */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: DrTimothyAldenDavis@gmail.com */ /* ------------------------------------------------------------------------- */ /* AMD_2: performs the AMD ordering on a symmetric sparse matrix A, followed * by a postordering (via depth-first search) of the assembly tree using the * AMD_postorder routine. */ #include "amd_internal.h" /* ========================================================================= */ /* === clear_flag ========================================================== */ /* ========================================================================= */ static Int clear_flag (Int wflg, Int wbig, Int W [ ], Int n) { Int x ; if (wflg < 2 || wflg >= wbig) { for (x = 0 ; x < n ; x++) { if (W [x] != 0) W [x] = 1 ; } wflg = 2 ; } /* at this point, W [0..n-1] < wflg holds */ return (wflg) ; } /* ========================================================================= */ /* === AMD_2 =============================================================== */ /* ========================================================================= */ GLOBAL void AMD_2 ( Int n, /* A is n-by-n, where n > 0 */ Int Pe [ ], /* Pe [0..n-1]: index in Iw of row i on input */ Int Iw [ ], /* workspace of size iwlen. Iw [0..pfree-1] * holds the matrix on input */ Int Len [ ], /* Len [0..n-1]: length for row/column i on input */ Int iwlen, /* length of Iw. iwlen >= pfree + n */ Int pfree, /* Iw [pfree ... iwlen-1] is empty on input */ /* 7 size-n workspaces, not defined on input: */ Int Nv [ ], /* the size of each supernode on output */ Int Next [ ], /* the output inverse permutation */ Int Last [ ], /* the output permutation */ Int Head [ ], Int Elen [ ], /* the size columns of L for each supernode */ Int Degree [ ], Int W [ ], /* control parameters and output statistics */ double Control [ ], /* array of size AMD_CONTROL */ double Info [ ] /* array of size AMD_INFO */ ) { /* * Given a representation of the nonzero pattern of a symmetric matrix, A, * (excluding the diagonal) perform an approximate minimum (UMFPACK/MA38-style) * degree ordering to compute a pivot order such that the introduction of * nonzeros (fill-in) in the Cholesky factors A = LL' is kept low. At each * step, the pivot selected is the one with the minimum UMFAPACK/MA38-style * upper-bound on the external degree. This routine can optionally perform * aggresive absorption (as done by MC47B in the Harwell Subroutine * Library). * * The approximate degree algorithm implemented here is the symmetric analog of * the degree update algorithm in MA38 and UMFPACK (the Unsymmetric-pattern * MultiFrontal PACKage, both by Davis and Duff). The routine is based on the * MA27 minimum degree ordering algorithm by Iain Duff and John Reid. * * This routine is a translation of the original AMDBAR and MC47B routines, * in Fortran, with the following modifications: * * (1) dense rows/columns are removed prior to ordering the matrix, and placed * last in the output order. The presence of a dense row/column can * increase the ordering time by up to O(n^2), unless they are removed * prior to ordering. * * (2) the minimum degree ordering is followed by a postordering (depth-first * search) of the assembly tree. Note that mass elimination (discussed * below) combined with the approximate degree update can lead to the mass * elimination of nodes with lower exact degree than the current pivot * element. No additional fill-in is caused in the representation of the * Schur complement. The mass-eliminated nodes merge with the current * pivot element. They are ordered prior to the current pivot element. * Because they can have lower exact degree than the current element, the * merger of two or more of these nodes in the current pivot element can * lead to a single element that is not a "fundamental supernode". The * diagonal block can have zeros in it. Thus, the assembly tree used here * is not guaranteed to be the precise supernodal elemination tree (with * "funadmental" supernodes), and the postordering performed by this * routine is not guaranteed to be a precise postordering of the * elimination tree. * * (3) input parameters are added, to control aggressive absorption and the * detection of "dense" rows/columns of A. * * (4) additional statistical information is returned, such as the number of * nonzeros in L, and the flop counts for subsequent LDL' and LU * factorizations. These are slight upper bounds, because of the mass * elimination issue discussed above. * * (5) additional routines are added to interface this routine to MATLAB * to provide a simple C-callable user-interface, to check inputs for * errors, compute the symmetry of the pattern of A and the number of * nonzeros in each row/column of A+A', to compute the pattern of A+A', * to perform the assembly tree postordering, and to provide debugging * ouput. Many of these functions are also provided by the Fortran * Harwell Subroutine Library routine MC47A. * * (6) both int and SuiteSparse_long versions are provided. In the * descriptions below and integer is and int or SuiteSparse_long depending * on which version is being used. ********************************************************************** ***** CAUTION: ARGUMENTS ARE NOT CHECKED FOR ERRORS ON INPUT. ****** ********************************************************************** ** If you want error checking, a more versatile input format, and a ** ** simpler user interface, use amd_order or amd_l_order instead. ** ** This routine is not meant to be user-callable. ** ********************************************************************** * ---------------------------------------------------------------------------- * References: * ---------------------------------------------------------------------------- * * [1] Timothy A. Davis and Iain Duff, "An unsymmetric-pattern multifrontal * method for sparse LU factorization", SIAM J. Matrix Analysis and * Applications, vol. 18, no. 1, pp. 140-158. Discusses UMFPACK / MA38, * which first introduced the approximate minimum degree used by this * routine. * * [2] Patrick Amestoy, Timothy A. Davis, and Iain S. Duff, "An approximate * minimum degree ordering algorithm," SIAM J. Matrix Analysis and * Applications, vol. 17, no. 4, pp. 886-905, 1996. Discusses AMDBAR and * MC47B, which are the Fortran versions of this routine. * * [3] Alan George and Joseph Liu, "The evolution of the minimum degree * ordering algorithm," SIAM Review, vol. 31, no. 1, pp. 1-19, 1989. * We list below the features mentioned in that paper that this code * includes: * * mass elimination: * Yes. MA27 relied on supervariable detection for mass elimination. * * indistinguishable nodes: * Yes (we call these "supervariables"). This was also in the MA27 * code - although we modified the method of detecting them (the * previous hash was the true degree, which we no longer keep track * of). A supervariable is a set of rows with identical nonzero * pattern. All variables in a supervariable are eliminated together. * Each supervariable has as its numerical name that of one of its * variables (its principal variable). * * quotient graph representation: * Yes. We use the term "element" for the cliques formed during * elimination. This was also in the MA27 code. The algorithm can * operate in place, but it will work more efficiently if given some * "elbow room." * * element absorption: * Yes. This was also in the MA27 code. * * external degree: * Yes. The MA27 code was based on the true degree. * * incomplete degree update and multiple elimination: * No. This was not in MA27, either. Our method of degree update * within MC47B is element-based, not variable-based. It is thus * not well-suited for use with incomplete degree update or multiple * elimination. * * Authors, and Copyright (C) 2004 by: * Timothy A. Davis, Patrick Amestoy, Iain S. Duff, John K. Reid. * * Acknowledgements: This work (and the UMFPACK package) was supported by the * National Science Foundation (ASC-9111263, DMS-9223088, and CCR-0203270). * The UMFPACK/MA38 approximate degree update algorithm, the unsymmetric analog * which forms the basis of AMD, was developed while Tim Davis was supported by * CERFACS (Toulouse, France) in a post-doctoral position. This C version, and * the etree postorder, were written while Tim Davis was on sabbatical at * Stanford University and Lawrence Berkeley National Laboratory. * ---------------------------------------------------------------------------- * INPUT ARGUMENTS (unaltered): * ---------------------------------------------------------------------------- * n: The matrix order. Restriction: n >= 1. * * iwlen: The size of the Iw array. On input, the matrix is stored in * Iw [0..pfree-1]. However, Iw [0..iwlen-1] should be slightly larger * than what is required to hold the matrix, at least iwlen >= pfree + n. * Otherwise, excessive compressions will take place. The recommended * value of iwlen is 1.2 * pfree + n, which is the value used in the * user-callable interface to this routine (amd_order.c). The algorithm * will not run at all if iwlen < pfree. Restriction: iwlen >= pfree + n. * Note that this is slightly more restrictive than the actual minimum * (iwlen >= pfree), but AMD_2 will be very slow with no elbow room. * Thus, this routine enforces a bare minimum elbow room of size n. * * pfree: On input the tail end of the array, Iw [pfree..iwlen-1], is empty, * and the matrix is stored in Iw [0..pfree-1]. During execution, * additional data is placed in Iw, and pfree is modified so that * Iw [pfree..iwlen-1] is always the unused part of Iw. * * Control: A double array of size AMD_CONTROL containing input parameters * that affect how the ordering is computed. If NULL, then default * settings are used. * * Control [AMD_DENSE] is used to determine whether or not a given input * row is "dense". A row is "dense" if the number of entries in the row * exceeds Control [AMD_DENSE] times sqrt (n), except that rows with 16 or * fewer entries are never considered "dense". To turn off the detection * of dense rows, set Control [AMD_DENSE] to a negative number, or to a * number larger than sqrt (n). The default value of Control [AMD_DENSE] * is AMD_DEFAULT_DENSE, which is defined in amd.h as 10. * * Control [AMD_AGGRESSIVE] is used to determine whether or not aggressive * absorption is to be performed. If nonzero, then aggressive absorption * is performed (this is the default). * ---------------------------------------------------------------------------- * INPUT/OUPUT ARGUMENTS: * ---------------------------------------------------------------------------- * * Pe: An integer array of size n. On input, Pe [i] is the index in Iw of * the start of row i. Pe [i] is ignored if row i has no off-diagonal * entries. Thus Pe [i] must be in the range 0 to pfree-1 for non-empty * rows. * * During execution, it is used for both supervariables and elements: * * Principal supervariable i: index into Iw of the description of * supervariable i. A supervariable represents one or more rows of * the matrix with identical nonzero pattern. In this case, * Pe [i] >= 0. * * Non-principal supervariable i: if i has been absorbed into another * supervariable j, then Pe [i] = FLIP (j), where FLIP (j) is defined * as (-(j)-2). Row j has the same pattern as row i. Note that j * might later be absorbed into another supervariable j2, in which * case Pe [i] is still FLIP (j), and Pe [j] = FLIP (j2) which is * < EMPTY, where EMPTY is defined as (-1) in amd_internal.h. * * Unabsorbed element e: the index into Iw of the description of element * e, if e has not yet been absorbed by a subsequent element. Element * e is created when the supervariable of the same name is selected as * the pivot. In this case, Pe [i] >= 0. * * Absorbed element e: if element e is absorbed into element e2, then * Pe [e] = FLIP (e2). This occurs when the pattern of e (which we * refer to as Le) is found to be a subset of the pattern of e2 (that * is, Le2). In this case, Pe [i] < EMPTY. If element e is "null" * (it has no nonzeros outside its pivot block), then Pe [e] = EMPTY, * and e is the root of an assembly subtree (or the whole tree if * there is just one such root). * * Dense variable i: if i is "dense", then Pe [i] = EMPTY. * * On output, Pe holds the assembly tree/forest, which implicitly * represents a pivot order with identical fill-in as the actual order * (via a depth-first search of the tree), as follows. If Nv [i] > 0, * then i represents a node in the assembly tree, and the parent of i is * Pe [i], or EMPTY if i is a root. If Nv [i] = 0, then (i, Pe [i]) * represents an edge in a subtree, the root of which is a node in the * assembly tree. Note that i refers to a row/column in the original * matrix, not the permuted matrix. * * Info: A double array of size AMD_INFO. If present, (that is, not NULL), * then statistics about the ordering are returned in the Info array. * See amd.h for a description. * ---------------------------------------------------------------------------- * INPUT/MODIFIED (undefined on output): * ---------------------------------------------------------------------------- * * Len: An integer array of size n. On input, Len [i] holds the number of * entries in row i of the matrix, excluding the diagonal. The contents * of Len are undefined on output. * * Iw: An integer array of size iwlen. On input, Iw [0..pfree-1] holds the * description of each row i in the matrix. The matrix must be symmetric, * and both upper and lower triangular parts must be present. The * diagonal must not be present. Row i is held as follows: * * Len [i]: the length of the row i data structure in the Iw array. * Iw [Pe [i] ... Pe [i] + Len [i] - 1]: * the list of column indices for nonzeros in row i (simple * supervariables), excluding the diagonal. All supervariables * start with one row/column each (supervariable i is just row i). * If Len [i] is zero on input, then Pe [i] is ignored on input. * * Note that the rows need not be in any particular order, and there * may be empty space between the rows. * * During execution, the supervariable i experiences fill-in. This is * represented by placing in i a list of the elements that cause fill-in * in supervariable i: * * Len [i]: the length of supervariable i in the Iw array. * Iw [Pe [i] ... Pe [i] + Elen [i] - 1]: * the list of elements that contain i. This list is kept short * by removing absorbed elements. * Iw [Pe [i] + Elen [i] ... Pe [i] + Len [i] - 1]: * the list of supervariables in i. This list is kept short by * removing nonprincipal variables, and any entry j that is also * contained in at least one of the elements (j in Le) in the list * for i (e in row i). * * When supervariable i is selected as pivot, we create an element e of * the same name (e=i): * * Len [e]: the length of element e in the Iw array. * Iw [Pe [e] ... Pe [e] + Len [e] - 1]: * the list of supervariables in element e. * * An element represents the fill-in that occurs when supervariable i is * selected as pivot (which represents the selection of row i and all * non-principal variables whose principal variable is i). We use the * term Le to denote the set of all supervariables in element e. Absorbed * supervariables and elements are pruned from these lists when * computationally convenient. * * CAUTION: THE INPUT MATRIX IS OVERWRITTEN DURING COMPUTATION. * The contents of Iw are undefined on output. * ---------------------------------------------------------------------------- * OUTPUT (need not be set on input): * ---------------------------------------------------------------------------- * * Nv: An integer array of size n. During execution, ABS (Nv [i]) is equal to * the number of rows that are represented by the principal supervariable * i. If i is a nonprincipal or dense variable, then Nv [i] = 0. * Initially, Nv [i] = 1 for all i. Nv [i] < 0 signifies that i is a * principal variable in the pattern Lme of the current pivot element me. * After element me is constructed, Nv [i] is set back to a positive * value. * * On output, Nv [i] holds the number of pivots represented by super * row/column i of the original matrix, or Nv [i] = 0 for non-principal * rows/columns. Note that i refers to a row/column in the original * matrix, not the permuted matrix. * * Elen: An integer array of size n. See the description of Iw above. At the * start of execution, Elen [i] is set to zero for all rows i. During * execution, Elen [i] is the number of elements in the list for * supervariable i. When e becomes an element, Elen [e] = FLIP (esize) is * set, where esize is the size of the element (the number of pivots, plus * the number of nonpivotal entries). Thus Elen [e] < EMPTY. * Elen (i) = EMPTY set when variable i becomes nonprincipal. * * For variables, Elen (i) >= EMPTY holds until just before the * postordering and permutation vectors are computed. For elements, * Elen [e] < EMPTY holds. * * On output, Elen [i] is the degree of the row/column in the Cholesky * factorization of the permuted matrix, corresponding to the original row * i, if i is a super row/column. It is equal to EMPTY if i is * non-principal. Note that i refers to a row/column in the original * matrix, not the permuted matrix. * * Note that the contents of Elen on output differ from the Fortran * version (Elen holds the inverse permutation in the Fortran version, * which is instead returned in the Next array in this C version, * described below). * * Last: In a degree list, Last [i] is the supervariable preceding i, or EMPTY * if i is the head of the list. In a hash bucket, Last [i] is the hash * key for i. * * Last [Head [hash]] is also used as the head of a hash bucket if * Head [hash] contains a degree list (see the description of Head, * below). * * On output, Last [0..n-1] holds the permutation. That is, if * i = Last [k], then row i is the kth pivot row (where k ranges from 0 to * n-1). Row Last [k] of A is the kth row in the permuted matrix, PAP'. * * Next: Next [i] is the supervariable following i in a link list, or EMPTY if * i is the last in the list. Used for two kinds of lists: degree lists * and hash buckets (a supervariable can be in only one kind of list at a * time). * * On output Next [0..n-1] holds the inverse permutation. That is, if * k = Next [i], then row i is the kth pivot row. Row i of A appears as * the (Next[i])-th row in the permuted matrix, PAP'. * * Note that the contents of Next on output differ from the Fortran * version (Next is undefined on output in the Fortran version). * ---------------------------------------------------------------------------- * LOCAL WORKSPACE (not input or output - used only during execution): * ---------------------------------------------------------------------------- * * Degree: An integer array of size n. If i is a supervariable, then * Degree [i] holds the current approximation of the external degree of * row i (an upper bound). The external degree is the number of nonzeros * in row i, minus ABS (Nv [i]), the diagonal part. The bound is equal to * the exact external degree if Elen [i] is less than or equal to two. * * We also use the term "external degree" for elements e to refer to * |Le \ Lme|. If e is an element, then Degree [e] is |Le|, which is the * degree of the off-diagonal part of the element e (not including the * diagonal part). * * Head: An integer array of size n. Head is used for degree lists. * Head [deg] is the first supervariable in a degree list. All * supervariables i in a degree list Head [deg] have the same approximate * degree, namely, deg = Degree [i]. If the list Head [deg] is empty then * Head [deg] = EMPTY. * * During supervariable detection Head [hash] also serves as a pointer to * a hash bucket. If Head [hash] >= 0, there is a degree list of degree * hash. The hash bucket head pointer is Last [Head [hash]]. If * Head [hash] = EMPTY, then the degree list and hash bucket are both * empty. If Head [hash] < EMPTY, then the degree list is empty, and * FLIP (Head [hash]) is the head of the hash bucket. After supervariable * detection is complete, all hash buckets are empty, and the * (Last [Head [hash]] = EMPTY) condition is restored for the non-empty * degree lists. * * W: An integer array of size n. The flag array W determines the status of * elements and variables, and the external degree of elements. * * for elements: * if W [e] = 0, then the element e is absorbed. * if W [e] >= wflg, then W [e] - wflg is the size of the set * |Le \ Lme|, in terms of nonzeros (the sum of ABS (Nv [i]) for * each principal variable i that is both in the pattern of * element e and NOT in the pattern of the current pivot element, * me). * if wflg > W [e] > 0, then e is not absorbed and has not yet been * seen in the scan of the element lists in the computation of * |Le\Lme| in Scan 1 below. * * for variables: * during supervariable detection, if W [j] != wflg then j is * not in the pattern of variable i. * * The W array is initialized by setting W [i] = 1 for all i, and by * setting wflg = 2. It is reinitialized if wflg becomes too large (to * ensure that wflg+n does not cause integer overflow). * ---------------------------------------------------------------------------- * LOCAL INTEGERS: * ---------------------------------------------------------------------------- */ Int deg, degme, dext, lemax, e, elenme, eln, i, ilast, inext, j, jlast, jnext, k, knt1, knt2, knt3, lenj, ln, me, mindeg, nel, nleft, nvi, nvj, nvpiv, slenme, wbig, we, wflg, wnvi, ok, ndense, ncmpa, dense, aggressive ; unsigned Int hash ; /* unsigned, so that hash % n is well defined.*/ /* * deg: the degree of a variable or element * degme: size, |Lme|, of the current element, me (= Degree [me]) * dext: external degree, |Le \ Lme|, of some element e * lemax: largest |Le| seen so far (called dmax in Fortran version) * e: an element * elenme: the length, Elen [me], of element list of pivotal variable * eln: the length, Elen [...], of an element list * hash: the computed value of the hash function * i: a supervariable * ilast: the entry in a link list preceding i * inext: the entry in a link list following i * j: a supervariable * jlast: the entry in a link list preceding j * jnext: the entry in a link list, or path, following j * k: the pivot order of an element or variable * knt1: loop counter used during element construction * knt2: loop counter used during element construction * knt3: loop counter used during compression * lenj: Len [j] * ln: length of a supervariable list * me: current supervariable being eliminated, and the current * element created by eliminating that supervariable * mindeg: current minimum degree * nel: number of pivots selected so far * nleft: n - nel, the number of nonpivotal rows/columns remaining * nvi: the number of variables in a supervariable i (= Nv [i]) * nvj: the number of variables in a supervariable j (= Nv [j]) * nvpiv: number of pivots in current element * slenme: number of variables in variable list of pivotal variable * wbig: = (INT_MAX - n) for the int version, (SuiteSparse_long_max - n) * for the SuiteSparse_long version. wflg is not allowed to * be >= wbig. * we: W [e] * wflg: used for flagging the W array. See description of Iw. * wnvi: wflg - Nv [i] * x: either a supervariable or an element * * ok: true if supervariable j can be absorbed into i * ndense: number of "dense" rows/columns * dense: rows/columns with initial degree > dense are considered "dense" * aggressive: true if aggressive absorption is being performed * ncmpa: number of garbage collections * ---------------------------------------------------------------------------- * LOCAL DOUBLES, used for statistical output only (except for alpha): * ---------------------------------------------------------------------------- */ double f, r, ndiv, s, nms_lu, nms_ldl, dmax, alpha, lnz, lnzme ; /* * f: nvpiv * r: degme + nvpiv * ndiv: number of divisions for LU or LDL' factorizations * s: number of multiply-subtract pairs for LU factorization, for the * current element me * nms_lu number of multiply-subtract pairs for LU factorization * nms_ldl number of multiply-subtract pairs for LDL' factorization * dmax: the largest number of entries in any column of L, including the * diagonal * alpha: "dense" degree ratio * lnz: the number of nonzeros in L (excluding the diagonal) * lnzme: the number of nonzeros in L (excl. the diagonal) for the * current element me * ---------------------------------------------------------------------------- * LOCAL "POINTERS" (indices into the Iw array) * ---------------------------------------------------------------------------- */ Int p, p1, p2, p3, p4, pdst, pend, pj, pme, pme1, pme2, pn, psrc ; /* * Any parameter (Pe [...] or pfree) or local variable starting with "p" (for * Pointer) is an index into Iw, and all indices into Iw use variables starting * with "p." The only exception to this rule is the iwlen input argument. * * p: pointer into lots of things * p1: Pe [i] for some variable i (start of element list) * p2: Pe [i] + Elen [i] - 1 for some variable i * p3: index of first supervariable in clean list * p4: * pdst: destination pointer, for compression * pend: end of memory to compress * pj: pointer into an element or variable * pme: pointer into the current element (pme1...pme2) * pme1: the current element, me, is stored in Iw [pme1...pme2] * pme2: the end of the current element * pn: pointer into a "clean" variable, also used to compress * psrc: source pointer, for compression */ /* ========================================================================= */ /* INITIALIZATIONS */ /* ========================================================================= */ /* Note that this restriction on iwlen is slightly more restrictive than * what is actually required in AMD_2. AMD_2 can operate with no elbow * room at all, but it will be slow. For better performance, at least * size-n elbow room is enforced. */ ASSERT (iwlen >= pfree + n) ; ASSERT (n > 0) ; /* initialize output statistics */ lnz = 0 ; ndiv = 0 ; nms_lu = 0 ; nms_ldl = 0 ; dmax = 1 ; me = EMPTY ; mindeg = 0 ; ncmpa = 0 ; nel = 0 ; lemax = 0 ; /* get control parameters */ if (Control != (double *) NULL) { alpha = Control [AMD_DENSE] ; aggressive = (Control [AMD_AGGRESSIVE] != 0) ; } else { alpha = AMD_DEFAULT_DENSE ; aggressive = AMD_DEFAULT_AGGRESSIVE ; } /* Note: if alpha is NaN, this is undefined: */ if (alpha < 0) { /* only remove completely dense rows/columns */ dense = n-2 ; } else { dense = alpha * sqrt ((double) n) ; } dense = MAX (16, dense) ; dense = MIN (n, dense) ; AMD_DEBUG1 (("\n\nAMD (debug), alpha %g, aggr. "ID"\n", alpha, aggressive)) ; for (i = 0 ; i < n ; i++) { Last [i] = EMPTY ; Head [i] = EMPTY ; Next [i] = EMPTY ; /* if separate Hhead array is used for hash buckets: * Hhead [i] = EMPTY ; */ Nv [i] = 1 ; W [i] = 1 ; Elen [i] = 0 ; Degree [i] = Len [i] ; } #ifndef NDEBUG AMD_DEBUG1 (("\n======Nel "ID" initial\n", nel)) ; AMD_dump (n, Pe, Iw, Len, iwlen, pfree, Nv, Next, Last, Head, Elen, Degree, W, -1) ; #endif /* initialize wflg */ wbig = Int_MAX - n ; wflg = clear_flag (0, wbig, W, n) ; /* --------------------------------------------------------------------- */ /* initialize degree lists and eliminate dense and empty rows */ /* --------------------------------------------------------------------- */ ndense = 0 ; for (i = 0 ; i < n ; i++) { deg = Degree [i] ; ASSERT (deg >= 0 && deg < n) ; if (deg == 0) { /* ------------------------------------------------------------- * we have a variable that can be eliminated at once because * there is no off-diagonal non-zero in its row. Note that * Nv [i] = 1 for an empty variable i. It is treated just * the same as an eliminated element i. * ------------------------------------------------------------- */ Elen [i] = FLIP (1) ; nel++ ; Pe [i] = EMPTY ; W [i] = 0 ; } else if (deg > dense) { /* ------------------------------------------------------------- * Dense variables are not treated as elements, but as unordered, * non-principal variables that have no parent. They do not take * part in the postorder, since Nv [i] = 0. Note that the Fortran * version does not have this option. * ------------------------------------------------------------- */ AMD_DEBUG1 (("Dense node "ID" degree "ID"\n", i, deg)) ; ndense++ ; Nv [i] = 0 ; /* do not postorder this node */ Elen [i] = EMPTY ; nel++ ; Pe [i] = EMPTY ; } else { /* ------------------------------------------------------------- * place i in the degree list corresponding to its degree * ------------------------------------------------------------- */ inext = Head [deg] ; ASSERT (inext >= EMPTY && inext < n) ; if (inext != EMPTY) Last [inext] = i ; Next [i] = inext ; Head [deg] = i ; } } /* ========================================================================= */ /* WHILE (selecting pivots) DO */ /* ========================================================================= */ while (nel < n) { #ifndef NDEBUG AMD_DEBUG1 (("\n======Nel "ID"\n", nel)) ; if (AMD_debug >= 2) { AMD_dump (n, Pe, Iw, Len, iwlen, pfree, Nv, Next, Last, Head, Elen, Degree, W, nel) ; } #endif /* ========================================================================= */ /* GET PIVOT OF MINIMUM DEGREE */ /* ========================================================================= */ /* ----------------------------------------------------------------- */ /* find next supervariable for elimination */ /* ----------------------------------------------------------------- */ ASSERT (mindeg >= 0 && mindeg < n) ; for (deg = mindeg ; deg < n ; deg++) { me = Head [deg] ; if (me != EMPTY) break ; } mindeg = deg ; ASSERT (me >= 0 && me < n) ; AMD_DEBUG1 (("=================me: "ID"\n", me)) ; /* ----------------------------------------------------------------- */ /* remove chosen variable from link list */ /* ----------------------------------------------------------------- */ inext = Next [me] ; ASSERT (inext >= EMPTY && inext < n) ; if (inext != EMPTY) Last [inext] = EMPTY ; Head [deg] = inext ; /* ----------------------------------------------------------------- */ /* me represents the elimination of pivots nel to nel+Nv[me]-1. */ /* place me itself as the first in this set. */ /* ----------------------------------------------------------------- */ elenme = Elen [me] ; nvpiv = Nv [me] ; ASSERT (nvpiv > 0) ; nel += nvpiv ; /* ========================================================================= */ /* CONSTRUCT NEW ELEMENT */ /* ========================================================================= */ /* ----------------------------------------------------------------- * At this point, me is the pivotal supervariable. It will be * converted into the current element. Scan list of the pivotal * supervariable, me, setting tree pointers and constructing new list * of supervariables for the new element, me. p is a pointer to the * current position in the old list. * ----------------------------------------------------------------- */ /* flag the variable "me" as being in Lme by negating Nv [me] */ Nv [me] = -nvpiv ; degme = 0 ; ASSERT (Pe [me] >= 0 && Pe [me] < iwlen) ; if (elenme == 0) { /* ------------------------------------------------------------- */ /* construct the new element in place */ /* ------------------------------------------------------------- */ pme1 = Pe [me] ; pme2 = pme1 - 1 ; for (p = pme1 ; p <= pme1 + Len [me] - 1 ; p++) { i = Iw [p] ; ASSERT (i >= 0 && i < n && Nv [i] >= 0) ; nvi = Nv [i] ; if (nvi > 0) { /* ----------------------------------------------------- */ /* i is a principal variable not yet placed in Lme. */ /* store i in new list */ /* ----------------------------------------------------- */ /* flag i as being in Lme by negating Nv [i] */ degme += nvi ; Nv [i] = -nvi ; Iw [++pme2] = i ; /* ----------------------------------------------------- */ /* remove variable i from degree list. */ /* ----------------------------------------------------- */ ilast = Last [i] ; inext = Next [i] ; ASSERT (ilast >= EMPTY && ilast < n) ; ASSERT (inext >= EMPTY && inext < n) ; if (inext != EMPTY) Last [inext] = ilast ; if (ilast != EMPTY) { Next [ilast] = inext ; } else { /* i is at the head of the degree list */ ASSERT (Degree [i] >= 0 && Degree [i] < n) ; Head [Degree [i]] = inext ; } } } } else { /* ------------------------------------------------------------- */ /* construct the new element in empty space, Iw [pfree ...] */ /* ------------------------------------------------------------- */ p = Pe [me] ; pme1 = pfree ; slenme = Len [me] - elenme ; for (knt1 = 1 ; knt1 <= elenme + 1 ; knt1++) { if (knt1 > elenme) { /* search the supervariables in me. */ e = me ; pj = p ; ln = slenme ; AMD_DEBUG2 (("Search sv: "ID" "ID" "ID"\n", me,pj,ln)) ; } else { /* search the elements in me. */ e = Iw [p++] ; ASSERT (e >= 0 && e < n) ; pj = Pe [e] ; ln = Len [e] ; AMD_DEBUG2 (("Search element e "ID" in me "ID"\n", e,me)) ; ASSERT (Elen [e] < EMPTY && W [e] > 0 && pj >= 0) ; } ASSERT (ln >= 0 && (ln == 0 || (pj >= 0 && pj < iwlen))) ; /* --------------------------------------------------------- * search for different supervariables and add them to the * new list, compressing when necessary. this loop is * executed once for each element in the list and once for * all the supervariables in the list. * --------------------------------------------------------- */ for (knt2 = 1 ; knt2 <= ln ; knt2++) { i = Iw [pj++] ; ASSERT (i >= 0 && i < n && (i == me || Elen [i] >= EMPTY)); nvi = Nv [i] ; AMD_DEBUG2 ((": "ID" "ID" "ID" "ID"\n", i, Elen [i], Nv [i], wflg)) ; if (nvi > 0) { /* ------------------------------------------------- */ /* compress Iw, if necessary */ /* ------------------------------------------------- */ if (pfree >= iwlen) { AMD_DEBUG1 (("GARBAGE COLLECTION\n")) ; /* prepare for compressing Iw by adjusting pointers * and lengths so that the lists being searched in * the inner and outer loops contain only the * remaining entries. */ Pe [me] = p ; Len [me] -= knt1 ; /* check if nothing left of supervariable me */ if (Len [me] == 0) Pe [me] = EMPTY ; Pe [e] = pj ; Len [e] = ln - knt2 ; /* nothing left of element e */ if (Len [e] == 0) Pe [e] = EMPTY ; ncmpa++ ; /* one more garbage collection */ /* store first entry of each object in Pe */ /* FLIP the first entry in each object */ for (j = 0 ; j < n ; j++) { pn = Pe [j] ; if (pn >= 0) { ASSERT (pn >= 0 && pn < iwlen) ; Pe [j] = Iw [pn] ; Iw [pn] = FLIP (j) ; } } /* psrc/pdst point to source/destination */ psrc = 0 ; pdst = 0 ; pend = pme1 - 1 ; while (psrc <= pend) { /* search for next FLIP'd entry */ j = FLIP (Iw [psrc++]) ; if (j >= 0) { AMD_DEBUG2 (("Got object j: "ID"\n", j)) ; Iw [pdst] = Pe [j] ; Pe [j] = pdst++ ; lenj = Len [j] ; /* copy from source to destination */ for (knt3 = 0 ; knt3 <= lenj - 2 ; knt3++) { Iw [pdst++] = Iw [psrc++] ; } } } /* move the new partially-constructed element */ p1 = pdst ; for (psrc = pme1 ; psrc <= pfree-1 ; psrc++) { Iw [pdst++] = Iw [psrc] ; } pme1 = p1 ; pfree = pdst ; pj = Pe [e] ; p = Pe [me] ; } /* ------------------------------------------------- */ /* i is a principal variable not yet placed in Lme */ /* store i in new list */ /* ------------------------------------------------- */ /* flag i as being in Lme by negating Nv [i] */ degme += nvi ; Nv [i] = -nvi ; Iw [pfree++] = i ; AMD_DEBUG2 ((" s: "ID" nv "ID"\n", i, Nv [i])); /* ------------------------------------------------- */ /* remove variable i from degree link list */ /* ------------------------------------------------- */ ilast = Last [i] ; inext = Next [i] ; ASSERT (ilast >= EMPTY && ilast < n) ; ASSERT (inext >= EMPTY && inext < n) ; if (inext != EMPTY) Last [inext] = ilast ; if (ilast != EMPTY) { Next [ilast] = inext ; } else { /* i is at the head of the degree list */ ASSERT (Degree [i] >= 0 && Degree [i] < n) ; Head [Degree [i]] = inext ; } } } if (e != me) { /* set tree pointer and flag to indicate element e is * absorbed into new element me (the parent of e is me) */ AMD_DEBUG1 ((" Element "ID" => "ID"\n", e, me)) ; Pe [e] = FLIP (me) ; W [e] = 0 ; } } pme2 = pfree - 1 ; } /* ----------------------------------------------------------------- */ /* me has now been converted into an element in Iw [pme1..pme2] */ /* ----------------------------------------------------------------- */ /* degme holds the external degree of new element */ Degree [me] = degme ; Pe [me] = pme1 ; Len [me] = pme2 - pme1 + 1 ; ASSERT (Pe [me] >= 0 && Pe [me] < iwlen) ; Elen [me] = FLIP (nvpiv + degme) ; /* FLIP (Elen (me)) is now the degree of pivot (including * diagonal part). */ #ifndef NDEBUG AMD_DEBUG2 (("New element structure: length= "ID"\n", pme2-pme1+1)) ; for (pme = pme1 ; pme <= pme2 ; pme++) AMD_DEBUG3 ((" "ID"", Iw[pme])); AMD_DEBUG3 (("\n")) ; #endif /* ----------------------------------------------------------------- */ /* make sure that wflg is not too large. */ /* ----------------------------------------------------------------- */ /* With the current value of wflg, wflg+n must not cause integer * overflow */ wflg = clear_flag (wflg, wbig, W, n) ; /* ========================================================================= */ /* COMPUTE (W [e] - wflg) = |Le\Lme| FOR ALL ELEMENTS */ /* ========================================================================= */ /* ----------------------------------------------------------------- * Scan 1: compute the external degrees of previous elements with * respect to the current element. That is: * (W [e] - wflg) = |Le \ Lme| * for each element e that appears in any supervariable in Lme. The * notation Le refers to the pattern (list of supervariables) of a * previous element e, where e is not yet absorbed, stored in * Iw [Pe [e] + 1 ... Pe [e] + Len [e]]. The notation Lme * refers to the pattern of the current element (stored in * Iw [pme1..pme2]). If aggressive absorption is enabled, and * (W [e] - wflg) becomes zero, then the element e will be absorbed * in Scan 2. * ----------------------------------------------------------------- */ AMD_DEBUG2 (("me: ")) ; for (pme = pme1 ; pme <= pme2 ; pme++) { i = Iw [pme] ; ASSERT (i >= 0 && i < n) ; eln = Elen [i] ; AMD_DEBUG3 ((""ID" Elen "ID": \n", i, eln)) ; if (eln > 0) { /* note that Nv [i] has been negated to denote i in Lme: */ nvi = -Nv [i] ; ASSERT (nvi > 0 && Pe [i] >= 0 && Pe [i] < iwlen) ; wnvi = wflg - nvi ; for (p = Pe [i] ; p <= Pe [i] + eln - 1 ; p++) { e = Iw [p] ; ASSERT (e >= 0 && e < n) ; we = W [e] ; AMD_DEBUG4 ((" e "ID" we "ID" ", e, we)) ; if (we >= wflg) { /* unabsorbed element e has been seen in this loop */ AMD_DEBUG4 ((" unabsorbed, first time seen")) ; we -= nvi ; } else if (we != 0) { /* e is an unabsorbed element */ /* this is the first we have seen e in all of Scan 1 */ AMD_DEBUG4 ((" unabsorbed")) ; we = Degree [e] + wnvi ; } AMD_DEBUG4 (("\n")) ; W [e] = we ; } } } AMD_DEBUG2 (("\n")) ; /* ========================================================================= */ /* DEGREE UPDATE AND ELEMENT ABSORPTION */ /* ========================================================================= */ /* ----------------------------------------------------------------- * Scan 2: for each i in Lme, sum up the degree of Lme (which is * degme), plus the sum of the external degrees of each Le for the * elements e appearing within i, plus the supervariables in i. * Place i in hash list. * ----------------------------------------------------------------- */ for (pme = pme1 ; pme <= pme2 ; pme++) { i = Iw [pme] ; ASSERT (i >= 0 && i < n && Nv [i] < 0 && Elen [i] >= 0) ; AMD_DEBUG2 (("Updating: i "ID" "ID" "ID"\n", i, Elen[i], Len [i])); p1 = Pe [i] ; p2 = p1 + Elen [i] - 1 ; pn = p1 ; hash = 0 ; deg = 0 ; ASSERT (p1 >= 0 && p1 < iwlen && p2 >= -1 && p2 < iwlen) ; /* ------------------------------------------------------------- */ /* scan the element list associated with supervariable i */ /* ------------------------------------------------------------- */ /* UMFPACK/MA38-style approximate degree: */ if (aggressive) { for (p = p1 ; p <= p2 ; p++) { e = Iw [p] ; ASSERT (e >= 0 && e < n) ; we = W [e] ; if (we != 0) { /* e is an unabsorbed element */ /* dext = | Le \ Lme | */ dext = we - wflg ; if (dext > 0) { deg += dext ; Iw [pn++] = e ; hash += e ; AMD_DEBUG4 ((" e: "ID" hash = "ID"\n",e,hash)) ; } else { /* external degree of e is zero, absorb e into me*/ AMD_DEBUG1 ((" Element "ID" =>"ID" (aggressive)\n", e, me)) ; ASSERT (dext == 0) ; Pe [e] = FLIP (me) ; W [e] = 0 ; } } } } else { for (p = p1 ; p <= p2 ; p++) { e = Iw [p] ; ASSERT (e >= 0 && e < n) ; we = W [e] ; if (we != 0) { /* e is an unabsorbed element */ dext = we - wflg ; ASSERT (dext >= 0) ; deg += dext ; Iw [pn++] = e ; hash += e ; AMD_DEBUG4 ((" e: "ID" hash = "ID"\n",e,hash)) ; } } } /* count the number of elements in i (including me): */ Elen [i] = pn - p1 + 1 ; /* ------------------------------------------------------------- */ /* scan the supervariables in the list associated with i */ /* ------------------------------------------------------------- */ /* The bulk of the AMD run time is typically spent in this loop, * particularly if the matrix has many dense rows that are not * removed prior to ordering. */ p3 = pn ; p4 = p1 + Len [i] ; for (p = p2 + 1 ; p < p4 ; p++) { j = Iw [p] ; ASSERT (j >= 0 && j < n) ; nvj = Nv [j] ; if (nvj > 0) { /* j is unabsorbed, and not in Lme. */ /* add to degree and add to new list */ deg += nvj ; Iw [pn++] = j ; hash += j ; AMD_DEBUG4 ((" s: "ID" hash "ID" Nv[j]= "ID"\n", j, hash, nvj)) ; } } /* ------------------------------------------------------------- */ /* update the degree and check for mass elimination */ /* ------------------------------------------------------------- */ /* with aggressive absorption, deg==0 is identical to the * Elen [i] == 1 && p3 == pn test, below. */ ASSERT (IMPLIES (aggressive, (deg==0) == (Elen[i]==1 && p3==pn))) ; if (Elen [i] == 1 && p3 == pn) { /* --------------------------------------------------------- */ /* mass elimination */ /* --------------------------------------------------------- */ /* There is nothing left of this node except for an edge to * the current pivot element. Elen [i] is 1, and there are * no variables adjacent to node i. Absorb i into the * current pivot element, me. Note that if there are two or * more mass eliminations, fillin due to mass elimination is * possible within the nvpiv-by-nvpiv pivot block. It is this * step that causes AMD's analysis to be an upper bound. * * The reason is that the selected pivot has a lower * approximate degree than the true degree of the two mass * eliminated nodes. There is no edge between the two mass * eliminated nodes. They are merged with the current pivot * anyway. * * No fillin occurs in the Schur complement, in any case, * and this effect does not decrease the quality of the * ordering itself, just the quality of the nonzero and * flop count analysis. It also means that the post-ordering * is not an exact elimination tree post-ordering. */ AMD_DEBUG1 ((" MASS i "ID" => parent e "ID"\n", i, me)) ; Pe [i] = FLIP (me) ; nvi = -Nv [i] ; degme -= nvi ; nvpiv += nvi ; nel += nvi ; Nv [i] = 0 ; Elen [i] = EMPTY ; } else { /* --------------------------------------------------------- */ /* update the upper-bound degree of i */ /* --------------------------------------------------------- */ /* the following degree does not yet include the size * of the current element, which is added later: */ Degree [i] = MIN (Degree [i], deg) ; /* --------------------------------------------------------- */ /* add me to the list for i */ /* --------------------------------------------------------- */ /* move first supervariable to end of list */ Iw [pn] = Iw [p3] ; /* move first element to end of element part of list */ Iw [p3] = Iw [p1] ; /* add new element, me, to front of list. */ Iw [p1] = me ; /* store the new length of the list in Len [i] */ Len [i] = pn - p1 + 1 ; /* --------------------------------------------------------- */ /* place in hash bucket. Save hash key of i in Last [i]. */ /* --------------------------------------------------------- */ /* NOTE: this can fail if hash is negative, because the ANSI C * standard does not define a % b when a and/or b are negative. * That's why hash is defined as an unsigned Int, to avoid this * problem. */ hash = hash % n ; ASSERT (((Int) hash) >= 0 && ((Int) hash) < n) ; /* if the Hhead array is not used: */ j = Head [hash] ; if (j <= EMPTY) { /* degree list is empty, hash head is FLIP (j) */ Next [i] = FLIP (j) ; Head [hash] = FLIP (i) ; } else { /* degree list is not empty, use Last [Head [hash]] as * hash head. */ Next [i] = Last [j] ; Last [j] = i ; } /* if a separate Hhead array is used: * Next [i] = Hhead [hash] ; Hhead [hash] = i ; */ Last [i] = hash ; } } Degree [me] = degme ; /* ----------------------------------------------------------------- */ /* Clear the counter array, W [...], by incrementing wflg. */ /* ----------------------------------------------------------------- */ /* make sure that wflg+n does not cause integer overflow */ lemax = MAX (lemax, degme) ; wflg += lemax ; wflg = clear_flag (wflg, wbig, W, n) ; /* at this point, W [0..n-1] < wflg holds */ /* ========================================================================= */ /* SUPERVARIABLE DETECTION */ /* ========================================================================= */ AMD_DEBUG1 (("Detecting supervariables:\n")) ; for (pme = pme1 ; pme <= pme2 ; pme++) { i = Iw [pme] ; ASSERT (i >= 0 && i < n) ; AMD_DEBUG2 (("Consider i "ID" nv "ID"\n", i, Nv [i])) ; if (Nv [i] < 0) { /* i is a principal variable in Lme */ /* --------------------------------------------------------- * examine all hash buckets with 2 or more variables. We do * this by examing all unique hash keys for supervariables in * the pattern Lme of the current element, me * --------------------------------------------------------- */ /* let i = head of hash bucket, and empty the hash bucket */ ASSERT (Last [i] >= 0 && Last [i] < n) ; hash = Last [i] ; /* if Hhead array is not used: */ j = Head [hash] ; if (j == EMPTY) { /* hash bucket and degree list are both empty */ i = EMPTY ; } else if (j < EMPTY) { /* degree list is empty */ i = FLIP (j) ; Head [hash] = EMPTY ; } else { /* degree list is not empty, restore Last [j] of head j */ i = Last [j] ; Last [j] = EMPTY ; } /* if separate Hhead array is used: * i = Hhead [hash] ; Hhead [hash] = EMPTY ; */ ASSERT (i >= EMPTY && i < n) ; AMD_DEBUG2 (("----i "ID" hash "ID"\n", i, hash)) ; while (i != EMPTY && Next [i] != EMPTY) { /* ----------------------------------------------------- * this bucket has one or more variables following i. * scan all of them to see if i can absorb any entries * that follow i in hash bucket. Scatter i into w. * ----------------------------------------------------- */ ln = Len [i] ; eln = Elen [i] ; ASSERT (ln >= 0 && eln >= 0) ; ASSERT (Pe [i] >= 0 && Pe [i] < iwlen) ; /* do not flag the first element in the list (me) */ for (p = Pe [i] + 1 ; p <= Pe [i] + ln - 1 ; p++) { ASSERT (Iw [p] >= 0 && Iw [p] < n) ; W [Iw [p]] = wflg ; } /* ----------------------------------------------------- */ /* scan every other entry j following i in bucket */ /* ----------------------------------------------------- */ jlast = i ; j = Next [i] ; ASSERT (j >= EMPTY && j < n) ; while (j != EMPTY) { /* ------------------------------------------------- */ /* check if j and i have identical nonzero pattern */ /* ------------------------------------------------- */ AMD_DEBUG3 (("compare i "ID" and j "ID"\n", i,j)) ; /* check if i and j have the same Len and Elen */ ASSERT (Len [j] >= 0 && Elen [j] >= 0) ; ASSERT (Pe [j] >= 0 && Pe [j] < iwlen) ; ok = (Len [j] == ln) && (Elen [j] == eln) ; /* skip the first element in the list (me) */ for (p = Pe [j] + 1 ; ok && p <= Pe [j] + ln - 1 ; p++) { ASSERT (Iw [p] >= 0 && Iw [p] < n) ; if (W [Iw [p]] != wflg) ok = 0 ; } if (ok) { /* --------------------------------------------- */ /* found it! j can be absorbed into i */ /* --------------------------------------------- */ AMD_DEBUG1 (("found it! j "ID" => i "ID"\n", j,i)); Pe [j] = FLIP (i) ; /* both Nv [i] and Nv [j] are negated since they */ /* are in Lme, and the absolute values of each */ /* are the number of variables in i and j: */ Nv [i] += Nv [j] ; Nv [j] = 0 ; Elen [j] = EMPTY ; /* delete j from hash bucket */ ASSERT (j != Next [j]) ; j = Next [j] ; Next [jlast] = j ; } else { /* j cannot be absorbed into i */ jlast = j ; ASSERT (j != Next [j]) ; j = Next [j] ; } ASSERT (j >= EMPTY && j < n) ; } /* ----------------------------------------------------- * no more variables can be absorbed into i * go to next i in bucket and clear flag array * ----------------------------------------------------- */ wflg++ ; i = Next [i] ; ASSERT (i >= EMPTY && i < n) ; } } } AMD_DEBUG2 (("detect done\n")) ; /* ========================================================================= */ /* RESTORE DEGREE LISTS AND REMOVE NONPRINCIPAL SUPERVARIABLES FROM ELEMENT */ /* ========================================================================= */ p = pme1 ; nleft = n - nel ; for (pme = pme1 ; pme <= pme2 ; pme++) { i = Iw [pme] ; ASSERT (i >= 0 && i < n) ; nvi = -Nv [i] ; AMD_DEBUG3 (("Restore i "ID" "ID"\n", i, nvi)) ; if (nvi > 0) { /* i is a principal variable in Lme */ /* restore Nv [i] to signify that i is principal */ Nv [i] = nvi ; /* --------------------------------------------------------- */ /* compute the external degree (add size of current element) */ /* --------------------------------------------------------- */ deg = Degree [i] + degme - nvi ; deg = MIN (deg, nleft - nvi) ; ASSERT (IMPLIES (aggressive, deg > 0) && deg >= 0 && deg < n) ; /* --------------------------------------------------------- */ /* place the supervariable at the head of the degree list */ /* --------------------------------------------------------- */ inext = Head [deg] ; ASSERT (inext >= EMPTY && inext < n) ; if (inext != EMPTY) Last [inext] = i ; Next [i] = inext ; Last [i] = EMPTY ; Head [deg] = i ; /* --------------------------------------------------------- */ /* save the new degree, and find the minimum degree */ /* --------------------------------------------------------- */ mindeg = MIN (mindeg, deg) ; Degree [i] = deg ; /* --------------------------------------------------------- */ /* place the supervariable in the element pattern */ /* --------------------------------------------------------- */ Iw [p++] = i ; } } AMD_DEBUG2 (("restore done\n")) ; /* ========================================================================= */ /* FINALIZE THE NEW ELEMENT */ /* ========================================================================= */ AMD_DEBUG2 (("ME = "ID" DONE\n", me)) ; Nv [me] = nvpiv ; /* save the length of the list for the new element me */ Len [me] = p - pme1 ; if (Len [me] == 0) { /* there is nothing left of the current pivot element */ /* it is a root of the assembly tree */ Pe [me] = EMPTY ; W [me] = 0 ; } if (elenme != 0) { /* element was not constructed in place: deallocate part of */ /* it since newly nonprincipal variables may have been removed */ pfree = p ; } /* The new element has nvpiv pivots and the size of the contribution * block for a multifrontal method is degme-by-degme, not including * the "dense" rows/columns. If the "dense" rows/columns are included, * the frontal matrix is no larger than * (degme+ndense)-by-(degme+ndense). */ if (Info != (double *) NULL) { f = nvpiv ; r = degme + ndense ; dmax = MAX (dmax, f + r) ; /* number of nonzeros in L (excluding the diagonal) */ lnzme = f*r + (f-1)*f/2 ; lnz += lnzme ; /* number of divide operations for LDL' and for LU */ ndiv += lnzme ; /* number of multiply-subtract pairs for LU */ s = f*r*r + r*(f-1)*f + (f-1)*f*(2*f-1)/6 ; nms_lu += s ; /* number of multiply-subtract pairs for LDL' */ nms_ldl += (s + lnzme)/2 ; } #ifndef NDEBUG AMD_DEBUG2 (("finalize done nel "ID" n "ID"\n ::::\n", nel, n)) ; for (pme = Pe [me] ; pme <= Pe [me] + Len [me] - 1 ; pme++) { AMD_DEBUG3 ((" "ID"", Iw [pme])) ; } AMD_DEBUG3 (("\n")) ; #endif } /* ========================================================================= */ /* DONE SELECTING PIVOTS */ /* ========================================================================= */ if (Info != (double *) NULL) { /* count the work to factorize the ndense-by-ndense submatrix */ f = ndense ; dmax = MAX (dmax, (double) ndense) ; /* number of nonzeros in L (excluding the diagonal) */ lnzme = (f-1)*f/2 ; lnz += lnzme ; /* number of divide operations for LDL' and for LU */ ndiv += lnzme ; /* number of multiply-subtract pairs for LU */ s = (f-1)*f*(2*f-1)/6 ; nms_lu += s ; /* number of multiply-subtract pairs for LDL' */ nms_ldl += (s + lnzme)/2 ; /* number of nz's in L (excl. diagonal) */ Info [AMD_LNZ] = lnz ; /* number of divide ops for LU and LDL' */ Info [AMD_NDIV] = ndiv ; /* number of multiply-subtract pairs for LDL' */ Info [AMD_NMULTSUBS_LDL] = nms_ldl ; /* number of multiply-subtract pairs for LU */ Info [AMD_NMULTSUBS_LU] = nms_lu ; /* number of "dense" rows/columns */ Info [AMD_NDENSE] = ndense ; /* largest front is dmax-by-dmax */ Info [AMD_DMAX] = dmax ; /* number of garbage collections in AMD */ Info [AMD_NCMPA] = ncmpa ; /* successful ordering */ Info [AMD_STATUS] = AMD_OK ; } /* ========================================================================= */ /* POST-ORDERING */ /* ========================================================================= */ /* ------------------------------------------------------------------------- * Variables at this point: * * Pe: holds the elimination tree. The parent of j is FLIP (Pe [j]), * or EMPTY if j is a root. The tree holds both elements and * non-principal (unordered) variables absorbed into them. * Dense variables are non-principal and unordered. * * Elen: holds the size of each element, including the diagonal part. * FLIP (Elen [e]) > 0 if e is an element. For unordered * variables i, Elen [i] is EMPTY. * * Nv: Nv [e] > 0 is the number of pivots represented by the element e. * For unordered variables i, Nv [i] is zero. * * Contents no longer needed: * W, Iw, Len, Degree, Head, Next, Last. * * The matrix itself has been destroyed. * * n: the size of the matrix. * No other scalars needed (pfree, iwlen, etc.) * ------------------------------------------------------------------------- */ /* restore Pe */ for (i = 0 ; i < n ; i++) { Pe [i] = FLIP (Pe [i]) ; } /* restore Elen, for output information, and for postordering */ for (i = 0 ; i < n ; i++) { Elen [i] = FLIP (Elen [i]) ; } /* Now the parent of j is Pe [j], or EMPTY if j is a root. Elen [e] > 0 * is the size of element e. Elen [i] is EMPTY for unordered variable i. */ #ifndef NDEBUG AMD_DEBUG2 (("\nTree:\n")) ; for (i = 0 ; i < n ; i++) { AMD_DEBUG2 ((" "ID" parent: "ID" ", i, Pe [i])) ; ASSERT (Pe [i] >= EMPTY && Pe [i] < n) ; if (Nv [i] > 0) { /* this is an element */ e = i ; AMD_DEBUG2 ((" element, size is "ID"\n", Elen [i])) ; ASSERT (Elen [e] > 0) ; } AMD_DEBUG2 (("\n")) ; } AMD_DEBUG2 (("\nelements:\n")) ; for (e = 0 ; e < n ; e++) { if (Nv [e] > 0) { AMD_DEBUG3 (("Element e= "ID" size "ID" nv "ID" \n", e, Elen [e], Nv [e])) ; } } AMD_DEBUG2 (("\nvariables:\n")) ; for (i = 0 ; i < n ; i++) { Int cnt ; if (Nv [i] == 0) { AMD_DEBUG3 (("i unordered: "ID"\n", i)) ; j = Pe [i] ; cnt = 0 ; AMD_DEBUG3 ((" j: "ID"\n", j)) ; if (j == EMPTY) { AMD_DEBUG3 ((" i is a dense variable\n")) ; } else { ASSERT (j >= 0 && j < n) ; while (Nv [j] == 0) { AMD_DEBUG3 ((" j : "ID"\n", j)) ; j = Pe [j] ; AMD_DEBUG3 ((" j:: "ID"\n", j)) ; cnt++ ; if (cnt > n) break ; } e = j ; AMD_DEBUG3 ((" got to e: "ID"\n", e)) ; } } } #endif /* ========================================================================= */ /* compress the paths of the variables */ /* ========================================================================= */ for (i = 0 ; i < n ; i++) { if (Nv [i] == 0) { /* ------------------------------------------------------------- * i is an un-ordered row. Traverse the tree from i until * reaching an element, e. The element, e, was the principal * supervariable of i and all nodes in the path from i to when e * was selected as pivot. * ------------------------------------------------------------- */ AMD_DEBUG1 (("Path compression, i unordered: "ID"\n", i)) ; j = Pe [i] ; ASSERT (j >= EMPTY && j < n) ; AMD_DEBUG3 ((" j: "ID"\n", j)) ; if (j == EMPTY) { /* Skip a dense variable. It has no parent. */ AMD_DEBUG3 ((" i is a dense variable\n")) ; continue ; } /* while (j is a variable) */ while (Nv [j] == 0) { AMD_DEBUG3 ((" j : "ID"\n", j)) ; j = Pe [j] ; AMD_DEBUG3 ((" j:: "ID"\n", j)) ; ASSERT (j >= 0 && j < n) ; } /* got to an element e */ e = j ; AMD_DEBUG3 (("got to e: "ID"\n", e)) ; /* ------------------------------------------------------------- * traverse the path again from i to e, and compress the path * (all nodes point to e). Path compression allows this code to * compute in O(n) time. * ------------------------------------------------------------- */ j = i ; /* while (j is a variable) */ while (Nv [j] == 0) { jnext = Pe [j] ; AMD_DEBUG3 (("j "ID" jnext "ID"\n", j, jnext)) ; Pe [j] = e ; j = jnext ; ASSERT (j >= 0 && j < n) ; } } } /* ========================================================================= */ /* postorder the assembly tree */ /* ========================================================================= */ AMD_postorder (n, Pe, Nv, Elen, W, /* output order */ Head, Next, Last) ; /* workspace */ /* ========================================================================= */ /* compute output permutation and inverse permutation */ /* ========================================================================= */ /* W [e] = k means that element e is the kth element in the new * order. e is in the range 0 to n-1, and k is in the range 0 to * the number of elements. Use Head for inverse order. */ for (k = 0 ; k < n ; k++) { Head [k] = EMPTY ; Next [k] = EMPTY ; } for (e = 0 ; e < n ; e++) { k = W [e] ; ASSERT ((k == EMPTY) == (Nv [e] == 0)) ; if (k != EMPTY) { ASSERT (k >= 0 && k < n) ; Head [k] = e ; } } /* construct output inverse permutation in Next, * and permutation in Last */ nel = 0 ; for (k = 0 ; k < n ; k++) { e = Head [k] ; if (e == EMPTY) break ; ASSERT (e >= 0 && e < n && Nv [e] > 0) ; Next [e] = nel ; nel += Nv [e] ; } ASSERT (nel == n - ndense) ; /* order non-principal variables (dense, & those merged into supervar's) */ for (i = 0 ; i < n ; i++) { if (Nv [i] == 0) { e = Pe [i] ; ASSERT (e >= EMPTY && e < n) ; if (e != EMPTY) { /* This is an unordered variable that was merged * into element e via supernode detection or mass * elimination of i when e became the pivot element. * Place i in order just before e. */ ASSERT (Next [i] == EMPTY && Nv [e] > 0) ; Next [i] = Next [e] ; Next [e]++ ; } else { /* This is a dense unordered variable, with no parent. * Place it last in the output order. */ Next [i] = nel++ ; } } } ASSERT (nel == n) ; AMD_DEBUG2 (("\n\nPerm:\n")) ; for (i = 0 ; i < n ; i++) { k = Next [i] ; ASSERT (k >= 0 && k < n) ; Last [k] = i ; AMD_DEBUG2 ((" perm ["ID"] = "ID"\n", k, i)) ; } } Matrix/src/AMD/Source/amd_info.c0000644000176200001440000001030513652535054016075 0ustar liggesusers/* ========================================================================= */ /* === AMD_info ============================================================ */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: DrTimothyAldenDavis@gmail.com */ /* ------------------------------------------------------------------------- */ /* User-callable. Prints the output statistics for AMD. See amd.h * for details. If the Info array is not present, nothing is printed. */ #include "amd_internal.h" #define PRI(format,x) { if (x >= 0) { SUITESPARSE_PRINTF ((format, x)) ; }} GLOBAL void AMD_info ( double Info [ ] ) { double n, ndiv, nmultsubs_ldl, nmultsubs_lu, lnz, lnzd ; SUITESPARSE_PRINTF (("\nAMD version %d.%d.%d, %s, results:\n", AMD_MAIN_VERSION, AMD_SUB_VERSION, AMD_SUBSUB_VERSION, AMD_DATE)) ; if (!Info) { return ; } n = Info [AMD_N] ; ndiv = Info [AMD_NDIV] ; nmultsubs_ldl = Info [AMD_NMULTSUBS_LDL] ; nmultsubs_lu = Info [AMD_NMULTSUBS_LU] ; lnz = Info [AMD_LNZ] ; lnzd = (n >= 0 && lnz >= 0) ? (n + lnz) : (-1) ; /* AMD return status */ SUITESPARSE_PRINTF ((" status: ")) ; if (Info [AMD_STATUS] == AMD_OK) { SUITESPARSE_PRINTF (("OK\n")) ; } else if (Info [AMD_STATUS] == AMD_OUT_OF_MEMORY) { SUITESPARSE_PRINTF (("out of memory\n")) ; } else if (Info [AMD_STATUS] == AMD_INVALID) { SUITESPARSE_PRINTF (("invalid matrix\n")) ; } else if (Info [AMD_STATUS] == AMD_OK_BUT_JUMBLED) { SUITESPARSE_PRINTF (("OK, but jumbled\n")) ; } else { SUITESPARSE_PRINTF (("unknown\n")) ; } /* statistics about the input matrix */ PRI (" n, dimension of A: %.20g\n", n); PRI (" nz, number of nonzeros in A: %.20g\n", Info [AMD_NZ]) ; PRI (" symmetry of A: %.4f\n", Info [AMD_SYMMETRY]) ; PRI (" number of nonzeros on diagonal: %.20g\n", Info [AMD_NZDIAG]) ; PRI (" nonzeros in pattern of A+A' (excl. diagonal): %.20g\n", Info [AMD_NZ_A_PLUS_AT]) ; PRI (" # dense rows/columns of A+A': %.20g\n", Info [AMD_NDENSE]) ; /* statistics about AMD's behavior */ PRI (" memory used, in bytes: %.20g\n", Info [AMD_MEMORY]) ; PRI (" # of memory compactions: %.20g\n", Info [AMD_NCMPA]) ; /* statistics about the ordering quality */ SUITESPARSE_PRINTF (("\n" " The following approximate statistics are for a subsequent\n" " factorization of A(P,P) + A(P,P)'. They are slight upper\n" " bounds if there are no dense rows/columns in A+A', and become\n" " looser if dense rows/columns exist.\n\n")) ; PRI (" nonzeros in L (excluding diagonal): %.20g\n", lnz) ; PRI (" nonzeros in L (including diagonal): %.20g\n", lnzd) ; PRI (" # divide operations for LDL' or LU: %.20g\n", ndiv) ; PRI (" # multiply-subtract operations for LDL': %.20g\n", nmultsubs_ldl) ; PRI (" # multiply-subtract operations for LU: %.20g\n", nmultsubs_lu) ; PRI (" max nz. in any column of L (incl. diagonal): %.20g\n", Info [AMD_DMAX]) ; /* total flop counts for various factorizations */ if (n >= 0 && ndiv >= 0 && nmultsubs_ldl >= 0 && nmultsubs_lu >= 0) { SUITESPARSE_PRINTF (("\n" " chol flop count for real A, sqrt counted as 1 flop: %.20g\n" " LDL' flop count for real A: %.20g\n" " LDL' flop count for complex A: %.20g\n" " LU flop count for real A (with no pivoting): %.20g\n" " LU flop count for complex A (with no pivoting): %.20g\n\n", n + ndiv + 2*nmultsubs_ldl, ndiv + 2*nmultsubs_ldl, 9*ndiv + 8*nmultsubs_ldl, ndiv + 2*nmultsubs_lu, 9*ndiv + 8*nmultsubs_lu)) ; } } Matrix/src/AMD/Source/amd_aat.c0000644000176200001440000001135711770402705015712 0ustar liggesusers/* ========================================================================= */ /* === AMD_aat ============================================================= */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: DrTimothyAldenDavis@gmail.com */ /* ------------------------------------------------------------------------- */ /* AMD_aat: compute the symmetry of the pattern of A, and count the number of * nonzeros each column of A+A' (excluding the diagonal). Assumes the input * matrix has no errors, with sorted columns and no duplicates * (AMD_valid (n, n, Ap, Ai) must be AMD_OK, but this condition is not * checked). */ #include "amd_internal.h" GLOBAL size_t AMD_aat /* returns nz in A+A' */ ( Int n, const Int Ap [ ], const Int Ai [ ], Int Len [ ], /* Len [j]: length of column j of A+A', excl diagonal*/ Int Tp [ ], /* workspace of size n */ double Info [ ] ) { Int p1, p2, p, i, j, pj, pj2, k, nzdiag, nzboth, nz ; double sym ; size_t nzaat ; #ifndef NDEBUG AMD_debug_init ("AMD AAT") ; for (k = 0 ; k < n ; k++) Tp [k] = EMPTY ; ASSERT (AMD_valid (n, n, Ap, Ai) == AMD_OK) ; #endif if (Info != (double *) NULL) { /* clear the Info array, if it exists */ for (i = 0 ; i < AMD_INFO ; i++) { Info [i] = EMPTY ; } Info [AMD_STATUS] = AMD_OK ; } for (k = 0 ; k < n ; k++) { Len [k] = 0 ; } nzdiag = 0 ; nzboth = 0 ; nz = Ap [n] ; for (k = 0 ; k < n ; k++) { p1 = Ap [k] ; p2 = Ap [k+1] ; AMD_DEBUG2 (("\nAAT Column: "ID" p1: "ID" p2: "ID"\n", k, p1, p2)) ; /* construct A+A' */ for (p = p1 ; p < p2 ; ) { /* scan the upper triangular part of A */ j = Ai [p] ; if (j < k) { /* entry A (j,k) is in the strictly upper triangular part, * add both A (j,k) and A (k,j) to the matrix A+A' */ Len [j]++ ; Len [k]++ ; AMD_DEBUG3 ((" upper ("ID","ID") ("ID","ID")\n", j,k, k,j)); p++ ; } else if (j == k) { /* skip the diagonal */ p++ ; nzdiag++ ; break ; } else /* j > k */ { /* first entry below the diagonal */ break ; } /* scan lower triangular part of A, in column j until reaching * row k. Start where last scan left off. */ ASSERT (Tp [j] != EMPTY) ; ASSERT (Ap [j] <= Tp [j] && Tp [j] <= Ap [j+1]) ; pj2 = Ap [j+1] ; for (pj = Tp [j] ; pj < pj2 ; ) { i = Ai [pj] ; if (i < k) { /* A (i,j) is only in the lower part, not in upper. * add both A (i,j) and A (j,i) to the matrix A+A' */ Len [i]++ ; Len [j]++ ; AMD_DEBUG3 ((" lower ("ID","ID") ("ID","ID")\n", i,j, j,i)) ; pj++ ; } else if (i == k) { /* entry A (k,j) in lower part and A (j,k) in upper */ pj++ ; nzboth++ ; break ; } else /* i > k */ { /* consider this entry later, when k advances to i */ break ; } } Tp [j] = pj ; } /* Tp [k] points to the entry just below the diagonal in column k */ Tp [k] = p ; } /* clean up, for remaining mismatched entries */ for (j = 0 ; j < n ; j++) { for (pj = Tp [j] ; pj < Ap [j+1] ; pj++) { i = Ai [pj] ; /* A (i,j) is only in the lower part, not in upper. * add both A (i,j) and A (j,i) to the matrix A+A' */ Len [i]++ ; Len [j]++ ; AMD_DEBUG3 ((" lower cleanup ("ID","ID") ("ID","ID")\n", i,j, j,i)) ; } } /* --------------------------------------------------------------------- */ /* compute the symmetry of the nonzero pattern of A */ /* --------------------------------------------------------------------- */ /* Given a matrix A, the symmetry of A is: * B = tril (spones (A), -1) + triu (spones (A), 1) ; * sym = nnz (B & B') / nnz (B) ; * or 1 if nnz (B) is zero. */ if (nz == nzdiag) { sym = 1 ; } else { sym = (2 * (double) nzboth) / ((double) (nz - nzdiag)) ; } nzaat = 0 ; for (k = 0 ; k < n ; k++) { nzaat += Len [k] ; } AMD_DEBUG1 (("AMD nz in A+A', excluding diagonal (nzaat) = %g\n", (double) nzaat)) ; AMD_DEBUG1 ((" nzboth: "ID" nz: "ID" nzdiag: "ID" symmetry: %g\n", nzboth, nz, nzdiag, sym)) ; if (Info != (double *) NULL) { Info [AMD_STATUS] = AMD_OK ; Info [AMD_N] = n ; Info [AMD_NZ] = nz ; Info [AMD_SYMMETRY] = sym ; /* symmetry of pattern of A */ Info [AMD_NZDIAG] = nzdiag ; /* nonzeros on diagonal of A */ Info [AMD_NZ_A_PLUS_AT] = nzaat ; /* nonzeros in A+A' */ } return (nzaat) ; } Matrix/src/AMD/Source/amd_control.c0000644000176200001440000000351313652535054016625 0ustar liggesusers/* ========================================================================= */ /* === AMD_control ========================================================= */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: DrTimothyAldenDavis@gmail.com */ /* ------------------------------------------------------------------------- */ /* User-callable. Prints the control parameters for AMD. See amd.h * for details. If the Control array is not present, the defaults are * printed instead. */ #include "amd_internal.h" GLOBAL void AMD_control ( double Control [ ] ) { double alpha ; Int aggressive ; if (Control != (double *) NULL) { alpha = Control [AMD_DENSE] ; aggressive = Control [AMD_AGGRESSIVE] != 0 ; } else { alpha = AMD_DEFAULT_DENSE ; aggressive = AMD_DEFAULT_AGGRESSIVE ; } SUITESPARSE_PRINTF (( "\nAMD version %d.%d.%d, %s: approximate minimum degree ordering\n" " dense row parameter: %g\n", AMD_MAIN_VERSION, AMD_SUB_VERSION, AMD_SUBSUB_VERSION, AMD_DATE, alpha)) ; if (alpha < 0) { SUITESPARSE_PRINTF ((" no rows treated as dense\n")) ; } else { SUITESPARSE_PRINTF (( " (rows with more than max (%g * sqrt (n), 16) entries are\n" " considered \"dense\", and placed last in output permutation)\n", alpha)) ; } if (aggressive) { SUITESPARSE_PRINTF ((" aggressive absorption: yes\n")) ; } else { SUITESPARSE_PRINTF ((" aggressive absorption: no\n")) ; } SUITESPARSE_PRINTF ((" size of AMD integer: %d\n\n", sizeof (Int))) ; } Matrix/src/AMD/Source/amd_order.c0000644000176200001440000001361713652535054016266 0ustar liggesusers/* ========================================================================= */ /* === AMD_order =========================================================== */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: DrTimothyAldenDavis@gmail.com */ /* ------------------------------------------------------------------------- */ /* User-callable AMD minimum degree ordering routine. See amd.h for * documentation. */ #include "amd_internal.h" /* ========================================================================= */ /* === AMD_order =========================================================== */ /* ========================================================================= */ GLOBAL Int AMD_order ( Int n, const Int Ap [ ], const Int Ai [ ], Int P [ ], double Control [ ], double Info [ ] ) { Int *Len, *S, nz, i, *Pinv, info, status, *Rp, *Ri, *Cp, *Ci, ok ; size_t nzaat, slen ; double mem = 0 ; #ifndef NDEBUG AMD_debug_init ("amd") ; #endif /* clear the Info array, if it exists */ info = Info != (double *) NULL ; if (info) { for (i = 0 ; i < AMD_INFO ; i++) { Info [i] = EMPTY ; } Info [AMD_N] = n ; Info [AMD_STATUS] = AMD_OK ; } /* make sure inputs exist and n is >= 0 */ if (Ai == (Int *) NULL || Ap == (Int *) NULL || P == (Int *) NULL || n < 0) { if (info) Info [AMD_STATUS] = AMD_INVALID ; return (AMD_INVALID) ; /* arguments are invalid */ } if (n == 0) { return (AMD_OK) ; /* n is 0 so there's nothing to do */ } nz = Ap [n] ; if (info) { Info [AMD_NZ] = nz ; } if (nz < 0) { if (info) Info [AMD_STATUS] = AMD_INVALID ; return (AMD_INVALID) ; } /* check if n or nz will cause size_t overflow */ if (((size_t) n) >= SIZE_T_MAX / sizeof (Int) || ((size_t) nz) >= SIZE_T_MAX / sizeof (Int)) { if (info) Info [AMD_STATUS] = AMD_OUT_OF_MEMORY ; return (AMD_OUT_OF_MEMORY) ; /* problem too large */ } /* check the input matrix: AMD_OK, AMD_INVALID, or AMD_OK_BUT_JUMBLED */ status = AMD_valid (n, n, Ap, Ai) ; if (status == AMD_INVALID) { if (info) Info [AMD_STATUS] = AMD_INVALID ; return (AMD_INVALID) ; /* matrix is invalid */ } /* allocate two size-n integer workspaces */ Len = SuiteSparse_malloc (n, sizeof (Int)) ; Pinv = SuiteSparse_malloc (n, sizeof (Int)) ; mem += n ; mem += n ; if (!Len || !Pinv) { /* :: out of memory :: */ SuiteSparse_free (Len) ; SuiteSparse_free (Pinv) ; if (info) Info [AMD_STATUS] = AMD_OUT_OF_MEMORY ; return (AMD_OUT_OF_MEMORY) ; } if (status == AMD_OK_BUT_JUMBLED) { /* sort the input matrix and remove duplicate entries */ AMD_DEBUG1 (("Matrix is jumbled\n")) ; Rp = SuiteSparse_malloc (n+1, sizeof (Int)) ; Ri = SuiteSparse_malloc (nz, sizeof (Int)) ; mem += (n+1) ; mem += MAX (nz,1) ; if (!Rp || !Ri) { /* :: out of memory :: */ SuiteSparse_free (Rp) ; SuiteSparse_free (Ri) ; SuiteSparse_free (Len) ; SuiteSparse_free (Pinv) ; if (info) Info [AMD_STATUS] = AMD_OUT_OF_MEMORY ; return (AMD_OUT_OF_MEMORY) ; } /* use Len and Pinv as workspace to create R = A' */ AMD_preprocess (n, Ap, Ai, Rp, Ri, Len, Pinv) ; Cp = Rp ; Ci = Ri ; } else { /* order the input matrix as-is. No need to compute R = A' first */ Rp = NULL ; Ri = NULL ; Cp = (Int *) Ap ; Ci = (Int *) Ai ; } /* --------------------------------------------------------------------- */ /* determine the symmetry and count off-diagonal nonzeros in A+A' */ /* --------------------------------------------------------------------- */ nzaat = AMD_aat (n, Cp, Ci, Len, P, Info) ; AMD_DEBUG1 (("nzaat: %g\n", (double) nzaat)) ; ASSERT ((MAX (nz-n, 0) <= nzaat) && (nzaat <= 2 * (size_t) nz)) ; /* --------------------------------------------------------------------- */ /* allocate workspace for matrix, elbow room, and 6 size-n vectors */ /* --------------------------------------------------------------------- */ S = NULL ; slen = nzaat ; /* space for matrix */ ok = ((slen + nzaat/5) >= slen) ; /* check for size_t overflow */ slen += nzaat/5 ; /* add elbow room */ for (i = 0 ; ok && i < 7 ; i++) { ok = ((slen + n) > slen) ; /* check for size_t overflow */ slen += n ; /* size-n elbow room, 6 size-n work */ } mem += slen ; ok = ok && (slen < SIZE_T_MAX / sizeof (Int)) ; /* check for overflow */ ok = ok && (slen < Int_MAX) ; /* S[i] for Int i must be OK */ if (ok) { S = SuiteSparse_malloc (slen, sizeof (Int)) ; } AMD_DEBUG1 (("slen %g\n", (double) slen)) ; if (!S) { /* :: out of memory :: (or problem too large) */ SuiteSparse_free (Rp) ; SuiteSparse_free (Ri) ; SuiteSparse_free (Len) ; SuiteSparse_free (Pinv) ; if (info) Info [AMD_STATUS] = AMD_OUT_OF_MEMORY ; return (AMD_OUT_OF_MEMORY) ; } if (info) { /* memory usage, in bytes. */ Info [AMD_MEMORY] = mem * sizeof (Int) ; } /* --------------------------------------------------------------------- */ /* order the matrix */ /* --------------------------------------------------------------------- */ AMD_1 (n, Cp, Ci, P, Pinv, Len, slen, S, Control, Info) ; /* --------------------------------------------------------------------- */ /* free the workspace */ /* --------------------------------------------------------------------- */ SuiteSparse_free (Rp) ; SuiteSparse_free (Ri) ; SuiteSparse_free (Len) ; SuiteSparse_free (Pinv) ; SuiteSparse_free (S) ; if (info) Info [AMD_STATUS] = status ; return (status) ; /* successful ordering */ } Matrix/src/AMD/Source/make-Make.R0000644000176200001440000000142113763176012016065 0ustar liggesusers## From: Prof Brian Ripley ## To: Martin Maechler ## cc: Doug and Martin ## Subject: Re: [Rd] Package Matrix does not compile in R-devel_2009-01-10 (fwd) ## Date: Thu, 15 Jan 2009 14:22:17 +0000 (GMT) AMD <- c("aat", "1", "2", "postorder", "post_tree", "defaults", "order", "control", "info", "valid", "preprocess", "dump") cat("OBJS = ") for (i in AMD) cat(sprintf("amd_i_%s.o amd_l_%s.o ", i, i)) cat("\n\n") CC1 <- "\t$(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include" for (i in AMD) cat(sprintf("amd_i_%s.o: amd_%s.c $(INC)", i, i), sprintf(paste(CC1, "-DDINT -c amd_%s.c -o $@"), i), sep="\n") cat("\n") for (i in AMD) cat(sprintf("amd_l_%s.o: amd_%s.c $(INC)", i,i), sprintf(paste(CC1, "-DDLONG -c amd_%s.c -o $@"), i), sep="\n") Matrix/src/AMD/Source/amd_1.c0000644000176200001440000001311611770402705015300 0ustar liggesusers/* ========================================================================= */ /* === AMD_1 =============================================================== */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: DrTimothyAldenDavis@gmail.com */ /* ------------------------------------------------------------------------- */ /* AMD_1: Construct A+A' for a sparse matrix A and perform the AMD ordering. * * The n-by-n sparse matrix A can be unsymmetric. It is stored in MATLAB-style * compressed-column form, with sorted row indices in each column, and no * duplicate entries. Diagonal entries may be present, but they are ignored. * Row indices of column j of A are stored in Ai [Ap [j] ... Ap [j+1]-1]. * Ap [0] must be zero, and nz = Ap [n] is the number of entries in A. The * size of the matrix, n, must be greater than or equal to zero. * * This routine must be preceded by a call to AMD_aat, which computes the * number of entries in each row/column in A+A', excluding the diagonal. * Len [j], on input, is the number of entries in row/column j of A+A'. This * routine constructs the matrix A+A' and then calls AMD_2. No error checking * is performed (this was done in AMD_valid). */ #include "amd_internal.h" GLOBAL void AMD_1 ( Int n, /* n > 0 */ const Int Ap [ ], /* input of size n+1, not modified */ const Int Ai [ ], /* input of size nz = Ap [n], not modified */ Int P [ ], /* size n output permutation */ Int Pinv [ ], /* size n output inverse permutation */ Int Len [ ], /* size n input, undefined on output */ Int slen, /* slen >= sum (Len [0..n-1]) + 7n, * ideally slen = 1.2 * sum (Len) + 8n */ Int S [ ], /* size slen workspace */ double Control [ ], /* input array of size AMD_CONTROL */ double Info [ ] /* output array of size AMD_INFO */ ) { Int i, j, k, p, pfree, iwlen, pj, p1, p2, pj2, *Iw, *Pe, *Nv, *Head, *Elen, *Degree, *s, *W, *Sp, *Tp ; /* --------------------------------------------------------------------- */ /* construct the matrix for AMD_2 */ /* --------------------------------------------------------------------- */ ASSERT (n > 0) ; iwlen = slen - 6*n ; s = S ; Pe = s ; s += n ; Nv = s ; s += n ; Head = s ; s += n ; Elen = s ; s += n ; Degree = s ; s += n ; W = s ; s += n ; Iw = s ; s += iwlen ; ASSERT (AMD_valid (n, n, Ap, Ai) == AMD_OK) ; /* construct the pointers for A+A' */ Sp = Nv ; /* use Nv and W as workspace for Sp and Tp [ */ Tp = W ; pfree = 0 ; for (j = 0 ; j < n ; j++) { Pe [j] = pfree ; Sp [j] = pfree ; pfree += Len [j] ; } /* Note that this restriction on iwlen is slightly more restrictive than * what is strictly required in AMD_2. AMD_2 can operate with no elbow * room at all, but it will be very slow. For better performance, at * least size-n elbow room is enforced. */ ASSERT (iwlen >= pfree + n) ; #ifndef NDEBUG for (p = 0 ; p < iwlen ; p++) Iw [p] = EMPTY ; #endif for (k = 0 ; k < n ; k++) { AMD_DEBUG1 (("Construct row/column k= "ID" of A+A'\n", k)) ; p1 = Ap [k] ; p2 = Ap [k+1] ; /* construct A+A' */ for (p = p1 ; p < p2 ; ) { /* scan the upper triangular part of A */ j = Ai [p] ; ASSERT (j >= 0 && j < n) ; if (j < k) { /* entry A (j,k) in the strictly upper triangular part */ ASSERT (Sp [j] < (j == n-1 ? pfree : Pe [j+1])) ; ASSERT (Sp [k] < (k == n-1 ? pfree : Pe [k+1])) ; Iw [Sp [j]++] = k ; Iw [Sp [k]++] = j ; p++ ; } else if (j == k) { /* skip the diagonal */ p++ ; break ; } else /* j > k */ { /* first entry below the diagonal */ break ; } /* scan lower triangular part of A, in column j until reaching * row k. Start where last scan left off. */ ASSERT (Ap [j] <= Tp [j] && Tp [j] <= Ap [j+1]) ; pj2 = Ap [j+1] ; for (pj = Tp [j] ; pj < pj2 ; ) { i = Ai [pj] ; ASSERT (i >= 0 && i < n) ; if (i < k) { /* A (i,j) is only in the lower part, not in upper */ ASSERT (Sp [i] < (i == n-1 ? pfree : Pe [i+1])) ; ASSERT (Sp [j] < (j == n-1 ? pfree : Pe [j+1])) ; Iw [Sp [i]++] = j ; Iw [Sp [j]++] = i ; pj++ ; } else if (i == k) { /* entry A (k,j) in lower part and A (j,k) in upper */ pj++ ; break ; } else /* i > k */ { /* consider this entry later, when k advances to i */ break ; } } Tp [j] = pj ; } Tp [k] = p ; } /* clean up, for remaining mismatched entries */ for (j = 0 ; j < n ; j++) { for (pj = Tp [j] ; pj < Ap [j+1] ; pj++) { i = Ai [pj] ; ASSERT (i >= 0 && i < n) ; /* A (i,j) is only in the lower part, not in upper */ ASSERT (Sp [i] < (i == n-1 ? pfree : Pe [i+1])) ; ASSERT (Sp [j] < (j == n-1 ? pfree : Pe [j+1])) ; Iw [Sp [i]++] = j ; Iw [Sp [j]++] = i ; } } #ifndef NDEBUG for (j = 0 ; j < n-1 ; j++) ASSERT (Sp [j] == Pe [j+1]) ; ASSERT (Sp [n-1] == pfree) ; #endif /* Tp and Sp no longer needed ] */ /* --------------------------------------------------------------------- */ /* order the matrix */ /* --------------------------------------------------------------------- */ AMD_2 (n, Pe, Iw, Len, iwlen, pfree, Nv, Pinv, P, Head, Elen, Degree, W, Control, Info) ; } Matrix/src/AMD/Source/Makefile0000644000176200001440000000033514154165630015614 0ustar liggesusersPKG_CPPFLAGS = -I../Include -I../../SuiteSparse_config LIB = ../../AMD.a lib: $(LIB) include make_o.mk $(LIB): $(OBJS) $(AR) -rucs $(LIB) $(OBJS) mostlyclean: clean clean: @-rm -rf .libs _libs $(LIB) @-rm -f *.o Matrix/src/AMD/Source/make_o.mk0000644000176200001440000000602513763176012015743 0ustar liggesusersOBJS = amd_i_aat.o amd_l_aat.o amd_i_1.o amd_l_1.o amd_i_2.o amd_l_2.o amd_i_postorder.o amd_l_postorder.o amd_i_post_tree.o amd_l_post_tree.o amd_i_defaults.o amd_l_defaults.o amd_i_order.o amd_l_order.o amd_i_control.o amd_l_control.o amd_i_info.o amd_l_info.o amd_i_valid.o amd_l_valid.o amd_i_preprocess.o amd_l_preprocess.o amd_i_dump.o amd_l_dump.o amd_i_aat.o: amd_aat.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDINT -c amd_aat.c -o $@ amd_i_1.o: amd_1.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDINT -c amd_1.c -o $@ amd_i_2.o: amd_2.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDINT -c amd_2.c -o $@ amd_i_postorder.o: amd_postorder.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDINT -c amd_postorder.c -o $@ amd_i_post_tree.o: amd_post_tree.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDINT -c amd_post_tree.c -o $@ amd_i_defaults.o: amd_defaults.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDINT -c amd_defaults.c -o $@ amd_i_order.o: amd_order.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDINT -c amd_order.c -o $@ amd_i_control.o: amd_control.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDINT -c amd_control.c -o $@ amd_i_info.o: amd_info.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDINT -c amd_info.c -o $@ amd_i_valid.o: amd_valid.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDINT -c amd_valid.c -o $@ amd_i_preprocess.o: amd_preprocess.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDINT -c amd_preprocess.c -o $@ amd_i_dump.o: amd_dump.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDINT -c amd_dump.c -o $@ amd_l_aat.o: amd_aat.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDLONG -c amd_aat.c -o $@ amd_l_1.o: amd_1.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDLONG -c amd_1.c -o $@ amd_l_2.o: amd_2.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDLONG -c amd_2.c -o $@ amd_l_postorder.o: amd_postorder.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDLONG -c amd_postorder.c -o $@ amd_l_post_tree.o: amd_post_tree.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDLONG -c amd_post_tree.c -o $@ amd_l_defaults.o: amd_defaults.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDLONG -c amd_defaults.c -o $@ amd_l_order.o: amd_order.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDLONG -c amd_order.c -o $@ amd_l_control.o: amd_control.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDLONG -c amd_control.c -o $@ amd_l_info.o: amd_info.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDLONG -c amd_info.c -o $@ amd_l_valid.o: amd_valid.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDLONG -c amd_valid.c -o $@ amd_l_preprocess.o: amd_preprocess.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDLONG -c amd_preprocess.c -o $@ amd_l_dump.o: amd_dump.c $(INC) $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDLONG -c amd_dump.c -o $@ Matrix/src/AMD/Source/amd_dump.c0000644000176200001440000001162411770402705016107 0ustar liggesusers/* ========================================================================= */ /* === AMD_dump ============================================================ */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: DrTimothyAldenDavis@gmail.com */ /* ------------------------------------------------------------------------- */ /* Debugging routines for AMD. Not used if NDEBUG is not defined at compile- * time (the default). See comments in amd_internal.h on how to enable * debugging. Not user-callable. */ #include "amd_internal.h" #ifndef NDEBUG /* This global variable is present only when debugging */ GLOBAL Int AMD_debug = -999 ; /* default is no debug printing */ /* ========================================================================= */ /* === AMD_debug_init ====================================================== */ /* ========================================================================= */ /* Sets the debug print level, by reading the file debug.amd (if it exists) */ GLOBAL void AMD_debug_init ( char *s ) { FILE *f ; f = fopen ("debug.amd", "r") ; if (f == (FILE *) NULL) { AMD_debug = -999 ; } else { fscanf (f, ID, &AMD_debug) ; fclose (f) ; } if (AMD_debug >= 0) { printf ("%s: AMD_debug_init, D= "ID"\n", s, AMD_debug) ; } } /* ========================================================================= */ /* === AMD_dump ============================================================ */ /* ========================================================================= */ /* Dump AMD's data structure, except for the hash buckets. This routine * cannot be called when the hash buckets are non-empty. */ GLOBAL void AMD_dump ( Int n, /* A is n-by-n */ Int Pe [ ], /* pe [0..n-1]: index in iw of start of row i */ Int Iw [ ], /* workspace of size iwlen, iwlen [0..pfree-1] * holds the matrix on input */ Int Len [ ], /* len [0..n-1]: length for row i */ Int iwlen, /* length of iw */ Int pfree, /* iw [pfree ... iwlen-1] is empty on input */ Int Nv [ ], /* nv [0..n-1] */ Int Next [ ], /* next [0..n-1] */ Int Last [ ], /* last [0..n-1] */ Int Head [ ], /* head [0..n-1] */ Int Elen [ ], /* size n */ Int Degree [ ], /* size n */ Int W [ ], /* size n */ Int nel ) { Int i, pe, elen, nv, len, e, p, k, j, deg, w, cnt, ilast ; if (AMD_debug < 0) return ; ASSERT (pfree <= iwlen) ; AMD_DEBUG3 (("\nAMD dump, pfree: "ID"\n", pfree)) ; for (i = 0 ; i < n ; i++) { pe = Pe [i] ; elen = Elen [i] ; nv = Nv [i] ; len = Len [i] ; w = W [i] ; if (elen >= EMPTY) { if (nv == 0) { AMD_DEBUG3 (("\nI "ID": nonprincipal: ", i)) ; ASSERT (elen == EMPTY) ; if (pe == EMPTY) { AMD_DEBUG3 ((" dense node\n")) ; ASSERT (w == 1) ; } else { ASSERT (pe < EMPTY) ; AMD_DEBUG3 ((" i "ID" -> parent "ID"\n", i, FLIP (Pe[i]))); } } else { AMD_DEBUG3 (("\nI "ID": active principal supervariable:\n",i)); AMD_DEBUG3 ((" nv(i): "ID" Flag: %d\n", nv, (nv < 0))) ; ASSERT (elen >= 0) ; ASSERT (nv > 0 && pe >= 0) ; p = pe ; AMD_DEBUG3 ((" e/s: ")) ; if (elen == 0) AMD_DEBUG3 ((" : ")) ; ASSERT (pe + len <= pfree) ; for (k = 0 ; k < len ; k++) { j = Iw [p] ; AMD_DEBUG3 ((" "ID"", j)) ; ASSERT (j >= 0 && j < n) ; if (k == elen-1) AMD_DEBUG3 ((" : ")) ; p++ ; } AMD_DEBUG3 (("\n")) ; } } else { e = i ; if (w == 0) { AMD_DEBUG3 (("\nE "ID": absorbed element: w "ID"\n", e, w)) ; ASSERT (nv > 0 && pe < 0) ; AMD_DEBUG3 ((" e "ID" -> parent "ID"\n", e, FLIP (Pe [e]))) ; } else { AMD_DEBUG3 (("\nE "ID": unabsorbed element: w "ID"\n", e, w)) ; ASSERT (nv > 0 && pe >= 0) ; p = pe ; AMD_DEBUG3 ((" : ")) ; ASSERT (pe + len <= pfree) ; for (k = 0 ; k < len ; k++) { j = Iw [p] ; AMD_DEBUG3 ((" "ID"", j)) ; ASSERT (j >= 0 && j < n) ; p++ ; } AMD_DEBUG3 (("\n")) ; } } } /* this routine cannot be called when the hash buckets are non-empty */ AMD_DEBUG3 (("\nDegree lists:\n")) ; if (nel >= 0) { cnt = 0 ; for (deg = 0 ; deg < n ; deg++) { if (Head [deg] == EMPTY) continue ; ilast = EMPTY ; AMD_DEBUG3 ((ID": \n", deg)) ; for (i = Head [deg] ; i != EMPTY ; i = Next [i]) { AMD_DEBUG3 ((" "ID" : next "ID" last "ID" deg "ID"\n", i, Next [i], Last [i], Degree [i])) ; ASSERT (i >= 0 && i < n && ilast == Last [i] && deg == Degree [i]) ; cnt += Nv [i] ; ilast = i ; } AMD_DEBUG3 (("\n")) ; } ASSERT (cnt == n - nel) ; } } #endif Matrix/src/AMD/Source/amd_defaults.c0000644000176200001440000000234511770402705016751 0ustar liggesusers/* ========================================================================= */ /* === AMD_defaults ======================================================== */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: DrTimothyAldenDavis@gmail.com */ /* ------------------------------------------------------------------------- */ /* User-callable. Sets default control parameters for AMD. See amd.h * for details. */ #include "amd_internal.h" /* ========================================================================= */ /* === AMD defaults ======================================================== */ /* ========================================================================= */ GLOBAL void AMD_defaults ( double Control [ ] ) { Int i ; if (Control != (double *) NULL) { for (i = 0 ; i < AMD_CONTROL ; i++) { Control [i] = 0 ; } Control [AMD_DENSE] = AMD_DEFAULT_DENSE ; Control [AMD_AGGRESSIVE] = AMD_DEFAULT_AGGRESSIVE ; } } Matrix/src/AMD/Source/amd_post_tree.c0000644000176200001440000000716711770402705017155 0ustar liggesusers/* ========================================================================= */ /* === AMD_post_tree ======================================================= */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: DrTimothyAldenDavis@gmail.com */ /* ------------------------------------------------------------------------- */ /* Post-ordering of a supernodal elimination tree. */ #include "amd_internal.h" GLOBAL Int AMD_post_tree ( Int root, /* root of the tree */ Int k, /* start numbering at k */ Int Child [ ], /* input argument of size nn, undefined on * output. Child [i] is the head of a link * list of all nodes that are children of node * i in the tree. */ const Int Sibling [ ], /* input argument of size nn, not modified. * If f is a node in the link list of the * children of node i, then Sibling [f] is the * next child of node i. */ Int Order [ ], /* output order, of size nn. Order [i] = k * if node i is the kth node of the reordered * tree. */ Int Stack [ ] /* workspace of size nn */ #ifndef NDEBUG , Int nn /* nodes are in the range 0..nn-1. */ #endif ) { Int f, head, h, i ; #if 0 /* --------------------------------------------------------------------- */ /* recursive version (Stack [ ] is not used): */ /* --------------------------------------------------------------------- */ /* this is simple, but can caouse stack overflow if nn is large */ i = root ; for (f = Child [i] ; f != EMPTY ; f = Sibling [f]) { k = AMD_post_tree (f, k, Child, Sibling, Order, Stack, nn) ; } Order [i] = k++ ; return (k) ; #endif /* --------------------------------------------------------------------- */ /* non-recursive version, using an explicit stack */ /* --------------------------------------------------------------------- */ /* push root on the stack */ head = 0 ; Stack [0] = root ; while (head >= 0) { /* get head of stack */ ASSERT (head < nn) ; i = Stack [head] ; AMD_DEBUG1 (("head of stack "ID" \n", i)) ; ASSERT (i >= 0 && i < nn) ; if (Child [i] != EMPTY) { /* the children of i are not yet ordered */ /* push each child onto the stack in reverse order */ /* so that small ones at the head of the list get popped first */ /* and the biggest one at the end of the list gets popped last */ for (f = Child [i] ; f != EMPTY ; f = Sibling [f]) { head++ ; ASSERT (head < nn) ; ASSERT (f >= 0 && f < nn) ; } h = head ; ASSERT (head < nn) ; for (f = Child [i] ; f != EMPTY ; f = Sibling [f]) { ASSERT (h > 0) ; Stack [h--] = f ; AMD_DEBUG1 (("push "ID" on stack\n", f)) ; ASSERT (f >= 0 && f < nn) ; } ASSERT (Stack [h] == i) ; /* delete child list so that i gets ordered next time we see it */ Child [i] = EMPTY ; } else { /* the children of i (if there were any) are already ordered */ /* remove i from the stack and order it. Front i is kth front */ head-- ; AMD_DEBUG1 (("pop "ID" order "ID"\n", i, k)) ; Order [i] = k++ ; ASSERT (k <= nn) ; } #ifndef NDEBUG AMD_DEBUG1 (("\nStack:")) ; for (h = head ; h >= 0 ; h--) { Int j = Stack [h] ; AMD_DEBUG1 ((" "ID, j)) ; ASSERT (j >= 0 && j < nn) ; } AMD_DEBUG1 (("\n\n")) ; ASSERT (head < nn) ; #endif } return (k) ; } Matrix/src/AMD/Source/amd_preprocess.c0000644000176200001440000000734011770402705017327 0ustar liggesusers/* ========================================================================= */ /* === AMD_preprocess ====================================================== */ /* ========================================================================= */ /* ------------------------------------------------------------------------- */ /* AMD, Copyright (c) Timothy A. Davis, */ /* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */ /* email: DrTimothyAldenDavis@gmail.com */ /* ------------------------------------------------------------------------- */ /* Sorts, removes duplicate entries, and transposes from the nonzero pattern of * a column-form matrix A, to obtain the matrix R. The input matrix can have * duplicate entries and/or unsorted columns (AMD_valid (n,Ap,Ai) must not be * AMD_INVALID). * * This input condition is NOT checked. This routine is not user-callable. */ #include "amd_internal.h" /* ========================================================================= */ /* === AMD_preprocess ====================================================== */ /* ========================================================================= */ /* AMD_preprocess does not check its input for errors or allocate workspace. * On input, the condition (AMD_valid (n,n,Ap,Ai) != AMD_INVALID) must hold. */ GLOBAL void AMD_preprocess ( Int n, /* input matrix: A is n-by-n */ const Int Ap [ ], /* size n+1 */ const Int Ai [ ], /* size nz = Ap [n] */ /* output matrix R: */ Int Rp [ ], /* size n+1 */ Int Ri [ ], /* size nz (or less, if duplicates present) */ Int W [ ], /* workspace of size n */ Int Flag [ ] /* workspace of size n */ ) { /* --------------------------------------------------------------------- */ /* local variables */ /* --------------------------------------------------------------------- */ Int i, j, p, p2 ; ASSERT (AMD_valid (n, n, Ap, Ai) != AMD_INVALID) ; /* --------------------------------------------------------------------- */ /* count the entries in each row of A (excluding duplicates) */ /* --------------------------------------------------------------------- */ for (i = 0 ; i < n ; i++) { W [i] = 0 ; /* # of nonzeros in row i (excl duplicates) */ Flag [i] = EMPTY ; /* Flag [i] = j if i appears in column j */ } for (j = 0 ; j < n ; j++) { p2 = Ap [j+1] ; for (p = Ap [j] ; p < p2 ; p++) { i = Ai [p] ; if (Flag [i] != j) { /* row index i has not yet appeared in column j */ W [i]++ ; /* one more entry in row i */ Flag [i] = j ; /* flag row index i as appearing in col j*/ } } } /* --------------------------------------------------------------------- */ /* compute the row pointers for R */ /* --------------------------------------------------------------------- */ Rp [0] = 0 ; for (i = 0 ; i < n ; i++) { Rp [i+1] = Rp [i] + W [i] ; } for (i = 0 ; i < n ; i++) { W [i] = Rp [i] ; Flag [i] = EMPTY ; } /* --------------------------------------------------------------------- */ /* construct the row form matrix R */ /* --------------------------------------------------------------------- */ /* R = row form of pattern of A */ for (j = 0 ; j < n ; j++) { p2 = Ap [j+1] ; for (p = Ap [j] ; p < p2 ; p++) { i = Ai [p] ; if (Flag [i] != j) { /* row index i has not yet appeared in column j */ Ri [W [i]++] = j ; /* put col j in row i */ Flag [i] = j ; /* flag row index i as appearing in col j*/ } } } #ifndef NDEBUG ASSERT (AMD_valid (n, n, Rp, Ri) == AMD_OK) ; for (j = 0 ; j < n ; j++) { ASSERT (W [j] == Rp [j+1]) ; } #endif } Matrix/src/dgTMatrix.h0000644000176200001440000000037712522710014014362 0ustar liggesusers#ifndef MATRIX_TRIPLET_H #define MATRIX_TRIPLET_H #include "Mutils.h" SEXP xTMatrix_validate(SEXP x); SEXP dgTMatrix_to_dgeMatrix(SEXP x); SEXP lgTMatrix_to_lgeMatrix(SEXP x); SEXP dgTMatrix_to_matrix(SEXP x); SEXP lgTMatrix_to_matrix(SEXP x); #endif Matrix/src/t_Csparse_subassign.c0000644000176200001440000003165213255476364016500 0ustar liggesusers/*------ Definition of a template for [diln]Csparse_subassign(...) : * * -------- ~~~~~~~~~~~~~~~~~~~~~~ * i.e., included several times from ./Csparse.c * ~~~~~~~~~~~ * _slot_kind : use the integer codes matching x_slot_kind in ./Mutils.h * ~~~~~~~~ */ #ifdef _d_Csp_ # define Csparse_subassign dCsparse_subassign # define x_CLASSES "dgCMatrix",/* 0 */ "dtCMatrix" /* 1 */ # define sparseVECTOR "dsparseVector" # define slot_kind_x 0 # define _DOUBLE_x # define _has_x_slot_ # undef _d_Csp_ #elif defined (_l_Csp_) # define Csparse_subassign lCsparse_subassign # define x_CLASSES "lgCMatrix",/* 0 */ "ltCMatrix" /* 1 */ # define sparseVECTOR "lsparseVector" # define slot_kind_x 1 # define _LGL_x # define _has_x_slot_ # undef _l_Csp_ #elif defined (_i_Csp_) # define Csparse_subassign iCsparse_subassign # define x_CLASSES "igCMatrix",/* 0 */ "itCMatrix" /* 1 */ # define sparseVECTOR "isparseVector" # define slot_kind_x 2 # define _INT_x # define _has_x_slot_ # undef _i_Csp_ #elif defined (_n_Csp_) # define Csparse_subassign nCsparse_subassign # define x_CLASSES "ngCMatrix",/* 0 */ "ntCMatrix" /* 1 */ # define sparseVECTOR "nsparseVector" # define slot_kind_x -1 # define _INT_x /* withOUT 'x' slot -- CARE! we assume that this is the *ONLY* case w/o x slot */ # undef _n_Csp_ #elif defined (_z_Csp_) // # error "zgC* not yet implemented" # define Csparse_subassign zCsparse_subassign # define x_CLASSES "zgCMatrix",/* 0 */ "ztCMatrix" /* 1 */ # define sparseVECTOR "zsparseVector" # define slot_kind_x 3 # define _CPLX_x # define _has_x_slot_ # undef _z_Csp_ #else # error "no valid _[dilnz]gC_ option" #endif // ------------------------------------------------- #ifdef _DOUBLE_x # define Type_x double # define Type_x_0_init(_VAR_) double _VAR_ = 0. # define Type_x_1_init(_VAR_) double _VAR_ = 1. # define STYP_x REAL # define SXP_x REALSXP #undef _DOUBLE_x #elif defined (_LGL_x) # define Type_x int # define Type_x_0_init(_VAR_) int _VAR_ = 0 # define Type_x_1_init(_VAR_) int _VAR_ = 1 # define STYP_x LOGICAL # define SXP_x LGLSXP #undef _LGL_x #elif defined (_INT_x) # define Type_x int # define Type_x_0_init(_VAR_) int _VAR_ = 0 # define Type_x_1_init(_VAR_) int _VAR_ = 1 # define STYP_x INTEGER # define SXP_x INTSXP #undef _INT_x #elif defined (_CPLX_x) # define Type_x Rcomplex # define Type_x_0_init(_VAR_) Rcomplex _VAR_; _VAR_.r = _VAR_.i = 0. # define Type_x_1_init(_VAR_) Rcomplex _VAR_; _VAR_.r = 1.; _VAR_.i = 0. # define STYP_x COMPLEX # define SXP_x CPLXSXP #else # error "invalid macro logic" #endif /** * Subassignment: x[i,j] <- value * * @param x * @param i_ integer row index 0-origin vector (as returned from R .ind.prep2()) * @param j_ integer column index 0-origin vector * @param value must be a [dln]sparseVector {which is recycled if needed} * * @return a Csparse matrix like x, but with the values replaced */ SEXP Csparse_subassign(SEXP x, SEXP i_, SEXP j_, SEXP value) { // TODO: for other classes consider using a trick as RallocedReal() in ./chm_common.c static const char *valid_cM [] = { // the only ones, for "the moment". FIXME: extend (!) x_CLASSES, ""}, // value: assume a "dsparseVector" for now -- slots: (i, length, x) *valid_spv[] = { sparseVECTOR, // = "the one with the same slot-class" // all others: ctype_v slot_kind "nsparseVector",// 1 -1 "lsparseVector",// 2 1 "isparseVector",// 3 2 "dsparseVector",// 4 0 "zsparseVector",// 5 3 ""}; int ctype_x = R_check_class_etc(x, valid_cM), ctype_v = R_check_class_etc(value, valid_spv); if (ctype_x < 0) error(_("invalid class of 'x' in Csparse_subassign()")); if (ctype_v < 0) error(_("invalid class of 'value' in Csparse_subassign()")); Rboolean value_is_nsp = ctype_v == 1; #ifndef _has_x_slot_ // i.e. "n.CMatrix" : sparseVECTOR == "nsparseVector" if(!value_is_nsp) value_is_nsp = (ctype_v == 0); #endif SEXP islot = GET_SLOT(x, Matrix_iSym), dimslot = GET_SLOT(x, Matrix_DimSym), i_cp = PROTECT(coerceVector(i_, INTSXP)), j_cp = PROTECT(coerceVector(j_, INTSXP)); // for d.CMatrix and l.CMatrix but not n.CMatrix: int *dims = INTEGER(dimslot), ncol = dims[1], /* nrow = dims[0], */ *i = INTEGER(i_cp), len_i = LENGTH(i_cp), *j = INTEGER(j_cp), len_j = LENGTH(j_cp), k, nnz_x = LENGTH(islot); int nnz = nnz_x; #define MATRIX_SUBASSIGN_VERBOSE // Temporary hack for debugging --- remove eventually -- FIXME #ifdef MATRIX_SUBASSIGN_VERBOSE Rboolean verbose = i[0] < 0; if(verbose) { i[0] = -i[0]; REprintf("Csparse_subassign() x[i,j] <- val; x is \"%s\"; value \"%s\" is_nsp=%d\n", valid_cM[ctype_x], valid_spv[ctype_v], (int)value_is_nsp); } #endif SEXP val_i_slot, val_x_slot; val_i_slot = PROTECT(coerceVector(GET_SLOT(value, Matrix_iSym), REALSXP)); double *val_i = REAL(val_i_slot); int nnz_val = LENGTH(GET_SLOT(value, Matrix_iSym)), n_prot = 4; Type_x *val_x = NULL; if(!value_is_nsp) { if(ctype_v) { // matrix 'x' and 'value' are of different kinds switch((enum x_slot_kind) slot_kind_x) { case x_pattern:// "n" case x_logical:// "l" if(ctype_v >= 3) warning(_("x[] <- val: val is coerced to logical for \"%s\" x"), valid_cM[ctype_x]); break; case x_integer: if(ctype_v >= 4) error(_("x[] <- val: val should be integer or logical, is coerced to integer, for \"%s\" x"), valid_cM[ctype_x]); break; case x_double: case x_complex: // coercion should be tried (and fail for complex -> double) below break; default: error(_("programming error in Csparse_subassign() should never happen")); } // otherwise: "coerce" : as(., ) : val_x_slot = PROTECT(coerceVector(GET_SLOT(value, Matrix_xSym), SXP_x)); n_prot++; val_x = STYP_x(val_x_slot); } else { val_x = STYP_x( GET_SLOT(value, Matrix_xSym)); } } int64_t len_val = (int64_t) asReal(GET_SLOT(value, Matrix_lengthSym)); /* llen_i = (int64_t) len_i; */ SEXP ans; /* Instead of simple "duplicate": PROTECT(ans = duplicate(x)) , build up: */ // Assuming that ans will have the same basic Matrix type as x : ans = PROTECT(NEW_OBJECT_OF_CLASS(valid_cM[ctype_x])); SET_SLOT(ans, Matrix_DimSym, duplicate(dimslot)); slot_dup(ans, x, Matrix_DimNamesSym); slot_dup(ans, x, Matrix_pSym); SEXP r_pslot = GET_SLOT(ans, Matrix_pSym); // and assign the i- and x- slots at the end, as they are potentially modified // not just in content, but also in their *length* int *rp = INTEGER(r_pslot), *ri = Calloc(nnz_x, int); // to contain the final i - slot Memcpy(ri, INTEGER(islot), nnz_x); Type_x_0_init(z_ans); Type_x_1_init(one_ans); #ifdef _has_x_slot_ Type_x *rx = Calloc(nnz_x, Type_x); // to contain the final x - slot Memcpy(rx, STYP_x(GET_SLOT(x, Matrix_xSym)), nnz_x); #endif // NB: nnz_x : will always be the "current allocated length" of (i, x) slots // -- nnz : the current *used* length; always nnz <= nnz_x int jj, j_val = 0; // in "running" conceptionally through all value[i+ jj*len_i] // values, we are "below"/"before" the (j_val)-th non-zero one. // e.g. if value = (0,0,...,0), have nnz_val == 0, j_val must remain == 0 int64_t ii_val;// == "running" index (i + jj*len_i) % len_val for value[] for(jj = 0, ii_val=0; jj < len_j; jj++) { int j__ = j[jj]; /* int64_t j_l = jj * llen_i; */ R_CheckUserInterrupt(); for(int ii = 0; ii < len_i; ii++, ii_val++) { int i__ = i[ii], p1, p2; if(nnz_val && ii_val >= len_val) { // "recycle" indexing into value[] ii_val -= len_val; // = (ii + jj*len_i) % len_val j_val = 0; } int64_t ii_v1;//= ii_val + 1; Type_x v, /* := value[(ii + j_l) % len_val] = .sparseVector_sub((ii + j_l) % len_val, nnz_val, val_i, val_x, len_val) */ M_ij; int ind; Rboolean have_entry = FALSE; // note that rp[]'s may have *changed* even when 'j' remained! // "FIXME": do this only *when* rp[] has changed p1 = rp[j__], p2 = rp[j__ + 1]; // v := value[(ii + j_l) % len_val] = value[ii_val] v = z_ans; if(j_val < nnz_val) { // maybe find v := non-zero value[ii_val] ii_v1 = ii_val + 1; if(ii_v1 < val_i[j_val]) { // typical case: are still in zero-stretch // v = z_ans (== 0) } else if(ii_v1 == val_i[j_val]) { // have a match v = (value_is_nsp) ? one_ans : val_x[j_val]; j_val++;// from now on, look at the next non-zero entry } else { // ii_v1 > val_i[j_val] REprintf("programming thinko in Csparse_subassign(*, i=%d,j=%d): ii_v=%d, v@i[j_val=%ld]=%g\n", i__,j__, ii_v1, j_val, val_i[j_val]); j_val++;// from now on, look at the next non-zero entry } } // --------------- M_ij := getM(i., j.) -------------------------------- M_ij = z_ans; // as in ./t_sparseVector.c for(ind = p1; ind < p2; ind++) { if(ri[ind] >= i__) { if(ri[ind] == i__) { #ifdef _has_x_slot_ M_ij = rx[ind]; #else M_ij = 1; #endif #ifdef MATRIX_SUBASSIGN_VERBOSE if(verbose) REprintf("have entry x[%d, %d] = %g\n", i__, j__, # ifdef _CPLX_x (double)M_ij.r); # else (double)M_ij); # endif #endif have_entry = TRUE; } else { // ri[ind] > i__ #ifdef MATRIX_SUBASSIGN_VERBOSE if(verbose) REprintf("@i > i__ = %d --> ind-- = %d\n", i__, ind); #endif } break; } } //-- R: if(getM(i., j.) != (v <- getV(ii, jj))) // if(contents differ) ==> value needs to be changed : #ifdef _CPLX_x if(M_ij.r != v.r || M_ij.i != v.i) { #else if(M_ij != v) { #endif #ifdef MATRIX_SUBASSIGN_VERBOSE if(verbose) REprintf("setting x[%d, %d] <- %g", i__,j__, # ifdef _CPLX_x (double) v.r); # else (double) v); # endif #endif // (otherwise: nothing to do): // setM(i__, j__, v) // ---------------------------------------------------------- #ifndef _has_x_slot_ if(v == z_ans) { // Case I ----- remove x[i, j] = M_ij which we know is *non*-zero // BUT it is more efficient (memory-management!) *NOT* to remove, /// but --- in the case of x slot put a 0 zero there, and only at the very end drop them, // currently using drop0() in R code // we know : have_entry = TRUE ; // ri[ind] == i__; M_ij = rx[ind]; #ifdef MATRIX_SUBASSIGN_VERBOSE if(verbose) REprintf(" rm ind=%d\n", ind); #endif // remove the 'ind'-th element from x@i and x@x : nnz-- ; for(k=ind; k < nnz; k++) { ri[k] = ri[k+1]; #ifdef _has_x_slot_ rx[k] = rx[k+1]; #endif } for(k=j__ + 1; k <= ncol; k++) { rp[k] = rp[k] - 1; } } else #endif if(have_entry) { // Case II ----- replace (non-empty) x[i,j] by v ------- #ifdef MATRIX_SUBASSIGN_VERBOSE if(verbose) REprintf(" repl. ind=%d\n", ind); #endif #ifdef _has_x_slot_ rx[ind] = v; #endif } else { // Case III ----- v != 0 : insert v into "empty" x[i,j] ---- // extend the i and x slot by one entry : --------------------- if(nnz+1 > nnz_x) { // need to reallocate: #ifdef MATRIX_SUBASSIGN_VERBOSE if(verbose) REprintf(" Realloc()ing: nnz_x=%d", nnz_x); #endif // do it "only" 1x,..4x at the very most increasing by the // nnz-length of "value": nnz_x += (1 + nnz_val / 4); #ifdef MATRIX_SUBASSIGN_VERBOSE if(verbose) REprintf("(nnz_v=%d) --> %d ", nnz_val, nnz_x); #endif // C doc on realloc() says that the old content is *preserve*d ri = Realloc(ri, nnz_x, int); #ifdef _has_x_slot_ rx = Realloc(rx, nnz_x, Type_x); #endif } // 3) fill them ... int i1 = ind; #ifdef MATRIX_SUBASSIGN_VERBOSE if(verbose) REprintf(" INSERT p12=(%d,%d) -> ind=%d -> i1 = %d\n", p1,p2, ind, i1); #endif // shift the "upper values" *before* the insertion: for(int l = nnz-1; l >= i1; l--) { ri[l+1] = ri[l]; #ifdef _has_x_slot_ rx[l+1] = rx[l]; #endif } ri[i1] = i__; #ifdef _has_x_slot_ rx[i1] = v; #endif nnz++; // the columns j "right" of the current one : for(k=j__ + 1; k <= ncol; k++) rp[k]++; } } #ifdef MATRIX_SUBASSIGN_VERBOSE else if(verbose) REprintf("M_ij == v = %g\n", # ifdef _CPLX_x (double) v.r); # else (double) v); # endif #endif }// for( ii ) }// for( jj ) if(ctype_x == 1) { // triangularMatrix: copy the 'diag' and 'uplo' slots slot_dup(ans, x, Matrix_uploSym); slot_dup(ans, x, Matrix_diagSym); } // now assign the i- and x- slots, free memory and return : Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, nnz)), ri, nnz); #ifdef _has_x_slot_ Memcpy( STYP_x(ALLOC_SLOT(ans, Matrix_xSym, SXP_x, nnz)), rx, nnz); Free(rx); #endif Free(ri); UNPROTECT(n_prot); return ans; } #undef Csparse_subassign #undef x_CLASSES #undef sparseVECTOR #undef Type_x #undef STYP_x #undef SXP_x #undef Type_x_0_init #undef Type_x_1_init #undef _has_x_slot_ #undef slot_kind_x #ifdef _CPLX_x # undef _CPLX_x #endif Matrix/src/CHMfactor.c0000644000176200001440000001274514060416534014273 0ustar liggesusers /* CHOLMOD factors */ #include "CHMfactor.h" SEXP CHMfactor_to_sparse(SEXP x) { CHM_FR L = AS_CHM_FR(x), Lcp; CHM_SP Lm; R_CheckStack(); /* cholmod_factor_to_sparse changes its first argument. Make a copy */ Lcp = cholmod_copy_factor(L, &c); if (!(Lcp->is_ll)) if (!cholmod_change_factor(Lcp->xtype, 1, 0, 1, 1, Lcp, &c)) error(_("cholmod_change_factor failed with status %d"), c.status); Lm = cholmod_factor_to_sparse(Lcp, &c); cholmod_free_factor(&Lcp, &c); return chm_sparse_to_SEXP(Lm, 1/*do_free*/, -1/*uploT*/, 0/*Rkind*/, "N"/*non_unit*/, R_NilValue/*dimNames*/); } SEXP CHMfactor_solve(SEXP a, SEXP b, SEXP system) { CHM_FR L = AS_CHM_FR(a); SEXP bb = PROTECT(dup_mMatrix_as_dgeMatrix(b)); CHM_DN B = AS_CHM_DN(bb), X; int sys = asInteger(system); R_CheckStack(); if (!(sys--)) /* align with CHOLMOD defs: R's {1:9} --> {0:8}, see ./CHOLMOD/Cholesky/cholmod_solve.c */ error(_("system argument is not valid")); X = cholmod_solve(sys, L, B, &c); SEXP ans = chm_dense_to_SEXP(X, 1/*do_free*/, 0/*Rkind*/, GET_SLOT(bb, Matrix_DimNamesSym), FALSE); UNPROTECT(1); return ans; } SEXP CHMfactor_updown(SEXP upd, SEXP C_, SEXP L_) { CHM_FR L = AS_CHM_FR(L_), Lcp; CHM_SP C = AS_CHM_SP__(C_); int update = asInteger(upd); R_CheckStack(); Lcp = cholmod_copy_factor(L, &c); int r = cholmod_updown(update, C, Lcp, &c); if(!r) error(_("cholmod_updown() returned %d"), r); return chm_factor_to_SEXP(Lcp, 1); } SEXP CHMfactor_spsolve(SEXP a, SEXP b, SEXP system) { CHM_FR L = AS_CHM_FR(a); CHM_SP B = AS_CHM_SP__(b); int sys = asInteger(system); R_CheckStack(); if (!(sys--)) /* align with CHOLMOD defs: R's {1:9} --> {0:8}, see ./CHOLMOD/Cholesky/cholmod_solve.c */ error(_("system argument is not valid")); // dimnames: SEXP dn = PROTECT(allocVector(VECSXP, 2)); // none from a: our CHMfactor objects have no dimnames SET_VECTOR_ELT(dn, 1, duplicate(VECTOR_ELT(GET_SLOT(b, Matrix_DimNamesSym), 1))); SEXP ans = chm_sparse_to_SEXP(cholmod_spsolve(sys, L, B, &c), 1/*do_free*/, 0/*uploT*/, 0/*Rkind*/, "", dn); UNPROTECT(1); return ans; } /** * Evaluate the logarithm of the square of the determinant of L * * @param f pointer to a CHMfactor object * * @return log(det(L)^2) * */ double chm_factor_ldetL2(CHM_FR f) { int i, j, p; double ans = 0; if (f->is_super) { int *lpi = (int*)(f->pi), *lsup = (int*)(f->super); for (i = 0; i < f->nsuper; i++) { /* supernodal block i */ int nrp1 = 1 + lpi[i + 1] - lpi[i], nc = lsup[i + 1] - lsup[i]; double *x = (double*)(f->x) + ((int*)(f->px))[i]; for (R_xlen_t jn = 0, j = 0; j < nc; j++, jn += nrp1) { // jn := j * nrp1 ans += 2 * log(fabs(x[jn])); } } } else { int *li = (int*)(f->i), *lp = (int*)(f->p); double *lx = (double *)(f->x); for (j = 0; j < f->n; j++) { for (p = lp[j]; li[p] != j && p < lp[j + 1]; p++) {}; if (li[p] != j) { error(_("diagonal element %d of Cholesky factor is missing"), j); break; /* -Wall */ } ans += log(lx[p] * ((f->is_ll) ? lx[p] : 1.)); } } return ans; } SEXP CHMfactor_ldetL2(SEXP x) { CHM_FR L = AS_CHM_FR(x); R_CheckStack(); return ScalarReal(chm_factor_ldetL2(L)); } /** * Update the numerical values in the factor f as A + mult * I, if A is * symmetric, otherwise AA' + mult * I * * @param f pointer to a CHM_FR object. f is updated upon return. * @param A pointer to a CHM_SP object, possibly symmetric * @param mult multiple of the identity to be added to A or AA' before * decomposing. * * @note: A and f must be compatible. There is no check on this * here. Incompatibility of A and f will cause the CHOLMOD functions * to take an error exit. * */ CHM_FR chm_factor_update(CHM_FR f, CHM_SP A, double mult) { int ll = f->is_ll; double mm[2] = {0, 0}; mm[0] = mult; // NB: Result depends if A is "dsC" or "dgC"; the latter case assumes we mean AA' !!! if (!cholmod_factorize_p(A, mm, (int*)NULL, 0 /*fsize*/, f, &c)) /* -> ./CHOLMOD/Cholesky/cholmod_factorize.c */ error(_("cholmod_factorize_p failed: status %d, minor %d of ncol %d"), c.status, f->minor, f->n); if (f->is_ll != ll) if(!cholmod_change_factor(f->xtype, ll, f->is_super, 1 /*to_packed*/, 1 /*to_monotonic*/, f, &c)) error(_("cholmod_change_factor failed")); return f; } // called from R .updateCHMfactor(object, parent, mult) SEXP CHMfactor_update(SEXP object, SEXP parent, SEXP mult) { CHM_FR L = AS_CHM_FR(object), Lcp; CHM_SP A = AS_CHM_SP__(parent); R_CheckStack(); Lcp = cholmod_copy_factor(L, &c); return chm_factor_to_SEXP(chm_factor_update(Lcp, A, asReal(mult)), 1); } // update its argument *in place* <==> "destructive" <==> use with much caution! SEXP destructive_CHM_update(SEXP object, SEXP parent, SEXP mult) { CHM_FR L = AS_CHM_FR(object); CHM_SP A = AS_CHM_SP__(parent); R_CheckStack(); chm_factor_update(L, A, asReal(mult)); return R_NilValue; } SEXP CHMfactor_ldetL2up(SEXP x, SEXP parent, SEXP mult) { SEXP ans = PROTECT(duplicate(mult)); int i, nmult = LENGTH(mult); double *aa = REAL(ans), *mm = REAL(mult); CHM_FR L = AS_CHM_FR(x), Lcp; CHM_SP A = AS_CHM_SP__(parent); R_CheckStack(); Lcp = cholmod_copy_factor(L, &c); for (i = 0; i < nmult; i++) aa[i] = chm_factor_ldetL2(chm_factor_update(Lcp, A, mm[i])); cholmod_free_factor(&Lcp, &c); UNPROTECT(1); return ans; } Matrix/src/ldense.h0000644000176200001440000000060210501357563013733 0ustar liggesusers#ifndef MATRIX_LDENSE_H #define MATRIX_LDENSE_H #include "Mutils.h" SEXP lspMatrix_as_lsyMatrix(SEXP from, SEXP kind); SEXP lsyMatrix_as_lspMatrix(SEXP from, SEXP kind); SEXP lsyMatrix_as_lgeMatrix(SEXP from, SEXP kind); SEXP ltpMatrix_as_ltrMatrix(SEXP from, SEXP kind); SEXP ltrMatrix_as_ltpMatrix(SEXP from, SEXP kind); SEXP ltrMatrix_as_lgeMatrix(SEXP from, SEXP kind); #endif Matrix/src/cs_utils.c0000644000176200001440000002411713440300120014266 0ustar liggesusers#include "cs_utils.h" /* Borrowed from one of Tim Davis' examples in the CSparse Demo directory */ /* 1 if A is square & upper tri., -1 if square & lower tri., 0 otherwise */ static int is_sym (cs *A) { int is_upper, is_lower, j, p, n = A->n, m = A->m, *Ap = A->p, *Ai = A->i ; if (m != n) return (0) ; is_upper = 1 ; is_lower = 1 ; for (j = 0 ; j < n ; j++) { for (p = Ap [j] ; p < Ap [j+1] ; p++) { if (Ai [p] > j) is_upper = 0 ; if (Ai [p] < j) is_lower = 0 ; } } return (is_upper ? 1 : (is_lower ? -1 : 0)) ; } /** * Create an identity matrix of size n as a cs struct. The structure * must be freed with cs_free by the caller. * * @param n size of identity matrix to construct. * * @return pointer to a cs object that contains the identity matrix. */ static CSP csp_eye(int n) { CSP eye = cs_spalloc(n, n, n, 1, 0); int *ep = eye->p, *ei = eye->i; double *ex = eye->x; if (n <= 0) error(_("csp_eye argument n must be positive")); eye->nz = -1; /* compressed column storage */ for (int j = 0; j < n; j++) { ep[j] = ei[j] = j; ex[j] = 1; } eye->nzmax = ep[n] = n; return eye; } /** * Create a cs object with the contents of x. Typically called via AS_CSP() * * @param ans pointer to a cs struct. This is allocated in the caller * so it is easier to keep track of where it should be freed - in many * applications the memory can be allocated with alloca and * automatically freed on exit from the caller. * @param x pointer to an object that inherits from CsparseMatrix * @param check_Udiag boolean - should a check for (and consequent * expansion of) a unit diagonal be performed. * * @return pointer to a cs object that contains pointers * to the slots of x. */ cs *Matrix_as_cs(cs *ans, SEXP x, Rboolean check_Udiag) { static const char *valid[] = {"dgCMatrix", "dtCMatrix", ""}; /* had also "dsCMatrix", but that only stores one triangle */ int *dims, ctype = R_check_class_etc(x, valid); SEXP islot; if (ctype < 0) error(_("invalid class of 'x' in Matrix_as_cs(a, x)")); /* dimensions and nzmax */ dims = INTEGER(GET_SLOT(x, Matrix_DimSym)); ans->m = dims[0]; ans->n = dims[1]; islot = GET_SLOT(x, Matrix_iSym); ans->nz = -1; /* indicates compressed column storage */ ans->nzmax = LENGTH(islot); ans->i = INTEGER(islot); ans->p = INTEGER(GET_SLOT(x, Matrix_pSym)); ans->x = REAL(GET_SLOT(x, Matrix_xSym)); if(check_Udiag && ctype == 1 && (*diag_P(x) == 'U')) { /* diagU2N(.) : */ int n = dims[0]; CSP I_n = csp_eye(n); /* tmp := 1*ans + 1*eye -- result is newly allocated in cs_add(): */ CSP tmp = cs_add(ans, I_n, 1., 1.), t2; int nz = (tmp->p)[n]; /* double transpose trick to sort the columns */ cs_spfree(I_n); t2 = cs_transpose(tmp, 1); /* transpose including values */ cs_spfree(tmp); tmp = cs_transpose(t2, 1); cs_spfree(t2); /* content(ans) := content(tmp) : */ ans->nzmax = nz; /* The ans "slots" were pointers to x@ ; all need new content now: */ ans->p = Memcpy(( int*) R_alloc(n+1, sizeof(int)), ( int*) tmp->p, n+1); ans->i = Memcpy(( int*) R_alloc(nz, sizeof(int)), ( int*) tmp->i, nz); ans->x = Memcpy((double*) R_alloc(nz, sizeof(double)), (double*) tmp->x, nz); cs_spfree(tmp); } return ans; } /** * Copy the contents of a to an appropriate CsparseMatrix object and, * optionally, free a or free both a and the pointers to its contents. * * @param a matrix to be converted * @param cl the name of the S4 class of the object to be generated * @param dofree 0 - don't free a; > 0 cs_free a; < 0 Free a * @param dn either R_NilValue or an SEXP suitable for the Dimnames slot. * * @return SEXP containing a copy of a */ // FIXME: Change API : Use object, not just class name 'cl' -- and use R_check_class(obj, *) SEXP Matrix_cs_to_SEXP(cs *a, char *cl, int dofree, SEXP dn) { static const char *valid[] = {"dgCMatrix", "dsCMatrix", "dtCMatrix", ""}; int ctype = Matrix_check_class(cl, valid); if (ctype < 0) error(_("invalid class of object to %s"), "Matrix_cs_to_SEXP"); SEXP ans = PROTECT(NEW_OBJECT_OF_CLASS(cl)); /* allocate and copy common slots */ int *dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2)); PROTECT(dn); // <- as in chm_sparse_to_SEXP() dims[0] = a->m; dims[1] = a->n; Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_pSym, INTSXP, a->n + 1)), a->p, a->n + 1); int nz = a->p[a->n]; Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, nz)), a->i, nz); Memcpy(REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, nz)), a->x, nz); if (ctype > 0) { /* dsC or dtC */ int uplo = is_sym(a); if (!uplo) error(_("cs matrix not compatible with class '%s'"), valid[ctype]); if (ctype == 2) /* dtC* */ SET_SLOT(ans, Matrix_diagSym, mkString("N")); SET_SLOT(ans, Matrix_uploSym, mkString(uplo < 0 ? "L" : "U")); } if (dofree > 0) cs_spfree(a); if (dofree < 0) Free(a); if (dn != R_NilValue) SET_SLOT(ans, Matrix_DimNamesSym, duplicate(dn)); UNPROTECT(2); return ans; } #if 0 /* unused ------------------------------------*/ /* -------------------------------------*/ /** * Populate a css object with the contents of x. * * @param ans pointer to a csn object * @param x pointer to an object of class css_LU or css_QR. * * @return pointer to a cs object that contains pointers * to the slots of x. */ css *Matrix_as_css(css *ans, SEXP x) { char *cl = class_P(x); static const char *valid[] = {"css_LU", "css_QR", ""}; int *nz = INTEGER(GET_SLOT(x, install("nz"))), ctype = Matrix_check_class(cl, valid); if (ctype < 0) error(_("invalid class of object to %s"), "Matrix_as_css"); ans->q = INTEGER(GET_SLOT(x, install("Q"))); ans->m2 = nz[0]; ans->lnz = nz[1]; ans->unz = nz[2]; switch(ctype) { case 0: /* css_LU */ ans->pinv = (int *) NULL; ans->parent = (int *) NULL; ans->cp = (int *) NULL; break; case 1: /* css_QR */ ans->pinv = INTEGER(GET_SLOT(x, install("Pinv"))); ans->parent = INTEGER(GET_SLOT(x, install("parent"))); ans->cp = INTEGER(GET_SLOT(x, install("cp"))); break; default: error(_("invalid class of object to %s"), "Matrix_as_css"); } return ans; } /** * Populate a csn object with the contents of x. * * @param ans pointer to a csn object * @param x pointer to an object of class csn_LU or csn_QR. * * @return pointer to a cs object that contains pointers * to the slots of x. */ csn *Matrix_as_csn(csn *ans, SEXP x) { static const char *valid[] = {"csn_LU", "csn_QR", ""}; int ctype = Matrix_check_class(class_P(x), valid); if (ctype < 0) error(_("invalid class of object to %s"), "Matrix_as_csn"); ans->U = Matrix_as_cs(GET_SLOT(x, Matrix_USym)); ans->L = Matrix_as_cs(GET_SLOT(x, Matrix_LSym)); switch(ctype) { case 0: ans->B = (double*) NULL; ans->pinv = INTEGER(GET_SLOT(x, install("Pinv"))); break; case 1: ans->B = REAL(GET_SLOT(x, Matrix_betaSym)); ans->pinv = (int*) NULL; break; default: error(_("invalid class of object to %s"), "Matrix_as_csn"); } return ans; } /** * Copy the contents of S to a css_LU or css_QR object and, * optionally, free S or free both S and the pointers to its contents. * * @param a css object to be converted * @param cl the name of the S4 class of the object to be generated * @param dofree 0 - don't free a; > 0 cs_free a; < 0 Free a * @param m number of rows in original matrix * @param n number of columns in original matrix * * @return SEXP containing a copy of S */ SEXP Matrix_css_to_SEXP(css *S, char *cl, int dofree, int m, int n) { SEXP ans; static const char *valid[] = {"css_LU", "css_QR", ""}; int *nz, ctype = Matrix_check_class(cl, valid); if (ctype < 0) error(_("Inappropriate class cl='%s' in Matrix_css_to_SEXP(S, cl, ..)"), cl); ans = PROTECT(NEW_OBJECT_OF_CLASS(cl)); /* allocate and copy common slots */ Memcpy(INTEGER(ALLOC_SLOT(ans, install("Q"), INTSXP, n)), S->q, n); nz = INTEGER(ALLOC_SLOT(ans, install("nz"), INTSXP, 3)); nz[0] = S->m2; nz[1] = S->lnz; nz[2] = S->unz; switch(ctype) { case 0: break; case 1: Memcpy(INTEGER(ALLOC_SLOT(ans, install("Pinv"), INTSXP, m)), S->pinv, m); Memcpy(INTEGER(ALLOC_SLOT(ans, install("parent"), INTSXP, n)), S->parent, n); Memcpy(INTEGER(ALLOC_SLOT(ans, install("cp"), INTSXP, n)), S->cp, n); break; default: error(_("Inappropriate class cl='%s' in Matrix_css_to_SEXP(S, cl, ..)"), cl); } if (dofree > 0) cs_sfree(S); if (dofree < 0) Free(S); UNPROTECT(1); return ans; } /** * Copy the contents of N to a csn_LU or csn_QR object and, * optionally, free N or free both N and the pointers to its contents. * * @param a csn object to be converted * @param cl the name of the S4 class of the object to be generated * @param dofree 0 - don't free a; > 0 cs_free a; < 0 Free a * @param dn either R_NilValue or an SEXP suitable for the Dimnames slot. FIXME (L,U!) * * @return SEXP containing a copy of S */ SEXP Matrix_csn_to_SEXP(csn *N, char *cl, int dofree, SEXP dn) { SEXP ans; static const char *valid[] = {"csn_LU", "csn_QR", ""}; int ctype = Matrix_check_class(cl, valid), n = (N->U)->n; if (ctype < 0) error(_("Inappropriate class cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)"), cl); ans = PROTECT(NEW_OBJECT_OF_CLASS(cl)); /* allocate and copy common slots */ /* FIXME: Use the triangular matrix classes for csn_LU */ SET_SLOT(ans, Matrix_LSym, /* these are free'd later if requested */ Matrix_cs_to_SEXP(N->L, "dgCMatrix", 0, dn)); // FIXME: dn SET_SLOT(ans, Matrix_USym, Matrix_cs_to_SEXP(N->U, "dgCMatrix", 0, dn)); // FIXME: dn switch(ctype) { case 0: Memcpy(INTEGER(ALLOC_SLOT(ans, install("Pinv"), INTSXP, n)), N->pinv, n); break; case 1: Memcpy(REAL(ALLOC_SLOT(ans, Matrix_betaSym, REALSXP, n)), N->B, n); break; default: error(_("Inappropriate class cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)"), cl); } if (dofree > 0) cs_nfree(N); if (dofree < 0) { Free(N->L); Free(N->U); Free(N); } UNPROTECT(1); return ans; } #endif /* unused */ Matrix/src/lgCMatrix.h0000644000176200001440000000021412213574105014345 0ustar liggesusers#ifndef MATRIX_LGCMATRIX_H #define MATRIX_LGCMATRIX_H #include "Mutils.h" SEXP lgC_to_matrix(SEXP x); SEXP ngC_to_matrix(SEXP x); #endif Matrix/src/Mutils.c0000644000176200001440000012135214154104143013727 0ustar liggesusers#include #include #include "Mutils.h" // La_norm_type() & La_rcond_type() have been in R_ext/Lapack.h // but have still not been available to package writers ... char La_norm_type(const char *typstr) { char typup; if (strlen(typstr) != 1) error( _("argument type[1]='%s' must be a one-letter character string"), typstr); typup = toupper(*typstr); if (typup == '1') typup = 'O'; /* alias */ else if (typup == 'E') typup = 'F'; else if (typup != 'M' && typup != 'O' && typup != 'I' && typup != 'F') error(_("argument type[1]='%s' must be one of 'M','1','O','I','F' or 'E'"), typstr); return typup; } char La_rcond_type(const char *typstr) { char typup; if (strlen(typstr) != 1) error( _("argument type[1]='%s' must be a one-letter character string"), typstr); typup = toupper(*typstr); if (typup == '1') typup = 'O'; /* alias */ else if (typup != 'O' && typup != 'I') error(_("argument type[1]='%s' must be one of '1','O', or 'I'"), typstr); return typup; } double get_double_by_name(SEXP obj, char *nm) { SEXP nms = PROTECT(getAttrib(obj, R_NamesSymbol)); int i, len = length(obj); if ((!isReal(obj)) || (length(obj) > 0 && nms == R_NilValue)) error(_("object must be a named, numeric vector")); for (i = 0; i < len; i++) { if (!strcmp(nm, CHAR(STRING_ELT(nms, i)))) { UNPROTECT(1); return REAL(obj)[i]; } } UNPROTECT(1); return R_NaReal; } SEXP set_double_by_name(SEXP obj, double val, char *nm) { SEXP nms = PROTECT(getAttrib(obj, R_NamesSymbol)); int i, len = length(obj); if ((!isReal(obj)) || (length(obj) > 0 && nms == R_NilValue)) error(_("object must be a named, numeric vector")); // case 1: replace existing entry named for (i = 0; i < len; i++) { if (!strcmp(nm, CHAR(STRING_ELT(nms, i)))) { REAL(obj)[i] = val; UNPROTECT(1); return obj; } } // case 2: no such name --> add new entry with that name at end of vec { SEXP nx = PROTECT(allocVector(REALSXP, len + 1)), nnms = allocVector(STRSXP, len + 1); setAttrib(nx, R_NamesSymbol, nnms); for (i = 0; i < len; i++) { REAL(nx)[i] = REAL(obj)[i]; SET_STRING_ELT(nnms, i, duplicate(STRING_ELT(nms, i))); } REAL(nx)[len] = val; SET_STRING_ELT(nnms, len, mkChar(nm)); UNPROTECT(2); return nx; } } SEXP as_det_obj(double val, int log, int sign) { SEXP det = PROTECT(allocVector(VECSXP, 2)), nms = PROTECT(allocVector(STRSXP, 2)), vv = PROTECT(ScalarReal(val)); setAttrib(det, R_NamesSymbol, nms); SET_STRING_ELT(nms, 0, mkChar("modulus")); SET_STRING_ELT(nms, 1, mkChar("sign")); setAttrib(vv, install("logarithm"), ScalarLogical(log)); SET_VECTOR_ELT(det, 0, vv); SET_VECTOR_ELT(det, 1, ScalarInteger(sign)); setAttrib(det, R_ClassSymbol, mkString("det")); UNPROTECT(3); return det; } SEXP get_factors(SEXP obj, char *nm) { SEXP fac = GET_SLOT(obj, Matrix_factorSym), nms = getAttrib(fac, R_NamesSymbol); int i, len = length(fac); if ((!isNewList(fac)) || (length(fac) > 0 && nms == R_NilValue)) error(_("'factors' slot must be a named list")); for (i = 0; i < len; i++) { if (!strcmp(nm, CHAR(STRING_ELT(nms, i)))) { return VECTOR_ELT(fac, i); } } return R_NilValue; } /** * Caches 'val' in the 'factors' slot of obj, i.e. modifies obj, and * returns val. * In the past this function installed a duplicate of * factors slot for obj then returned the (typically unprotected) * val. This is now changed to return the duplicate, which will be * protected if obj is protected. */ SEXP set_factors(SEXP obj, SEXP val, char *nm) { PROTECT(val); /* set_factors(..) may be called as "finalizer" after UNPROTECT()*/ SEXP fac = GET_SLOT(obj, Matrix_factorSym), nms = PROTECT(getAttrib(fac, R_NamesSymbol)); int i, len = length(fac); if ((!isNewList(fac)) || (length(fac) > 0 && nms == R_NilValue)) error(_("'factors' slot must be a named list")); // if there's already a 'nm' factor, we replace it and return: for (i = 0; i < len; i++) { if (!strcmp(nm, CHAR(STRING_ELT(nms, i)))) { SET_VECTOR_ELT(fac, i, duplicate(val)); UNPROTECT(2); return val; } } // Otherwise: create a new 'nm' entry in the 'factors' list: // create a list of length (len + 1), SEXP nfac = PROTECT(allocVector(VECSXP, len + 1)), nnms = PROTECT(allocVector(STRSXP, len + 1)); setAttrib(nfac, R_NamesSymbol, nnms); // copy all the previous entries, for (i = 0; i < len; i++) { SET_VECTOR_ELT(nfac, i, VECTOR_ELT(fac, i)); SET_STRING_ELT(nnms, i, duplicate(STRING_ELT(nms, i))); } // and add the new entry at the end. SET_VECTOR_ELT(nfac, len, duplicate(val)); SET_STRING_ELT(nnms, len, mkChar(nm)); SET_SLOT(obj, Matrix_factorSym, nfac); UNPROTECT(4); return VECTOR_ELT(nfac, len); } // R interface [for updating the '@ factors' slot of a function *argument* [CARE!] SEXP R_set_factors(SEXP obj, SEXP val, SEXP name, SEXP warn) { Rboolean do_warn = asLogical(warn); if(R_has_slot(obj, Matrix_factorSym)) return set_factors(obj, val, (char *)CHAR(asChar(name))); else { if(do_warn) warning(_("Matrix object has no 'factors' slot")); return val; } } // R interface for emptying the '@ factors' slot of *function *argument* 'obj' [CARE!] SEXP R_empty_factors(SEXP obj, SEXP warn) { Rboolean do_warn = asLogical(warn), modified = FALSE; PROTECT(obj); if(R_has_slot(obj, Matrix_factorSym)) { SEXP fac = GET_SLOT(obj, Matrix_factorSym); if (length(fac) > 0) { // if there's a non-empty factor slot, replace it with list() SEXP fac = PROTECT(allocVector(VECSXP, 0)); SET_SLOT(obj, Matrix_factorSym, fac); modified = TRUE; UNPROTECT(1); } } else { if(do_warn) warning(_("Matrix object has no 'factors' slot")); } UNPROTECT(1); return ScalarLogical(modified); } #if 0 /* unused */ /* useful for all the ..CMatrix classes (and ..R by [0] <-> [1]); but unused */ SEXP CMatrix_set_Dim(SEXP x, int nrow) { int *dims = INTEGER(GET_SLOT(x, Matrix_DimSym)); dims[0] = nrow; dims[1] = length(GET_SLOT(x, Matrix_pSym)) - 1; return x; } #endif /* unused */ /* Fill in the "trivial remainder" in n*m array ; * typically the 'x' slot of a "dtrMatrix", such that * it should be usable for double/logical/int/complex : */ #define MAKE_TRIANGULAR_BODY(_TO_, _FROM_, _ZERO_, _ONE_) \ { \ int i, j, *dims = INTEGER(GET_SLOT(_FROM_, Matrix_DimSym)); \ int n = dims[0], m = dims[1]; \ \ if (*uplo_P(_FROM_) == 'U') { \ for (j = 0; j < n; j++) \ for (i = j+1; i < m; i++) \ _TO_[i + j*m] = _ZERO_; \ } else { \ for (j = 1; j < n; j++) \ for (i = 0; i < j && i < m; i++) \ _TO_[i + j*m] = _ZERO_; \ } \ if (*diag_P(_FROM_) == 'U') { \ j = (n < m) ? n : m; \ for (i = 0; i < j; i++) \ _TO_[i * (m + 1)] = _ONE_; \ } \ } void make_d_matrix_triangular(double *to, SEXP from) MAKE_TRIANGULAR_BODY(to, from, 0., 1.) void make_i_matrix_triangular(int *to, SEXP from) MAKE_TRIANGULAR_BODY(to, from, 0, 1) /* Should work for double/logical/int/complex : */ #define MAKE_SYMMETRIC_BODY(_TO_, _FROM_) \ { \ int i, j, n = INTEGER(GET_SLOT(_FROM_, Matrix_DimSym))[0]; \ \ if (*uplo_P(_FROM_) == 'U') { \ for (j = 0; j < n; j++) \ for (i = j+1; i < n; i++) \ _TO_[i + j*n] = _TO_[j + i*n]; \ } else { \ for (j = 1; j < n; j++) \ for (i = 0; i < j && i < n; i++) \ _TO_[i + j*n] = _TO_[j + i*n]; \ } \ } void make_d_matrix_symmetric(double *to, SEXP from) MAKE_SYMMETRIC_BODY(to, from) void make_i_matrix_symmetric(int *to, SEXP from) MAKE_SYMMETRIC_BODY(to, from) #define Matrix_Error_Bufsiz 4096 /** * Check validity of 1-letter string from a set of possible values * (typically used in S4 validity method) * * @param sP * @param vals a string containing the possible valid letters * @param nm the name of the slot being checked * * @return a SEXP, either NULL (= success) or an error message */ SEXP check_scalar_string(SEXP sP, char *vals, char *nm) { SEXP val = ScalarLogical(1); char *buf; /* only allocate when needed: in good case, none is needed */ #define SPRINTF buf = Alloca(Matrix_Error_Bufsiz, char); R_CheckStack(); sprintf if (length(sP) != 1) { SPRINTF(buf, _("'%s' slot must have length 1"), nm); } else { const char *str = CHAR(STRING_ELT(sP, 0)); if (strlen(str) != 1) { SPRINTF(buf, _("'%s' must have string length 1"), nm); } else { int i, len; for (i = 0, len = strlen(vals); i < len; i++) { if (str[0] == vals[i]) return R_NilValue; } SPRINTF(buf, _("'%s' must be in '%s'"), nm, vals); } } /* 'error' returns : */ val = mkString(buf); return val; #undef SPRINTF } /* FIXME? Something like this should be part of the R API ? * But then, R has the more general R_compute_identical() * in src/main/identical.c: Rboolean R_compute_identical(SEXP x, SEXP y); */ Rboolean equal_string_vectors(SEXP s1, SEXP s2) { Rboolean n1 = isNull(s1), n2 = isNull(s2); if (n1 || n2) // if one is NULL : "equal" if both are return (n1 == n2) ? TRUE : FALSE; else if (TYPEOF(s1) != STRSXP || TYPEOF(s2) != STRSXP) { error(_("'s1' and 's2' must be \"character\" vectors")); return FALSE; /* -Wall */ } else { int n = LENGTH(s1), i; if (n != LENGTH(s2)) return FALSE; for(i = 0; i < n; i++) { /* note that compute_identical() code for STRSXP is careful about NA's which we don't need */ if(strcmp(CHAR(STRING_ELT(s1, i)), CHAR(STRING_ELT(s2, i)))) return FALSE; } return TRUE; /* they *are* equal */ } } SEXP dense_nonpacked_validate(SEXP obj) { int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)); if ((((double) dims[0]) * dims[1]) != XLENGTH(GET_SLOT(obj, Matrix_xSym))) return mkString(_("length of x slot != prod(Dim)")); return ScalarLogical(1); } SEXP dim_validate(SEXP Dim, const char* name) { if (length(Dim) != 2) return mkString(_("Dim slot must have length 2")); /* if (TYPEOF(Dim) != INTSXP && TYPEOF(Dim) != REALSXP) */ /* return mkString(_("Dim slot is not numeric")); */ if (TYPEOF(Dim) != INTSXP) // TODO?: coerce REALSXP to INTSXP in the "double" case ??? return mkString(_("Dim slot is not integer")); int m = INTEGER(Dim)[0], n = INTEGER(Dim)[1]; if (m < 0 || n < 0) return mkString(dngettext(name, "Negative value in Dim", "Negative values in Dim", (m*n > 0) ? 2 : 1)); return ScalarLogical(1); } // to be called from R : SEXP Dim_validate(SEXP obj, SEXP name) { return dim_validate(GET_SLOT(obj, Matrix_DimSym), CHAR(STRING_ELT(name, 0))); } /** * Validate dimnames (the @Dim slot typically), assuming * that 'dims' is already checked. * * Utility, called from dimNames_validate(), but available to other routines. * * @param dmNms an R object should be valid `dimnames` * @param dims an integer vector of length 2 (must have been checked by caller!). * @return a SEXP, either TRUE (= success) or an error message string ("character") */ SEXP dimNames_validate__(SEXP dmNms, int dims[], const char* obj_name) { char buf[99]; if(!isNewList(dmNms)) { sprintf(buf, _("%s is not a list"), obj_name); return mkString(buf); } if(length(dmNms) != 2) { sprintf(buf, _("%s is a list, but not of length 2"), obj_name); return mkString(buf); } for(int j=0; j < 2; j++) { // x@Dimnames[j] must be NULL or character(length(x@Dim[j])) if(!isNull(VECTOR_ELT(dmNms, j))) { if(TYPEOF(VECTOR_ELT(dmNms, j)) != STRSXP) { sprintf(buf, _("Dimnames[%d] is not a character vector"), j+1); return mkString(buf); } if(LENGTH(VECTOR_ELT(dmNms, j)) != 0 && // character(0) allowed here LENGTH(VECTOR_ELT(dmNms, j)) != dims[j]) { sprintf(buf, _("length(Dimnames[%d]) differs from Dim[%d] which is %d"), j+1, j+1, dims[j]); return mkString(buf); } } } return ScalarLogical(1); } /** * Check R (Matrix-like) object: must have @Dim and @Dimnames. * Assume 'Dim' is already checked. * (typically used in S4 validity method) * * @param obj an R object (typically inheriting from `Matrix`) * * @return a SEXP, either TRUE (= success) or an error message string ("character") */ SEXP dimNames_validate(SEXP obj) { return dimNames_validate__(/* dmNms = */ GET_SLOT(obj, Matrix_DimNamesSym), /* dims = */ INTEGER(GET_SLOT(obj, Matrix_DimSym)), "Dimnames slot"); } #define PACKED_TO_FULL(TYPE) \ TYPE *packed_to_full_ ## TYPE(TYPE *dest, const TYPE *src, \ int n, enum CBLAS_UPLO uplo) \ { \ int i, j, pos = 0; \ size_t n2 = n * (size_t)n; \ \ AZERO(dest, n2); \ for (j = 0; j < n; j++) { \ size_t jn = j * (size_t)n; \ switch(uplo) { \ case UPP: \ for (i = 0; i <= j; i++) dest[i + jn] = src[pos++]; \ break; \ case LOW: \ for (i = j; i < n; i++) dest[i + jn] = src[pos++]; \ break; \ default: \ error(_("'uplo' must be UPP or LOW")); \ } \ } \ return dest; \ } PACKED_TO_FULL(double) PACKED_TO_FULL(int) #define FULL_TO_PACKED(TYPE) \ TYPE *full_to_packed_ ## TYPE(TYPE *dest, const TYPE *src, int n, \ enum CBLAS_UPLO uplo, enum CBLAS_DIAG diag) \ { \ int i, j, pos = 0; \ \ for (j = 0; j < n; j++) { \ switch(uplo) { \ case UPP: \ for (i = 0; i <= j; i++) \ dest[pos++] = (i == j && diag== UNT) ? 1 : src[i + j*n]; \ break; \ case LOW: \ for (i = j; i < n; i++) \ dest[pos++] = (i == j && diag== UNT) ? 1 : src[i + j*n]; \ break; \ default: \ error(_("'uplo' must be UPP or LOW")); \ } \ } \ return dest; \ } FULL_TO_PACKED(double) FULL_TO_PACKED(int) /** * Copy the diagonal elements of the packed denseMatrix x to dest * * @param dest vector of length ncol(x) * @param x (pointer to) a "d?pMatrix" object * @param n number of columns in the matrix represented by x * * @return dest */ void d_packed_getDiag(double *dest, SEXP x, int n) { double *xx = REAL(GET_SLOT(x, Matrix_xSym)); #define END_packed_getDiag \ int j, pos = 0; \ \ if (*uplo_P(x) == 'U') { \ for(pos= 0, j=0; j < n; pos += 1+(++j)) dest[j] = xx[pos]; \ } else { \ for(pos= 0, j=0; j < n; pos += (n - j), j++) dest[j] = xx[pos]; \ } \ return END_packed_getDiag; } void l_packed_getDiag(int *dest, SEXP x, int n) { int *xx = LOGICAL(GET_SLOT(x, Matrix_xSym)); END_packed_getDiag; } #undef END_packed_getDiag //---------------------------------------------------------------------- /** diag(x) <- D for x a or dppMatrix, ..etc */ SEXP d_packed_setDiag(double *diag, int l_d, SEXP x, int n) { #define SET_packed_setDiag \ SEXP ret = PROTECT(duplicate(x)), \ r_x = GET_SLOT(ret, Matrix_xSym); \ Rboolean d_full = (l_d == n); \ if (!d_full && l_d != 1) \ error(_("replacement diagonal has wrong length")) #define END_packed_setDiag \ int j, pos = 0; \ \ if (*uplo_P(x) == 'U') { \ if(d_full) \ for(pos= 0, j=0; j < n; pos += 1+(++j)) xx[pos] = diag[j]; \ else /* l_d == 1 */ \ for(pos= 0, j=0; j < n; pos += 1+(++j)) xx[pos] = *diag; \ } else { \ if(d_full) \ for(pos= 0, j=0; j < n; pos += (n - j), j++) xx[pos] = diag[j]; \ else /* l_d == 1 */ \ for(pos= 0, j=0; j < n; pos += (n - j), j++) xx[pos] = *diag; \ } \ UNPROTECT(1); \ return ret SET_packed_setDiag; double *xx = REAL(r_x); END_packed_setDiag; } SEXP l_packed_setDiag(int *diag, int l_d, SEXP x, int n) { SET_packed_setDiag; int *xx = LOGICAL(r_x); END_packed_setDiag; } #define tr_END_packed_setDiag \ if (*diag_P(x) == 'U') { /* uni-triangular */ \ /* after setting, typically is not uni-triangular anymore: */ \ SEXP ch_N = PROTECT(mkChar("N")); \ SET_STRING_ELT(GET_SLOT(ret, Matrix_diagSym), 0, ch_N); \ UNPROTECT(1); \ } \ END_packed_setDiag SEXP tr_d_packed_setDiag(double *diag, int l_d, SEXP x, int n) { SET_packed_setDiag; double *xx = REAL(r_x); tr_END_packed_setDiag; } SEXP tr_l_packed_setDiag(int *diag, int l_d, SEXP x, int n) { SET_packed_setDiag; int *xx = LOGICAL(r_x); tr_END_packed_setDiag; } #undef SET_packed_setDiag #undef END_packed_setDiag #undef tr_END_packed_setDiag //---------------------------------------------------------------------- SEXP d_packed_addDiag(double *diag, int l_d, SEXP x, int n) { SEXP ret = PROTECT(duplicate(x)), r_x = GET_SLOT(ret, Matrix_xSym); double *xx = REAL(r_x); int j, pos = 0; if (*uplo_P(x) == 'U') { for(pos= 0, j=0; j < n; pos += 1+(++j)) xx[pos] += diag[j]; } else { for(pos= 0, j=0; j < n; pos += (n - j), j++) xx[pos] += diag[j]; } UNPROTECT(1); return ret; } SEXP tr_d_packed_addDiag(double *diag, int l_d, SEXP x, int n) { SEXP ret = PROTECT(d_packed_addDiag(diag, l_d, x, n)); if (*diag_P(x) == 'U') { /* uni-triangular */ SEXP ch_N = PROTECT(mkChar("N")); SET_STRING_ELT(GET_SLOT(ret, Matrix_diagSym), 0, ch_N); UNPROTECT(1); } UNPROTECT(1); return ret; } //---------------------------------------------------------------------- void tr_d_packed_getDiag(double *dest, SEXP x, int n) { if (*diag_P(x) == 'U') { for (int j = 0; j < n; j++) dest[j] = 1.; } else { d_packed_getDiag(dest, x, n); } return; } void tr_l_packed_getDiag( int *dest, SEXP x, int n) { if (*diag_P(x) == 'U') for (int j = 0; j < n; j++) dest[j] = 1; else l_packed_getDiag(dest, x, n); return; } SEXP Matrix_expand_pointers(SEXP pP) { int n = length(pP) - 1; int *p = INTEGER(pP); SEXP ans = PROTECT(allocVector(INTSXP, p[n])); expand_cmprPt(n, p, INTEGER(ans)); UNPROTECT(1); return ans; } /** * Return the element of a given name from a named list * * @param list * @param nm name of desired element * * @return element of list with name nm */ SEXP Matrix_getElement(SEXP list, char *nm) { SEXP names = getAttrib(list, R_NamesSymbol); int i; for (i = 0; i < LENGTH(names); i++) if (!strcmp(CHAR(STRING_ELT(names, i)), nm)) return(VECTOR_ELT(list, i)); return R_NilValue; } /** * Zero a square matrix of size nc then copy a vector to the diagonal * * @param dest destination array of length nc * nc * @param A pointer to a square Matrix object * * @return dest */ static double * install_diagonal(double *dest, SEXP A) { int nc = INTEGER(GET_SLOT(A, Matrix_DimSym))[0]; int i, ncp1 = nc + 1, unit = *diag_P(A) == 'U'; double *ax = REAL(GET_SLOT(A, Matrix_xSym)); size_t in1 = 0; AZERO(dest, nc * (size_t)nc); for (i = 0; i < nc; i++, in1 += ncp1) // in1 == i * ncp1 dest[in1] = (unit) ? 1. : ax[i]; return dest; } static int * install_diagonal_int(int *dest, SEXP A) { int nc = INTEGER(GET_SLOT(A, Matrix_DimSym))[0]; int i, ncp1 = nc + 1, unit = *diag_P(A) == 'U'; int *ax = INTEGER(GET_SLOT(A, Matrix_xSym)); size_t in1 = 0; AZERO(dest, nc * (size_t)nc); for (i = 0; i < nc; i++, in1 += ncp1) // in1 == i * ncp1 dest[in1] = (unit) ? 1 : ax[i]; return dest; } /** @brief Duplicate a [dln]denseMatrix _or_ a numeric matrix or even a vector * as a [dln]geMatrix. * * This is for the many "*_matrix_{prod,crossprod,tcrossprod, etc.}" * functions that work with both classed and unclassed matrices. * * Used generally for Generalized -- "geMatrix" -- dispatch where needed. * * @param A either a denseMatrix, a diagonalMatrix or a traditional matrix object * */ SEXP dup_mMatrix_as_geMatrix(SEXP A) { /* NOTA BENE: If you enlarge this list, do change '14' and '6' below ! * --------- ddiMatrix & ldiMatrix are no longer ddense or ldense on the R level, * --- --- but are still dealt with here: */ static const char *valid[] = { "_NOT_A_CLASS_",// *_CLASSES defined in ./Mutils.h : MATRIX_VALID_ddense, /* 14 */ MATRIX_VALID_ldense, /* 6 */ MATRIX_VALID_ndense, /* 5 */ ""}; SEXP ans, ad = R_NilValue, an = R_NilValue; /* -Wall */ int ctype = R_check_class_etc(A, valid), nprot = 1; enum dense_enum M_type = ddense /* -Wall */; if (ctype > 0) { /* a [nld]denseMatrix or [dl]diMatrix object */ M_type = (ctype <= 14) ? ddense : ((ctype <= 14+6) ? ldense : ndense); /// TODO: Return 'A' unduplicated if ctype indicates "?geMatrix"' -- and *new argument* 'check' is TRUE ad = GET_SLOT(A, Matrix_DimSym); an = GET_SLOT(A, Matrix_DimNamesSym); } else if (ctype < 0) { /* not a (recognized) classed matrix */ if (isReal(A)) M_type = ddense; else if (isInteger(A)) { A = PROTECT(coerceVector(A, REALSXP)); nprot++; M_type = ddense; } else if (isLogical(A)) M_type = ldense; else error(_("invalid class '%s' to dup_mMatrix_as_geMatrix"), class_P(A)); #define DUP_MMATRIX_NON_CLASS(transpose_if_vec) \ if (isMatrix(A)) { /* "matrix" */ \ ad = getAttrib(A, R_DimSymbol); \ an = getAttrib(A, R_DimNamesSymbol); \ } else {/* maybe "numeric" (incl integer,logical) --> (n x 1) */ \ int* dd = INTEGER(ad = PROTECT(allocVector(INTSXP, 2))); \ nprot++; \ if(transpose_if_vec) { \ dd[0] = 1; \ dd[1] = LENGTH(A); \ } else { \ dd[0] = LENGTH(A); \ dd[1] = 1; \ } \ SEXP nms = PROTECT(getAttrib(A, R_NamesSymbol)); nprot++; \ if(nms != R_NilValue) { \ an = PROTECT(allocVector(VECSXP, 2)); nprot++; \ SET_VECTOR_ELT(an, (transpose_if_vec)? 1 : 0, nms); \ /* not needed: SET_VECTOR_ELT(an, 1, R_NilValue); */ \ } /* else nms = NULL ==> an remains NULL */ \ } \ ctype = 0 DUP_MMATRIX_NON_CLASS(FALSE); } ans = PROTECT(NEW_OBJECT_OF_CLASS(M_type == ddense ? "dgeMatrix" : (M_type == ldense ? "lgeMatrix" : "ngeMatrix"))); #define DUP_MMATRIX_SET_1(_IS_SYM_) do { \ SET_SLOT(ans, Matrix_DimSym, duplicate(ad)); \ SET_SLOT(ans, Matrix_DimNamesSym, _IS_SYM_ ? symmetric_DimNames(an) : \ (!isNull(an) && LENGTH(an) == 2) ? duplicate(an): allocVector(VECSXP,2)); \ } while(0) R_xlen_t sz = ((R_xlen_t) INTEGER(ad)[0]) * INTEGER(ad)[1]; Rboolean is_symm = FALSE; if(M_type == ddense) { /* ddense -> dge */ double *ansx; #define DUP_MMATRIX_ddense_CASES \ ansx = REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, sz)); \ switch(ctype) { \ case 0: /* unclassed real matrix */ \ Memcpy(ansx, REAL(A), sz); \ break; \ case 1: /* dgeMatrix */ \ Memcpy(ansx, REAL(GET_SLOT(A, Matrix_xSym)), sz); \ break; \ case 2: /* dtrMatrix and subclasses */ \ case 9: case 10: case 11: /* --- Cholesky, LDL, BunchKaufman */ \ Memcpy(ansx, REAL(GET_SLOT(A, Matrix_xSym)), sz); \ make_d_matrix_triangular(ansx, A); \ break; \ case 3: /* dsyMatrix */ \ case 4: /* dpoMatrix + subclass */ \ case 14: /* --- corMatrix */ \ Memcpy(ansx, REAL(GET_SLOT(A, Matrix_xSym)), sz); \ make_d_matrix_symmetric(ansx, A); \ is_symm = TRUE; \ break; \ case 5: /* ddiMatrix */ \ install_diagonal(ansx, A); \ break; \ case 6: /* dtpMatrix + subclasses */ \ case 12: case 13: /* --- pCholesky, pBunchKaufman */ \ packed_to_full_double(ansx, REAL(GET_SLOT(A, Matrix_xSym)), \ INTEGER(ad)[0], \ *uplo_P(A) == 'U' ? UPP : LOW); \ make_d_matrix_triangular(ansx, A); \ break; \ case 7: /* dspMatrix */ \ case 8: /* dppMatrix */ \ packed_to_full_double(ansx, REAL(GET_SLOT(A, Matrix_xSym)), \ INTEGER(ad)[0], \ *uplo_P(A) == 'U' ? UPP : LOW); \ make_d_matrix_symmetric(ansx, A); \ is_symm = TRUE; \ break; \ } /* switch(ctype) */ DUP_MMATRIX_ddense_CASES; // also setting is_symm DUP_MMATRIX_SET_1(is_symm); } else { /* M_type == ldense || M_type = ndense */ /* ldense -> lge */ /* ndense -> nge */ int *ansx = LOGICAL(ALLOC_SLOT(ans, Matrix_xSym, LGLSXP, sz)); switch(ctype) { case 0: /* unclassed logical matrix */ Memcpy(ansx, LOGICAL(A), sz); break; case 1+14: /* lgeMatrix */ case 1+14+6: /* ngeMatrix */ Memcpy(ansx, LOGICAL(GET_SLOT(A, Matrix_xSym)), sz); break; case 2+14: /* ltrMatrix */ case 2+14+6: /* ntrMatrix */ Memcpy(ansx, LOGICAL(GET_SLOT(A, Matrix_xSym)), sz); make_i_matrix_triangular(ansx, A); break; case 3+14: /* lsyMatrix */ case 3+14+6: /* nsyMatrix */ Memcpy(ansx, LOGICAL(GET_SLOT(A, Matrix_xSym)), sz); make_i_matrix_symmetric(ansx, A); is_symm = TRUE; break; case 4+14: /* ldiMatrix */ // case 4+14+6: /* ndiMatrix _DOES NOT EXIST_ */ install_diagonal_int(ansx, A); break; case 5+14: /* ltpMatrix */ case 4+14+6: /* ntpMatrix */ packed_to_full_int(ansx, LOGICAL(GET_SLOT(A, Matrix_xSym)), INTEGER(ad)[0], *uplo_P(A) == 'U' ? UPP : LOW); make_i_matrix_triangular(ansx, A); break; case 6+14: /* lspMatrix */ case 5+14+6: /* nspMatrix */ packed_to_full_int(ansx, LOGICAL(GET_SLOT(A, Matrix_xSym)), INTEGER(ad)[0], *uplo_P(A) == 'U' ? UPP : LOW); make_i_matrix_symmetric(ansx, A); is_symm = TRUE; break; default: error(_("unexpected ctype = %d in dup_mMatrix_as_geMatrix"), ctype); } /* switch(ctype) */ DUP_MMATRIX_SET_1(is_symm); } /* if(M_type == .) */ UNPROTECT(nprot); return ans; } SEXP dup_mMatrix_as_dgeMatrix2(SEXP A, Rboolean tr_if_vec) { SEXP ans = PROTECT(NEW_OBJECT_OF_CLASS("dgeMatrix")), ad = R_NilValue , an = R_NilValue; /* -Wall */ static const char *valid[] = {"_NOT_A_CLASS_", MATRIX_VALID_ddense, ""}; int ctype = R_check_class_etc(A, valid), nprot = 1; double *ansx; if (ctype > 0) { /* a ddenseMatrix object */ ad = GET_SLOT(A, Matrix_DimSym); an = GET_SLOT(A, Matrix_DimNamesSym); } else if (ctype < 0) { /* not a (recognized) classed matrix */ if (!isReal(A)) { if (isInteger(A) || isLogical(A)) { A = PROTECT(coerceVector(A, REALSXP)); nprot++; } else error(_("invalid class '%s' to dup_mMatrix_as_dgeMatrix"), class_P(A)); } DUP_MMATRIX_NON_CLASS(tr_if_vec); } R_xlen_t sz = ((R_xlen_t) INTEGER(ad)[0]) * INTEGER(ad)[1]; Rboolean is_symm = FALSE; DUP_MMATRIX_ddense_CASES; // also setting is_symm DUP_MMATRIX_SET_1(is_symm); UNPROTECT(nprot); return ans; } SEXP dup_mMatrix_as_dgeMatrix(SEXP A) { return dup_mMatrix_as_dgeMatrix2(A, FALSE); } SEXP new_dgeMatrix(int nrow, int ncol) { SEXP ans = PROTECT(NEW_OBJECT_OF_CLASS("dgeMatrix")), ad = PROTECT(allocVector(INTSXP, 2)); INTEGER(ad)[0] = nrow; INTEGER(ad)[1] = ncol; SET_SLOT(ans, Matrix_DimSym, ad); SET_SLOT(ans, Matrix_DimNamesSym, allocVector(VECSXP, 2)); ALLOC_SLOT(ans, Matrix_xSym, REALSXP, ((R_xlen_t) nrow) * ncol); UNPROTECT(2); return ans; } /** * Encode Matrix index (i,j) |--> i + j * nrow {i,j : 0-origin} * * @param ij: 2-column integer matrix * @param di: dim(.), i.e. length 2 integer vector * @param chk_bnds: logical indicating 0 <= ij[,k] < di[k] need to be checked. * * @return encoded index; integer if prod(dim) is small; double otherwise */ SEXP m_encodeInd(SEXP ij, SEXP di, SEXP orig_1, SEXP chk_bnds) { SEXP ans; int *ij_di = NULL, n, nprot=1; Rboolean check_bounds = asLogical(chk_bnds), one_ind = asLogical(orig_1); if(TYPEOF(di) != INTSXP) {di = PROTECT(coerceVector(di, INTSXP)); nprot++; } if(TYPEOF(ij) != INTSXP) {ij = PROTECT(coerceVector(ij, INTSXP)); nprot++; } if(!isMatrix(ij) || (ij_di = INTEGER(getAttrib(ij, R_DimSymbol)))[1] != 2) error(_("Argument ij must be 2-column integer matrix")); n = ij_di[0]; int *Di = INTEGER(di), *IJ = INTEGER(ij), *j_ = IJ+n;/* pointer offset! */ if((Di[0] * (double) Di[1]) >= 1 + (double)INT_MAX) { /* need double */ ans = PROTECT(allocVector(REALSXP, n)); double *ii = REAL(ans), nr = (double) Di[0]; #define do_ii_FILL(_i_, _j_) \ int i; \ if(check_bounds) { \ for(i=0; i < n; i++) { \ if(_i_[i] == NA_INTEGER || _j_[i] == NA_INTEGER) \ ii[i] = NA_INTEGER; \ else { \ register int i_i, j_i; \ if(one_ind) { i_i = _i_[i]-1; j_i = _j_[i]-1; } \ else { i_i = _i_[i] ; j_i = _j_[i] ; } \ if(i_i < 0 || i_i >= Di[0]) \ error(_("subscript 'i' out of bounds in M[ij]")); \ if(j_i < 0 || j_i >= Di[1]) \ error(_("subscript 'j' out of bounds in M[ij]")); \ ii[i] = i_i + j_i * nr; \ } \ } \ } else { \ for(i=0; i < n; i++) \ ii[i] = (_i_[i] == NA_INTEGER || _j_[i] == NA_INTEGER) \ ? NA_INTEGER \ : (one_ind ? ((_i_[i]-1) + (_j_[i]-1)*nr) \ : _i_[i] + _j_[i] *nr); \ } do_ii_FILL(IJ, j_); } else { ans = PROTECT(allocVector(INTSXP, n)); int *ii = INTEGER(ans), nr = Di[0]; do_ii_FILL(IJ, j_); } UNPROTECT(nprot); return ans; } /** * Encode Matrix index (i,j) |--> i + j * nrow {i,j : 0-origin} * * @param i: integer vector * @param j: integer vector of same length as 'i' * @param orig_1: logical: if TRUE, "1-origin" otherwise "0-origin" * @param di: dim(.), i.e. length 2 integer vector * @param chk_bnds: logical indicating 0 <= ij[,k] < di[k] need to be checked. * * @return encoded index; integer if prod(dim) is small; double otherwise */ SEXP m_encodeInd2(SEXP i, SEXP j, SEXP di, SEXP orig_1, SEXP chk_bnds) { SEXP ans; int n = LENGTH(i), nprot = 1; Rboolean check_bounds = asLogical(chk_bnds), one_ind = asLogical(orig_1); if(TYPEOF(di)!= INTSXP) {di = PROTECT(coerceVector(di,INTSXP)); nprot++; } if(TYPEOF(i) != INTSXP) { i = PROTECT(coerceVector(i, INTSXP)); nprot++; } if(TYPEOF(j) != INTSXP) { j = PROTECT(coerceVector(j, INTSXP)); nprot++; } if(LENGTH(j) != n) error(_("i and j must be integer vectors of the same length")); int *Di = INTEGER(di), *i_ = INTEGER(i), *j_ = INTEGER(j); if((Di[0] * (double) Di[1]) >= 1 + (double)INT_MAX) { /* need double */ ans = PROTECT(allocVector(REALSXP, n)); double *ii = REAL(ans), nr = (double) Di[0]; do_ii_FILL(i_, j_); } else { ans = PROTECT(allocVector(INTSXP, n)); int *ii = INTEGER(ans), nr = Di[0]; do_ii_FILL(i_, j_); } UNPROTECT(nprot); return ans; } #undef do_ii_FILL // Almost "Cut n Paste" from ...R../src/main/array.c do_matrix() : // used in ../R/Matrix.R as // // .External(Mmatrix, // data, nrow, ncol, byrow, dimnames, // missing(nrow), missing(ncol)) SEXP Mmatrix(SEXP args) { SEXP vals, ans, snr, snc, dimnames; int nr = 1, nc = 1, byrow, miss_nr, miss_nc; R_xlen_t lendat; args = CDR(args); /* skip 'name' */ vals = CAR(args); args = CDR(args); /* Supposedly as.vector() gave a vector type, but we check */ switch(TYPEOF(vals)) { case LGLSXP: case INTSXP: case REALSXP: case CPLXSXP: case STRSXP: case RAWSXP: case EXPRSXP: case VECSXP: break; default: error(_("'data' must be of a vector type")); } lendat = XLENGTH(vals); snr = CAR(args); args = CDR(args); snc = CAR(args); args = CDR(args); byrow = asLogical(CAR(args)); args = CDR(args); if (byrow == NA_INTEGER) error(_("invalid '%s' argument"), "byrow"); dimnames = CAR(args); args = CDR(args); miss_nr = asLogical(CAR(args)); args = CDR(args); miss_nc = asLogical(CAR(args)); if (!miss_nr) { if (!isNumeric(snr)) error(_("non-numeric matrix extent")); nr = asInteger(snr); if (nr == NA_INTEGER) error(_("invalid 'nrow' value (too large or NA)")); if (nr < 0) error(_("invalid 'nrow' value (< 0)")); } if (!miss_nc) { if (!isNumeric(snc)) error(_("non-numeric matrix extent")); nc = asInteger(snc); if (nc == NA_INTEGER) error(_("invalid 'ncol' value (too large or NA)")); if (nc < 0) error(_("invalid 'ncol' value (< 0)")); } if (miss_nr && miss_nc) { if (lendat > INT_MAX) error("data is too long"); nr = (int) lendat; } else if (miss_nr) { if (lendat > (double) nc * INT_MAX) error("data is too long"); nr = (int) ceil((double) lendat / (double) nc); } else if (miss_nc) { if (lendat > (double) nr * INT_MAX) error("data is too long"); nc = (int) ceil((double) lendat / (double) nr); } if(lendat > 0) { R_xlen_t nrc = (R_xlen_t) nr * nc; if (lendat > 1 && nrc % lendat != 0) { if (((lendat > nr) && (lendat / nr) * nr != lendat) || ((lendat < nr) && (nr / lendat) * lendat != nr)) warning(_("data length [%d] is not a sub-multiple or multiple of the number of rows [%d]"), lendat, nr); else if (((lendat > nc) && (lendat / nc) * nc != lendat) || ((lendat < nc) && (nc / lendat) * lendat != nc)) warning(_("data length [%d] is not a sub-multiple or multiple of the number of columns [%d]"), lendat, nc); } else if ((lendat > 1) && (nrc == 0)){ warning(_("data length exceeds size of matrix")); } } #ifndef LONG_VECTOR_SUPPORT if ((double)nr * (double)nc > INT_MAX) error(_("too many elements specified")); #endif PROTECT(ans = allocMatrix(TYPEOF(vals), nr, nc)); if(lendat) { if (isVector(vals)) copyMatrix(ans, vals, byrow); else copyListMatrix(ans, vals, byrow); } else if (isVector(vals)) { /* fill with NAs */ R_xlen_t N = (R_xlen_t) nr * nc, i; switch(TYPEOF(vals)) { case STRSXP: for (i = 0; i < N; i++) SET_STRING_ELT(ans, i, NA_STRING); break; case LGLSXP: for (i = 0; i < N; i++) LOGICAL(ans)[i] = NA_LOGICAL; break; case INTSXP: for (i = 0; i < N; i++) INTEGER(ans)[i] = NA_INTEGER; break; case REALSXP: for (i = 0; i < N; i++) REAL(ans)[i] = NA_REAL; break; case CPLXSXP: { Rcomplex na_cmplx; na_cmplx.r = NA_REAL; na_cmplx.i = 0; for (i = 0; i < N; i++) COMPLEX(ans)[i] = na_cmplx; } break; case RAWSXP: // FIXME: N may overflow size_t !! memset(RAW(ans), 0, N); break; default: /* don't fill with anything */ ; } } if(!isNull(dimnames)&& length(dimnames) > 0) ans = dimnamesgets(ans, dimnames); UNPROTECT(1); return ans; } /** * From the two 'x' slots of two dense matrices a and b, * compute the 'x' slot of rbind(a, b) * * Currently, an auxiliary only for setMethod rbind2(, ) * in ../R/bind2.R * * @param a * @param b * * @return */SEXP R_rbind2_vector(SEXP a, SEXP b) { int *d_a = INTEGER(GET_SLOT(a, Matrix_DimSym)), *d_b = INTEGER(GET_SLOT(b, Matrix_DimSym)), n1 = d_a[0], m = d_a[1], n2 = d_b[0]; if(d_b[1] != m) error(_("the number of columns differ in R_rbind2_vector: %d != %d"), m, d_b[1]); SEXP a_x = GET_SLOT(a, Matrix_xSym), b_x = GET_SLOT(b, Matrix_xSym); int nprot = 1; // Care: can have "ddenseMatrix" "ldenseMatrix" or "ndenseMatrix" if(TYPEOF(a_x) != TYPEOF(b_x)) { // choose the "common type" // Now know: either LGLSXP or REALSXP. FIXME for iMatrix, zMatrix,.. if(TYPEOF(a_x) != REALSXP) { a_x = PROTECT(duplicate(coerceVector(a_x, REALSXP))); nprot++; } else if(TYPEOF(b_x) != REALSXP) { b_x = PROTECT(duplicate(coerceVector(b_x, REALSXP))); nprot++; } } SEXP ans = PROTECT(allocVector(TYPEOF(a_x), m * (n1 + n2))); int ii = 0; switch(TYPEOF(a_x)) { case LGLSXP: { int *r = LOGICAL(ans), *ax= LOGICAL(a_x), *bx= LOGICAL(b_x); #define COPY_a_AND_b_j \ for(int j=0; j < m; j++) { \ Memcpy(r+ii, ax+ j*n1, n1); ii += n1; \ Memcpy(r+ii, bx+ j*n2, n2); ii += n2; \ } ; break COPY_a_AND_b_j; } case REALSXP: { double *r = REAL(ans), *ax= REAL(a_x), *bx= REAL(b_x); COPY_a_AND_b_j; } } // switch UNPROTECT(nprot); return ans; } #define TRUE_ ScalarLogical(1) #define FALSE_ ScalarLogical(0) // Fast implementation of [ originally in ../R/Auxiliaries.R ] // all0 <- function(x) !any(is.na(x)) && all(!x) ## ~= allFalse // allFalse <- function(x) !any(x) && !any(is.na(x)) ## ~= all0 SEXP R_all0(SEXP x) { if (!isVectorAtomic(x)) { if(length(x) == 0) return TRUE_; // Typically S4. TODO: Call the R code above, instead! error(_("Argument must be numeric-like atomic vector")); } R_xlen_t i, n = XLENGTH(x); if(n == 0) return TRUE_; switch(TYPEOF(x)) { case LGLSXP: { int *xx = LOGICAL(x); for(i=0; i < n; i++) if(xx[i] == NA_LOGICAL || xx[i] != 0) return FALSE_; return TRUE_; } case INTSXP: { int *xx = INTEGER(x); for(i=0; i < n; i++) if(xx[i] == NA_INTEGER || xx[i] != 0) return FALSE_; return TRUE_; } case REALSXP: { double *xx = REAL(x); for(i=0; i < n; i++) if(ISNAN(xx[i]) || xx[i] != 0.) return FALSE_; return TRUE_; } case RAWSXP: { unsigned char *xx = RAW(x); for(i=0; i < n; i++) if(xx[i] != 0) return FALSE_; return TRUE_; } } error(_("Argument must be numeric-like atomic vector")); return R_NilValue; // -Wall } // Fast implementation of [ originally in ../R/Auxiliaries.R ] // any0 <- function(x) isTRUE(any(x == 0)) ## ~= anyFalse // anyFalse <- function(x) isTRUE(any(!x)) ## ~= any0 SEXP R_any0(SEXP x) { if (!isVectorAtomic(x)) { if(length(x) == 0) return FALSE_; // Typically S4. TODO: Call the R code above, instead! error(_("Argument must be numeric-like atomic vector")); } R_xlen_t i, n = XLENGTH(x); if(n == 0) return FALSE_; switch(TYPEOF(x)) { case LGLSXP: { int *xx = LOGICAL(x); for(i=0; i < n; i++) if(xx[i] == 0) return TRUE_; return FALSE_; } case INTSXP: { int *xx = INTEGER(x); for(i=0; i < n; i++) if(xx[i] == 0) return TRUE_; return FALSE_; } case REALSXP: { double *xx = REAL(x); for(i=0; i < n; i++) if(xx[i] == 0.) return TRUE_; return FALSE_; } case RAWSXP: { unsigned char *xx = RAW(x); for(i=0; i < n; i++) if(xx[i] == 0) return TRUE_; return FALSE_; } } error(_("Argument must be numeric-like atomic vector")); return R_NilValue; // -Wall } #undef TRUE_ #undef FALSE_ /* FIXME: Compare and synchronize with MK_SYMMETRIC_DIMNAMES.. in ./dense.c * ----- which *also* considers names(dimnames(.)) !! */ /** * Produce symmetric 'Dimnames' from possibly asymmetric ones. * * @param dn list of length 2; typically 'Dimnames' slot of "symmetricMatrix" */ SEXP symmetric_DimNames(SEXP dn) { Rboolean do_nm = FALSE; #define NON_TRIVIAL_DN \ !isNull(VECTOR_ELT(dn, 0)) || \ !isNull(VECTOR_ELT(dn, 1)) || \ (do_nm = !isNull(getAttrib(dn, R_NamesSymbol))) #define SYMM_DIMNAMES \ /* Fixup dimnames to be symmetric <==> \ symmetricDimnames() in ../R/symmetricMatrix.R */ \ PROTECT(dn = duplicate(dn)); \ if (isNull(VECTOR_ELT(dn,0))) \ SET_VECTOR_ELT(dn, 0, VECTOR_ELT(dn, 1)); \ if (isNull(VECTOR_ELT(dn,1))) \ SET_VECTOR_ELT(dn, 1, VECTOR_ELT(dn, 0)); \ if(do_nm) { /* names(dimnames(.)): */ \ SEXP nms_dn = PROTECT(getAttrib(dn, R_NamesSymbol)); \ if(!R_compute_identical(STRING_ELT(nms_dn, 0), \ STRING_ELT(nms_dn, 1), 16)) { \ int J = LENGTH(STRING_ELT(nms_dn, 0)) == 0; /* 0/1 */ \ SET_STRING_ELT(nms_dn, !J, STRING_ELT(nms_dn, J)); \ setAttrib(dn, R_NamesSymbol, nms_dn); \ } \ UNPROTECT(1); \ } \ UNPROTECT(1) // Be fast (do nothing!) for the case where dimnames = list(NULL,NULL) : if (NON_TRIVIAL_DN) { SYMM_DIMNAMES; } return dn; } /** * Even if the Dimnames slot is list(NULL, ) etc, return * __symmetric__ dimnames: Get . @Dimnames and modify when needed. * * Called e.g., from symmetricDimnames() in ../R/symmetricMatrix.R * * @param from a symmetricMatrix * * @return symmetric dimnames: length-2 list twice the same, NULL or * character vector (of correct length) */ SEXP R_symmetric_Dimnames(SEXP x) { return symmetric_DimNames(GET_SLOT(x, Matrix_DimNamesSym)); } /** * Set 'Dimnames' slot of 'dest' from the one of 'src' when * 'src' is a "symmetricMatrix" with possibly asymmetric dimnames, * and 'dest' must contain corresponding symmetric dimnames. * * @param dest Matrix, typically *not* symmetric * @param src symmetricMatrix */ void SET_DimNames_symm(SEXP dest, SEXP src) { SEXP dn = GET_SLOT(src, Matrix_DimNamesSym); Rboolean do_nm = FALSE; // Be fast (do nothing!) for the case where dimnames = list(NULL,NULL) : if (NON_TRIVIAL_DN) { SYMM_DIMNAMES; SET_SLOT(dest, Matrix_DimNamesSym, dn); } return; } /** * A safe NEW_OBJECT(MAKE_CLASS(cls)), where the caller must protect the * return value of this function * * @param an R character string specifying the name of a known S4 class */ SEXP NEW_OBJECT_OF_CLASS(const char* cls) { SEXP ans = NEW_OBJECT(PROTECT(MAKE_CLASS(cls))); UNPROTECT(1); return ans; } Matrix/src/dtCMatrix.c0000644000176200001440000001232014060416534014351 0ustar liggesusers /* Sparse triangular numeric matrices */ #include "dtCMatrix.h" #include "cs_utils.h" #define RETURN(_CH_) UNPROTECT(1); return (_CH_); /* This is used for *BOTH* triangular and symmetric Csparse: */ SEXP tCMatrix_validate(SEXP x) { SEXP val = xCMatrix_validate(x);/* checks x slot */ if(isString(val)) return(val); else { SEXP islot = GET_SLOT(x, Matrix_iSym), pslot = GET_SLOT(x, Matrix_pSym); int uploT = (*uplo_P(x) == 'U'), k, nnz = length(islot), *xi = INTEGER(islot), *xj = INTEGER(PROTECT(allocVector(INTSXP, nnz))); expand_cmprPt(length(pslot) - 1, INTEGER(pslot), xj); /* Maybe FIXME: ">" should be ">=" for diag = 'U' (uplo = 'U') */ if(uploT) { for (k = 0; k < nnz; k++) if(xi[k] > xj[k]) { RETURN(mkString(_("uplo='U' must not have sparse entries below the diagonal"))); } } else { for (k = 0; k < nnz; k++) if(xi[k] < xj[k]) { RETURN(mkString(_("uplo='L' must not have sparse entries above the diagonal"))); } } RETURN(ScalarLogical(1)); } } /* This is used for *BOTH* triangular and symmetric Rsparse: */ SEXP tRMatrix_validate(SEXP x) { SEXP val = xRMatrix_validate(x);/* checks x slot */ if(isString(val)) return(val); else { SEXP jslot = GET_SLOT(x, Matrix_jSym), pslot = GET_SLOT(x, Matrix_pSym); int uploT = (*uplo_P(x) == 'U'), k, nnz = length(jslot), *xj = INTEGER(jslot), *xi = INTEGER(PROTECT(allocVector(INTSXP, nnz))); expand_cmprPt(length(pslot) - 1, INTEGER(pslot), xi); /* Maybe FIXME: ">" should be ">=" for diag = 'U' (uplo = 'U') */ if(uploT) { for (k = 0; k < nnz; k++) if(xi[k] > xj[k]) { RETURN(mkString(_("uplo='U' must not have sparse entries below the diagonal"))); } } else { for (k = 0; k < nnz; k++) if(xi[k] < xj[k]) { RETURN(mkString(_("uplo='L' must not have sparse entries above the diagonal"))); } } RETURN(ScalarLogical(1)); } } SEXP dtCMatrix_matrix_solve(SEXP a, SEXP b, SEXP classed) { int cl = asLogical(classed); SEXP ans = PROTECT(NEW_OBJECT_OF_CLASS("dgeMatrix")); CSP A = AS_CSP(a); int *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)), *bdims = INTEGER(cl ? GET_SLOT(b, Matrix_DimSym) : getAttrib(b, R_DimSymbol)); int j, n = bdims[0], nrhs = bdims[1], lo = (*uplo_P(a) == 'L'); double *bx; R_CheckStack(); if (adims[0] != n || n != adims[1]) error(_("Dimensions of system to be solved are inconsistent")); Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2)), bdims, 2); // dimnames: SEXP dn = PROTECT(allocVector(VECSXP, 2)), dn2; SET_VECTOR_ELT(dn, 0, duplicate(VECTOR_ELT(GET_SLOT(a, Matrix_DimNamesSym), 1))); if(!cl) { dn2 = getAttrib(b, R_DimNamesSymbol); if(dn2 != R_NilValue) // either NULL or list(, ) dn2 = VECTOR_ELT(dn2, 1); } SET_VECTOR_ELT(dn, 1, duplicate(cl // b can be "Matrix" or not: ? VECTOR_ELT(GET_SLOT(b, Matrix_DimNamesSym), 1) : dn2)); SET_SLOT(ans, Matrix_DimNamesSym, dn); UNPROTECT(1); if(n >= 1 && nrhs >=1) { R_xlen_t n_ = n; bx = Memcpy(REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, n_ * nrhs)), REAL(cl ? GET_SLOT(b, Matrix_xSym) : b), n_ * nrhs); for (j = 0; j < nrhs; j++) lo ? cs_lsolve(A, bx + n_ * j) : cs_usolve(A, bx + n_ * j); } RETURN(ans); } SEXP dtCMatrix_sparse_solve(SEXP a, SEXP b) { SEXP ans = PROTECT(NEW_OBJECT_OF_CLASS("dgCMatrix")); CSP A = AS_CSP(a), B = AS_CSP(b); R_CheckStack(); if (A->m != A->n || B->n < 1 || A->n < 1 || A->n != B->m) error(_("Dimensions of system to be solved are inconsistent")); // *before* Calloc()ing below [memory leak]! -- FIXME: 0-extent should work // FIXME: xnz == same type as *xp; must assume no integer overflow below ("10 *" and " xnz *= 2 ") int *xp = INTEGER(ALLOC_SLOT(ans, Matrix_pSym, INTSXP, (B->n) + 1)), xnz = 10 * B->p[B->n]; /* initial estimate of nnz in x */ int k, lo = uplo_P(a)[0] == 'L', pos = 0; int *ti = Calloc(xnz, int), *xi = Calloc(2*A->n, int); /* for cs_reach */ double *tx = Calloc(xnz, double), *wrk = Calloc( A->n, double); slot_dup(ans, b, Matrix_DimSym); xp[0] = 0; for (k = 0; k < B->n; k++) { int top = cs_spsolve (A, B, k, xi, wrk, (int *)NULL, lo); int nz = A->n - top; xp[k + 1] = nz + xp[k]; if (xp[k + 1] > xnz) { while (xp[k + 1] > xnz) xnz *= 2; ti = Realloc(ti, xnz, int); tx = Realloc(tx, xnz, double); } if (lo) /* increasing row order */ for(int p = top; p < A->n; p++, pos++) { ti[pos] = xi[p]; tx[pos] = wrk[xi[p]]; } else /* decreasing order, reverse copy */ for(int p = A->n - 1; p >= top; p--, pos++) { ti[pos] = xi[p]; tx[pos] = wrk[xi[p]]; } } xnz = xp[B->n]; Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, xnz)), ti, xnz); Memcpy( REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, xnz)), tx, xnz); Free(ti); Free(tx); Free(wrk); Free(xi); // dimnames: SEXP dn = PROTECT(allocVector(VECSXP, 2)); SET_VECTOR_ELT(dn, 0, duplicate(VECTOR_ELT(GET_SLOT(a, Matrix_DimNamesSym), 1))); SET_VECTOR_ELT(dn, 1, duplicate(VECTOR_ELT(GET_SLOT(b, Matrix_DimNamesSym), 1))); SET_SLOT(ans, Matrix_DimNamesSym, dn); UNPROTECT(1); RETURN(ans); } #undef RETURN Matrix/src/COLAMD/0000755000176200001440000000000014154165630013251 5ustar liggesusersMatrix/src/COLAMD/Include/0000755000176200001440000000000014154165363014637 5ustar liggesusersMatrix/src/COLAMD/Include/colamd.h0000644000176200001440000002025113652535054016247 0ustar liggesusers/* ========================================================================== */ /* === colamd/symamd prototypes and definitions ============================= */ /* ========================================================================== */ /* COLAMD / SYMAMD include file You must include this file (colamd.h) in any routine that uses colamd, symamd, or the related macros and definitions. Authors: The authors of the code itself are Stefan I. Larimore and Timothy A. Davis (DrTimothyAldenDavis@gmail.com). The algorithm was developed in collaboration with John Gilbert, Xerox PARC, and Esmond Ng, Oak Ridge National Laboratory. Acknowledgements: This work was supported by the National Science Foundation, under grants DMS-9504974 and DMS-9803599. Notice: Copyright (c) 1998-2007, Timothy A. Davis, All Rights Reserved. See COLAMD/Doc/License.txt for the license. Availability: The colamd/symamd library is available at http://www.suitesparse.com This file is required by the colamd.c, colamdmex.c, and symamdmex.c files, and by any C code that calls the routines whose prototypes are listed below, or that uses the colamd/symamd definitions listed below. */ #ifndef COLAMD_H #define COLAMD_H /* make it easy for C++ programs to include COLAMD */ #ifdef __cplusplus extern "C" { #endif /* ========================================================================== */ /* === Include files ======================================================== */ /* ========================================================================== */ #include /* ========================================================================== */ /* === COLAMD version ======================================================= */ /* ========================================================================== */ /* COLAMD Version 2.4 and later will include the following definitions. * As an example, to test if the version you are using is 2.4 or later: * * #ifdef COLAMD_VERSION * if (COLAMD_VERSION >= COLAMD_VERSION_CODE (2,4)) ... * #endif * * This also works during compile-time: * * #if defined(COLAMD_VERSION) && (COLAMD_VERSION >= COLAMD_VERSION_CODE (2,4)) * printf ("This is version 2.4 or later\n") ; * #else * printf ("This is an early version\n") ; * #endif * * Versions 2.3 and earlier of COLAMD do not include a #define'd version number. */ #define COLAMD_DATE "May 4, 2016" #define COLAMD_VERSION_CODE(main,sub) ((main) * 1000 + (sub)) #define COLAMD_MAIN_VERSION 2 #define COLAMD_SUB_VERSION 9 #define COLAMD_SUBSUB_VERSION 6 #define COLAMD_VERSION \ COLAMD_VERSION_CODE(COLAMD_MAIN_VERSION,COLAMD_SUB_VERSION) /* ========================================================================== */ /* === Knob and statistics definitions ====================================== */ /* ========================================================================== */ /* size of the knobs [ ] array. Only knobs [0..1] are currently used. */ #define COLAMD_KNOBS 20 /* number of output statistics. Only stats [0..6] are currently used. */ #define COLAMD_STATS 20 /* knobs [0] and stats [0]: dense row knob and output statistic. */ #define COLAMD_DENSE_ROW 0 /* knobs [1] and stats [1]: dense column knob and output statistic. */ #define COLAMD_DENSE_COL 1 /* knobs [2]: aggressive absorption */ #define COLAMD_AGGRESSIVE 2 /* stats [2]: memory defragmentation count output statistic */ #define COLAMD_DEFRAG_COUNT 2 /* stats [3]: colamd status: zero OK, > 0 warning or notice, < 0 error */ #define COLAMD_STATUS 3 /* stats [4..6]: error info, or info on jumbled columns */ #define COLAMD_INFO1 4 #define COLAMD_INFO2 5 #define COLAMD_INFO3 6 /* error codes returned in stats [3]: */ #define COLAMD_OK (0) #define COLAMD_OK_BUT_JUMBLED (1) #define COLAMD_ERROR_A_not_present (-1) #define COLAMD_ERROR_p_not_present (-2) #define COLAMD_ERROR_nrow_negative (-3) #define COLAMD_ERROR_ncol_negative (-4) #define COLAMD_ERROR_nnz_negative (-5) #define COLAMD_ERROR_p0_nonzero (-6) #define COLAMD_ERROR_A_too_small (-7) #define COLAMD_ERROR_col_length_negative (-8) #define COLAMD_ERROR_row_index_out_of_bounds (-9) #define COLAMD_ERROR_out_of_memory (-10) #define COLAMD_ERROR_internal_error (-999) /* ========================================================================== */ /* === Prototypes of user-callable routines ================================= */ /* ========================================================================== */ #include "SuiteSparse_config.h" size_t colamd_recommended /* returns recommended value of Alen, */ /* or 0 if input arguments are erroneous */ ( int nnz, /* nonzeros in A */ int n_row, /* number of rows in A */ int n_col /* number of columns in A */ ) ; size_t colamd_l_recommended /* returns recommended value of Alen, */ /* or 0 if input arguments are erroneous */ ( SuiteSparse_long nnz, /* nonzeros in A */ SuiteSparse_long n_row, /* number of rows in A */ SuiteSparse_long n_col /* number of columns in A */ ) ; void colamd_set_defaults /* sets default parameters */ ( /* knobs argument is modified on output */ double knobs [COLAMD_KNOBS] /* parameter settings for colamd */ ) ; void colamd_l_set_defaults /* sets default parameters */ ( /* knobs argument is modified on output */ double knobs [COLAMD_KNOBS] /* parameter settings for colamd */ ) ; int colamd /* returns (1) if successful, (0) otherwise*/ ( /* A and p arguments are modified on output */ int n_row, /* number of rows in A */ int n_col, /* number of columns in A */ int Alen, /* size of the array A */ int A [], /* row indices of A, of size Alen */ int p [], /* column pointers of A, of size n_col+1 */ double knobs [COLAMD_KNOBS],/* parameter settings for colamd */ int stats [COLAMD_STATS] /* colamd output statistics and error codes */ ) ; SuiteSparse_long colamd_l /* returns (1) if successful, (0) otherwise*/ ( /* A and p arguments are modified on output */ SuiteSparse_long n_row, /* number of rows in A */ SuiteSparse_long n_col, /* number of columns in A */ SuiteSparse_long Alen, /* size of the array A */ SuiteSparse_long A [], /* row indices of A, of size Alen */ SuiteSparse_long p [], /* column pointers of A, of size n_col+1 */ double knobs [COLAMD_KNOBS],/* parameter settings for colamd */ SuiteSparse_long stats [COLAMD_STATS] /* colamd output statistics * and error codes */ ) ; int symamd /* return (1) if OK, (0) otherwise */ ( int n, /* number of rows and columns of A */ int A [], /* row indices of A */ int p [], /* column pointers of A */ int perm [], /* output permutation, size n_col+1 */ double knobs [COLAMD_KNOBS], /* parameters (uses defaults if NULL) */ int stats [COLAMD_STATS], /* output statistics and error codes */ void * (*allocate) (size_t, size_t), /* pointer to calloc (ANSI C) or */ /* mxCalloc (for MATLAB mexFunction) */ void (*release) (void *) /* pointer to free (ANSI C) or */ /* mxFree (for MATLAB mexFunction) */ ) ; SuiteSparse_long symamd_l /* return (1) if OK, (0) otherwise */ ( SuiteSparse_long n, /* number of rows and columns of A */ SuiteSparse_long A [], /* row indices of A */ SuiteSparse_long p [], /* column pointers of A */ SuiteSparse_long perm [], /* output permutation, size n_col+1 */ double knobs [COLAMD_KNOBS], /* parameters (uses defaults if NULL) */ SuiteSparse_long stats [COLAMD_STATS], /* output stats and error codes */ void * (*allocate) (size_t, size_t), /* pointer to calloc (ANSI C) or */ /* mxCalloc (for MATLAB mexFunction) */ void (*release) (void *) /* pointer to free (ANSI C) or */ /* mxFree (for MATLAB mexFunction) */ ) ; void colamd_report ( int stats [COLAMD_STATS] ) ; void colamd_l_report ( SuiteSparse_long stats [COLAMD_STATS] ) ; void symamd_report ( int stats [COLAMD_STATS] ) ; void symamd_l_report ( SuiteSparse_long stats [COLAMD_STATS] ) ; #ifdef __cplusplus } #endif #endif /* COLAMD_H */ Matrix/src/COLAMD/Makefile0000644000176200001440000000027614154165630014716 0ustar liggesusers# compile just the C-callable library library: ( cd Source ; $(MAKE) lib ) # remove object files, but keep the compiled programs and library archives clean: ( cd Source ; $(MAKE) clean ) Matrix/src/COLAMD/Source/0000755000176200001440000000000014154165627014517 5ustar liggesusersMatrix/src/COLAMD/Source/Makefile0000644000176200001440000000050714154165630016153 0ustar liggesusersPKG_CPPFLAGS = -I../Include -I../../SuiteSparse_config LIB = ../../COLAMD.a lib: $(LIB) colamd_l.o: colamd.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -I../Include -DDLONG -c colamd.c -o $@ $(LIB): colamd.o colamd_l.o $(AR) -rucs $(LIB) colamd.o colamd_l.o mostlyclean: clean clean: @-rm -rf .libs _libs $(LIB) @-rm -f *.o Matrix/src/COLAMD/Source/colamd.c0000644000176200001440000032200513652535054016121 0ustar liggesusers/* ========================================================================== */ /* === colamd/symamd - a sparse matrix column ordering algorithm ============ */ /* ========================================================================== */ /* COLAMD / SYMAMD colamd: an approximate minimum degree column ordering algorithm, for LU factorization of symmetric or unsymmetric matrices, QR factorization, least squares, interior point methods for linear programming problems, and other related problems. symamd: an approximate minimum degree ordering algorithm for Cholesky factorization of symmetric matrices. Purpose: Colamd computes a permutation Q such that the Cholesky factorization of (AQ)'(AQ) has less fill-in and requires fewer floating point operations than A'A. This also provides a good ordering for sparse partial pivoting methods, P(AQ) = LU, where Q is computed prior to numerical factorization, and P is computed during numerical factorization via conventional partial pivoting with row interchanges. Colamd is the column ordering method used in SuperLU, part of the ScaLAPACK library. It is also available as built-in function in MATLAB Version 6, available from MathWorks, Inc. (http://www.mathworks.com). This routine can be used in place of colmmd in MATLAB. Symamd computes a permutation P of a symmetric matrix A such that the Cholesky factorization of PAP' has less fill-in and requires fewer floating point operations than A. Symamd constructs a matrix M such that M'M has the same nonzero pattern of A, and then orders the columns of M using colmmd. The column ordering of M is then returned as the row and column ordering P of A. Authors: The authors of the code itself are Stefan I. Larimore and Timothy A. Davis (DrTimothyAldenDavis@gmail.com). The algorithm was developed in collaboration with John Gilbert, Xerox PARC, and Esmond Ng, Oak Ridge National Laboratory. Acknowledgements: This work was supported by the National Science Foundation, under grants DMS-9504974 and DMS-9803599. Copyright and License: Copyright (c) 1998-2007, Timothy A. Davis, All Rights Reserved. COLAMD is also available under alternate licenses, contact T. Davis for details. See COLAMD/Doc/License.txt for the license. Availability: The colamd/symamd library is available at http://www.suitesparse.com Appears as ACM Algorithm 836. See the ChangeLog file for changes since Version 1.0. References: T. A. Davis, J. R. Gilbert, S. Larimore, E. Ng, An approximate column minimum degree ordering algorithm, ACM Transactions on Mathematical Software, vol. 30, no. 3., pp. 353-376, 2004. T. A. Davis, J. R. Gilbert, S. Larimore, E. Ng, Algorithm 836: COLAMD, an approximate column minimum degree ordering algorithm, ACM Transactions on Mathematical Software, vol. 30, no. 3., pp. 377-380, 2004. */ /* ========================================================================== */ /* === Description of user-callable routines ================================ */ /* ========================================================================== */ /* COLAMD includes both int and SuiteSparse_long versions of all its routines. The description below is for the int version. For SuiteSparse_long, all int arguments become SuiteSparse_long. SuiteSparse_long is normally defined as long, except for WIN64. ---------------------------------------------------------------------------- colamd_recommended: ---------------------------------------------------------------------------- C syntax: #include "colamd.h" size_t colamd_recommended (int nnz, int n_row, int n_col) ; size_t colamd_l_recommended (SuiteSparse_long nnz, SuiteSparse_long n_row, SuiteSparse_long n_col) ; Purpose: Returns recommended value of Alen for use by colamd. Returns 0 if any input argument is negative. The use of this routine is optional. Not needed for symamd, which dynamically allocates its own memory. Note that in v2.4 and earlier, these routines returned int or long. They now return a value of type size_t. Arguments (all input arguments): int nnz ; Number of nonzeros in the matrix A. This must be the same value as p [n_col] in the call to colamd - otherwise you will get a wrong value of the recommended memory to use. int n_row ; Number of rows in the matrix A. int n_col ; Number of columns in the matrix A. ---------------------------------------------------------------------------- colamd_set_defaults: ---------------------------------------------------------------------------- C syntax: #include "colamd.h" colamd_set_defaults (double knobs [COLAMD_KNOBS]) ; colamd_l_set_defaults (double knobs [COLAMD_KNOBS]) ; Purpose: Sets the default parameters. The use of this routine is optional. Arguments: double knobs [COLAMD_KNOBS] ; Output only. NOTE: the meaning of the dense row/col knobs has changed in v2.4 knobs [0] and knobs [1] control dense row and col detection: Colamd: rows with more than max (16, knobs [COLAMD_DENSE_ROW] * sqrt (n_col)) entries are removed prior to ordering. Columns with more than max (16, knobs [COLAMD_DENSE_COL] * sqrt (MIN (n_row,n_col))) entries are removed prior to ordering, and placed last in the output column ordering. Symamd: uses only knobs [COLAMD_DENSE_ROW], which is knobs [0]. Rows and columns with more than max (16, knobs [COLAMD_DENSE_ROW] * sqrt (n)) entries are removed prior to ordering, and placed last in the output ordering. COLAMD_DENSE_ROW and COLAMD_DENSE_COL are defined as 0 and 1, respectively, in colamd.h. Default values of these two knobs are both 10. Currently, only knobs [0] and knobs [1] are used, but future versions may use more knobs. If so, they will be properly set to their defaults by the future version of colamd_set_defaults, so that the code that calls colamd will not need to change, assuming that you either use colamd_set_defaults, or pass a (double *) NULL pointer as the knobs array to colamd or symamd. knobs [2]: aggressive absorption knobs [COLAMD_AGGRESSIVE] controls whether or not to do aggressive absorption during the ordering. Default is TRUE. ---------------------------------------------------------------------------- colamd: ---------------------------------------------------------------------------- C syntax: #include "colamd.h" int colamd (int n_row, int n_col, int Alen, int *A, int *p, double knobs [COLAMD_KNOBS], int stats [COLAMD_STATS]) ; SuiteSparse_long colamd_l (SuiteSparse_long n_row, SuiteSparse_long n_col, SuiteSparse_long Alen, SuiteSparse_long *A, SuiteSparse_long *p, double knobs [COLAMD_KNOBS], SuiteSparse_long stats [COLAMD_STATS]) ; Purpose: Computes a column ordering (Q) of A such that P(AQ)=LU or (AQ)'AQ=LL' have less fill-in and require fewer floating point operations than factorizing the unpermuted matrix A or A'A, respectively. Returns: TRUE (1) if successful, FALSE (0) otherwise. Arguments: int n_row ; Input argument. Number of rows in the matrix A. Restriction: n_row >= 0. Colamd returns FALSE if n_row is negative. int n_col ; Input argument. Number of columns in the matrix A. Restriction: n_col >= 0. Colamd returns FALSE if n_col is negative. int Alen ; Input argument. Restriction (see note): Alen >= 2*nnz + 6*(n_col+1) + 4*(n_row+1) + n_col Colamd returns FALSE if these conditions are not met. Note: this restriction makes an modest assumption regarding the size of the two typedef's structures in colamd.h. We do, however, guarantee that Alen >= colamd_recommended (nnz, n_row, n_col) will be sufficient. Note: the macro version does not check for integer overflow, and thus is not recommended. Use the colamd_recommended routine instead. int A [Alen] ; Input argument, undefined on output. A is an integer array of size Alen. Alen must be at least as large as the bare minimum value given above, but this is very low, and can result in excessive run time. For best performance, we recommend that Alen be greater than or equal to colamd_recommended (nnz, n_row, n_col), which adds nnz/5 to the bare minimum value given above. On input, the row indices of the entries in column c of the matrix are held in A [(p [c]) ... (p [c+1]-1)]. The row indices in a given column c need not be in ascending order, and duplicate row indices may be be present. However, colamd will work a little faster if both of these conditions are met (Colamd puts the matrix into this format, if it finds that the the conditions are not met). The matrix is 0-based. That is, rows are in the range 0 to n_row-1, and columns are in the range 0 to n_col-1. Colamd returns FALSE if any row index is out of range. The contents of A are modified during ordering, and are undefined on output. int p [n_col+1] ; Both input and output argument. p is an integer array of size n_col+1. On input, it holds the "pointers" for the column form of the matrix A. Column c of the matrix A is held in A [(p [c]) ... (p [c+1]-1)]. The first entry, p [0], must be zero, and p [c] <= p [c+1] must hold for all c in the range 0 to n_col-1. The value p [n_col] is thus the total number of entries in the pattern of the matrix A. Colamd returns FALSE if these conditions are not met. On output, if colamd returns TRUE, the array p holds the column permutation (Q, for P(AQ)=LU or (AQ)'(AQ)=LL'), where p [0] is the first column index in the new ordering, and p [n_col-1] is the last. That is, p [k] = j means that column j of A is the kth pivot column, in AQ, where k is in the range 0 to n_col-1 (p [0] = j means that column j of A is the first column in AQ). If colamd returns FALSE, then no permutation is returned, and p is undefined on output. double knobs [COLAMD_KNOBS] ; Input argument. See colamd_set_defaults for a description. int stats [COLAMD_STATS] ; Output argument. Statistics on the ordering, and error status. See colamd.h for related definitions. Colamd returns FALSE if stats is not present. stats [0]: number of dense or empty rows ignored. stats [1]: number of dense or empty columns ignored (and ordered last in the output permutation p) Note that a row can become "empty" if it contains only "dense" and/or "empty" columns, and similarly a column can become "empty" if it only contains "dense" and/or "empty" rows. stats [2]: number of garbage collections performed. This can be excessively high if Alen is close to the minimum required value. stats [3]: status code. < 0 is an error code. > 1 is a warning or notice. 0 OK. Each column of the input matrix contained row indices in increasing order, with no duplicates. 1 OK, but columns of input matrix were jumbled (unsorted columns or duplicate entries). Colamd had to do some extra work to sort the matrix first and remove duplicate entries, but it still was able to return a valid permutation (return value of colamd was TRUE). stats [4]: highest numbered column that is unsorted or has duplicate entries. stats [5]: last seen duplicate or unsorted row index. stats [6]: number of duplicate or unsorted row indices. -1 A is a null pointer -2 p is a null pointer -3 n_row is negative stats [4]: n_row -4 n_col is negative stats [4]: n_col -5 number of nonzeros in matrix is negative stats [4]: number of nonzeros, p [n_col] -6 p [0] is nonzero stats [4]: p [0] -7 A is too small stats [4]: required size stats [5]: actual size (Alen) -8 a column has a negative number of entries stats [4]: column with < 0 entries stats [5]: number of entries in col -9 a row index is out of bounds stats [4]: column with bad row index stats [5]: bad row index stats [6]: n_row, # of rows of matrx -10 (unused; see symamd.c) -999 (unused; see symamd.c) Future versions may return more statistics in the stats array. Example: See colamd_example.c for a complete example. To order the columns of a 5-by-4 matrix with 11 nonzero entries in the following nonzero pattern x 0 x 0 x 0 x x 0 x x 0 0 0 x x x x 0 0 with default knobs and no output statistics, do the following: #include "colamd.h" #define ALEN 100 int A [ALEN] = {0, 1, 4, 2, 4, 0, 1, 2, 3, 1, 3} ; int p [ ] = {0, 3, 5, 9, 11} ; int stats [COLAMD_STATS] ; colamd (5, 4, ALEN, A, p, (double *) NULL, stats) ; The permutation is returned in the array p, and A is destroyed. ---------------------------------------------------------------------------- symamd: ---------------------------------------------------------------------------- C syntax: #include "colamd.h" int symamd (int n, int *A, int *p, int *perm, double knobs [COLAMD_KNOBS], int stats [COLAMD_STATS], void (*allocate) (size_t, size_t), void (*release) (void *)) ; SuiteSparse_long symamd_l (SuiteSparse_long n, SuiteSparse_long *A, SuiteSparse_long *p, SuiteSparse_long *perm, double knobs [COLAMD_KNOBS], SuiteSparse_long stats [COLAMD_STATS], void (*allocate) (size_t, size_t), void (*release) (void *)) ; Purpose: The symamd routine computes an ordering P of a symmetric sparse matrix A such that the Cholesky factorization PAP' = LL' remains sparse. It is based on a column ordering of a matrix M constructed so that the nonzero pattern of M'M is the same as A. The matrix A is assumed to be symmetric; only the strictly lower triangular part is accessed. You must pass your selected memory allocator (usually calloc/free or mxCalloc/mxFree) to symamd, for it to allocate memory for the temporary matrix M. Returns: TRUE (1) if successful, FALSE (0) otherwise. Arguments: int n ; Input argument. Number of rows and columns in the symmetrix matrix A. Restriction: n >= 0. Symamd returns FALSE if n is negative. int A [nnz] ; Input argument. A is an integer array of size nnz, where nnz = p [n]. The row indices of the entries in column c of the matrix are held in A [(p [c]) ... (p [c+1]-1)]. The row indices in a given column c need not be in ascending order, and duplicate row indices may be present. However, symamd will run faster if the columns are in sorted order with no duplicate entries. The matrix is 0-based. That is, rows are in the range 0 to n-1, and columns are in the range 0 to n-1. Symamd returns FALSE if any row index is out of range. The contents of A are not modified. int p [n+1] ; Input argument. p is an integer array of size n+1. On input, it holds the "pointers" for the column form of the matrix A. Column c of the matrix A is held in A [(p [c]) ... (p [c+1]-1)]. The first entry, p [0], must be zero, and p [c] <= p [c+1] must hold for all c in the range 0 to n-1. The value p [n] is thus the total number of entries in the pattern of the matrix A. Symamd returns FALSE if these conditions are not met. The contents of p are not modified. int perm [n+1] ; Output argument. On output, if symamd returns TRUE, the array perm holds the permutation P, where perm [0] is the first index in the new ordering, and perm [n-1] is the last. That is, perm [k] = j means that row and column j of A is the kth column in PAP', where k is in the range 0 to n-1 (perm [0] = j means that row and column j of A are the first row and column in PAP'). The array is used as a workspace during the ordering, which is why it must be of length n+1, not just n. double knobs [COLAMD_KNOBS] ; Input argument. See colamd_set_defaults for a description. int stats [COLAMD_STATS] ; Output argument. Statistics on the ordering, and error status. See colamd.h for related definitions. Symamd returns FALSE if stats is not present. stats [0]: number of dense or empty row and columns ignored (and ordered last in the output permutation perm). Note that a row/column can become "empty" if it contains only "dense" and/or "empty" columns/rows. stats [1]: (same as stats [0]) stats [2]: number of garbage collections performed. stats [3]: status code. < 0 is an error code. > 1 is a warning or notice. 0 OK. Each column of the input matrix contained row indices in increasing order, with no duplicates. 1 OK, but columns of input matrix were jumbled (unsorted columns or duplicate entries). Symamd had to do some extra work to sort the matrix first and remove duplicate entries, but it still was able to return a valid permutation (return value of symamd was TRUE). stats [4]: highest numbered column that is unsorted or has duplicate entries. stats [5]: last seen duplicate or unsorted row index. stats [6]: number of duplicate or unsorted row indices. -1 A is a null pointer -2 p is a null pointer -3 (unused, see colamd.c) -4 n is negative stats [4]: n -5 number of nonzeros in matrix is negative stats [4]: # of nonzeros (p [n]). -6 p [0] is nonzero stats [4]: p [0] -7 (unused) -8 a column has a negative number of entries stats [4]: column with < 0 entries stats [5]: number of entries in col -9 a row index is out of bounds stats [4]: column with bad row index stats [5]: bad row index stats [6]: n_row, # of rows of matrx -10 out of memory (unable to allocate temporary workspace for M or count arrays using the "allocate" routine passed into symamd). Future versions may return more statistics in the stats array. void * (*allocate) (size_t, size_t) A pointer to a function providing memory allocation. The allocated memory must be returned initialized to zero. For a C application, this argument should normally be a pointer to calloc. For a MATLAB mexFunction, the routine mxCalloc is passed instead. void (*release) (size_t, size_t) A pointer to a function that frees memory allocated by the memory allocation routine above. For a C application, this argument should normally be a pointer to free. For a MATLAB mexFunction, the routine mxFree is passed instead. ---------------------------------------------------------------------------- colamd_report: ---------------------------------------------------------------------------- C syntax: #include "colamd.h" colamd_report (int stats [COLAMD_STATS]) ; colamd_l_report (SuiteSparse_long stats [COLAMD_STATS]) ; Purpose: Prints the error status and statistics recorded in the stats array on the standard error output (for a standard C routine) or on the MATLAB output (for a mexFunction). Arguments: int stats [COLAMD_STATS] ; Input only. Statistics from colamd. ---------------------------------------------------------------------------- symamd_report: ---------------------------------------------------------------------------- C syntax: #include "colamd.h" symamd_report (int stats [COLAMD_STATS]) ; symamd_l_report (SuiteSparse_long stats [COLAMD_STATS]) ; Purpose: Prints the error status and statistics recorded in the stats array on the standard error output (for a standard C routine) or on the MATLAB output (for a mexFunction). Arguments: int stats [COLAMD_STATS] ; Input only. Statistics from symamd. */ /* ========================================================================== */ /* === Scaffolding code definitions ======================================== */ /* ========================================================================== */ /* Ensure that debugging is turned off: */ #ifndef NDEBUG #define NDEBUG #endif /* turn on debugging by uncommenting the following line #undef NDEBUG */ /* Our "scaffolding code" philosophy: In our opinion, well-written library code should keep its "debugging" code, and just normally have it turned off by the compiler so as not to interfere with performance. This serves several purposes: (1) assertions act as comments to the reader, telling you what the code expects at that point. All assertions will always be true (unless there really is a bug, of course). (2) leaving in the scaffolding code assists anyone who would like to modify the code, or understand the algorithm (by reading the debugging output, one can get a glimpse into what the code is doing). (3) (gasp!) for actually finding bugs. This code has been heavily tested and "should" be fully functional and bug-free ... but you never know... The code will become outrageously slow when debugging is enabled. To control the level of debugging output, set an environment variable D to 0 (little), 1 (some), 2, 3, or 4 (lots). When debugging, you should see the following message on the standard output: colamd: debug version, D = 1 (THIS WILL BE SLOW!) or a similar message for symamd. If you don't, then debugging has not been enabled. */ /* ========================================================================== */ /* === Include files ======================================================== */ /* ========================================================================== */ #include "colamd.h" #include #include #ifdef MATLAB_MEX_FILE #include "mex.h" #include "matrix.h" #endif /* MATLAB_MEX_FILE */ #if !defined (NPRINT) || !defined (NDEBUG) #include #endif #ifndef NULL #define NULL ((void *) 0) #endif /* ========================================================================== */ /* === int or SuiteSparse_long ============================================== */ /* ========================================================================== */ #ifdef DLONG #define Int SuiteSparse_long #define ID SuiteSparse_long_id #define Int_MAX SuiteSparse_long_max #define COLAMD_recommended colamd_l_recommended #define COLAMD_set_defaults colamd_l_set_defaults #define COLAMD_MAIN colamd_l #define SYMAMD_MAIN symamd_l #define COLAMD_report colamd_l_report #define SYMAMD_report symamd_l_report #else #define Int int #define ID "%d" #define Int_MAX INT_MAX #define COLAMD_recommended colamd_recommended #define COLAMD_set_defaults colamd_set_defaults #define COLAMD_MAIN colamd #define SYMAMD_MAIN symamd #define COLAMD_report colamd_report #define SYMAMD_report symamd_report #endif /* ========================================================================== */ /* === Row and Column structures ============================================ */ /* ========================================================================== */ /* User code that makes use of the colamd/symamd routines need not directly */ /* reference these structures. They are used only for colamd_recommended. */ typedef struct Colamd_Col_struct { Int start ; /* index for A of first row in this column, or DEAD */ /* if column is dead */ Int length ; /* number of rows in this column */ union { Int thickness ; /* number of original columns represented by this */ /* col, if the column is alive */ Int parent ; /* parent in parent tree super-column structure, if */ /* the column is dead */ } shared1 ; union { Int score ; /* the score used to maintain heap, if col is alive */ Int order ; /* pivot ordering of this column, if col is dead */ } shared2 ; union { Int headhash ; /* head of a hash bucket, if col is at the head of */ /* a degree list */ Int hash ; /* hash value, if col is not in a degree list */ Int prev ; /* previous column in degree list, if col is in a */ /* degree list (but not at the head of a degree list) */ } shared3 ; union { Int degree_next ; /* next column, if col is in a degree list */ Int hash_next ; /* next column, if col is in a hash list */ } shared4 ; } Colamd_Col ; typedef struct Colamd_Row_struct { Int start ; /* index for A of first col in this row */ Int length ; /* number of principal columns in this row */ union { Int degree ; /* number of principal & non-principal columns in row */ Int p ; /* used as a row pointer in init_rows_cols () */ } shared1 ; union { Int mark ; /* for computing set differences and marking dead rows*/ Int first_column ;/* first column in row (used in garbage collection) */ } shared2 ; } Colamd_Row ; /* ========================================================================== */ /* === Definitions ========================================================== */ /* ========================================================================== */ /* Routines are either PUBLIC (user-callable) or PRIVATE (not user-callable) */ #define PUBLIC #define PRIVATE static #define DENSE_DEGREE(alpha,n) \ ((Int) MAX (16.0, (alpha) * sqrt ((double) (n)))) #define MAX(a,b) (((a) > (b)) ? (a) : (b)) #define MIN(a,b) (((a) < (b)) ? (a) : (b)) #define ONES_COMPLEMENT(r) (-(r)-1) /* -------------------------------------------------------------------------- */ /* Change for version 2.1: define TRUE and FALSE only if not yet defined */ /* -------------------------------------------------------------------------- */ #ifndef TRUE #define TRUE (1) #endif #ifndef FALSE #define FALSE (0) #endif /* -------------------------------------------------------------------------- */ #define EMPTY (-1) /* Row and column status */ #define ALIVE (0) #define DEAD (-1) /* Column status */ #define DEAD_PRINCIPAL (-1) #define DEAD_NON_PRINCIPAL (-2) /* Macros for row and column status update and checking. */ #define ROW_IS_DEAD(r) ROW_IS_MARKED_DEAD (Row[r].shared2.mark) #define ROW_IS_MARKED_DEAD(row_mark) (row_mark < ALIVE) #define ROW_IS_ALIVE(r) (Row [r].shared2.mark >= ALIVE) #define COL_IS_DEAD(c) (Col [c].start < ALIVE) #define COL_IS_ALIVE(c) (Col [c].start >= ALIVE) #define COL_IS_DEAD_PRINCIPAL(c) (Col [c].start == DEAD_PRINCIPAL) #define KILL_ROW(r) { Row [r].shared2.mark = DEAD ; } #define KILL_PRINCIPAL_COL(c) { Col [c].start = DEAD_PRINCIPAL ; } #define KILL_NON_PRINCIPAL_COL(c) { Col [c].start = DEAD_NON_PRINCIPAL ; } /* ========================================================================== */ /* === Colamd reporting mechanism =========================================== */ /* ========================================================================== */ #if defined (MATLAB_MEX_FILE) || defined (MATHWORKS) /* In MATLAB, matrices are 1-based to the user, but 0-based internally */ #define INDEX(i) ((i)+1) #else /* In C, matrices are 0-based and indices are reported as such in *_report */ #define INDEX(i) (i) #endif /* ========================================================================== */ /* === Prototypes of PRIVATE routines ======================================= */ /* ========================================================================== */ PRIVATE Int init_rows_cols ( Int n_row, Int n_col, Colamd_Row Row [], Colamd_Col Col [], Int A [], Int p [], Int stats [COLAMD_STATS] ) ; PRIVATE void init_scoring ( Int n_row, Int n_col, Colamd_Row Row [], Colamd_Col Col [], Int A [], Int head [], double knobs [COLAMD_KNOBS], Int *p_n_row2, Int *p_n_col2, Int *p_max_deg ) ; PRIVATE Int find_ordering ( Int n_row, Int n_col, Int Alen, Colamd_Row Row [], Colamd_Col Col [], Int A [], Int head [], Int n_col2, Int max_deg, Int pfree, Int aggressive ) ; PRIVATE void order_children ( Int n_col, Colamd_Col Col [], Int p [] ) ; PRIVATE void detect_super_cols ( #ifndef NDEBUG Int n_col, Colamd_Row Row [], #endif /* NDEBUG */ Colamd_Col Col [], Int A [], Int head [], Int row_start, Int row_length ) ; PRIVATE Int garbage_collection ( Int n_row, Int n_col, Colamd_Row Row [], Colamd_Col Col [], Int A [], Int *pfree ) ; PRIVATE Int clear_mark ( Int tag_mark, Int max_mark, Int n_row, Colamd_Row Row [] ) ; PRIVATE void print_report ( char *method, Int stats [COLAMD_STATS] ) ; /* ========================================================================== */ /* === Debugging prototypes and definitions ================================= */ /* ========================================================================== */ #ifndef NDEBUG #include /* colamd_debug is the *ONLY* global variable, and is only */ /* present when debugging */ PRIVATE Int colamd_debug = 0 ; /* debug print level */ #define DEBUG0(params) { SUITESPARSE_PRINTF (params) ; } #define DEBUG1(params) { if (colamd_debug >= 1) SUITESPARSE_PRINTF (params) ; } #define DEBUG2(params) { if (colamd_debug >= 2) SUITESPARSE_PRINTF (params) ; } #define DEBUG3(params) { if (colamd_debug >= 3) SUITESPARSE_PRINTF (params) ; } #define DEBUG4(params) { if (colamd_debug >= 4) SUITESPARSE_PRINTF (params) ; } #ifdef MATLAB_MEX_FILE #define ASSERT(expression) (mxAssert ((expression), "")) #else #define ASSERT(expression) (assert (expression)) #endif /* MATLAB_MEX_FILE */ PRIVATE void colamd_get_debug /* gets the debug print level from getenv */ ( char *method ) ; PRIVATE void debug_deg_lists ( Int n_row, Int n_col, Colamd_Row Row [], Colamd_Col Col [], Int head [], Int min_score, Int should, Int max_deg ) ; PRIVATE void debug_mark ( Int n_row, Colamd_Row Row [], Int tag_mark, Int max_mark ) ; PRIVATE void debug_matrix ( Int n_row, Int n_col, Colamd_Row Row [], Colamd_Col Col [], Int A [] ) ; PRIVATE void debug_structures ( Int n_row, Int n_col, Colamd_Row Row [], Colamd_Col Col [], Int A [], Int n_col2 ) ; #else /* NDEBUG */ /* === No debugging ========================================================= */ #define DEBUG0(params) ; #define DEBUG1(params) ; #define DEBUG2(params) ; #define DEBUG3(params) ; #define DEBUG4(params) ; #define ASSERT(expression) #endif /* NDEBUG */ /* ========================================================================== */ /* === USER-CALLABLE ROUTINES: ============================================== */ /* ========================================================================== */ /* ========================================================================== */ /* === colamd_recommended =================================================== */ /* ========================================================================== */ /* The colamd_recommended routine returns the suggested size for Alen. This value has been determined to provide good balance between the number of garbage collections and the memory requirements for colamd. If any argument is negative, or if integer overflow occurs, a 0 is returned as an error condition. 2*nnz space is required for the row and column indices of the matrix. COLAMD_C (n_col) + COLAMD_R (n_row) space is required for the Col and Row arrays, respectively, which are internal to colamd (roughly 6*n_col + 4*n_row). An additional n_col space is the minimal amount of "elbow room", and nnz/5 more space is recommended for run time efficiency. Alen is approximately 2.2*nnz + 7*n_col + 4*n_row + 10. This function is not needed when using symamd. */ /* add two values of type size_t, and check for integer overflow */ static size_t t_add (size_t a, size_t b, int *ok) { (*ok) = (*ok) && ((a + b) >= MAX (a,b)) ; return ((*ok) ? (a + b) : 0) ; } /* compute a*k where k is a small integer, and check for integer overflow */ static size_t t_mult (size_t a, size_t k, int *ok) { size_t i, s = 0 ; for (i = 0 ; i < k ; i++) { s = t_add (s, a, ok) ; } return (s) ; } /* size of the Col and Row structures */ #define COLAMD_C(n_col,ok) \ ((t_mult (t_add (n_col, 1, ok), sizeof (Colamd_Col), ok) / sizeof (Int))) #define COLAMD_R(n_row,ok) \ ((t_mult (t_add (n_row, 1, ok), sizeof (Colamd_Row), ok) / sizeof (Int))) PUBLIC size_t COLAMD_recommended /* returns recommended value of Alen. */ ( /* === Parameters ======================================================= */ Int nnz, /* number of nonzeros in A */ Int n_row, /* number of rows in A */ Int n_col /* number of columns in A */ ) { size_t s, c, r ; int ok = TRUE ; if (nnz < 0 || n_row < 0 || n_col < 0) { return (0) ; } s = t_mult (nnz, 2, &ok) ; /* 2*nnz */ c = COLAMD_C (n_col, &ok) ; /* size of column structures */ r = COLAMD_R (n_row, &ok) ; /* size of row structures */ s = t_add (s, c, &ok) ; s = t_add (s, r, &ok) ; s = t_add (s, n_col, &ok) ; /* elbow room */ s = t_add (s, nnz/5, &ok) ; /* elbow room */ ok = ok && (s < Int_MAX) ; return (ok ? s : 0) ; } /* ========================================================================== */ /* === colamd_set_defaults ================================================== */ /* ========================================================================== */ /* The colamd_set_defaults routine sets the default values of the user- controllable parameters for colamd and symamd: Colamd: rows with more than max (16, knobs [0] * sqrt (n_col)) entries are removed prior to ordering. Columns with more than max (16, knobs [1] * sqrt (MIN (n_row,n_col))) entries are removed prior to ordering, and placed last in the output column ordering. Symamd: Rows and columns with more than max (16, knobs [0] * sqrt (n)) entries are removed prior to ordering, and placed last in the output ordering. knobs [0] dense row control knobs [1] dense column control knobs [2] if nonzero, do aggresive absorption knobs [3..19] unused, but future versions might use this */ PUBLIC void COLAMD_set_defaults ( /* === Parameters ======================================================= */ double knobs [COLAMD_KNOBS] /* knob array */ ) { /* === Local variables ================================================== */ Int i ; if (!knobs) { return ; /* no knobs to initialize */ } for (i = 0 ; i < COLAMD_KNOBS ; i++) { knobs [i] = 0 ; } knobs [COLAMD_DENSE_ROW] = 10 ; knobs [COLAMD_DENSE_COL] = 10 ; knobs [COLAMD_AGGRESSIVE] = TRUE ; /* default: do aggressive absorption*/ } /* ========================================================================== */ /* === symamd =============================================================== */ /* ========================================================================== */ PUBLIC Int SYMAMD_MAIN /* return TRUE if OK, FALSE otherwise */ ( /* === Parameters ======================================================= */ Int n, /* number of rows and columns of A */ Int A [], /* row indices of A */ Int p [], /* column pointers of A */ Int perm [], /* output permutation, size n+1 */ double knobs [COLAMD_KNOBS], /* parameters (uses defaults if NULL) */ Int stats [COLAMD_STATS], /* output statistics and error codes */ void * (*allocate) (size_t, size_t), /* pointer to calloc (ANSI C) or */ /* mxCalloc (for MATLAB mexFunction) */ void (*release) (void *) /* pointer to free (ANSI C) or */ /* mxFree (for MATLAB mexFunction) */ ) { /* === Local variables ================================================== */ Int *count ; /* length of each column of M, and col pointer*/ Int *mark ; /* mark array for finding duplicate entries */ Int *M ; /* row indices of matrix M */ size_t Mlen ; /* length of M */ Int n_row ; /* number of rows in M */ Int nnz ; /* number of entries in A */ Int i ; /* row index of A */ Int j ; /* column index of A */ Int k ; /* row index of M */ Int mnz ; /* number of nonzeros in M */ Int pp ; /* index into a column of A */ Int last_row ; /* last row seen in the current column */ Int length ; /* number of nonzeros in a column */ double cknobs [COLAMD_KNOBS] ; /* knobs for colamd */ double default_knobs [COLAMD_KNOBS] ; /* default knobs for colamd */ #ifndef NDEBUG colamd_get_debug ("symamd") ; #endif /* NDEBUG */ /* === Check the input arguments ======================================== */ if (!stats) { DEBUG0 (("symamd: stats not present\n")) ; return (FALSE) ; } for (i = 0 ; i < COLAMD_STATS ; i++) { stats [i] = 0 ; } stats [COLAMD_STATUS] = COLAMD_OK ; stats [COLAMD_INFO1] = -1 ; stats [COLAMD_INFO2] = -1 ; if (!A) { stats [COLAMD_STATUS] = COLAMD_ERROR_A_not_present ; DEBUG0 (("symamd: A not present\n")) ; return (FALSE) ; } if (!p) /* p is not present */ { stats [COLAMD_STATUS] = COLAMD_ERROR_p_not_present ; DEBUG0 (("symamd: p not present\n")) ; return (FALSE) ; } if (n < 0) /* n must be >= 0 */ { stats [COLAMD_STATUS] = COLAMD_ERROR_ncol_negative ; stats [COLAMD_INFO1] = n ; DEBUG0 (("symamd: n negative %d\n", n)) ; return (FALSE) ; } nnz = p [n] ; if (nnz < 0) /* nnz must be >= 0 */ { stats [COLAMD_STATUS] = COLAMD_ERROR_nnz_negative ; stats [COLAMD_INFO1] = nnz ; DEBUG0 (("symamd: number of entries negative %d\n", nnz)) ; return (FALSE) ; } if (p [0] != 0) { stats [COLAMD_STATUS] = COLAMD_ERROR_p0_nonzero ; stats [COLAMD_INFO1] = p [0] ; DEBUG0 (("symamd: p[0] not zero %d\n", p [0])) ; return (FALSE) ; } /* === If no knobs, set default knobs =================================== */ if (!knobs) { COLAMD_set_defaults (default_knobs) ; knobs = default_knobs ; } /* === Allocate count and mark ========================================== */ count = (Int *) ((*allocate) (n+1, sizeof (Int))) ; if (!count) { stats [COLAMD_STATUS] = COLAMD_ERROR_out_of_memory ; DEBUG0 (("symamd: allocate count (size %d) failed\n", n+1)) ; return (FALSE) ; } mark = (Int *) ((*allocate) (n+1, sizeof (Int))) ; if (!mark) { stats [COLAMD_STATUS] = COLAMD_ERROR_out_of_memory ; (*release) ((void *) count) ; DEBUG0 (("symamd: allocate mark (size %d) failed\n", n+1)) ; return (FALSE) ; } /* === Compute column counts of M, check if A is valid ================== */ stats [COLAMD_INFO3] = 0 ; /* number of duplicate or unsorted row indices*/ for (i = 0 ; i < n ; i++) { mark [i] = -1 ; } for (j = 0 ; j < n ; j++) { last_row = -1 ; length = p [j+1] - p [j] ; if (length < 0) { /* column pointers must be non-decreasing */ stats [COLAMD_STATUS] = COLAMD_ERROR_col_length_negative ; stats [COLAMD_INFO1] = j ; stats [COLAMD_INFO2] = length ; (*release) ((void *) count) ; (*release) ((void *) mark) ; DEBUG0 (("symamd: col %d negative length %d\n", j, length)) ; return (FALSE) ; } for (pp = p [j] ; pp < p [j+1] ; pp++) { i = A [pp] ; if (i < 0 || i >= n) { /* row index i, in column j, is out of bounds */ stats [COLAMD_STATUS] = COLAMD_ERROR_row_index_out_of_bounds ; stats [COLAMD_INFO1] = j ; stats [COLAMD_INFO2] = i ; stats [COLAMD_INFO3] = n ; (*release) ((void *) count) ; (*release) ((void *) mark) ; DEBUG0 (("symamd: row %d col %d out of bounds\n", i, j)) ; return (FALSE) ; } if (i <= last_row || mark [i] == j) { /* row index is unsorted or repeated (or both), thus col */ /* is jumbled. This is a notice, not an error condition. */ stats [COLAMD_STATUS] = COLAMD_OK_BUT_JUMBLED ; stats [COLAMD_INFO1] = j ; stats [COLAMD_INFO2] = i ; (stats [COLAMD_INFO3]) ++ ; DEBUG1 (("symamd: row %d col %d unsorted/duplicate\n", i, j)) ; } if (i > j && mark [i] != j) { /* row k of M will contain column indices i and j */ count [i]++ ; count [j]++ ; } /* mark the row as having been seen in this column */ mark [i] = j ; last_row = i ; } } /* v2.4: removed free(mark) */ /* === Compute column pointers of M ===================================== */ /* use output permutation, perm, for column pointers of M */ perm [0] = 0 ; for (j = 1 ; j <= n ; j++) { perm [j] = perm [j-1] + count [j-1] ; } for (j = 0 ; j < n ; j++) { count [j] = perm [j] ; } /* === Construct M ====================================================== */ mnz = perm [n] ; n_row = mnz / 2 ; Mlen = COLAMD_recommended (mnz, n_row, n) ; M = (Int *) ((*allocate) (Mlen, sizeof (Int))) ; DEBUG0 (("symamd: M is %d-by-%d with %d entries, Mlen = %g\n", n_row, n, mnz, (double) Mlen)) ; if (!M) { stats [COLAMD_STATUS] = COLAMD_ERROR_out_of_memory ; (*release) ((void *) count) ; (*release) ((void *) mark) ; DEBUG0 (("symamd: allocate M (size %g) failed\n", (double) Mlen)) ; return (FALSE) ; } k = 0 ; if (stats [COLAMD_STATUS] == COLAMD_OK) { /* Matrix is OK */ for (j = 0 ; j < n ; j++) { ASSERT (p [j+1] - p [j] >= 0) ; for (pp = p [j] ; pp < p [j+1] ; pp++) { i = A [pp] ; ASSERT (i >= 0 && i < n) ; if (i > j) { /* row k of M contains column indices i and j */ M [count [i]++] = k ; M [count [j]++] = k ; k++ ; } } } } else { /* Matrix is jumbled. Do not add duplicates to M. Unsorted cols OK. */ DEBUG0 (("symamd: Duplicates in A.\n")) ; for (i = 0 ; i < n ; i++) { mark [i] = -1 ; } for (j = 0 ; j < n ; j++) { ASSERT (p [j+1] - p [j] >= 0) ; for (pp = p [j] ; pp < p [j+1] ; pp++) { i = A [pp] ; ASSERT (i >= 0 && i < n) ; if (i > j && mark [i] != j) { /* row k of M contains column indices i and j */ M [count [i]++] = k ; M [count [j]++] = k ; k++ ; mark [i] = j ; } } } /* v2.4: free(mark) moved below */ } /* count and mark no longer needed */ (*release) ((void *) count) ; (*release) ((void *) mark) ; /* v2.4: free (mark) moved here */ ASSERT (k == n_row) ; /* === Adjust the knobs for M =========================================== */ for (i = 0 ; i < COLAMD_KNOBS ; i++) { cknobs [i] = knobs [i] ; } /* there are no dense rows in M */ cknobs [COLAMD_DENSE_ROW] = -1 ; cknobs [COLAMD_DENSE_COL] = knobs [COLAMD_DENSE_ROW] ; /* === Order the columns of M =========================================== */ /* v2.4: colamd cannot fail here, so the error check is removed */ (void) COLAMD_MAIN (n_row, n, (Int) Mlen, M, perm, cknobs, stats) ; /* Note that the output permutation is now in perm */ /* === get the statistics for symamd from colamd ======================== */ /* a dense column in colamd means a dense row and col in symamd */ stats [COLAMD_DENSE_ROW] = stats [COLAMD_DENSE_COL] ; /* === Free M =========================================================== */ (*release) ((void *) M) ; DEBUG0 (("symamd: done.\n")) ; return (TRUE) ; } /* ========================================================================== */ /* === colamd =============================================================== */ /* ========================================================================== */ /* The colamd routine computes a column ordering Q of a sparse matrix A such that the LU factorization P(AQ) = LU remains sparse, where P is selected via partial pivoting. The routine can also be viewed as providing a permutation Q such that the Cholesky factorization (AQ)'(AQ) = LL' remains sparse. */ PUBLIC Int COLAMD_MAIN /* returns TRUE if successful, FALSE otherwise*/ ( /* === Parameters ======================================================= */ Int n_row, /* number of rows in A */ Int n_col, /* number of columns in A */ Int Alen, /* length of A */ Int A [], /* row indices of A */ Int p [], /* pointers to columns in A */ double knobs [COLAMD_KNOBS],/* parameters (uses defaults if NULL) */ Int stats [COLAMD_STATS] /* output statistics and error codes */ ) { /* === Local variables ================================================== */ Int i ; /* loop index */ Int nnz ; /* nonzeros in A */ size_t Row_size ; /* size of Row [], in integers */ size_t Col_size ; /* size of Col [], in integers */ size_t need ; /* minimum required length of A */ Colamd_Row *Row ; /* pointer into A of Row [0..n_row] array */ Colamd_Col *Col ; /* pointer into A of Col [0..n_col] array */ Int n_col2 ; /* number of non-dense, non-empty columns */ Int n_row2 ; /* number of non-dense, non-empty rows */ Int ngarbage ; /* number of garbage collections performed */ Int max_deg ; /* maximum row degree */ double default_knobs [COLAMD_KNOBS] ; /* default knobs array */ Int aggressive ; /* do aggressive absorption */ int ok ; #ifndef NDEBUG colamd_get_debug ("colamd") ; #endif /* NDEBUG */ /* === Check the input arguments ======================================== */ if (!stats) { DEBUG0 (("colamd: stats not present\n")) ; return (FALSE) ; } for (i = 0 ; i < COLAMD_STATS ; i++) { stats [i] = 0 ; } stats [COLAMD_STATUS] = COLAMD_OK ; stats [COLAMD_INFO1] = -1 ; stats [COLAMD_INFO2] = -1 ; if (!A) /* A is not present */ { stats [COLAMD_STATUS] = COLAMD_ERROR_A_not_present ; DEBUG0 (("colamd: A not present\n")) ; return (FALSE) ; } if (!p) /* p is not present */ { stats [COLAMD_STATUS] = COLAMD_ERROR_p_not_present ; DEBUG0 (("colamd: p not present\n")) ; return (FALSE) ; } if (n_row < 0) /* n_row must be >= 0 */ { stats [COLAMD_STATUS] = COLAMD_ERROR_nrow_negative ; stats [COLAMD_INFO1] = n_row ; DEBUG0 (("colamd: nrow negative %d\n", n_row)) ; return (FALSE) ; } if (n_col < 0) /* n_col must be >= 0 */ { stats [COLAMD_STATUS] = COLAMD_ERROR_ncol_negative ; stats [COLAMD_INFO1] = n_col ; DEBUG0 (("colamd: ncol negative %d\n", n_col)) ; return (FALSE) ; } nnz = p [n_col] ; if (nnz < 0) /* nnz must be >= 0 */ { stats [COLAMD_STATUS] = COLAMD_ERROR_nnz_negative ; stats [COLAMD_INFO1] = nnz ; DEBUG0 (("colamd: number of entries negative %d\n", nnz)) ; return (FALSE) ; } if (p [0] != 0) { stats [COLAMD_STATUS] = COLAMD_ERROR_p0_nonzero ; stats [COLAMD_INFO1] = p [0] ; DEBUG0 (("colamd: p[0] not zero %d\n", p [0])) ; return (FALSE) ; } /* === If no knobs, set default knobs =================================== */ if (!knobs) { COLAMD_set_defaults (default_knobs) ; knobs = default_knobs ; } aggressive = (knobs [COLAMD_AGGRESSIVE] != FALSE) ; /* === Allocate the Row and Col arrays from array A ===================== */ ok = TRUE ; Col_size = COLAMD_C (n_col, &ok) ; /* size of Col array of structs */ Row_size = COLAMD_R (n_row, &ok) ; /* size of Row array of structs */ /* need = 2*nnz + n_col + Col_size + Row_size ; */ need = t_mult (nnz, 2, &ok) ; need = t_add (need, n_col, &ok) ; need = t_add (need, Col_size, &ok) ; need = t_add (need, Row_size, &ok) ; if (!ok || need > (size_t) Alen || need > Int_MAX) { /* not enough space in array A to perform the ordering */ stats [COLAMD_STATUS] = COLAMD_ERROR_A_too_small ; stats [COLAMD_INFO1] = need ; stats [COLAMD_INFO2] = Alen ; DEBUG0 (("colamd: Need Alen >= %d, given only Alen = %d\n", need,Alen)); return (FALSE) ; } Alen -= Col_size + Row_size ; Col = (Colamd_Col *) &A [Alen] ; Row = (Colamd_Row *) &A [Alen + Col_size] ; /* === Construct the row and column data structures ===================== */ if (!init_rows_cols (n_row, n_col, Row, Col, A, p, stats)) { /* input matrix is invalid */ DEBUG0 (("colamd: Matrix invalid\n")) ; return (FALSE) ; } /* === Initialize scores, kill dense rows/columns ======================= */ init_scoring (n_row, n_col, Row, Col, A, p, knobs, &n_row2, &n_col2, &max_deg) ; /* === Order the supercolumns =========================================== */ ngarbage = find_ordering (n_row, n_col, Alen, Row, Col, A, p, n_col2, max_deg, 2*nnz, aggressive) ; /* === Order the non-principal columns ================================== */ order_children (n_col, Col, p) ; /* === Return statistics in stats ======================================= */ stats [COLAMD_DENSE_ROW] = n_row - n_row2 ; stats [COLAMD_DENSE_COL] = n_col - n_col2 ; stats [COLAMD_DEFRAG_COUNT] = ngarbage ; DEBUG0 (("colamd: done.\n")) ; return (TRUE) ; } /* ========================================================================== */ /* === colamd_report ======================================================== */ /* ========================================================================== */ PUBLIC void COLAMD_report ( Int stats [COLAMD_STATS] ) { print_report ("colamd", stats) ; } /* ========================================================================== */ /* === symamd_report ======================================================== */ /* ========================================================================== */ PUBLIC void SYMAMD_report ( Int stats [COLAMD_STATS] ) { print_report ("symamd", stats) ; } /* ========================================================================== */ /* === NON-USER-CALLABLE ROUTINES: ========================================== */ /* ========================================================================== */ /* There are no user-callable routines beyond this point in the file */ /* ========================================================================== */ /* === init_rows_cols ======================================================= */ /* ========================================================================== */ /* Takes the column form of the matrix in A and creates the row form of the matrix. Also, row and column attributes are stored in the Col and Row structs. If the columns are un-sorted or contain duplicate row indices, this routine will also sort and remove duplicate row indices from the column form of the matrix. Returns FALSE if the matrix is invalid, TRUE otherwise. Not user-callable. */ PRIVATE Int init_rows_cols /* returns TRUE if OK, or FALSE otherwise */ ( /* === Parameters ======================================================= */ Int n_row, /* number of rows of A */ Int n_col, /* number of columns of A */ Colamd_Row Row [], /* of size n_row+1 */ Colamd_Col Col [], /* of size n_col+1 */ Int A [], /* row indices of A, of size Alen */ Int p [], /* pointers to columns in A, of size n_col+1 */ Int stats [COLAMD_STATS] /* colamd statistics */ ) { /* === Local variables ================================================== */ Int col ; /* a column index */ Int row ; /* a row index */ Int *cp ; /* a column pointer */ Int *cp_end ; /* a pointer to the end of a column */ Int *rp ; /* a row pointer */ Int *rp_end ; /* a pointer to the end of a row */ Int last_row ; /* previous row */ /* === Initialize columns, and check column pointers ==================== */ for (col = 0 ; col < n_col ; col++) { Col [col].start = p [col] ; Col [col].length = p [col+1] - p [col] ; if (Col [col].length < 0) { /* column pointers must be non-decreasing */ stats [COLAMD_STATUS] = COLAMD_ERROR_col_length_negative ; stats [COLAMD_INFO1] = col ; stats [COLAMD_INFO2] = Col [col].length ; DEBUG0 (("colamd: col %d length %d < 0\n", col, Col [col].length)) ; return (FALSE) ; } Col [col].shared1.thickness = 1 ; Col [col].shared2.score = 0 ; Col [col].shared3.prev = EMPTY ; Col [col].shared4.degree_next = EMPTY ; } /* p [0..n_col] no longer needed, used as "head" in subsequent routines */ /* === Scan columns, compute row degrees, and check row indices ========= */ stats [COLAMD_INFO3] = 0 ; /* number of duplicate or unsorted row indices*/ for (row = 0 ; row < n_row ; row++) { Row [row].length = 0 ; Row [row].shared2.mark = -1 ; } for (col = 0 ; col < n_col ; col++) { last_row = -1 ; cp = &A [p [col]] ; cp_end = &A [p [col+1]] ; while (cp < cp_end) { row = *cp++ ; /* make sure row indices within range */ if (row < 0 || row >= n_row) { stats [COLAMD_STATUS] = COLAMD_ERROR_row_index_out_of_bounds ; stats [COLAMD_INFO1] = col ; stats [COLAMD_INFO2] = row ; stats [COLAMD_INFO3] = n_row ; DEBUG0 (("colamd: row %d col %d out of bounds\n", row, col)) ; return (FALSE) ; } if (row <= last_row || Row [row].shared2.mark == col) { /* row index are unsorted or repeated (or both), thus col */ /* is jumbled. This is a notice, not an error condition. */ stats [COLAMD_STATUS] = COLAMD_OK_BUT_JUMBLED ; stats [COLAMD_INFO1] = col ; stats [COLAMD_INFO2] = row ; (stats [COLAMD_INFO3]) ++ ; DEBUG1 (("colamd: row %d col %d unsorted/duplicate\n",row,col)); } if (Row [row].shared2.mark != col) { Row [row].length++ ; } else { /* this is a repeated entry in the column, */ /* it will be removed */ Col [col].length-- ; } /* mark the row as having been seen in this column */ Row [row].shared2.mark = col ; last_row = row ; } } /* === Compute row pointers ============================================= */ /* row form of the matrix starts directly after the column */ /* form of matrix in A */ Row [0].start = p [n_col] ; Row [0].shared1.p = Row [0].start ; Row [0].shared2.mark = -1 ; for (row = 1 ; row < n_row ; row++) { Row [row].start = Row [row-1].start + Row [row-1].length ; Row [row].shared1.p = Row [row].start ; Row [row].shared2.mark = -1 ; } /* === Create row form ================================================== */ if (stats [COLAMD_STATUS] == COLAMD_OK_BUT_JUMBLED) { /* if cols jumbled, watch for repeated row indices */ for (col = 0 ; col < n_col ; col++) { cp = &A [p [col]] ; cp_end = &A [p [col+1]] ; while (cp < cp_end) { row = *cp++ ; if (Row [row].shared2.mark != col) { A [(Row [row].shared1.p)++] = col ; Row [row].shared2.mark = col ; } } } } else { /* if cols not jumbled, we don't need the mark (this is faster) */ for (col = 0 ; col < n_col ; col++) { cp = &A [p [col]] ; cp_end = &A [p [col+1]] ; while (cp < cp_end) { A [(Row [*cp++].shared1.p)++] = col ; } } } /* === Clear the row marks and set row degrees ========================== */ for (row = 0 ; row < n_row ; row++) { Row [row].shared2.mark = 0 ; Row [row].shared1.degree = Row [row].length ; } /* === See if we need to re-create columns ============================== */ if (stats [COLAMD_STATUS] == COLAMD_OK_BUT_JUMBLED) { DEBUG0 (("colamd: reconstructing column form, matrix jumbled\n")) ; #ifndef NDEBUG /* make sure column lengths are correct */ for (col = 0 ; col < n_col ; col++) { p [col] = Col [col].length ; } for (row = 0 ; row < n_row ; row++) { rp = &A [Row [row].start] ; rp_end = rp + Row [row].length ; while (rp < rp_end) { p [*rp++]-- ; } } for (col = 0 ; col < n_col ; col++) { ASSERT (p [col] == 0) ; } /* now p is all zero (different than when debugging is turned off) */ #endif /* NDEBUG */ /* === Compute col pointers ========================================= */ /* col form of the matrix starts at A [0]. */ /* Note, we may have a gap between the col form and the row */ /* form if there were duplicate entries, if so, it will be */ /* removed upon the first garbage collection */ Col [0].start = 0 ; p [0] = Col [0].start ; for (col = 1 ; col < n_col ; col++) { /* note that the lengths here are for pruned columns, i.e. */ /* no duplicate row indices will exist for these columns */ Col [col].start = Col [col-1].start + Col [col-1].length ; p [col] = Col [col].start ; } /* === Re-create col form =========================================== */ for (row = 0 ; row < n_row ; row++) { rp = &A [Row [row].start] ; rp_end = rp + Row [row].length ; while (rp < rp_end) { A [(p [*rp++])++] = row ; } } } /* === Done. Matrix is not (or no longer) jumbled ====================== */ return (TRUE) ; } /* ========================================================================== */ /* === init_scoring ========================================================= */ /* ========================================================================== */ /* Kills dense or empty columns and rows, calculates an initial score for each column, and places all columns in the degree lists. Not user-callable. */ PRIVATE void init_scoring ( /* === Parameters ======================================================= */ Int n_row, /* number of rows of A */ Int n_col, /* number of columns of A */ Colamd_Row Row [], /* of size n_row+1 */ Colamd_Col Col [], /* of size n_col+1 */ Int A [], /* column form and row form of A */ Int head [], /* of size n_col+1 */ double knobs [COLAMD_KNOBS],/* parameters */ Int *p_n_row2, /* number of non-dense, non-empty rows */ Int *p_n_col2, /* number of non-dense, non-empty columns */ Int *p_max_deg /* maximum row degree */ ) { /* === Local variables ================================================== */ Int c ; /* a column index */ Int r, row ; /* a row index */ Int *cp ; /* a column pointer */ Int deg ; /* degree of a row or column */ Int *cp_end ; /* a pointer to the end of a column */ Int *new_cp ; /* new column pointer */ Int col_length ; /* length of pruned column */ Int score ; /* current column score */ Int n_col2 ; /* number of non-dense, non-empty columns */ Int n_row2 ; /* number of non-dense, non-empty rows */ Int dense_row_count ; /* remove rows with more entries than this */ Int dense_col_count ; /* remove cols with more entries than this */ Int min_score ; /* smallest column score */ Int max_deg ; /* maximum row degree */ Int next_col ; /* Used to add to degree list.*/ #ifndef NDEBUG Int debug_count ; /* debug only. */ #endif /* NDEBUG */ /* === Extract knobs ==================================================== */ /* Note: if knobs contains a NaN, this is undefined: */ if (knobs [COLAMD_DENSE_ROW] < 0) { /* only remove completely dense rows */ dense_row_count = n_col-1 ; } else { dense_row_count = DENSE_DEGREE (knobs [COLAMD_DENSE_ROW], n_col) ; } if (knobs [COLAMD_DENSE_COL] < 0) { /* only remove completely dense columns */ dense_col_count = n_row-1 ; } else { dense_col_count = DENSE_DEGREE (knobs [COLAMD_DENSE_COL], MIN (n_row, n_col)) ; } DEBUG1 (("colamd: densecount: %d %d\n", dense_row_count, dense_col_count)) ; max_deg = 0 ; n_col2 = n_col ; n_row2 = n_row ; /* === Kill empty columns =============================================== */ /* Put the empty columns at the end in their natural order, so that LU */ /* factorization can proceed as far as possible. */ for (c = n_col-1 ; c >= 0 ; c--) { deg = Col [c].length ; if (deg == 0) { /* this is a empty column, kill and order it last */ Col [c].shared2.order = --n_col2 ; KILL_PRINCIPAL_COL (c) ; } } DEBUG1 (("colamd: null columns killed: %d\n", n_col - n_col2)) ; /* === Kill dense columns =============================================== */ /* Put the dense columns at the end, in their natural order */ for (c = n_col-1 ; c >= 0 ; c--) { /* skip any dead columns */ if (COL_IS_DEAD (c)) { continue ; } deg = Col [c].length ; if (deg > dense_col_count) { /* this is a dense column, kill and order it last */ Col [c].shared2.order = --n_col2 ; /* decrement the row degrees */ cp = &A [Col [c].start] ; cp_end = cp + Col [c].length ; while (cp < cp_end) { Row [*cp++].shared1.degree-- ; } KILL_PRINCIPAL_COL (c) ; } } DEBUG1 (("colamd: Dense and null columns killed: %d\n", n_col - n_col2)) ; /* === Kill dense and empty rows ======================================== */ for (r = 0 ; r < n_row ; r++) { deg = Row [r].shared1.degree ; ASSERT (deg >= 0 && deg <= n_col) ; if (deg > dense_row_count || deg == 0) { /* kill a dense or empty row */ KILL_ROW (r) ; --n_row2 ; } else { /* keep track of max degree of remaining rows */ max_deg = MAX (max_deg, deg) ; } } DEBUG1 (("colamd: Dense and null rows killed: %d\n", n_row - n_row2)) ; /* === Compute initial column scores ==================================== */ /* At this point the row degrees are accurate. They reflect the number */ /* of "live" (non-dense) columns in each row. No empty rows exist. */ /* Some "live" columns may contain only dead rows, however. These are */ /* pruned in the code below. */ /* now find the initial matlab score for each column */ for (c = n_col-1 ; c >= 0 ; c--) { /* skip dead column */ if (COL_IS_DEAD (c)) { continue ; } score = 0 ; cp = &A [Col [c].start] ; new_cp = cp ; cp_end = cp + Col [c].length ; while (cp < cp_end) { /* get a row */ row = *cp++ ; /* skip if dead */ if (ROW_IS_DEAD (row)) { continue ; } /* compact the column */ *new_cp++ = row ; /* add row's external degree */ score += Row [row].shared1.degree - 1 ; /* guard against integer overflow */ score = MIN (score, n_col) ; } /* determine pruned column length */ col_length = (Int) (new_cp - &A [Col [c].start]) ; if (col_length == 0) { /* a newly-made null column (all rows in this col are "dense" */ /* and have already been killed) */ DEBUG2 (("Newly null killed: %d\n", c)) ; Col [c].shared2.order = --n_col2 ; KILL_PRINCIPAL_COL (c) ; } else { /* set column length and set score */ ASSERT (score >= 0) ; ASSERT (score <= n_col) ; Col [c].length = col_length ; Col [c].shared2.score = score ; } } DEBUG1 (("colamd: Dense, null, and newly-null columns killed: %d\n", n_col-n_col2)) ; /* At this point, all empty rows and columns are dead. All live columns */ /* are "clean" (containing no dead rows) and simplicial (no supercolumns */ /* yet). Rows may contain dead columns, but all live rows contain at */ /* least one live column. */ #ifndef NDEBUG debug_structures (n_row, n_col, Row, Col, A, n_col2) ; #endif /* NDEBUG */ /* === Initialize degree lists ========================================== */ #ifndef NDEBUG debug_count = 0 ; #endif /* NDEBUG */ /* clear the hash buckets */ for (c = 0 ; c <= n_col ; c++) { head [c] = EMPTY ; } min_score = n_col ; /* place in reverse order, so low column indices are at the front */ /* of the lists. This is to encourage natural tie-breaking */ for (c = n_col-1 ; c >= 0 ; c--) { /* only add principal columns to degree lists */ if (COL_IS_ALIVE (c)) { DEBUG4 (("place %d score %d minscore %d ncol %d\n", c, Col [c].shared2.score, min_score, n_col)) ; /* === Add columns score to DList =============================== */ score = Col [c].shared2.score ; ASSERT (min_score >= 0) ; ASSERT (min_score <= n_col) ; ASSERT (score >= 0) ; ASSERT (score <= n_col) ; ASSERT (head [score] >= EMPTY) ; /* now add this column to dList at proper score location */ next_col = head [score] ; Col [c].shared3.prev = EMPTY ; Col [c].shared4.degree_next = next_col ; /* if there already was a column with the same score, set its */ /* previous pointer to this new column */ if (next_col != EMPTY) { Col [next_col].shared3.prev = c ; } head [score] = c ; /* see if this score is less than current min */ min_score = MIN (min_score, score) ; #ifndef NDEBUG debug_count++ ; #endif /* NDEBUG */ } } #ifndef NDEBUG DEBUG1 (("colamd: Live cols %d out of %d, non-princ: %d\n", debug_count, n_col, n_col-debug_count)) ; ASSERT (debug_count == n_col2) ; debug_deg_lists (n_row, n_col, Row, Col, head, min_score, n_col2, max_deg) ; #endif /* NDEBUG */ /* === Return number of remaining columns, and max row degree =========== */ *p_n_col2 = n_col2 ; *p_n_row2 = n_row2 ; *p_max_deg = max_deg ; } /* ========================================================================== */ /* === find_ordering ======================================================== */ /* ========================================================================== */ /* Order the principal columns of the supercolumn form of the matrix (no supercolumns on input). Uses a minimum approximate column minimum degree ordering method. Not user-callable. */ PRIVATE Int find_ordering /* return the number of garbage collections */ ( /* === Parameters ======================================================= */ Int n_row, /* number of rows of A */ Int n_col, /* number of columns of A */ Int Alen, /* size of A, 2*nnz + n_col or larger */ Colamd_Row Row [], /* of size n_row+1 */ Colamd_Col Col [], /* of size n_col+1 */ Int A [], /* column form and row form of A */ Int head [], /* of size n_col+1 */ Int n_col2, /* Remaining columns to order */ Int max_deg, /* Maximum row degree */ Int pfree, /* index of first free slot (2*nnz on entry) */ Int aggressive ) { /* === Local variables ================================================== */ Int k ; /* current pivot ordering step */ Int pivot_col ; /* current pivot column */ Int *cp ; /* a column pointer */ Int *rp ; /* a row pointer */ Int pivot_row ; /* current pivot row */ Int *new_cp ; /* modified column pointer */ Int *new_rp ; /* modified row pointer */ Int pivot_row_start ; /* pointer to start of pivot row */ Int pivot_row_degree ; /* number of columns in pivot row */ Int pivot_row_length ; /* number of supercolumns in pivot row */ Int pivot_col_score ; /* score of pivot column */ Int needed_memory ; /* free space needed for pivot row */ Int *cp_end ; /* pointer to the end of a column */ Int *rp_end ; /* pointer to the end of a row */ Int row ; /* a row index */ Int col ; /* a column index */ Int max_score ; /* maximum possible score */ Int cur_score ; /* score of current column */ unsigned Int hash ; /* hash value for supernode detection */ Int head_column ; /* head of hash bucket */ Int first_col ; /* first column in hash bucket */ Int tag_mark ; /* marker value for mark array */ Int row_mark ; /* Row [row].shared2.mark */ Int set_difference ; /* set difference size of row with pivot row */ Int min_score ; /* smallest column score */ Int col_thickness ; /* "thickness" (no. of columns in a supercol) */ Int max_mark ; /* maximum value of tag_mark */ Int pivot_col_thickness ; /* number of columns represented by pivot col */ Int prev_col ; /* Used by Dlist operations. */ Int next_col ; /* Used by Dlist operations. */ Int ngarbage ; /* number of garbage collections performed */ #ifndef NDEBUG Int debug_d ; /* debug loop counter */ Int debug_step = 0 ; /* debug loop counter */ #endif /* NDEBUG */ /* === Initialization and clear mark ==================================== */ max_mark = INT_MAX - n_col ; /* INT_MAX defined in */ tag_mark = clear_mark (0, max_mark, n_row, Row) ; min_score = 0 ; ngarbage = 0 ; DEBUG1 (("colamd: Ordering, n_col2=%d\n", n_col2)) ; /* === Order the columns ================================================ */ for (k = 0 ; k < n_col2 ; /* 'k' is incremented below */) { #ifndef NDEBUG if (debug_step % 100 == 0) { DEBUG2 (("\n... Step k: %d out of n_col2: %d\n", k, n_col2)) ; } else { DEBUG3 (("\n----------Step k: %d out of n_col2: %d\n", k, n_col2)) ; } debug_step++ ; debug_deg_lists (n_row, n_col, Row, Col, head, min_score, n_col2-k, max_deg) ; debug_matrix (n_row, n_col, Row, Col, A) ; #endif /* NDEBUG */ /* === Select pivot column, and order it ============================ */ /* make sure degree list isn't empty */ ASSERT (min_score >= 0) ; ASSERT (min_score <= n_col) ; ASSERT (head [min_score] >= EMPTY) ; #ifndef NDEBUG for (debug_d = 0 ; debug_d < min_score ; debug_d++) { ASSERT (head [debug_d] == EMPTY) ; } #endif /* NDEBUG */ /* get pivot column from head of minimum degree list */ while (head [min_score] == EMPTY && min_score < n_col) { min_score++ ; } pivot_col = head [min_score] ; ASSERT (pivot_col >= 0 && pivot_col <= n_col) ; next_col = Col [pivot_col].shared4.degree_next ; head [min_score] = next_col ; if (next_col != EMPTY) { Col [next_col].shared3.prev = EMPTY ; } ASSERT (COL_IS_ALIVE (pivot_col)) ; /* remember score for defrag check */ pivot_col_score = Col [pivot_col].shared2.score ; /* the pivot column is the kth column in the pivot order */ Col [pivot_col].shared2.order = k ; /* increment order count by column thickness */ pivot_col_thickness = Col [pivot_col].shared1.thickness ; k += pivot_col_thickness ; ASSERT (pivot_col_thickness > 0) ; DEBUG3 (("Pivot col: %d thick %d\n", pivot_col, pivot_col_thickness)) ; /* === Garbage_collection, if necessary ============================= */ needed_memory = MIN (pivot_col_score, n_col - k) ; if (pfree + needed_memory >= Alen) { pfree = garbage_collection (n_row, n_col, Row, Col, A, &A [pfree]) ; ngarbage++ ; /* after garbage collection we will have enough */ ASSERT (pfree + needed_memory < Alen) ; /* garbage collection has wiped out the Row[].shared2.mark array */ tag_mark = clear_mark (0, max_mark, n_row, Row) ; #ifndef NDEBUG debug_matrix (n_row, n_col, Row, Col, A) ; #endif /* NDEBUG */ } /* === Compute pivot row pattern ==================================== */ /* get starting location for this new merged row */ pivot_row_start = pfree ; /* initialize new row counts to zero */ pivot_row_degree = 0 ; /* tag pivot column as having been visited so it isn't included */ /* in merged pivot row */ Col [pivot_col].shared1.thickness = -pivot_col_thickness ; /* pivot row is the union of all rows in the pivot column pattern */ cp = &A [Col [pivot_col].start] ; cp_end = cp + Col [pivot_col].length ; while (cp < cp_end) { /* get a row */ row = *cp++ ; DEBUG4 (("Pivot col pattern %d %d\n", ROW_IS_ALIVE (row), row)) ; /* skip if row is dead */ if (ROW_IS_ALIVE (row)) { rp = &A [Row [row].start] ; rp_end = rp + Row [row].length ; while (rp < rp_end) { /* get a column */ col = *rp++ ; /* add the column, if alive and untagged */ col_thickness = Col [col].shared1.thickness ; if (col_thickness > 0 && COL_IS_ALIVE (col)) { /* tag column in pivot row */ Col [col].shared1.thickness = -col_thickness ; ASSERT (pfree < Alen) ; /* place column in pivot row */ A [pfree++] = col ; pivot_row_degree += col_thickness ; } } } } /* clear tag on pivot column */ Col [pivot_col].shared1.thickness = pivot_col_thickness ; max_deg = MAX (max_deg, pivot_row_degree) ; #ifndef NDEBUG DEBUG3 (("check2\n")) ; debug_mark (n_row, Row, tag_mark, max_mark) ; #endif /* NDEBUG */ /* === Kill all rows used to construct pivot row ==================== */ /* also kill pivot row, temporarily */ cp = &A [Col [pivot_col].start] ; cp_end = cp + Col [pivot_col].length ; while (cp < cp_end) { /* may be killing an already dead row */ row = *cp++ ; DEBUG3 (("Kill row in pivot col: %d\n", row)) ; KILL_ROW (row) ; } /* === Select a row index to use as the new pivot row =============== */ pivot_row_length = pfree - pivot_row_start ; if (pivot_row_length > 0) { /* pick the "pivot" row arbitrarily (first row in col) */ pivot_row = A [Col [pivot_col].start] ; DEBUG3 (("Pivotal row is %d\n", pivot_row)) ; } else { /* there is no pivot row, since it is of zero length */ pivot_row = EMPTY ; ASSERT (pivot_row_length == 0) ; } ASSERT (Col [pivot_col].length > 0 || pivot_row_length == 0) ; /* === Approximate degree computation =============================== */ /* Here begins the computation of the approximate degree. The column */ /* score is the sum of the pivot row "length", plus the size of the */ /* set differences of each row in the column minus the pattern of the */ /* pivot row itself. The column ("thickness") itself is also */ /* excluded from the column score (we thus use an approximate */ /* external degree). */ /* The time taken by the following code (compute set differences, and */ /* add them up) is proportional to the size of the data structure */ /* being scanned - that is, the sum of the sizes of each column in */ /* the pivot row. Thus, the amortized time to compute a column score */ /* is proportional to the size of that column (where size, in this */ /* context, is the column "length", or the number of row indices */ /* in that column). The number of row indices in a column is */ /* monotonically non-decreasing, from the length of the original */ /* column on input to colamd. */ /* === Compute set differences ====================================== */ DEBUG3 (("** Computing set differences phase. **\n")) ; /* pivot row is currently dead - it will be revived later. */ DEBUG3 (("Pivot row: ")) ; /* for each column in pivot row */ rp = &A [pivot_row_start] ; rp_end = rp + pivot_row_length ; while (rp < rp_end) { col = *rp++ ; ASSERT (COL_IS_ALIVE (col) && col != pivot_col) ; DEBUG3 (("Col: %d\n", col)) ; /* clear tags used to construct pivot row pattern */ col_thickness = -Col [col].shared1.thickness ; ASSERT (col_thickness > 0) ; Col [col].shared1.thickness = col_thickness ; /* === Remove column from degree list =========================== */ cur_score = Col [col].shared2.score ; prev_col = Col [col].shared3.prev ; next_col = Col [col].shared4.degree_next ; ASSERT (cur_score >= 0) ; ASSERT (cur_score <= n_col) ; ASSERT (cur_score >= EMPTY) ; if (prev_col == EMPTY) { head [cur_score] = next_col ; } else { Col [prev_col].shared4.degree_next = next_col ; } if (next_col != EMPTY) { Col [next_col].shared3.prev = prev_col ; } /* === Scan the column ========================================== */ cp = &A [Col [col].start] ; cp_end = cp + Col [col].length ; while (cp < cp_end) { /* get a row */ row = *cp++ ; row_mark = Row [row].shared2.mark ; /* skip if dead */ if (ROW_IS_MARKED_DEAD (row_mark)) { continue ; } ASSERT (row != pivot_row) ; set_difference = row_mark - tag_mark ; /* check if the row has been seen yet */ if (set_difference < 0) { ASSERT (Row [row].shared1.degree <= max_deg) ; set_difference = Row [row].shared1.degree ; } /* subtract column thickness from this row's set difference */ set_difference -= col_thickness ; ASSERT (set_difference >= 0) ; /* absorb this row if the set difference becomes zero */ if (set_difference == 0 && aggressive) { DEBUG3 (("aggressive absorption. Row: %d\n", row)) ; KILL_ROW (row) ; } else { /* save the new mark */ Row [row].shared2.mark = set_difference + tag_mark ; } } } #ifndef NDEBUG debug_deg_lists (n_row, n_col, Row, Col, head, min_score, n_col2-k-pivot_row_degree, max_deg) ; #endif /* NDEBUG */ /* === Add up set differences for each column ======================= */ DEBUG3 (("** Adding set differences phase. **\n")) ; /* for each column in pivot row */ rp = &A [pivot_row_start] ; rp_end = rp + pivot_row_length ; while (rp < rp_end) { /* get a column */ col = *rp++ ; ASSERT (COL_IS_ALIVE (col) && col != pivot_col) ; hash = 0 ; cur_score = 0 ; cp = &A [Col [col].start] ; /* compact the column */ new_cp = cp ; cp_end = cp + Col [col].length ; DEBUG4 (("Adding set diffs for Col: %d.\n", col)) ; while (cp < cp_end) { /* get a row */ row = *cp++ ; ASSERT(row >= 0 && row < n_row) ; row_mark = Row [row].shared2.mark ; /* skip if dead */ if (ROW_IS_MARKED_DEAD (row_mark)) { DEBUG4 ((" Row %d, dead\n", row)) ; continue ; } DEBUG4 ((" Row %d, set diff %d\n", row, row_mark-tag_mark)); ASSERT (row_mark >= tag_mark) ; /* compact the column */ *new_cp++ = row ; /* compute hash function */ hash += row ; /* add set difference */ cur_score += row_mark - tag_mark ; /* integer overflow... */ cur_score = MIN (cur_score, n_col) ; } /* recompute the column's length */ Col [col].length = (Int) (new_cp - &A [Col [col].start]) ; /* === Further mass elimination ================================= */ if (Col [col].length == 0) { DEBUG4 (("further mass elimination. Col: %d\n", col)) ; /* nothing left but the pivot row in this column */ KILL_PRINCIPAL_COL (col) ; pivot_row_degree -= Col [col].shared1.thickness ; ASSERT (pivot_row_degree >= 0) ; /* order it */ Col [col].shared2.order = k ; /* increment order count by column thickness */ k += Col [col].shared1.thickness ; } else { /* === Prepare for supercolumn detection ==================== */ DEBUG4 (("Preparing supercol detection for Col: %d.\n", col)) ; /* save score so far */ Col [col].shared2.score = cur_score ; /* add column to hash table, for supercolumn detection */ hash %= n_col + 1 ; DEBUG4 ((" Hash = %d, n_col = %d.\n", hash, n_col)) ; ASSERT (((Int) hash) <= n_col) ; head_column = head [hash] ; if (head_column > EMPTY) { /* degree list "hash" is non-empty, use prev (shared3) of */ /* first column in degree list as head of hash bucket */ first_col = Col [head_column].shared3.headhash ; Col [head_column].shared3.headhash = col ; } else { /* degree list "hash" is empty, use head as hash bucket */ first_col = - (head_column + 2) ; head [hash] = - (col + 2) ; } Col [col].shared4.hash_next = first_col ; /* save hash function in Col [col].shared3.hash */ Col [col].shared3.hash = (Int) hash ; ASSERT (COL_IS_ALIVE (col)) ; } } /* The approximate external column degree is now computed. */ /* === Supercolumn detection ======================================== */ DEBUG3 (("** Supercolumn detection phase. **\n")) ; detect_super_cols ( #ifndef NDEBUG n_col, Row, #endif /* NDEBUG */ Col, A, head, pivot_row_start, pivot_row_length) ; /* === Kill the pivotal column ====================================== */ KILL_PRINCIPAL_COL (pivot_col) ; /* === Clear mark =================================================== */ tag_mark = clear_mark (tag_mark+max_deg+1, max_mark, n_row, Row) ; #ifndef NDEBUG DEBUG3 (("check3\n")) ; debug_mark (n_row, Row, tag_mark, max_mark) ; #endif /* NDEBUG */ /* === Finalize the new pivot row, and column scores ================ */ DEBUG3 (("** Finalize scores phase. **\n")) ; /* for each column in pivot row */ rp = &A [pivot_row_start] ; /* compact the pivot row */ new_rp = rp ; rp_end = rp + pivot_row_length ; while (rp < rp_end) { col = *rp++ ; /* skip dead columns */ if (COL_IS_DEAD (col)) { continue ; } *new_rp++ = col ; /* add new pivot row to column */ A [Col [col].start + (Col [col].length++)] = pivot_row ; /* retrieve score so far and add on pivot row's degree. */ /* (we wait until here for this in case the pivot */ /* row's degree was reduced due to mass elimination). */ cur_score = Col [col].shared2.score + pivot_row_degree ; /* calculate the max possible score as the number of */ /* external columns minus the 'k' value minus the */ /* columns thickness */ max_score = n_col - k - Col [col].shared1.thickness ; /* make the score the external degree of the union-of-rows */ cur_score -= Col [col].shared1.thickness ; /* make sure score is less or equal than the max score */ cur_score = MIN (cur_score, max_score) ; ASSERT (cur_score >= 0) ; /* store updated score */ Col [col].shared2.score = cur_score ; /* === Place column back in degree list ========================= */ ASSERT (min_score >= 0) ; ASSERT (min_score <= n_col) ; ASSERT (cur_score >= 0) ; ASSERT (cur_score <= n_col) ; ASSERT (head [cur_score] >= EMPTY) ; next_col = head [cur_score] ; Col [col].shared4.degree_next = next_col ; Col [col].shared3.prev = EMPTY ; if (next_col != EMPTY) { Col [next_col].shared3.prev = col ; } head [cur_score] = col ; /* see if this score is less than current min */ min_score = MIN (min_score, cur_score) ; } #ifndef NDEBUG debug_deg_lists (n_row, n_col, Row, Col, head, min_score, n_col2-k, max_deg) ; #endif /* NDEBUG */ /* === Resurrect the new pivot row ================================== */ if (pivot_row_degree > 0) { /* update pivot row length to reflect any cols that were killed */ /* during super-col detection and mass elimination */ Row [pivot_row].start = pivot_row_start ; Row [pivot_row].length = (Int) (new_rp - &A[pivot_row_start]) ; ASSERT (Row [pivot_row].length > 0) ; Row [pivot_row].shared1.degree = pivot_row_degree ; Row [pivot_row].shared2.mark = 0 ; /* pivot row is no longer dead */ DEBUG1 (("Resurrect Pivot_row %d deg: %d\n", pivot_row, pivot_row_degree)) ; } } /* === All principal columns have now been ordered ====================== */ return (ngarbage) ; } /* ========================================================================== */ /* === order_children ======================================================= */ /* ========================================================================== */ /* The find_ordering routine has ordered all of the principal columns (the representatives of the supercolumns). The non-principal columns have not yet been ordered. This routine orders those columns by walking up the parent tree (a column is a child of the column which absorbed it). The final permutation vector is then placed in p [0 ... n_col-1], with p [0] being the first column, and p [n_col-1] being the last. It doesn't look like it at first glance, but be assured that this routine takes time linear in the number of columns. Although not immediately obvious, the time taken by this routine is O (n_col), that is, linear in the number of columns. Not user-callable. */ PRIVATE void order_children ( /* === Parameters ======================================================= */ Int n_col, /* number of columns of A */ Colamd_Col Col [], /* of size n_col+1 */ Int p [] /* p [0 ... n_col-1] is the column permutation*/ ) { /* === Local variables ================================================== */ Int i ; /* loop counter for all columns */ Int c ; /* column index */ Int parent ; /* index of column's parent */ Int order ; /* column's order */ /* === Order each non-principal column ================================== */ for (i = 0 ; i < n_col ; i++) { /* find an un-ordered non-principal column */ ASSERT (COL_IS_DEAD (i)) ; if (!COL_IS_DEAD_PRINCIPAL (i) && Col [i].shared2.order == EMPTY) { parent = i ; /* once found, find its principal parent */ do { parent = Col [parent].shared1.parent ; } while (!COL_IS_DEAD_PRINCIPAL (parent)) ; /* now, order all un-ordered non-principal columns along path */ /* to this parent. collapse tree at the same time */ c = i ; /* get order of parent */ order = Col [parent].shared2.order ; do { ASSERT (Col [c].shared2.order == EMPTY) ; /* order this column */ Col [c].shared2.order = order++ ; /* collaps tree */ Col [c].shared1.parent = parent ; /* get immediate parent of this column */ c = Col [c].shared1.parent ; /* continue until we hit an ordered column. There are */ /* guarranteed not to be anymore unordered columns */ /* above an ordered column */ } while (Col [c].shared2.order == EMPTY) ; /* re-order the super_col parent to largest order for this group */ Col [parent].shared2.order = order ; } } /* === Generate the permutation ========================================= */ for (c = 0 ; c < n_col ; c++) { p [Col [c].shared2.order] = c ; } } /* ========================================================================== */ /* === detect_super_cols ==================================================== */ /* ========================================================================== */ /* Detects supercolumns by finding matches between columns in the hash buckets. Check amongst columns in the set A [row_start ... row_start + row_length-1]. The columns under consideration are currently *not* in the degree lists, and have already been placed in the hash buckets. The hash bucket for columns whose hash function is equal to h is stored as follows: if head [h] is >= 0, then head [h] contains a degree list, so: head [h] is the first column in degree bucket h. Col [head [h]].headhash gives the first column in hash bucket h. otherwise, the degree list is empty, and: -(head [h] + 2) is the first column in hash bucket h. For a column c in a hash bucket, Col [c].shared3.prev is NOT a "previous column" pointer. Col [c].shared3.hash is used instead as the hash number for that column. The value of Col [c].shared4.hash_next is the next column in the same hash bucket. Assuming no, or "few" hash collisions, the time taken by this routine is linear in the sum of the sizes (lengths) of each column whose score has just been computed in the approximate degree computation. Not user-callable. */ PRIVATE void detect_super_cols ( /* === Parameters ======================================================= */ #ifndef NDEBUG /* these two parameters are only needed when debugging is enabled: */ Int n_col, /* number of columns of A */ Colamd_Row Row [], /* of size n_row+1 */ #endif /* NDEBUG */ Colamd_Col Col [], /* of size n_col+1 */ Int A [], /* row indices of A */ Int head [], /* head of degree lists and hash buckets */ Int row_start, /* pointer to set of columns to check */ Int row_length /* number of columns to check */ ) { /* === Local variables ================================================== */ Int hash ; /* hash value for a column */ Int *rp ; /* pointer to a row */ Int c ; /* a column index */ Int super_c ; /* column index of the column to absorb into */ Int *cp1 ; /* column pointer for column super_c */ Int *cp2 ; /* column pointer for column c */ Int length ; /* length of column super_c */ Int prev_c ; /* column preceding c in hash bucket */ Int i ; /* loop counter */ Int *rp_end ; /* pointer to the end of the row */ Int col ; /* a column index in the row to check */ Int head_column ; /* first column in hash bucket or degree list */ Int first_col ; /* first column in hash bucket */ /* === Consider each column in the row ================================== */ rp = &A [row_start] ; rp_end = rp + row_length ; while (rp < rp_end) { col = *rp++ ; if (COL_IS_DEAD (col)) { continue ; } /* get hash number for this column */ hash = Col [col].shared3.hash ; ASSERT (hash <= n_col) ; /* === Get the first column in this hash bucket ===================== */ head_column = head [hash] ; if (head_column > EMPTY) { first_col = Col [head_column].shared3.headhash ; } else { first_col = - (head_column + 2) ; } /* === Consider each column in the hash bucket ====================== */ for (super_c = first_col ; super_c != EMPTY ; super_c = Col [super_c].shared4.hash_next) { ASSERT (COL_IS_ALIVE (super_c)) ; ASSERT (Col [super_c].shared3.hash == hash) ; length = Col [super_c].length ; /* prev_c is the column preceding column c in the hash bucket */ prev_c = super_c ; /* === Compare super_c with all columns after it ================ */ for (c = Col [super_c].shared4.hash_next ; c != EMPTY ; c = Col [c].shared4.hash_next) { ASSERT (c != super_c) ; ASSERT (COL_IS_ALIVE (c)) ; ASSERT (Col [c].shared3.hash == hash) ; /* not identical if lengths or scores are different */ if (Col [c].length != length || Col [c].shared2.score != Col [super_c].shared2.score) { prev_c = c ; continue ; } /* compare the two columns */ cp1 = &A [Col [super_c].start] ; cp2 = &A [Col [c].start] ; for (i = 0 ; i < length ; i++) { /* the columns are "clean" (no dead rows) */ ASSERT (ROW_IS_ALIVE (*cp1)) ; ASSERT (ROW_IS_ALIVE (*cp2)) ; /* row indices will same order for both supercols, */ /* no gather scatter nessasary */ if (*cp1++ != *cp2++) { break ; } } /* the two columns are different if the for-loop "broke" */ if (i != length) { prev_c = c ; continue ; } /* === Got it! two columns are identical =================== */ ASSERT (Col [c].shared2.score == Col [super_c].shared2.score) ; Col [super_c].shared1.thickness += Col [c].shared1.thickness ; Col [c].shared1.parent = super_c ; KILL_NON_PRINCIPAL_COL (c) ; /* order c later, in order_children() */ Col [c].shared2.order = EMPTY ; /* remove c from hash bucket */ Col [prev_c].shared4.hash_next = Col [c].shared4.hash_next ; } } /* === Empty this hash bucket ======================================= */ if (head_column > EMPTY) { /* corresponding degree list "hash" is not empty */ Col [head_column].shared3.headhash = EMPTY ; } else { /* corresponding degree list "hash" is empty */ head [hash] = EMPTY ; } } } /* ========================================================================== */ /* === garbage_collection =================================================== */ /* ========================================================================== */ /* Defragments and compacts columns and rows in the workspace A. Used when all avaliable memory has been used while performing row merging. Returns the index of the first free position in A, after garbage collection. The time taken by this routine is linear is the size of the array A, which is itself linear in the number of nonzeros in the input matrix. Not user-callable. */ PRIVATE Int garbage_collection /* returns the new value of pfree */ ( /* === Parameters ======================================================= */ Int n_row, /* number of rows */ Int n_col, /* number of columns */ Colamd_Row Row [], /* row info */ Colamd_Col Col [], /* column info */ Int A [], /* A [0 ... Alen-1] holds the matrix */ Int *pfree /* &A [0] ... pfree is in use */ ) { /* === Local variables ================================================== */ Int *psrc ; /* source pointer */ Int *pdest ; /* destination pointer */ Int j ; /* counter */ Int r ; /* a row index */ Int c ; /* a column index */ Int length ; /* length of a row or column */ #ifndef NDEBUG Int debug_rows ; DEBUG2 (("Defrag..\n")) ; for (psrc = &A[0] ; psrc < pfree ; psrc++) ASSERT (*psrc >= 0) ; debug_rows = 0 ; #endif /* NDEBUG */ /* === Defragment the columns =========================================== */ pdest = &A[0] ; for (c = 0 ; c < n_col ; c++) { if (COL_IS_ALIVE (c)) { psrc = &A [Col [c].start] ; /* move and compact the column */ ASSERT (pdest <= psrc) ; Col [c].start = (Int) (pdest - &A [0]) ; length = Col [c].length ; for (j = 0 ; j < length ; j++) { r = *psrc++ ; if (ROW_IS_ALIVE (r)) { *pdest++ = r ; } } Col [c].length = (Int) (pdest - &A [Col [c].start]) ; } } /* === Prepare to defragment the rows =================================== */ for (r = 0 ; r < n_row ; r++) { if (ROW_IS_DEAD (r) || (Row [r].length == 0)) { /* This row is already dead, or is of zero length. Cannot compact * a row of zero length, so kill it. NOTE: in the current version, * there are no zero-length live rows. Kill the row (for the first * time, or again) just to be safe. */ KILL_ROW (r) ; } else { /* save first column index in Row [r].shared2.first_column */ psrc = &A [Row [r].start] ; Row [r].shared2.first_column = *psrc ; ASSERT (ROW_IS_ALIVE (r)) ; /* flag the start of the row with the one's complement of row */ *psrc = ONES_COMPLEMENT (r) ; #ifndef NDEBUG debug_rows++ ; #endif /* NDEBUG */ } } /* === Defragment the rows ============================================== */ psrc = pdest ; while (psrc < pfree) { /* find a negative number ... the start of a row */ if (*psrc++ < 0) { psrc-- ; /* get the row index */ r = ONES_COMPLEMENT (*psrc) ; ASSERT (r >= 0 && r < n_row) ; /* restore first column index */ *psrc = Row [r].shared2.first_column ; ASSERT (ROW_IS_ALIVE (r)) ; ASSERT (Row [r].length > 0) ; /* move and compact the row */ ASSERT (pdest <= psrc) ; Row [r].start = (Int) (pdest - &A [0]) ; length = Row [r].length ; for (j = 0 ; j < length ; j++) { c = *psrc++ ; if (COL_IS_ALIVE (c)) { *pdest++ = c ; } } Row [r].length = (Int) (pdest - &A [Row [r].start]) ; ASSERT (Row [r].length > 0) ; #ifndef NDEBUG debug_rows-- ; #endif /* NDEBUG */ } } /* ensure we found all the rows */ ASSERT (debug_rows == 0) ; /* === Return the new value of pfree ==================================== */ return ((Int) (pdest - &A [0])) ; } /* ========================================================================== */ /* === clear_mark =========================================================== */ /* ========================================================================== */ /* Clears the Row [].shared2.mark array, and returns the new tag_mark. Return value is the new tag_mark. Not user-callable. */ PRIVATE Int clear_mark /* return the new value for tag_mark */ ( /* === Parameters ======================================================= */ Int tag_mark, /* new value of tag_mark */ Int max_mark, /* max allowed value of tag_mark */ Int n_row, /* number of rows in A */ Colamd_Row Row [] /* Row [0 ... n_row-1].shared2.mark is set to zero */ ) { /* === Local variables ================================================== */ Int r ; if (tag_mark <= 0 || tag_mark >= max_mark) { for (r = 0 ; r < n_row ; r++) { if (ROW_IS_ALIVE (r)) { Row [r].shared2.mark = 0 ; } } tag_mark = 1 ; } return (tag_mark) ; } /* ========================================================================== */ /* === print_report ========================================================= */ /* ========================================================================== */ PRIVATE void print_report ( char *method, Int stats [COLAMD_STATS] ) { Int i1, i2, i3 ; SUITESPARSE_PRINTF (("\n%s version %d.%d, %s: ", method, COLAMD_MAIN_VERSION, COLAMD_SUB_VERSION, COLAMD_DATE)) ; if (!stats) { SUITESPARSE_PRINTF (("No statistics available.\n")) ; return ; } i1 = stats [COLAMD_INFO1] ; i2 = stats [COLAMD_INFO2] ; i3 = stats [COLAMD_INFO3] ; if (stats [COLAMD_STATUS] >= 0) { SUITESPARSE_PRINTF (("OK. ")) ; } else { SUITESPARSE_PRINTF (("ERROR. ")) ; } switch (stats [COLAMD_STATUS]) { case COLAMD_OK_BUT_JUMBLED: SUITESPARSE_PRINTF(( "Matrix has unsorted or duplicate row indices.\n")) ; SUITESPARSE_PRINTF(( "%s: number of duplicate or out-of-order row indices: %d\n", method, i3)) ; SUITESPARSE_PRINTF(( "%s: last seen duplicate or out-of-order row index: %d\n", method, INDEX (i2))) ; SUITESPARSE_PRINTF(( "%s: last seen in column: %d", method, INDEX (i1))) ; /* no break - fall through to next case instead */ case COLAMD_OK: SUITESPARSE_PRINTF(("\n")) ; SUITESPARSE_PRINTF(( "%s: number of dense or empty rows ignored: %d\n", method, stats [COLAMD_DENSE_ROW])) ; SUITESPARSE_PRINTF(( "%s: number of dense or empty columns ignored: %d\n", method, stats [COLAMD_DENSE_COL])) ; SUITESPARSE_PRINTF(( "%s: number of garbage collections performed: %d\n", method, stats [COLAMD_DEFRAG_COUNT])) ; break ; case COLAMD_ERROR_A_not_present: SUITESPARSE_PRINTF(( "Array A (row indices of matrix) not present.\n")) ; break ; case COLAMD_ERROR_p_not_present: SUITESPARSE_PRINTF(( "Array p (column pointers for matrix) not present.\n")) ; break ; case COLAMD_ERROR_nrow_negative: SUITESPARSE_PRINTF(("Invalid number of rows (%d).\n", i1)) ; break ; case COLAMD_ERROR_ncol_negative: SUITESPARSE_PRINTF(("Invalid number of columns (%d).\n", i1)) ; break ; case COLAMD_ERROR_nnz_negative: SUITESPARSE_PRINTF(( "Invalid number of nonzero entries (%d).\n", i1)) ; break ; case COLAMD_ERROR_p0_nonzero: SUITESPARSE_PRINTF(( "Invalid column pointer, p [0] = %d, must be zero.\n", i1)); break ; case COLAMD_ERROR_A_too_small: SUITESPARSE_PRINTF(("Array A too small.\n")) ; SUITESPARSE_PRINTF(( " Need Alen >= %d, but given only Alen = %d.\n", i1, i2)) ; break ; case COLAMD_ERROR_col_length_negative: SUITESPARSE_PRINTF (("Column %d has a negative number of nonzero entries (%d).\n", INDEX (i1), i2)) ; break ; case COLAMD_ERROR_row_index_out_of_bounds: SUITESPARSE_PRINTF (("Row index (row %d) out of bounds (%d to %d) in column %d.\n", INDEX (i2), INDEX (0), INDEX (i3-1), INDEX (i1))) ; break ; case COLAMD_ERROR_out_of_memory: SUITESPARSE_PRINTF(("Out of memory.\n")) ; break ; /* v2.4: internal-error case deleted */ } } /* ========================================================================== */ /* === colamd debugging routines ============================================ */ /* ========================================================================== */ /* When debugging is disabled, the remainder of this file is ignored. */ #ifndef NDEBUG /* ========================================================================== */ /* === debug_structures ===================================================== */ /* ========================================================================== */ /* At this point, all empty rows and columns are dead. All live columns are "clean" (containing no dead rows) and simplicial (no supercolumns yet). Rows may contain dead columns, but all live rows contain at least one live column. */ PRIVATE void debug_structures ( /* === Parameters ======================================================= */ Int n_row, Int n_col, Colamd_Row Row [], Colamd_Col Col [], Int A [], Int n_col2 ) { /* === Local variables ================================================== */ Int i ; Int c ; Int *cp ; Int *cp_end ; Int len ; Int score ; Int r ; Int *rp ; Int *rp_end ; Int deg ; /* === Check A, Row, and Col ============================================ */ for (c = 0 ; c < n_col ; c++) { if (COL_IS_ALIVE (c)) { len = Col [c].length ; score = Col [c].shared2.score ; DEBUG4 (("initial live col %5d %5d %5d\n", c, len, score)) ; ASSERT (len > 0) ; ASSERT (score >= 0) ; ASSERT (Col [c].shared1.thickness == 1) ; cp = &A [Col [c].start] ; cp_end = cp + len ; while (cp < cp_end) { r = *cp++ ; ASSERT (ROW_IS_ALIVE (r)) ; } } else { i = Col [c].shared2.order ; ASSERT (i >= n_col2 && i < n_col) ; } } for (r = 0 ; r < n_row ; r++) { if (ROW_IS_ALIVE (r)) { i = 0 ; len = Row [r].length ; deg = Row [r].shared1.degree ; ASSERT (len > 0) ; ASSERT (deg > 0) ; rp = &A [Row [r].start] ; rp_end = rp + len ; while (rp < rp_end) { c = *rp++ ; if (COL_IS_ALIVE (c)) { i++ ; } } ASSERT (i > 0) ; } } } /* ========================================================================== */ /* === debug_deg_lists ====================================================== */ /* ========================================================================== */ /* Prints the contents of the degree lists. Counts the number of columns in the degree list and compares it to the total it should have. Also checks the row degrees. */ PRIVATE void debug_deg_lists ( /* === Parameters ======================================================= */ Int n_row, Int n_col, Colamd_Row Row [], Colamd_Col Col [], Int head [], Int min_score, Int should, Int max_deg ) { /* === Local variables ================================================== */ Int deg ; Int col ; Int have ; Int row ; /* === Check the degree lists =========================================== */ if (n_col > 10000 && colamd_debug <= 0) { return ; } have = 0 ; DEBUG4 (("Degree lists: %d\n", min_score)) ; for (deg = 0 ; deg <= n_col ; deg++) { col = head [deg] ; if (col == EMPTY) { continue ; } DEBUG4 (("%d:", deg)) ; while (col != EMPTY) { DEBUG4 ((" %d", col)) ; have += Col [col].shared1.thickness ; ASSERT (COL_IS_ALIVE (col)) ; col = Col [col].shared4.degree_next ; } DEBUG4 (("\n")) ; } DEBUG4 (("should %d have %d\n", should, have)) ; ASSERT (should == have) ; /* === Check the row degrees ============================================ */ if (n_row > 10000 && colamd_debug <= 0) { return ; } for (row = 0 ; row < n_row ; row++) { if (ROW_IS_ALIVE (row)) { ASSERT (Row [row].shared1.degree <= max_deg) ; } } } /* ========================================================================== */ /* === debug_mark =========================================================== */ /* ========================================================================== */ /* Ensures that the tag_mark is less that the maximum and also ensures that each entry in the mark array is less than the tag mark. */ PRIVATE void debug_mark ( /* === Parameters ======================================================= */ Int n_row, Colamd_Row Row [], Int tag_mark, Int max_mark ) { /* === Local variables ================================================== */ Int r ; /* === Check the Row marks ============================================== */ ASSERT (tag_mark > 0 && tag_mark <= max_mark) ; if (n_row > 10000 && colamd_debug <= 0) { return ; } for (r = 0 ; r < n_row ; r++) { ASSERT (Row [r].shared2.mark < tag_mark) ; } } /* ========================================================================== */ /* === debug_matrix ========================================================= */ /* ========================================================================== */ /* Prints out the contents of the columns and the rows. */ PRIVATE void debug_matrix ( /* === Parameters ======================================================= */ Int n_row, Int n_col, Colamd_Row Row [], Colamd_Col Col [], Int A [] ) { /* === Local variables ================================================== */ Int r ; Int c ; Int *rp ; Int *rp_end ; Int *cp ; Int *cp_end ; /* === Dump the rows and columns of the matrix ========================== */ if (colamd_debug < 3) { return ; } DEBUG3 (("DUMP MATRIX:\n")) ; for (r = 0 ; r < n_row ; r++) { DEBUG3 (("Row %d alive? %d\n", r, ROW_IS_ALIVE (r))) ; if (ROW_IS_DEAD (r)) { continue ; } DEBUG3 (("start %d length %d degree %d\n", Row [r].start, Row [r].length, Row [r].shared1.degree)) ; rp = &A [Row [r].start] ; rp_end = rp + Row [r].length ; while (rp < rp_end) { c = *rp++ ; DEBUG4 ((" %d col %d\n", COL_IS_ALIVE (c), c)) ; } } for (c = 0 ; c < n_col ; c++) { DEBUG3 (("Col %d alive? %d\n", c, COL_IS_ALIVE (c))) ; if (COL_IS_DEAD (c)) { continue ; } DEBUG3 (("start %d length %d shared1 %d shared2 %d\n", Col [c].start, Col [c].length, Col [c].shared1.thickness, Col [c].shared2.score)) ; cp = &A [Col [c].start] ; cp_end = cp + Col [c].length ; while (cp < cp_end) { r = *cp++ ; DEBUG4 ((" %d row %d\n", ROW_IS_ALIVE (r), r)) ; } } } PRIVATE void colamd_get_debug ( char *method ) { FILE *f ; colamd_debug = 0 ; /* no debug printing */ f = fopen ("debug", "r") ; if (f == (FILE *) NULL) { colamd_debug = 0 ; } else { fscanf (f, "%d", &colamd_debug) ; fclose (f) ; } DEBUG0 (("%s: debug version, D = %d (THIS WILL BE SLOW!)\n", method, colamd_debug)) ; } #endif /* NDEBUG */ Matrix/src/TMatrix_as.h0000644000176200001440000000062710557453135014546 0ustar liggesusers#ifndef MATRIX_TRS_H #define MATRIX_TRS_H #include "Mutils.h" SEXP dsTMatrix_as_dsyMatrix(SEXP x); SEXP lsTMatrix_as_lsyMatrix(SEXP x); SEXP nsTMatrix_as_nsyMatrix(SEXP x); SEXP dtTMatrix_as_dtrMatrix(SEXP x); SEXP ltTMatrix_as_ltrMatrix(SEXP x); SEXP ntTMatrix_as_ntrMatrix(SEXP x); SEXP dsTMatrix_as_dgTMatrix(SEXP x); SEXP lsTMatrix_as_lgTMatrix(SEXP x); SEXP nsTMatrix_as_ngTMatrix(SEXP x); #endif Matrix/src/t_Matrix_rle.c0000644000176200001440000000467711643347276015135 0ustar liggesusers/*------ Definition of a template for Matrix_rle_[di](...) : * * -------- ~~~~~~~~~~~~~~~~~~~~~~ * i.e., included several times from ./abIndex.c * ~~~~~~~~~~~ */ /* for all cases with an 'x' slot -- i.e. almost all cases ; * just redefine this in the other cases: */ #ifdef _rle_d_ # define Matrix_RLE_ Matrix_rle_d # define Type_x_ double # define STYP_x_ REAL # define SXP_ans REALSXP #elif defined _rle_i_ # define Matrix_RLE_ Matrix_rle_i # define Type_x_ int # define STYP_x_ INTEGER # define SXP_ans INTSXP #else # error "invalid _rle_ macro logic" #endif /** * RLE (Run Length Encoding) -- only when it's worth * * @param x_ R vector which can be coerced to "double" / "integer" * @param force_ R logical indicating if the result must be "RLE" even when inefficient * * @return NULL or a valid R object of class "rle" */ SEXP Matrix_RLE_(SEXP x_, SEXP force_) { int n = LENGTH(PROTECT(x_ = coerceVector(x_, SXP_ans))); Rboolean no_force = !asLogical(force_); if (no_force && n < 3) { UNPROTECT(1); return R_NilValue; } else { register Type_x_ lv; register int ln, i, c = 0; int n2 = (no_force) ? n / 3 : n; /* upper bound: ==> max RAM requirement 2 x n2, (= 2/3 n); * using 2 instead of 3 would need 50% more time, have max * RAM requirement 2.5x for savings of any size */ Type_x_ *x = STYP_x_(x_), *val; int *len; const char *res_nms[] = {"lengths", "values", ""}; SEXP ans; if(n > 0) { /* needed for force=TRUE */ len = Calloc(n2, int); val = Calloc(n2, Type_x_); lv = x[0]; ln = 1; for(i = 1; i < n; i++) { if (x[i] == lv) { ln++; } else { val[c] = lv; len[c] = ln; c++; if (no_force && c == n2) { /* reached the "efficiency bound" */ Free(len); Free(val); UNPROTECT(1); return R_NilValue; } lv = x[i]; ln = 1; } } val[c] = lv; len[c] = ln; c++; } ans = PROTECT(Rf_mkNamed(VECSXP, res_nms)); SET_VECTOR_ELT(ans, 0, allocVector(INTSXP, c)); /* lengths */ SET_VECTOR_ELT(ans, 1, allocVector(SXP_ans, c)); /* values */ if(n > 0) { Memcpy(INTEGER(VECTOR_ELT(ans, 0)), len, c); Memcpy(STYP_x_(VECTOR_ELT(ans, 1)), val, c); } setAttrib(ans, R_ClassSymbol, mkString("rle")); if(n > 0) { Free(len); Free(val); } UNPROTECT(2); return ans; } } /* Matrix_RLE_() template */ #undef Matrix_RLE_ #undef Type_x_ #undef STYP_x_ #undef SXP_ans Matrix/src/CHMfactor.h0000644000176200001440000000113211743530637014272 0ustar liggesusers#ifndef MATRIX_CHMFACTOR_H #define MATRIX_CHMFACTOR_H #include "Mutils.h" #include "chm_common.h" SEXP CHMfactor_ldetL2(SEXP x); SEXP CHMfactor_to_sparse(SEXP x); SEXP CHMfactor_solve(SEXP a, SEXP b, SEXP type); SEXP CHMfactor_spsolve(SEXP a, SEXP b, SEXP type); SEXP CHMfactor_update(SEXP object, SEXP parent, SEXP mult); SEXP destructive_CHM_update(SEXP object, SEXP parent, SEXP mult); SEXP CHMfactor_ldetL2up(SEXP x, SEXP parent, SEXP mult); double chm_factor_ldetL2(CHM_FR f); CHM_FR chm_factor_update(CHM_FR f, CHM_SP A, double fac); SEXP CHMfactor_updown(SEXP update, SEXP C, SEXP L); #endif Matrix/src/abIndex.c0000644000176200001440000000102012506222056014014 0ustar liggesusers/** @file abIndex.c * C-level Methods for the ``abstract Index'' class * * Note: this heavily builds on ideas and code from Jens Oehlschlaegel, * ---- as implemented (in the GPL'ed part of) package 'ff'. */ #include "abIndex.h" /** * RLE (Run Length Encoding) -- only when it's worth * * @param x R vector which can be coerced to "integer" * * @return NULL or a valid R object of class "rle" */ #define _rle_d_ #include "t_Matrix_rle.c" #undef _rle_d_ #define _rle_i_ #include "t_Matrix_rle.c" #undef _rle_i_ Matrix/src/Tsparse.c0000644000176200001440000001044613255476364014116 0ustar liggesusers /* Sparse matrices in triplet form */ #include "Tsparse.h" #include "chm_common.h" SEXP Tsparse_validate(SEXP x) { /* NB: we do *NOT* check a potential 'x' slot here, at all */ SEXP islot = GET_SLOT(x, Matrix_iSym), jslot = GET_SLOT(x, Matrix_jSym), dimslot = GET_SLOT(x, Matrix_DimSym); int j, nrow = INTEGER(dimslot)[0], ncol = INTEGER(dimslot)[1], nnz = length(islot), *xj = INTEGER(jslot), *xi = INTEGER(islot); if (length(jslot) != nnz) return mkString(_("lengths of slots i and j must match")); /* FIXME: this is checked in super class -- no need to do here: */ if (length(dimslot) != 2) return mkString(_("slot Dim must have length 2")); for (j = 0; j < nnz; j++) { if (xi[j] < 0 || xi[j] >= nrow) return mkString(_("all row indices (slot 'i') must be between 0 and nrow-1 in a TsparseMatrix")); if (xj[j] < 0 || xj[j] >= ncol) return mkString(_("all column indices (slot 'j') must be between 0 and ncol-1 in a TsparseMatrix")); } return ScalarLogical(1); } SEXP Tsparse_to_Csparse(SEXP x, SEXP tri) { CHM_TR chxt = AS_CHM_TR__(x); /* << should *preserve* diag = "U" ! */ CHM_SP chxs = cholmod_triplet_to_sparse(chxt, chxt->nnz, &c); int tr = asLogical(tri); int Rkind = (chxt->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0; R_CheckStack(); return chm_sparse_to_SEXP(chxs, 1, tr ? ((*uplo_P(x) == 'U') ? 1 : -1) : 0, Rkind, tr ? diag_P(x) : "", GET_SLOT(x, Matrix_DimNamesSym)); } /* speedup utility, needed e.g. after subsetting: */ SEXP Tsparse_to_tCsparse(SEXP x, SEXP uplo, SEXP diag) { CHM_TR chxt = AS_CHM_TR__(x); CHM_SP chxs = cholmod_triplet_to_sparse(chxt, chxt->nnz, &c); int Rkind = (chxt->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0; R_CheckStack(); return chm_sparse_to_SEXP(chxs, 1, /* uploT = */ (*CHAR(asChar(uplo)) == 'U')? 1: -1, Rkind, /* diag = */ CHAR(STRING_ELT(diag, 0)), GET_SLOT(x, Matrix_DimNamesSym)); } SEXP Tsparse_diagU2N(SEXP x) { static const char *valid[] = { "dtTMatrix", /* 0 */ "ltTMatrix", /* 1 */ "ntTMatrix", /* 2 : no x slot */ "ztTMatrix", /* 3 */ ""}; /* #define xSXP(iTyp) ((iTyp == 0) ? REALSXP : ((iTyp == 1) ? LGLSXP : /\* else *\/ CPLXSXP)); */ /* #define xTYPE(iTyp) ((iTyp == 0) ? double : ((iTyp == 1) ? int : /\* else *\/ Rcomplex)); */ int ctype = R_check_class_etc(x, valid); if (ctype < 0 || *diag_P(x) != 'U') { /* "trivially fast" when not triangular (<==> no 'diag' slot), or not *unit* triangular */ return (x); } else { /* instead of going to Csparse -> Cholmod -> Csparse -> Tsparse, work directly: */ int i, n = INTEGER(GET_SLOT(x, Matrix_DimSym))[0]; R_xlen_t nnz = xlength(GET_SLOT(x, Matrix_iSym)), new_n = nnz + n; SEXP ans = PROTECT(NEW_OBJECT_OF_CLASS(class_P(x))); int *islot = INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, new_n)), *jslot = INTEGER(ALLOC_SLOT(ans, Matrix_jSym, INTSXP, new_n)); slot_dup(ans, x, Matrix_DimSym); SET_DimNames(ans, x); slot_dup(ans, x, Matrix_uploSym); SET_SLOT(ans, Matrix_diagSym, mkString("N")); /* Build the new i- and j- slots : first copy the current : */ Memcpy(islot, INTEGER(GET_SLOT(x, Matrix_iSym)), nnz); Memcpy(jslot, INTEGER(GET_SLOT(x, Matrix_jSym)), nnz); /* then, add the new (i,j) slot entries: */ for(i = 0; i < n; i++) { islot[i + nnz] = i; jslot[i + nnz] = i; } /* build the new x-slot : */ switch(ctype) { case 0: { /* "d" */ double *x_new = REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, new_n)); Memcpy(x_new, REAL(GET_SLOT(x, Matrix_xSym)), nnz); for(i = 0; i < n; i++) /* add x[i,i] = 1. */ x_new[i + nnz] = 1.; break; } case 1: { /* "l" */ int *x_new = LOGICAL(ALLOC_SLOT(ans, Matrix_xSym, LGLSXP, new_n)); Memcpy(x_new, LOGICAL(GET_SLOT(x, Matrix_xSym)), nnz); for(i = 0; i < n; i++) /* add x[i,i] = 1 (= TRUE) */ x_new[i + nnz] = 1; break; } case 2: /* "n" */ /* nothing to do here */ break; case 3: { /* "z" */ Rcomplex *x_new = COMPLEX(ALLOC_SLOT(ans, Matrix_xSym, CPLXSXP, new_n)); Memcpy(x_new, COMPLEX(GET_SLOT(x, Matrix_xSym)), nnz); for(i = 0; i < n; i++) /* add x[i,i] = 1 (= TRUE) */ x_new[i + nnz] = (Rcomplex) {1., 0.}; break; } }/* switch() */ UNPROTECT(1); return ans; } } Matrix/src/scripts/0000755000176200001440000000000014154165630014001 5ustar liggesusersMatrix/src/scripts/DEPS.mkf_make.sh0000755000176200001440000000267713253126366016662 0ustar liggesusers#!/bin/sh # R=${R:-R-patched} if [ x$R_HOME = x ] ; then R_HOME=`$R RHOME`; fi RINC=${R_HOME}/include # For consistency of *.c below: set locale to simple C # MM: Setting locale here does *NOT* help me; setting in the calling shell does !?!? # Do something like this in the shell LC_CTYPE=C export LC_CTYPE unset LANG unset LANGUAGE unset LC_ADDRESS unset LC_COLLATE unset LC_IDENTIFICATION unset LC_MEASUREMENT unset LC_MESSAGES unset LC_NAME unset LC_PAPER unset LC_TELEPHONE unset LC_NUMERIC unset LC_MONETARY unset LC_TIME ## for debugging: # echo '------------------------' # locale # echo '------------------------' # MatrixDir=`dirname $0`/..; cd $MatrixDir; MatrixDir=`pwd` if [ ! -d $MatrixDir ] then echo "no directory '$MatrixDir' .. exiting"; exit 3 fi cd $MatrixDir ## __begin fix__ CHOLMOD has one include for which gcc -MM fails below: FIX=CHOLMOD/Include/cholmod.h if [ -f $FIX ] then sed '/^#include "SuiteSparse_config/s/\(.*\)/\/* \1 *\//' $FIX > ${FIX}_fixed mv $FIX ${FIX}_orig mv ${FIX}_fixed $FIX fi ## __end fix__ out=scripts/DEPS.mkf_automade (echo '#-*- Makefile -*- #-------------'" produced by $0 (plus minimal emacs cleanup) #" ls *.c | grep -v '^t_' | xargs gcc -I$RINC -MM | perl -pe "s{$RINC/[^.]*.h( \\\\\\n)?}{}g; s{^[ \\s]+Syms.h \\\\\\n[ \\s]*}{ Syms.h }" ) > $out if [ -f ${FIX}_orig ] ; then mv ${FIX}_orig $FIX ; fi echo '------------------------' echo ''; echo "$0 done. Resulting file is $MatrixDir/$out" ; echo Matrix/src/scripts/DEPS.mkf0000644000176200001440000001606613253126366015246 0ustar liggesusers#-*- Makefile -*- #------------- produced by scripts/DEPS.mkf_make.sh (plus minimal emacs cleanup) # CHMfactor.o: CHMfactor.c CHMfactor.h Mutils.h Syms.h \ t_sparseVector.c chm_common.h SuiteSparse_config/SuiteSparse_config.h \ CHOLMOD/Include/cholmod.h CHOLMOD/Include/cholmod_io64.h \ CHOLMOD/Include/cholmod_config.h CHOLMOD/Include/cholmod_core.h \ CHOLMOD/Include/cholmod_check.h CHOLMOD/Include/cholmod_cholesky.h \ CHOLMOD/Include/cholmod_partition.h CHOLMOD/Include/cholmod_camd.h \ CHOLMOD/Include/cholmod_supernodal.h CHOLMOD/Include/cholmod_matrixops.h \ CHOLMOD/Include/cholmod_modify.h Csparse.o: Csparse.c Csparse.h Mutils.h Syms.h \ t_sparseVector.c Tsparse.h chm_common.h \ SuiteSparse_config/SuiteSparse_config.h CHOLMOD/Include/cholmod.h \ CHOLMOD/Include/cholmod_io64.h CHOLMOD/Include/cholmod_config.h \ CHOLMOD/Include/cholmod_core.h CHOLMOD/Include/cholmod_check.h \ CHOLMOD/Include/cholmod_cholesky.h CHOLMOD/Include/cholmod_partition.h \ CHOLMOD/Include/cholmod_camd.h CHOLMOD/Include/cholmod_supernodal.h \ CHOLMOD/Include/cholmod_matrixops.h CHOLMOD/Include/cholmod_modify.h \ t_Csparse_validate.c t_Csparse_subassign.c t_matrix_to_Csp.c Mutils.o: Mutils.c Mutils.h Syms.h t_sparseVector.c TMatrix_as.o: TMatrix_as.c TMatrix_as.h Mutils.h Syms.h t_sparseVector.c Tsparse.o: Tsparse.c Tsparse.h Mutils.h Syms.h t_sparseVector.c \ chm_common.h SuiteSparse_config/SuiteSparse_config.h \ CHOLMOD/Include/cholmod.h CHOLMOD/Include/cholmod_io64.h \ CHOLMOD/Include/cholmod_config.h CHOLMOD/Include/cholmod_core.h \ CHOLMOD/Include/cholmod_check.h CHOLMOD/Include/cholmod_cholesky.h \ CHOLMOD/Include/cholmod_partition.h CHOLMOD/Include/cholmod_camd.h \ CHOLMOD/Include/cholmod_supernodal.h CHOLMOD/Include/cholmod_matrixops.h \ CHOLMOD/Include/cholmod_modify.h abIndex.o: abIndex.c abIndex.h Mutils.h Syms.h \ t_sparseVector.c t_Matrix_rle.c chm_common.o: chm_common.c chm_common.h \ SuiteSparse_config/SuiteSparse_config.h CHOLMOD/Include/cholmod.h \ CHOLMOD/Include/cholmod_io64.h CHOLMOD/Include/cholmod_config.h \ CHOLMOD/Include/cholmod_core.h CHOLMOD/Include/cholmod_check.h \ CHOLMOD/Include/cholmod_cholesky.h CHOLMOD/Include/cholmod_partition.h \ CHOLMOD/Include/cholmod_camd.h CHOLMOD/Include/cholmod_supernodal.h \ CHOLMOD/Include/cholmod_matrixops.h CHOLMOD/Include/cholmod_modify.h \ Mutils.h Syms.h t_sparseVector.c cs.o: cs.c cs.h cs_utils.o: cs_utils.c cs_utils.h cs.h Mutils.h Syms.h t_sparseVector.c dense.o: dense.c dense.h Mutils.h Syms.h t_sparseVector.c \ chm_common.h SuiteSparse_config/SuiteSparse_config.h \ CHOLMOD/Include/cholmod.h CHOLMOD/Include/cholmod_io64.h \ CHOLMOD/Include/cholmod_config.h CHOLMOD/Include/cholmod_core.h \ CHOLMOD/Include/cholmod_check.h CHOLMOD/Include/cholmod_cholesky.h \ CHOLMOD/Include/cholmod_partition.h CHOLMOD/Include/cholmod_camd.h \ CHOLMOD/Include/cholmod_supernodal.h CHOLMOD/Include/cholmod_matrixops.h \ CHOLMOD/Include/cholmod_modify.h dgCMatrix.o: dgCMatrix.c dgCMatrix.h Mutils.h Syms.h t_sparseVector.c \ cs_utils.h cs.h Csparse.h chm_common.h \ SuiteSparse_config/SuiteSparse_config.h CHOLMOD/Include/cholmod.h \ CHOLMOD/Include/cholmod_io64.h CHOLMOD/Include/cholmod_config.h \ CHOLMOD/Include/cholmod_core.h CHOLMOD/Include/cholmod_check.h \ CHOLMOD/Include/cholmod_cholesky.h CHOLMOD/Include/cholmod_partition.h \ CHOLMOD/Include/cholmod_camd.h CHOLMOD/Include/cholmod_supernodal.h \ CHOLMOD/Include/cholmod_matrixops.h CHOLMOD/Include/cholmod_modify.h \ t_gCMatrix_colSums.c dgTMatrix.o: dgTMatrix.c dgTMatrix.h Mutils.h Syms.h t_sparseVector.c \ chm_common.h SuiteSparse_config/SuiteSparse_config.h \ CHOLMOD/Include/cholmod.h CHOLMOD/Include/cholmod_io64.h \ CHOLMOD/Include/cholmod_config.h CHOLMOD/Include/cholmod_core.h \ CHOLMOD/Include/cholmod_check.h CHOLMOD/Include/cholmod_cholesky.h \ CHOLMOD/Include/cholmod_partition.h CHOLMOD/Include/cholmod_camd.h \ CHOLMOD/Include/cholmod_supernodal.h CHOLMOD/Include/cholmod_matrixops.h \ CHOLMOD/Include/cholmod_modify.h Tsparse.h dgeMatrix.o: dgeMatrix.c dgeMatrix.h Mutils.h Syms.h t_sparseVector.c dpoMatrix.o: dpoMatrix.c dpoMatrix.h Mutils.h Syms.h t_sparseVector.c dppMatrix.o: dppMatrix.c dppMatrix.h Mutils.h \ Syms.h t_sparseVector.c dspMatrix.h dgeMatrix.h dsCMatrix.o: dsCMatrix.c dsCMatrix.h Mutils.h \ Syms.h t_sparseVector.c Csparse.h chm_common.h \ SuiteSparse_config/SuiteSparse_config.h CHOLMOD/Include/cholmod.h \ CHOLMOD/Include/cholmod_io64.h CHOLMOD/Include/cholmod_config.h \ CHOLMOD/Include/cholmod_core.h CHOLMOD/Include/cholmod_check.h \ CHOLMOD/Include/cholmod_cholesky.h CHOLMOD/Include/cholmod_partition.h \ CHOLMOD/Include/cholmod_camd.h CHOLMOD/Include/cholmod_supernodal.h \ CHOLMOD/Include/cholmod_matrixops.h CHOLMOD/Include/cholmod_modify.h dspMatrix.o: dspMatrix.c dspMatrix.h dgeMatrix.h Mutils.h Syms.h \ t_sparseVector.c dsyMatrix.o: dsyMatrix.c dsyMatrix.h Mutils.h Syms.h t_sparseVector.c dtCMatrix.o: dtCMatrix.c dtCMatrix.h Mutils.h Syms.h t_sparseVector.c \ dgCMatrix.h cs_utils.h cs.h dtTMatrix.o: dtTMatrix.c dtTMatrix.h Mutils.h \ Syms.h t_sparseVector.c chm_common.h \ CHOLMOD/Include/cholmod.h CHOLMOD/Include/cholmod_io64.h \ CHOLMOD/Include/cholmod_config.h CHOLMOD/Include/cholmod_core.h \ CHOLMOD/Include/cholmod_check.h CHOLMOD/Include/cholmod_cholesky.h \ CHOLMOD/Include/cholmod_partition.h CHOLMOD/Include/cholmod_camd.h \ CHOLMOD/Include/cholmod_supernodal.h CHOLMOD/Include/cholmod_matrixops.h \ CHOLMOD/Include/cholmod_modify.h dgTMatrix.h dtpMatrix.o: dtpMatrix.c dtpMatrix.h Mutils.h Syms.h t_sparseVector.c dtrMatrix.o: dtrMatrix.c dtrMatrix.h Mutils.h Syms.h t_sparseVector.c factorizations.o: factorizations.c factorizations.h Mutils.h \ Syms.h t_sparseVector.c init.o: init.c Mutils.h Syms.h t_sparseVector.c abIndex.h chm_common.h \ SuiteSparse_config/SuiteSparse_config.h CHOLMOD/Include/cholmod.h \ CHOLMOD/Include/cholmod_io64.h CHOLMOD/Include/cholmod_config.h \ CHOLMOD/Include/cholmod_core.h CHOLMOD/Include/cholmod_check.h \ CHOLMOD/Include/cholmod_cholesky.h CHOLMOD/Include/cholmod_partition.h \ CHOLMOD/Include/cholmod_camd.h CHOLMOD/Include/cholmod_supernodal.h \ CHOLMOD/Include/cholmod_matrixops.h CHOLMOD/Include/cholmod_modify.h \ CHMfactor.h Csparse.h Tsparse.h dense.h dgCMatrix.h \ cs_utils.h cs.h dgTMatrix.h dgeMatrix.h dpoMatrix.h dppMatrix.h \ dspMatrix.h dsCMatrix.h TMatrix_as.h dsyMatrix.h dtCMatrix.h dtTMatrix.h \ dtrMatrix.h dtpMatrix.h factorizations.h ldense.h lgCMatrix.h sparseQR.h ldense.o: ldense.c ldense.h Mutils.h Syms.h t_sparseVector.c lgCMatrix.o: lgCMatrix.c lgCMatrix.h Mutils.h Syms.h \ t_sparseVector.c dgCMatrix.h cs_utils.h cs.h sparseQR.o: sparseQR.c sparseQR.h Mutils.h \ Syms.h t_sparseVector.c cs_utils.h cs.h chm_common.h \ SuiteSparse_config/SuiteSparse_config.h CHOLMOD/Include/cholmod.h \ CHOLMOD/Include/cholmod_io64.h CHOLMOD/Include/cholmod_config.h \ CHOLMOD/Include/cholmod_core.h CHOLMOD/Include/cholmod_check.h \ CHOLMOD/Include/cholmod_cholesky.h CHOLMOD/Include/cholmod_partition.h \ CHOLMOD/Include/cholmod_camd.h CHOLMOD/Include/cholmod_supernodal.h \ CHOLMOD/Include/cholmod_matrixops.h CHOLMOD/Include/cholmod_modify.h Matrix/src/scripts/UFconfig.patch20000644000176200001440000000100611704016077016577 0ustar liggesusers--- UFconfig/UFconfig.h~ 2011-04-06 08:55:54.000000000 +0200 +++ UFconfig/UFconfig.h 2012-01-13 10:27:04.002662000 +0100 @@ -44,6 +44,10 @@ #include #include +// For use with R package 'Matrix' +#include +#define printf Rprintf + /* ========================================================================== */ /* === UF_long ============================================================== */ /* ========================================================================== */ Matrix/src/scripts/fixup-fn.R0000644000176200001440000000277611076041562015671 0ustar liggesusers## From: Prof Brian Ripley ## To: Martin Maechler ## cc: Kurt.Hornik@wu-wien.ac.at, Matrix-authors@r-project.org, ## simon.urbanek@r-project.org ## Subject: Re: Matrix 0.999375-16 uploaded to CRAN ## Date: Thu, 16 Oct 2008 16:26:57 +0100 (BST) ## ................ ## A) The good news is that I have a set of Makefiles that work on Sun make ## and I believe are POSIX-compliant. The following R script ## was applied to src/CHOLMOD/Lib/Makefile ## and src/SPQR/Lib/Makefile ## to 'POSIXify' them, fixup <- function(file="Makefile") { file.copy(file, paste(file, "orig", sep=".")) orig <- readLines(file) current <- "" for(i in seq_along(orig)) { if (length(grep(".o: ", orig[i], fixed = TRUE))) { print(orig[i]) # "verbose info" current <- sub("[^ ]* (.*)", "\\1", orig[i]) current <- strsplit(current, " ")[[1]][1] } else if (length(grep("$<", orig[i], fixed = TRUE))) { ## use last line's current : orig[i] <- sub("$<", current, orig[i], fixed = TRUE) } else if (length(grep("^PKG_CFLAGS *= *-I", orig[i]))) { orig[i] <- sub("^PKG_CFLAGS", "PKG_CPPFLAGS", orig[i]) } } writeLines(orig, file) } ## and I hand edited ../AMD/Source/Makefile and ## ../CHOLMOD/Lib/Makefile. If I did it right those changes are attached as ## Matrix.patch2. Hopefully such a script makes future maintenance easy. ## MM: Try to apply it to all 4 Makefiles and only use a patch file for ## "the rest" Matrix/src/scripts/0get-SuiteSparse.sh0000755000176200001440000001536413652535054017460 0ustar liggesusers#!/bin/sh ## This *REPLACES* former ./UFsparse_download.sh ## Update Libraries from Tim Davis (formerly University of Florida (UF), now Texas A&M)'s "SuiteSparse": # if [ ! -d ../src -o ! -d ./scripts ] then echo 'Must run in Matrix/src/ !' ; exit 1 fi getSPQR=no ## --- since late summer 2010, we no longer get SPQR # # Tim Davis moved to Texas A&M, on July 1, 2014 # ufl_URL=http://www.cise.ufl.edu/research/sparse/SuiteSparse/current/ # TGZ=SuiteSparse.tar.gz # wget -nc $ufl_URL/$TGZ ## 2020-04-03: Pointed to from http://faculty.cse.tamu.edu/davis/suitesparse.html ## ----------- SuiteSparse is on github currently: GH_base=https://github.com/DrTimothyAldenDavis/SuiteSparse GH_rel=${GH_base}/releases GH_latest=${GH_rel}/latest curl --dump-header hd_latest $GH_latest > curl_out 2>&1 # Careful: curl gives results "in MSDOS Format" with \cr\lf --> remove \r VER=$(sed -n -e '/^location:/{p;q}' hd_latest | tee SS_location | sed 's#.*/v\([1-9]\.[0-9]\.[0-9]\)\r#\1#') echo "SS_location:"; cat SS_location echo " SuiteSparse version VER='$VER' " GH_tar_url=https://github.com/DrTimothyAldenDavis/SuiteSparse/archive/v${VER}.tar.gz SS=SuiteSparse-${VER} TGZ=${SS}.tar.gz if [ -f $TGZ ] then echo 'Tarfile present; not downloading (remove it to change this!)' echo 'Maybe *continue* downloading by'; echo; echo " wget -c $GH_tar_url -O $TGZ" ; echo ## just for experimenting! # echo ' >> INTERRUPT (Ctrl C) within 7 sec !) if you want do that ' # sleep 7 else echo ' ==> Trying to get it from '"$GH_tar_url :" wget -nc $GH_tar_url -O $TGZ fi ls -l $TGZ SSdocDir=../inst/doc/SuiteSparse ## 1) SuiteSparse_config --------------------------------------------- ## NOTA BENE: SuiteSparse_config/ is what UFconfig/ used to be Sdir=$SS/SuiteSparse_config ## install SuiteSparse_config.h file (now needed by some SuiteSparse libraries) tar zxf $TGZ $Sdir/SuiteSparse_config.h $Sdir/SuiteSparse_config.c $Sdir/Makefile $Sdir/README.txt ## Move the SuiteSparse_config/README.txt file to docs: mv $Sdir/README.txt $SSdocDir/SuiteSparse_config.txt mv $Sdir/Makefile $Sdir/Makefile_orig ## touch the file $Sdir/SuiteSparse_config.mk. We use other configuration ## environment variables but this name is embedded in some Makefiles touch $Sdir/SuiteSparse_config.mk ## move directory *up* dd=`basename $Sdir`; mv $Sdir/* $dd/ ## Need to add the Matrix-specific changes to SuiteSparse_config/SuiteSparse_config.h : ## 2014-08: different patch: patch -p0 < scripts/SuiteSparse_config.patch ## 2) COLAMD ----------------------------------------------- Sdir=$SS/COLAMD ## install COLAMD/Source and COLAMD/Include directories tar zxf $TGZ $Sdir/Source/ $Sdir/Include/ $Sdir/Doc/ $Sdir/README.txt ## MM {2014-12}: following Makefile no longer exists f=$Sdir/Source/Makefile if [ -f $f ] then Rscript --vanilla -e 'source("scripts/fixup-fn.R")' -e 'fixup("'$f'")' fi ## install documentation for COLAMD mv $Sdir/README.txt $SSdocDir/COLAMD.txt mv $Sdir/Doc/ChangeLog $SSdocDir/COLAMD-ChangeLog.txt rm -rf $Sdir/Doc # 2014: no longer # patch -p0 < scripts/COLAMD.patch ## --------------------- ## move directory *up* dd=`basename $Sdir`; rsync -auv $Sdir/ $dd/ ## 3) AMD -------------------------------------------------- Sdir=$SS/AMD ## install AMD/Source, AMD/Include and AMD/Lib directories tar zxf $TGZ $Sdir/Source $Sdir/Include $Sdir/Lib $Sdir/README.txt ## install AMD documentation mv $Sdir/README.txt $SSdocDir/AMD.txt ## remove Fortran source files and GNUMakefile rm $Sdir/Source/*.f $Sdir/Lib/GNUmakefile #(for f in $Sdir/Include/amd_internal.h $Sdir/Source/amd_global.c; do diff -ubBw ${f}.~1~ $f ; done ) | tee scripts/AMD-noprint.patch ## 2014: no longer # patch -p0 < scripts/AMD-noprint.patch ## --------------------- ## move directory *up* dd=`basename $Sdir`; rsync -auv $Sdir/ $dd/ ## 4) CHOLMOD ---------------------------------------------- Sdir=$SS/CHOLMOD ## install CHOLMOD source files for d in Check Cholesky Core Include Lib MatrixOps Modify Partition Supernodal README.txt do tar zxf $TGZ $Sdir/$d done ## install CHOLMOD documentation mv $Sdir/README.txt $SSdocDir/CHOLMOD.txt cp -p $Sdir/Lib/Makefile $Sdir/Lib/Makefile_CHOLMOD Rscript --vanilla -e 'source("scripts/fixup-fn.R")' -e 'fixup("'$Sdir'/Lib/Makefile")' ## but typically, this is not good enough, so we need manual work: mv $Sdir/Lib/Makefile $Sdir/Lib/Makefile_pre ## move directory *up* dd=`basename $Sdir`; rsync -auv $Sdir/ $dd/ echo 'If there changes in the following you ** MUST ** manually update / inst/include/cholmod.h --- to export what we have. Also, RcppEigen headers may also need to be updated -- ask Doug Bates. This can be VERY IMPORTANT, not the least for lme4 ' svn diff --diff-cmd /usr/bin/diff -x "-bBw" $dd/Include/cholmod_core.h echo 'Did the above show any non trivial diffs? --> do update inst/include/cholmod.h !! ' svn revert $dd/Lib/Makefile ls -l $dd/Lib/Makefile_pre echo "now diff $dd/Lib/Makefile $dd/Lib/Makefile_pre [I do it for you below]" echo ' make changes as necessary, and then (later)' echo " rm $dd"'/Lib/Makefile_*' ; echo echo "Ok, now diff $dd/Lib/Makefile $dd/Lib/Makefile_pre :" diff $dd/Lib/Makefile $dd/Lib/Makefile_pre ## 5) CSparse ------------------------------------------------- Sdir=$SS/CSparse ## install CSparse/Source & CSparse/Include tar zxf $TGZ $Sdir/Source $Sdir/Include $Sdir/README.txt ## Include: echo -n "Moving from $Sdir/Include .. " f=$Sdir/Include/cs.h chmod a+r $f && mv $f . ## Source: MatrixDir=`pwd` cd $Sdir/Source cat cs_*.c | sed -e '1 p' -e '/^#include/d' -e 's/\bprintf/Rprintf/g' > $MatrixDir/cs.c cd $MatrixDir patch -p0 < scripts/cs.patch echo '[Ok]' echo -n "removing $Sdir .." rm -rf $Sdir echo '[Ok]' ## 6) SPQR ------------------------------------------------- if [ $getSPQR = yes ] then ## install SPQR source files for d in Source Include Lib do tar zxf ./SPQR.tar.gz SPQR/$d done ## install CHOLMOD documentation in ../inst/doc/UFsparse tar zxf ./SPQR.tar.gz SPQR/README.txt mv SPQR/README.txt $SSdocDir/SPQR.txt ## patch for Matrix: patch -p0 < scripts/SPQR.patch cp -p SPQR/Lib/Makefile SPQR/Lib/Makefile_SPQR Rscript --vanilla -e 'source("scripts/fixup-fn.R")' -e 'fixup("SPQR/Lib/Makefile")' mv SPQR/Lib/Makefile SPQR/Lib/Makefile_pre svn revert SPQR/Lib/Makefile ## ls -l SPQR/Lib/Makefile_pre echo 'now diff SPQR/Lib/Makefile with SPQR/Lib/Makefile_pre' echo ' make changes as necessary, and then (later)' echo ' rm SPQR/Lib/Makefile_*' ; echo fi ## ----- remove the downloaded tar file ------------------- echo 'You could (eventually) do rm '"$TGZ"' but keeping it will not download it anew, if not changed. Further, consider updating the doxygen docu on the R-forge web site via /u/maechler/R/Pkgs/Matrix-doxygen-update ' Matrix/src/scripts/SOURCES_C.mkf0000644000176200001440000000114711601432164016061 0ustar liggesusersSOURCES_C = \ CHMfactor.c \ Csparse.c \ TMatrix_as.c \ Tsparse.c \ init.c \ Mutils.c \ chm_common.c \ cs.c \ cs_utils.c \ dense.c \ dgCMatrix.c \ dgTMatrix.c \ dgeMatrix.c \ dpoMatrix.c \ dppMatrix.c \ dsCMatrix.c \ dsyMatrix.c \ dspMatrix.c \ dtCMatrix.c \ dtTMatrix.c \ dtrMatrix.c \ dtpMatrix.c \ factorizations.c \ ldense.c \ lgCMatrix.c \ sparseQR.c \ abIndex.c Matrix/src/CHOLMOD/0000755000176200001440000000000014154165363013402 5ustar liggesusersMatrix/src/CHOLMOD/Core/0000755000176200001440000000000014154165363014272 5ustar liggesusersMatrix/src/CHOLMOD/Core/cholmod_common.c0000644000176200001440000005714413652535054017446 0ustar liggesusers/* ========================================================================== */ /* === Core/cholmod_common ================================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Core Module. Copyright (C) 2005-2006, * Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* Core utility routines for the cholmod_common object: * * Primary routines: * ----------------- * cholmod_start the first call to CHOLMOD * cholmod_finish the last call to CHOLMOD * * Secondary routines: * ------------------- * cholmod_defaults restore (most) default control parameters * cholmod_allocate_work allocate (or reallocate) workspace in Common * cholmod_free_work free workspace in Common * cholmod_clear_flag clear Common->Flag in workspace * cholmod_maxrank column dimension of Common->Xwork workspace * * The Common object is unique. It cannot be allocated or deallocated by * CHOLMOD, since it contains the definition of the memory management routines * used (pointers to malloc, free, realloc, and calloc, or their equivalent). * The Common object contains workspace that is used between calls to * CHOLMOD routines. This workspace allocated by CHOLMOD as needed, by * cholmod_allocate_work and cholmod_free_work. */ #include "cholmod_internal.h" #include "cholmod_core.h" #ifdef GPU_BLAS #include "cholmod_gpu.h" #endif /* ========================================================================== */ /* === cholmod_start ======================================================== */ /* ========================================================================== */ /* Initialize Common default parameters and statistics. Sets workspace * pointers to NULL. * * This routine must be called just once, prior to calling any other CHOLMOD * routine. Do not call this routine after any other CHOLMOD routine (except * cholmod_finish, to start a new CHOLMOD session), or a memory leak will * occur. * * workspace: none */ int CHOLMOD(start) ( cholmod_common *Common ) { int k ; if (Common == NULL) { return (FALSE) ; } /* ---------------------------------------------------------------------- */ /* user error handling routine */ /* ---------------------------------------------------------------------- */ Common->error_handler = NULL ; /* ---------------------------------------------------------------------- */ /* integer and numerical types */ /* ---------------------------------------------------------------------- */ Common->itype = ITYPE ; Common->dtype = DTYPE ; /* ---------------------------------------------------------------------- */ /* default control parameters */ /* ---------------------------------------------------------------------- */ CHOLMOD(defaults) (Common) ; Common->try_catch = FALSE ; /* ---------------------------------------------------------------------- */ /* memory management routines */ /* ---------------------------------------------------------------------- */ /* moved to SuiteSparse_config */ /* ---------------------------------------------------------------------- */ /* complex arithmetic routines */ /* ---------------------------------------------------------------------- */ /* moved to SuiteSparse_config */ /* ---------------------------------------------------------------------- */ /* print routine */ /* ---------------------------------------------------------------------- */ /* moved to SuiteSparse_config */ /* ---------------------------------------------------------------------- */ /* workspace */ /* ---------------------------------------------------------------------- */ /* This code assumes the workspace held in Common is not initialized. If * it is, then a memory leak will occur because the pointers are * overwritten with NULL. */ Common->nrow = 0 ; Common->mark = EMPTY ; Common->xworksize = 0 ; Common->iworksize = 0 ; Common->Flag = NULL ; Common->Head = NULL ; Common->Iwork = NULL ; Common->Xwork = NULL ; Common->no_workspace_reallocate = FALSE ; /* ---------------------------------------------------------------------- */ /* statistics */ /* ---------------------------------------------------------------------- */ /* fl and lnz are computed in cholmod_analyze and cholmod_rowcolcounts */ Common->fl = EMPTY ; Common->lnz = EMPTY ; /* modfl is computed in cholmod_updown, cholmod_rowadd, and cholmod_rowdel*/ Common->modfl = EMPTY ; /* all routines use status as their error-report code */ Common->status = CHOLMOD_OK ; Common->malloc_count = 0 ; /* # calls to malloc minus # calls to free */ Common->memory_usage = 0 ; /* peak memory usage (in bytes) */ Common->memory_inuse = 0 ; /* current memory in use (in bytes) */ Common->nrealloc_col = 0 ; Common->nrealloc_factor = 0 ; Common->ndbounds_hit = 0 ; Common->rowfacfl = 0 ; Common->aatfl = EMPTY ; /* Common->called_nd is TRUE if cholmod_analyze called or NESDIS */ Common->called_nd = FALSE ; Common->blas_ok = TRUE ; /* false if BLAS int overflow occurs */ /* ---------------------------------------------------------------------- */ /* default SuiteSparseQR knobs and statististics */ /* ---------------------------------------------------------------------- */ for (k = 0 ; k < 10 ; k++) Common->SPQR_istat [k] = 0 ; Common->SPQR_flopcount_bound = 0 ; /* upper bound on flop count */ Common->SPQR_tol_used = 0 ; /* tolerance used */ Common->SPQR_norm_E_fro = 0 ; /* Frobenius norm of dropped entries */ Common->SPQR_grain = 1 ; /* no Intel TBB multitasking, by default */ Common->SPQR_small = 1e6 ; /* target min task size for TBB */ Common->SPQR_shrink = 1 ; /* controls SPQR shrink realloc */ Common->SPQR_nthreads = 0 ; /* 0: let TBB decide how many threads to use */ Common->SPQR_flopcount = 0 ; /* flop count for SPQR */ Common->SPQR_analyze_time = 0 ; /* analysis time for SPQR */ Common->SPQR_factorize_time = 0 ; /* factorize time for SPQR */ Common->SPQR_solve_time = 0 ; /* backsolve time for SPQR */ /* ---------------------------------------------------------------------- */ /* GPU initializations */ /* ---------------------------------------------------------------------- */ /* these are destroyed by cholmod_gpu_deallocate and cholmod_gpu_end */ Common->cublasHandle = NULL ; Common->cublasEventPotrf [0] = NULL ; Common->cublasEventPotrf [1] = NULL ; Common->cublasEventPotrf [2] = NULL ; for (k = 0 ; k < CHOLMOD_HOST_SUPERNODE_BUFFERS ; k++) { Common->gpuStream [k] = NULL ; Common->updateCBuffersFree [k] = NULL ; } Common->updateCKernelsComplete = NULL; /* these are destroyed by cholmod_gpu_deallocate */ Common->dev_mempool = NULL; Common->dev_mempool_size = 0; Common->host_pinned_mempool = NULL; Common->host_pinned_mempool_size = 0; Common->syrkStart = 0 ; Common->cholmod_cpu_gemm_time = 0 ; Common->cholmod_cpu_syrk_time = 0 ; Common->cholmod_cpu_trsm_time = 0 ; Common->cholmod_cpu_potrf_time = 0 ; Common->cholmod_gpu_gemm_time = 0 ; Common->cholmod_gpu_syrk_time = 0 ; Common->cholmod_gpu_trsm_time = 0 ; Common->cholmod_gpu_potrf_time = 0 ; Common->cholmod_assemble_time = 0 ; Common->cholmod_assemble_time2 = 0 ; Common->cholmod_cpu_gemm_calls = 0 ; Common->cholmod_cpu_syrk_calls = 0 ; Common->cholmod_cpu_trsm_calls = 0 ; Common->cholmod_cpu_potrf_calls = 0 ; Common->cholmod_gpu_gemm_calls = 0 ; Common->cholmod_gpu_syrk_calls = 0 ; Common->cholmod_gpu_trsm_calls = 0 ; Common->cholmod_gpu_potrf_calls = 0 ; Common->maxGpuMemBytes = 0; Common->maxGpuMemFraction = 0.0; /* SPQR statistics and settings */ Common->gpuMemorySize = 1 ; /* default: no GPU memory available */ Common->gpuKernelTime = 0.0 ; Common->gpuFlops = 0 ; Common->gpuNumKernelLaunches = 0 ; DEBUG_INIT ("cholmod start", Common) ; return (TRUE) ; } /* ========================================================================== */ /* === cholmod_defaults ===================================================== */ /* ========================================================================== */ /* Set Common default parameters, except for the function pointers. * * workspace: none */ int CHOLMOD(defaults) ( cholmod_common *Common ) { Int i ; RETURN_IF_NULL_COMMON (FALSE) ; /* ---------------------------------------------------------------------- */ /* default control parameters */ /* ---------------------------------------------------------------------- */ Common->dbound = 0.0 ; Common->grow0 = 1.2 ; Common->grow1 = 1.2 ; Common->grow2 = 5 ; Common->maxrank = 8 ; Common->final_asis = TRUE ; Common->final_super = TRUE ; Common->final_ll = FALSE ; Common->final_pack = TRUE ; Common->final_monotonic = TRUE ; Common->final_resymbol = FALSE ; /* use simplicial factorization if flop/nnz(L) < 40, supernodal otherwise */ Common->supernodal = CHOLMOD_AUTO ; Common->supernodal_switch = 40 ; Common->nrelax [0] = 4 ; Common->nrelax [1] = 16 ; Common->nrelax [2] = 48 ; Common->zrelax [0] = 0.8 ; Common->zrelax [1] = 0.1 ; Common->zrelax [2] = 0.05 ; Common->prefer_zomplex = FALSE ; Common->prefer_upper = TRUE ; Common->prefer_binary = FALSE ; Common->quick_return_if_not_posdef = FALSE ; /* METIS workarounds */ Common->metis_memory = 0.0 ; /* > 0 for memory guard (2 is reasonable) */ Common->metis_nswitch = 3000 ; Common->metis_dswitch = 0.66 ; Common->print = 3 ; Common->precise = FALSE ; /* ---------------------------------------------------------------------- */ /* default ordering methods */ /* ---------------------------------------------------------------------- */ /* Note that if the Partition module is not installed, the CHOLMOD_METIS * and CHOLMOD_NESDIS methods will not be available. cholmod_analyze will * report the CHOLMOD_NOT_INSTALLED error, and safely skip over them. */ #if (CHOLMOD_MAXMETHODS < 9) #error "CHOLMOD_MAXMETHODS must be 9 or more (defined in cholmod_core.h)." #endif /* default strategy: try given, AMD, and then METIS if AMD reports high * fill-in. NESDIS can be used instead, if Common->default_nesdis is TRUE. */ Common->nmethods = 0 ; /* use default strategy */ Common->default_nesdis = FALSE ; /* use METIS in default strategy */ Common->current = 0 ; /* current method being tried */ Common->selected = 0 ; /* the best method selected */ /* first, fill each method with default parameters */ for (i = 0 ; i <= CHOLMOD_MAXMETHODS ; i++) { /* CHOLMOD's default method is AMD for A or AA' */ Common->method [i].ordering = CHOLMOD_AMD ; /* CHOLMOD nested dissection and minimum degree parameter */ Common->method [i].prune_dense = 10.0 ; /* dense row/col control */ /* min degree parameters (AMD, COLAMD, SYMAMD, CAMD, CCOLAMD, CSYMAMD)*/ Common->method [i].prune_dense2 = -1 ; /* COLAMD dense row control */ Common->method [i].aggressive = TRUE ; /* aggressive absorption */ Common->method [i].order_for_lu = FALSE ;/* order for Cholesky not LU */ /* CHOLMOD's nested dissection (METIS + constrained AMD) */ Common->method [i].nd_small = 200 ; /* small graphs aren't cut */ Common->method [i].nd_compress = TRUE ; /* compress graph & subgraphs */ Common->method [i].nd_camd = 1 ; /* use CAMD */ Common->method [i].nd_components = FALSE ; /* lump connected comp. */ Common->method [i].nd_oksep = 1.0 ; /* sep ok if < oksep*n */ /* statistics for each method are not yet computed */ Common->method [i].fl = EMPTY ; Common->method [i].lnz = EMPTY ; } Common->postorder = TRUE ; /* follow ordering with weighted postorder */ /* Next, define some methods. The first five use default parameters. */ Common->method [0].ordering = CHOLMOD_GIVEN ; /* skip if UserPerm NULL */ Common->method [1].ordering = CHOLMOD_AMD ; Common->method [2].ordering = CHOLMOD_METIS ; Common->method [3].ordering = CHOLMOD_NESDIS ; Common->method [4].ordering = CHOLMOD_NATURAL ; /* CHOLMOD's nested dissection with large leaves of separator tree */ Common->method [5].ordering = CHOLMOD_NESDIS ; Common->method [5].nd_small = 20000 ; /* CHOLMOD's nested dissection with tiny leaves, and no AMD ordering */ Common->method [6].ordering = CHOLMOD_NESDIS ; Common->method [6].nd_small = 4 ; Common->method [6].nd_camd = 0 ; /* no CSYMAMD or CAMD */ /* CHOLMOD's nested dissection with no dense node removal */ Common->method [7].ordering = CHOLMOD_NESDIS ; Common->method [7].prune_dense = -1. ; /* COLAMD for A*A', AMD for A */ Common->method [8].ordering = CHOLMOD_COLAMD ; /* ---------------------------------------------------------------------- */ /* GPU configuration and statistics */ /* ---------------------------------------------------------------------- */ #ifdef DLONG Common->useGPU = EMPTY ; #else /* GPU acceleration is not supported for int version of CHOLMOD */ Common->useGPU = 0 ; #endif return (TRUE) ; } /* ========================================================================== */ /* === cholmod_finish ======================================================= */ /* ========================================================================== */ /* The last call to CHOLMOD must be cholmod_finish. You may call this routine * more than once, and can safely call any other CHOLMOD routine after calling * it (including cholmod_start). * * The statistics and parameter settings in Common are preserved. The * workspace in Common is freed. This routine is just another name for * cholmod_free_work. */ int CHOLMOD(finish) ( cholmod_common *Common ) { return (CHOLMOD(free_work) (Common)) ; } /* ========================================================================== */ /* === cholmod_allocate_work ================================================ */ /* ========================================================================== */ /* Allocate and initialize workspace for CHOLMOD routines, or increase the size * of already-allocated workspace. If enough workspace is already allocated, * then nothing happens. * * workspace: Flag (nrow), Head (nrow+1), Iwork (iworksize), Xwork (xworksize) */ int CHOLMOD(allocate_work) ( /* ---- input ---- */ size_t nrow, /* # of rows in the matrix A */ size_t iworksize, /* size of Iwork */ size_t xworksize, /* size of Xwork */ /* --------------- */ cholmod_common *Common ) { double *W ; Int *Head ; Int i ; size_t nrow1 ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* Allocate Flag (nrow) and Head (nrow+1) */ /* ---------------------------------------------------------------------- */ nrow = MAX (1, nrow) ; /* nrow1 = nrow + 1 */ nrow1 = CHOLMOD(add_size_t) (nrow, 1, &ok) ; if (!ok) { /* nrow+1 causes size_t overflow ; problem is too large */ Common->status = CHOLMOD_TOO_LARGE ; CHOLMOD(free_work) (Common) ; return (FALSE) ; } if (nrow > Common->nrow) { if (Common->no_workspace_reallocate) { /* CHOLMOD is not allowed to change the workspace here */ Common->status = CHOLMOD_INVALID ; return (FALSE) ; } /* free the old workspace (if any) and allocate new space */ Common->Flag = CHOLMOD(free) (Common->nrow, sizeof (Int), Common->Flag, Common) ; Common->Head = CHOLMOD(free) (Common->nrow+1,sizeof (Int), Common->Head, Common) ; Common->Flag = CHOLMOD(malloc) (nrow, sizeof (Int), Common) ; Common->Head = CHOLMOD(malloc) (nrow1, sizeof (Int), Common) ; /* record the new size of Flag and Head */ Common->nrow = nrow ; if (Common->status < CHOLMOD_OK) { CHOLMOD(free_work) (Common) ; return (FALSE) ; } /* initialize Flag and Head */ Common->mark = EMPTY ; CHOLMOD(clear_flag) (Common) ; Head = Common->Head ; for (i = 0 ; i <= (Int) (nrow) ; i++) { Head [i] = EMPTY ; } } /* ---------------------------------------------------------------------- */ /* Allocate Iwork (iworksize) */ /* ---------------------------------------------------------------------- */ iworksize = MAX (1, iworksize) ; if (iworksize > Common->iworksize) { if (Common->no_workspace_reallocate) { /* CHOLMOD is not allowed to change the workspace here */ Common->status = CHOLMOD_INVALID ; return (FALSE) ; } /* free the old workspace (if any) and allocate new space. * integer overflow safely detected in cholmod_malloc */ CHOLMOD(free) (Common->iworksize, sizeof (Int), Common->Iwork, Common) ; Common->Iwork = CHOLMOD(malloc) (iworksize, sizeof (Int), Common) ; /* record the new size of Iwork */ Common->iworksize = iworksize ; if (Common->status < CHOLMOD_OK) { CHOLMOD(free_work) (Common) ; return (FALSE) ; } /* note that Iwork does not need to be initialized */ } /* ---------------------------------------------------------------------- */ /* Allocate Xwork (xworksize) and set it to ((double) 0.) */ /* ---------------------------------------------------------------------- */ /* make sure xworksize is >= 1 */ xworksize = MAX (1, xworksize) ; if (xworksize > Common->xworksize) { if (Common->no_workspace_reallocate) { /* CHOLMOD is not allowed to change the workspace here */ Common->status = CHOLMOD_INVALID ; return (FALSE) ; } /* free the old workspace (if any) and allocate new space */ CHOLMOD(free) (Common->xworksize, sizeof (double), Common->Xwork, Common) ; Common->Xwork = CHOLMOD(malloc) (xworksize, sizeof (double), Common) ; /* record the new size of Xwork */ Common->xworksize = xworksize ; if (Common->status < CHOLMOD_OK) { CHOLMOD(free_work) (Common) ; return (FALSE) ; } /* initialize Xwork */ W = Common->Xwork ; for (i = 0 ; i < (Int) xworksize ; i++) { W [i] = 0. ; } } return (TRUE) ; } /* ========================================================================== */ /* === cholmod_free_work ==================================================== */ /* ========================================================================== */ /* Deallocate the CHOLMOD workspace. * * workspace: deallocates all workspace in Common */ int CHOLMOD(free_work) ( cholmod_common *Common ) { RETURN_IF_NULL_COMMON (FALSE) ; Common->Flag = CHOLMOD(free) (Common->nrow, sizeof (Int), Common->Flag, Common) ; Common->Head = CHOLMOD(free) (Common->nrow+1, sizeof (Int), Common->Head, Common) ; Common->Iwork = CHOLMOD(free) (Common->iworksize, sizeof (Int), Common->Iwork, Common) ; Common->Xwork = CHOLMOD(free) (Common->xworksize, sizeof (double), Common->Xwork, Common) ; Common->nrow = 0 ; Common->iworksize = 0 ; Common->xworksize = 0 ; #ifdef GPU_BLAS CHOLMOD(gpu_deallocate) (Common) ; #endif return (TRUE) ; } /* ========================================================================== */ /* === cholmod_clear_flag =================================================== */ /* ========================================================================== */ /* Increment mark to ensure Flag [0..nrow-1] < mark. If integer overflow * occurs, or mark was initially negative, reset the entire array. This is * not an error condition, but an intended function of the Flag workspace. * * workspace: Flag (nrow). Does not modify Flag if nrow is zero. */ SuiteSparse_long CHOLMOD(clear_flag) ( cholmod_common *Common ) { Int i, nrow, *Flag ; RETURN_IF_NULL_COMMON (-1) ; Common->mark++ ; if (Common->mark <= 0) { nrow = Common->nrow ; Flag = Common->Flag ; PRINT2 (("reset Flag: nrow "ID"\n", nrow)) ; PRINT2 (("reset Flag: mark %ld\n", Common->mark)) ; for (i = 0 ; i < nrow ; i++) { Flag [i] = EMPTY ; } Common->mark = 0 ; } return (Common->mark) ; } /* ========================================================================== */ /* ==== cholmod_maxrank ===================================================== */ /* ========================================================================== */ /* Find a valid value of Common->maxrank. Returns 0 if error, or 2, 4, or 8 * if successful. */ size_t CHOLMOD(maxrank) /* returns validated value of Common->maxrank */ ( /* ---- input ---- */ size_t n, /* A and L will have n rows */ /* --------------- */ cholmod_common *Common ) { size_t maxrank ; RETURN_IF_NULL_COMMON (0) ; maxrank = Common->maxrank ; if (n > 0) { /* Ensure maxrank*n*sizeof(double) does not result in integer overflow. * If n is so large that 2*n*sizeof(double) results in integer overflow * (n = 268,435,455 if an Int is 32 bits), then maxrank will be 0 or 1, * but maxrank will be set to 2 below. 2*n will not result in integer * overflow, and CHOLMOD will run out of memory or safely detect integer * overflow elsewhere. */ maxrank = MIN (maxrank, Size_max / (n * sizeof (double))) ; } if (maxrank <= 2) { maxrank = 2 ; } else if (maxrank <= 4) { maxrank = 4 ; } else { maxrank = 8 ; } return (maxrank) ; } /* ========================================================================== */ /* === cholmod_dbound ======================================================= */ /* ========================================================================== */ /* Ensure the absolute value of a diagonal entry, D (j,j), is greater than * Common->dbound. This routine is not meant for the user to call. It is used * by the various LDL' factorization and update/downdate routines. The * default value of Common->dbound is zero, and in that case this routine is not * called at all. No change is made if D (j,j) is NaN. CHOLMOD does not call * this routine if Common->dbound is NaN. */ double CHOLMOD(dbound) /* returns modified diagonal entry of D */ ( /* ---- input ---- */ double dj, /* diagonal entry of D, for LDL' factorization */ /* --------------- */ cholmod_common *Common ) { double dbound ; RETURN_IF_NULL_COMMON (0) ; if (!IS_NAN (dj)) { dbound = Common->dbound ; if (dj < 0) { if (dj > -dbound) { dj = -dbound ; Common->ndbounds_hit++ ; if (Common->status == CHOLMOD_OK) { ERROR (CHOLMOD_DSMALL, "diagonal below threshold") ; } } } else { if (dj < dbound) { dj = dbound ; Common->ndbounds_hit++ ; if (Common->status == CHOLMOD_OK) { ERROR (CHOLMOD_DSMALL, "diagonal below threshold") ; } } } } return (dj) ; } /* ========================================================================== */ /* === scorecomp ============================================================ */ /* ========================================================================== */ /* For sorting descendant supernodes with qsort */ int CHOLMOD(score_comp) (struct cholmod_descendant_score_t *i, struct cholmod_descendant_score_t *j) { if ((*i).score < (*j).score) { return (1) ; } else { return (-1) ; } } Matrix/src/CHOLMOD/Core/cholmod_aat.c0000644000176200001440000002035413652535054016714 0ustar liggesusers/* ========================================================================== */ /* === Core/cholmod_aat ===================================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Core Module. Copyright (C) 2005-2006, * Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* C = A*A' or C = A(:,f)*A(:,f)' * * A can be packed or unpacked, sorted or unsorted, but must be stored with * both upper and lower parts (A->stype of zero). C is returned as packed, * C->stype of zero (both upper and lower parts present), and unsorted. See * cholmod_ssmult in the MatrixOps Module for a more general matrix-matrix * multiply. * * You can trivially convert C into a symmetric upper/lower matrix by * changing C->stype = 1 or -1 after calling this routine. * * workspace: * Flag (A->nrow), * Iwork (max (A->nrow, A->ncol)) if fset present, * Iwork (A->nrow) if no fset, * W (A->nrow) if mode > 0, * allocates temporary copy for A'. * * A can be pattern or real. Complex or zomplex cases are supported only * if the mode is <= 0 (in which case the numerical values are ignored). */ #include "cholmod_internal.h" #include "cholmod_core.h" cholmod_sparse *CHOLMOD(aat) ( /* ---- input ---- */ cholmod_sparse *A, /* input matrix; C=A*A' is constructed */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ int mode, /* >0: numerical, 0: pattern, <0: pattern (no diag) * -2: pattern only, no diagonal, add 50% + n extra * space to C */ /* --------------- */ cholmod_common *Common ) { double fjt ; double *Ax, *Fx, *Cx, *W ; Int *Ap, *Anz, *Ai, *Fp, *Fi, *Cp, *Ci, *Flag ; cholmod_sparse *C, *F ; Int packed, j, i, pa, paend, pf, pfend, n, mark, cnz, t, p, values, diag, extra ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (A, NULL) ; values = (mode > 0) && (A->xtype != CHOLMOD_PATTERN) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ; if (A->stype) { ERROR (CHOLMOD_INVALID, "matrix cannot be symmetric") ; return (NULL) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ diag = (mode >= 0) ; n = A->nrow ; CHOLMOD(allocate_work) (n, MAX (A->ncol, A->nrow), values ? n : 0, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n : 0, Common)) ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ ASSERT (CHOLMOD(dump_sparse) (A, "A", Common) >= 0) ; /* get the A matrix */ Ap = A->p ; Anz = A->nz ; Ai = A->i ; Ax = A->x ; packed = A->packed ; /* get workspace */ W = Common->Xwork ; /* size n, unused if values is FALSE */ Flag = Common->Flag ; /* size n, Flag [0..n-1] < mark on input*/ /* ---------------------------------------------------------------------- */ /* F = A' or A(:,f)' */ /* ---------------------------------------------------------------------- */ /* workspace: Iwork (nrow if no fset; MAX (nrow,ncol) if fset)*/ F = CHOLMOD(ptranspose) (A, values, NULL, fset, fsize, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } Fp = F->p ; Fi = F->i ; Fx = F->x ; /* ---------------------------------------------------------------------- */ /* count the number of entries in the result C */ /* ---------------------------------------------------------------------- */ cnz = 0 ; for (j = 0 ; j < n ; j++) { /* clear the Flag array */ /* mark = CHOLMOD(clear_flag) (Common) ; */ CHOLMOD_CLEAR_FLAG (Common) ; mark = Common->mark ; /* exclude the diagonal, if requested */ if (!diag) { Flag [j] = mark ; } /* for each nonzero F(t,j) in column j, do: */ pfend = Fp [j+1] ; for (pf = Fp [j] ; pf < pfend ; pf++) { /* F(t,j) is nonzero */ t = Fi [pf] ; /* add the nonzero pattern of A(:,t) to the pattern of C(:,j) */ pa = Ap [t] ; paend = (packed) ? (Ap [t+1]) : (pa + Anz [t]) ; for ( ; pa < paend ; pa++) { i = Ai [pa] ; if (Flag [i] != mark) { Flag [i] = mark ; cnz++ ; } } } if (cnz < 0) { break ; /* integer overflow case */ } } extra = (mode == -2) ? (cnz/2 + n) : 0 ; mark = CHOLMOD(clear_flag) (Common) ; /* ---------------------------------------------------------------------- */ /* check for integer overflow */ /* ---------------------------------------------------------------------- */ if (cnz < 0 || (cnz + extra) < 0) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; CHOLMOD(clear_flag) (Common) ; CHOLMOD(free_sparse) (&F, Common) ; return (NULL) ; /* problem too large */ } /* ---------------------------------------------------------------------- */ /* allocate C */ /* ---------------------------------------------------------------------- */ C = CHOLMOD(allocate_sparse) (n, n, cnz + extra, FALSE, TRUE, 0, values ? A->xtype : CHOLMOD_PATTERN, Common) ; if (Common->status < CHOLMOD_OK) { CHOLMOD(free_sparse) (&F, Common) ; return (NULL) ; /* out of memory */ } Cp = C->p ; Ci = C->i ; Cx = C->x ; /* ---------------------------------------------------------------------- */ /* C = A*A' */ /* ---------------------------------------------------------------------- */ cnz = 0 ; if (values) { /* pattern and values */ for (j = 0 ; j < n ; j++) { /* clear the Flag array */ mark = CHOLMOD(clear_flag) (Common) ; /* start column j of C */ Cp [j] = cnz ; /* for each nonzero F(t,j) in column j, do: */ pfend = Fp [j+1] ; for (pf = Fp [j] ; pf < pfend ; pf++) { /* F(t,j) is nonzero */ t = Fi [pf] ; fjt = Fx [pf] ; /* add the nonzero pattern of A(:,t) to the pattern of C(:,j) * and scatter the values into W */ pa = Ap [t] ; paend = (packed) ? (Ap [t+1]) : (pa + Anz [t]) ; for ( ; pa < paend ; pa++) { i = Ai [pa] ; if (Flag [i] != mark) { Flag [i] = mark ; Ci [cnz++] = i ; } W [i] += Ax [pa] * fjt ; } } /* gather the values into C(:,j) */ for (p = Cp [j] ; p < cnz ; p++) { i = Ci [p] ; Cx [p] = W [i] ; W [i] = 0 ; } } } else { /* pattern only */ for (j = 0 ; j < n ; j++) { /* clear the Flag array */ mark = CHOLMOD(clear_flag) (Common) ; /* exclude the diagonal, if requested */ if (!diag) { Flag [j] = mark ; } /* start column j of C */ Cp [j] = cnz ; /* for each nonzero F(t,j) in column j, do: */ pfend = Fp [j+1] ; for (pf = Fp [j] ; pf < pfend ; pf++) { /* F(t,j) is nonzero */ t = Fi [pf] ; /* add the nonzero pattern of A(:,t) to the pattern of C(:,j) */ pa = Ap [t] ; paend = (packed) ? (Ap [t+1]) : (pa + Anz [t]) ; for ( ; pa < paend ; pa++) { i = Ai [pa] ; if (Flag [i] != mark) { Flag [i] = mark ; Ci [cnz++] = i ; } } } } } Cp [n] = cnz ; ASSERT (IMPLIES (mode != -2, MAX (1,cnz) == C->nzmax)) ; /* ---------------------------------------------------------------------- */ /* clear workspace and free temporary matrices and return result */ /* ---------------------------------------------------------------------- */ CHOLMOD(free_sparse) (&F, Common) ; CHOLMOD(clear_flag) (Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n : 0, Common)) ; DEBUG (i = CHOLMOD(dump_sparse) (C, "aat", Common)) ; ASSERT (IMPLIES (mode < 0, i == 0)) ; return (C) ; } Matrix/src/CHOLMOD/Core/cholmod_complex.c0000644000176200001440000003525113652535054017620 0ustar liggesusers/* ========================================================================== */ /* === Core/cholmod_complex ================================================= */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Core Module. Copyright (C) 2005-2006, * Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* If you convert a matrix that contains uninitialized data, valgrind will * complain. This can occur in a factor L which has gaps (a partial * factorization, or after updates that change the nonzero pattern), an * unpacked sparse matrix, a dense matrix with leading dimension d > # of rows, * or any matrix (dense, sparse, triplet, or factor) with more space allocated * than is used. You can safely ignore any of these complaints by valgrind. */ #include "cholmod_internal.h" #include "cholmod_core.h" /* ========================================================================== */ /* === cholmod_hypot ======================================================== */ /* ========================================================================== */ double CHOLMOD(hypot) (double x, double y) { return (SuiteSparse_config.hypot_func (x, y)) ; } /* ========================================================================== */ /* === cholmod_divcomplex =================================================== */ /* ========================================================================== */ /* c = a/b where c, a, and b are complex. The real and imaginary parts are * passed as separate arguments to this routine. The NaN case is ignored * for the double relop br >= bi. Returns 1 if the denominator is zero, * 0 otherwise. Note that this return value is the single exception to the * rule that all CHOLMOD routines that return int return TRUE if successful * or FALSE otherise. * * This uses ACM Algo 116, by R. L. Smith, 1962, which tries to avoid * underflow and overflow. * * c can be the same variable as a or b. * * Default value of the SuiteSparse_config.divcomplex_func pointer is * SuiteSparse_divcomplex, located in SuiteSparse_config.c. */ int CHOLMOD(divcomplex) ( double ar, double ai, /* real and imaginary parts of a */ double br, double bi, /* real and imaginary parts of b */ double *cr, double *ci /* real and imaginary parts of c */ ) { return (SuiteSparse_config.divcomplex_func (ar, ai, br, bi, cr, ci)) ; } /* ========================================================================== */ /* === change_complexity ==================================================== */ /* ========================================================================== */ /* X and Z represent an array of size nz, with numeric xtype given by xtype_in. * * If xtype_in is: * CHOLMOD_PATTERN: X and Z must be NULL. * CHOLMOD_REAL: X is of size nz, Z must be NULL. * CHOLMOD_COMPLEX: X is of size 2*nz, Z must be NULL. * CHOLMOD_ZOMPLEX: X is of size nz, Z is of size nz. * * The array is changed into the numeric xtype given by xtype_out, with the * same definitions of X and Z above. Note that the input conditions, above, * are not checked. These are checked in the caller routine. * * Returns TRUE if successful, FALSE otherwise. X and Z are not modified if * not successful. */ static int change_complexity ( /* ---- input ---- */ Int nz, /* size of X and/or Z */ int xtype_in, /* xtype of X and Z on input */ int xtype_out, /* requested xtype of X and Z on output */ int xtype1, /* xtype_out must be in the range [xtype1 .. xtype2] */ int xtype2, /* ---- in/out --- */ void **XX, /* old X on input, new X on output */ void **ZZ, /* old Z on input, new Z on output */ /* --------------- */ cholmod_common *Common ) { double *Xold, *Zold, *Xnew, *Znew ; Int k ; size_t nz2 ; if (xtype_out < xtype1 || xtype_out > xtype2) { ERROR (CHOLMOD_INVALID, "invalid xtype") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; Xold = *XX ; Zold = *ZZ ; switch (xtype_in) { /* ------------------------------------------------------------------ */ /* converting from pattern */ /* ------------------------------------------------------------------ */ case CHOLMOD_PATTERN: switch (xtype_out) { /* ---------------------------------------------------------- */ /* pattern -> real */ /* ---------------------------------------------------------- */ case CHOLMOD_REAL: /* allocate X and set to all ones */ Xnew = CHOLMOD(malloc) (nz, sizeof (double), Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } for (k = 0 ; k < nz ; k++) { Xnew [k] = 1 ; } *XX = Xnew ; break ; /* ---------------------------------------------------------- */ /* pattern -> complex */ /* ---------------------------------------------------------- */ case CHOLMOD_COMPLEX: /* allocate X and set to all ones */ Xnew = CHOLMOD(malloc) (nz, 2*sizeof (double), Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } for (k = 0 ; k < nz ; k++) { Xnew [2*k ] = 1 ; Xnew [2*k+1] = 0 ; } *XX = Xnew ; break ; /* ---------------------------------------------------------- */ /* pattern -> zomplex */ /* ---------------------------------------------------------- */ case CHOLMOD_ZOMPLEX: /* allocate X and Z and set to all ones */ Xnew = CHOLMOD(malloc) (nz, sizeof (double), Common) ; Znew = CHOLMOD(malloc) (nz, sizeof (double), Common) ; if (Common->status < CHOLMOD_OK) { CHOLMOD(free) (nz, sizeof (double), Xnew, Common) ; CHOLMOD(free) (nz, sizeof (double), Znew, Common) ; return (FALSE) ; } for (k = 0 ; k < nz ; k++) { Xnew [k] = 1 ; Znew [k] = 0 ; } *XX = Xnew ; *ZZ = Znew ; break ; } break ; /* ------------------------------------------------------------------ */ /* converting from real */ /* ------------------------------------------------------------------ */ case CHOLMOD_REAL: switch (xtype_out) { /* ---------------------------------------------------------- */ /* real -> pattern */ /* ---------------------------------------------------------- */ case CHOLMOD_PATTERN: /* free X */ *XX = CHOLMOD(free) (nz, sizeof (double), *XX, Common) ; break ; /* ---------------------------------------------------------- */ /* real -> complex */ /* ---------------------------------------------------------- */ case CHOLMOD_COMPLEX: /* allocate a new X and copy the old X */ Xnew = CHOLMOD(malloc) (nz, 2*sizeof (double), Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } for (k = 0 ; k < nz ; k++) { Xnew [2*k ] = Xold [k] ; Xnew [2*k+1] = 0 ; } CHOLMOD(free) (nz, sizeof (double), *XX, Common) ; *XX = Xnew ; break ; /* ---------------------------------------------------------- */ /* real -> zomplex */ /* ---------------------------------------------------------- */ case CHOLMOD_ZOMPLEX: /* allocate a new Z and set it to zero */ Znew = CHOLMOD(malloc) (nz, sizeof (double), Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } for (k = 0 ; k < nz ; k++) { Znew [k] = 0 ; } *ZZ = Znew ; break ; } break ; /* ------------------------------------------------------------------ */ /* converting from complex */ /* ------------------------------------------------------------------ */ case CHOLMOD_COMPLEX: switch (xtype_out) { /* ---------------------------------------------------------- */ /* complex -> pattern */ /* ---------------------------------------------------------- */ case CHOLMOD_PATTERN: /* free X */ *XX = CHOLMOD(free) (nz, 2*sizeof (double), *XX, Common) ; break ; /* ---------------------------------------------------------- */ /* complex -> real */ /* ---------------------------------------------------------- */ case CHOLMOD_REAL: /* pack the real part of X, discarding the imaginary part */ for (k = 0 ; k < nz ; k++) { Xold [k] = Xold [2*k] ; } /* shrink X in half (this cannot fail) */ nz2 = 2*nz ; *XX = CHOLMOD(realloc) (nz, sizeof (double), *XX, &nz2, Common) ; break ; /* ---------------------------------------------------------- */ /* complex -> zomplex */ /* ---------------------------------------------------------- */ case CHOLMOD_ZOMPLEX: /* allocate X and Z and copy the old X into them */ Xnew = CHOLMOD(malloc) (nz, sizeof (double), Common) ; Znew = CHOLMOD(malloc) (nz, sizeof (double), Common) ; if (Common->status < CHOLMOD_OK) { CHOLMOD(free) (nz, sizeof (double), Xnew, Common) ; CHOLMOD(free) (nz, sizeof (double), Znew, Common) ; return (FALSE) ; } for (k = 0 ; k < nz ; k++) { Xnew [k] = Xold [2*k ] ; Znew [k] = Xold [2*k+1] ; } CHOLMOD(free) (nz, 2*sizeof (double), *XX, Common) ; *XX = Xnew ; *ZZ = Znew ; break ; } break ; /* ------------------------------------------------------------------ */ /* converting from zomplex */ /* ------------------------------------------------------------------ */ case CHOLMOD_ZOMPLEX: switch (xtype_out) { /* ---------------------------------------------------------- */ /* zomplex -> pattern */ /* ---------------------------------------------------------- */ case CHOLMOD_PATTERN: /* free X and Z */ *XX = CHOLMOD(free) (nz, sizeof (double), *XX, Common) ; *ZZ = CHOLMOD(free) (nz, sizeof (double), *ZZ, Common) ; break ; /* ---------------------------------------------------------- */ /* zomplex -> real */ /* ---------------------------------------------------------- */ case CHOLMOD_REAL: /* free the imaginary part */ *ZZ = CHOLMOD(free) (nz, sizeof (double), *ZZ, Common) ; break ; /* ---------------------------------------------------------- */ /* zomplex -> complex */ /* ---------------------------------------------------------- */ case CHOLMOD_COMPLEX: Xnew = CHOLMOD(malloc) (nz, 2*sizeof (double), Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } for (k = 0 ; k < nz ; k++) { Xnew [2*k ] = Xold [k] ; Xnew [2*k+1] = Zold [k] ; } CHOLMOD(free) (nz, sizeof (double), *XX, Common) ; CHOLMOD(free) (nz, sizeof (double), *ZZ, Common) ; *XX = Xnew ; *ZZ = NULL ; break ; } break ; } return (TRUE) ; } /* ========================================================================== */ /* === cholmod_sparse_xtype ================================================= */ /* ========================================================================== */ /* Change the numeric xtype of a sparse matrix. Supports any type on input * and output (pattern, real, complex, or zomplex). */ int CHOLMOD(sparse_xtype) ( /* ---- input ---- */ int to_xtype, /* requested xtype */ /* ---- in/out --- */ cholmod_sparse *A, /* sparse matrix to change */ /* --------------- */ cholmod_common *Common ) { Int ok ; RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; ok = change_complexity (A->nzmax, A->xtype, to_xtype, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, &(A->x), &(A->z), Common) ; if (ok) { A->xtype = to_xtype ; } return (ok) ; } /* ========================================================================== */ /* === cholmod_triplet_xtype ================================================ */ /* ========================================================================== */ /* Change the numeric xtype of a triplet matrix. Supports any type on input * and output (pattern, real, complex, or zomplex). */ int CHOLMOD(triplet_xtype) ( /* ---- input ---- */ int to_xtype, /* requested xtype */ /* ---- in/out --- */ cholmod_triplet *T, /* triplet matrix to change */ /* --------------- */ cholmod_common *Common ) { Int ok ; RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (T, FALSE) ; RETURN_IF_XTYPE_INVALID (T, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; ok = change_complexity (T->nzmax, T->xtype, to_xtype, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, &(T->x), &(T->z), Common) ; if (ok) { T->xtype = to_xtype ; } return (ok) ; } /* ========================================================================== */ /* === cholmod_dense_xtype ================================================= */ /* ========================================================================== */ /* Change the numeric xtype of a dense matrix. Supports real, complex or * zomplex on input and output */ int CHOLMOD(dense_xtype) ( /* ---- input ---- */ int to_xtype, /* requested xtype */ /* ---- in/out --- */ cholmod_dense *X, /* dense matrix to change */ /* --------------- */ cholmod_common *Common ) { Int ok ; RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (X, FALSE) ; RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ; ok = change_complexity (X->nzmax, X->xtype, to_xtype, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, &(X->x), &(X->z), Common) ; if (ok) { X->xtype = to_xtype ; } return (ok) ; } /* ========================================================================== */ /* === cholmod_factor_xtype ================================================= */ /* ========================================================================== */ /* Change the numeric xtype of a factor. Supports real, complex or zomplex on * input and output. Supernodal zomplex factors are not supported. */ int CHOLMOD(factor_xtype) ( /* ---- input ---- */ int to_xtype, /* requested xtype */ /* ---- in/out --- */ cholmod_factor *L, /* factor to change */ /* --------------- */ cholmod_common *Common ) { Int ok ; RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ; if (L->is_super && (L->xtype == CHOLMOD_ZOMPLEX || to_xtype == CHOLMOD_ZOMPLEX)) { ERROR (CHOLMOD_INVALID, "invalid xtype for supernodal L") ; return (FALSE) ; } ok = change_complexity ((L->is_super ? L->xsize : L->nzmax), L->xtype, to_xtype, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, &(L->x), &(L->z), Common) ; if (ok) { L->xtype = to_xtype ; } return (ok) ; } Matrix/src/CHOLMOD/Core/t_cholmod_transpose.c0000644000176200001440000002070313652535054020506 0ustar liggesusers/* ========================================================================== */ /* === Core/t_cholmod_transpose ============================================= */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Core Module. Copyright (C) 2005-2006, * Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* Template routine for cholmod_transpose. All xtypes are supported. For * complex matrices, either the array tranpose or complex conjugate transpose * can be computed. */ #include "cholmod_template.h" /* ========================================================================== */ /* === t_cholmod_transpose_unsym ============================================ */ /* ========================================================================== */ /* Compute F = A', A (:,f)', or A (p,f)', where A is unsymmetric and F is * already allocated. The complex case performs either the array transpose * or complex conjugate transpose. * * workspace: * Iwork (MAX (nrow,ncol)) if fset is present * Iwork (nrow) if fset is NULL */ static int TEMPLATE (cholmod_transpose_unsym) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to transpose */ Int *Perm, /* size nrow, if present (can be NULL) */ Int *fset, /* subset of 0:(A->ncol)-1 */ Int nf, /* size of fset */ /* ---- output --- */ cholmod_sparse *F, /* F = A', A(:,f)', or A(p,f)' */ /* --------------- */ cholmod_common *Common ) { double *Ax, *Az, *Fx, *Fz ; Int *Ap, *Anz, *Ai, *Fp, *Fnz, *Fj, *Wi, *Iwork ; Int j, p, pend, nrow, ncol, Apacked, use_fset, fp, Fpacked, jj, permute ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ /* ensure the xtype of A and F match (ignored if this is pattern version) */ if (!XTYPE_OK (A->xtype)) { ERROR (CHOLMOD_INVALID, "real/complex mismatch") ; return (FALSE) ; } /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ use_fset = (fset != NULL) ; nrow = A->nrow ; ncol = A->ncol ; Ap = A->p ; /* size A->ncol+1, column pointers of A */ Ai = A->i ; /* size nz = Ap [A->ncol], row indices of A */ Ax = A->x ; /* size nz, real values of A */ Az = A->z ; /* size nz, imag values of A */ Anz = A->nz ; Apacked = A->packed ; ASSERT (IMPLIES (!Apacked, Anz != NULL)) ; permute = (Perm != NULL) ; Fp = F->p ; /* size A->nrow+1, row pointers of F */ Fj = F->i ; /* size nz, column indices of F */ Fx = F->x ; /* size nz, real values of F */ Fz = F->z ; /* size nz, imag values of F */ Fnz = F->nz ; Fpacked = F->packed ; ASSERT (IMPLIES (!Fpacked, Fnz != NULL)) ; nf = (use_fset) ? nf : ncol ; /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ Iwork = Common->Iwork ; Wi = Iwork ; /* size nrow (i/l/l) */ /* ---------------------------------------------------------------------- */ /* construct the transpose */ /* ---------------------------------------------------------------------- */ for (jj = 0 ; jj < nf ; jj++) { j = (use_fset) ? (fset [jj]) : jj ; p = Ap [j] ; pend = (Apacked) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { fp = Wi [Ai [p]]++ ; Fj [fp] = j ; #ifdef NCONJUGATE ASSIGN (Fx, Fz, fp, Ax, Az, p) ; #else ASSIGN_CONJ (Fx, Fz, fp, Ax, Az, p) ; #endif } } return (TRUE) ; } /* ========================================================================== */ /* === t_cholmod_transpose_sym ============================================== */ /* ========================================================================== */ /* Compute F = A' or A (p,p)', where A is symmetric and F is already allocated. * The complex case performs either the array transpose or complex conjugate * transpose. * * workspace: Iwork (nrow) if Perm NULL, Iwork (2*nrow) if Perm non-NULL. */ static int TEMPLATE (cholmod_transpose_sym) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to transpose */ Int *Perm, /* size n, if present (can be NULL) */ /* ---- output --- */ cholmod_sparse *F, /* F = A' or A(p,p)' */ /* --------------- */ cholmod_common *Common ) { double *Ax, *Az, *Fx, *Fz ; Int *Ap, *Anz, *Ai, *Fp, *Fj, *Wi, *Pinv, *Iwork ; Int p, pend, packed, fp, upper, permute, jold, n, i, j, iold ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ /* ensure the xtype of A and F match (ignored if this is pattern version) */ if (!XTYPE_OK (A->xtype)) { ERROR (CHOLMOD_INVALID, "real/complex mismatch") ; return (FALSE) ; } /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ permute = (Perm != NULL) ; n = A->nrow ; Ap = A->p ; /* size A->ncol+1, column pointers of A */ Ai = A->i ; /* size nz = Ap [A->ncol], row indices of A */ Ax = A->x ; /* size nz, real values of A */ Az = A->z ; /* size nz, imag values of A */ Anz = A->nz ; packed = A->packed ; ASSERT (IMPLIES (!packed, Anz != NULL)) ; upper = (A->stype > 0) ; Fp = F->p ; /* size A->nrow+1, row pointers of F */ Fj = F->i ; /* size nz, column indices of F */ Fx = F->x ; /* size nz, real values of F */ Fz = F->z ; /* size nz, imag values of F */ /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ Iwork = Common->Iwork ; Wi = Iwork ; /* size n (i/l/l) */ Pinv = Iwork + n ; /* size n (i/i/l) , unused if Perm NULL */ /* ---------------------------------------------------------------------- */ /* construct the transpose */ /* ---------------------------------------------------------------------- */ if (permute) { if (upper) { /* permuted, upper */ for (j = 0 ; j < n ; j++) { jold = Perm [j] ; p = Ap [jold] ; pend = (packed) ? Ap [jold+1] : p + Anz [jold] ; for ( ; p < pend ; p++) { iold = Ai [p] ; if (iold <= jold) { i = Pinv [iold] ; if (i < j) { fp = Wi [i]++ ; Fj [fp] = j ; #ifdef NCONJUGATE ASSIGN (Fx, Fz, fp, Ax, Az, p) ; #else ASSIGN_CONJ (Fx, Fz, fp, Ax, Az, p) ; #endif } else { fp = Wi [j]++ ; Fj [fp] = i ; ASSIGN (Fx, Fz, fp, Ax, Az, p) ; } } } } } else { /* permuted, lower */ for (j = 0 ; j < n ; j++) { jold = Perm [j] ; p = Ap [jold] ; pend = (packed) ? Ap [jold+1] : p + Anz [jold] ; for ( ; p < pend ; p++) { iold = Ai [p] ; if (iold >= jold) { i = Pinv [iold] ; if (i > j) { fp = Wi [i]++ ; Fj [fp] = j ; #ifdef NCONJUGATE ASSIGN (Fx, Fz, fp, Ax, Az, p) ; #else ASSIGN_CONJ (Fx, Fz, fp, Ax, Az, p) ; #endif } else { fp = Wi [j]++ ; Fj [fp] = i ; ASSIGN (Fx, Fz, fp, Ax, Az, p) ; } } } } } } else { if (upper) { /* unpermuted, upper */ for (j = 0 ; j < n ; j++) { p = Ap [j] ; pend = (packed) ? Ap [j+1] : p + Anz [j] ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i <= j) { fp = Wi [i]++ ; Fj [fp] = j ; #ifdef NCONJUGATE ASSIGN (Fx, Fz, fp, Ax, Az, p) ; #else ASSIGN_CONJ (Fx, Fz, fp, Ax, Az, p) ; #endif } } } } else { /* unpermuted, lower */ for (j = 0 ; j < n ; j++) { p = Ap [j] ; pend = (packed) ? Ap [j+1] : p + Anz [j] ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i >= j) { fp = Wi [i]++ ; Fj [fp] = j ; #ifdef NCONJUGATE ASSIGN (Fx, Fz, fp, Ax, Az, p) ; #else ASSIGN_CONJ (Fx, Fz, fp, Ax, Az, p) ; #endif } } } } } return (TRUE) ; } #undef PATTERN #undef REAL #undef COMPLEX #undef ZOMPLEX #undef NCONJUGATE Matrix/src/CHOLMOD/Core/cholmod_version.c0000644000176200001440000000226013652535054017630 0ustar liggesusers/* ========================================================================== */ /* === Core/cholmod_version ================================================= */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Core Module. Copyright (C) 2005-2013, * Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* Return the current version of CHOLMOD. Unlike all other functions in CHOLMOD, this function does not require the CHOLMOD Common. */ #include "cholmod_internal.h" #include "cholmod_core.h" int CHOLMOD(version) /* returns CHOLMOD_VERSION */ ( /* output, contents not defined on input. Not used if NULL. version [0] = CHOLMOD_MAIN_VERSION ; version [1] = CHOLMOD_SUB_VERSION ; version [2] = CHOLMOD_SUBSUB_VERSION ; */ int version [3] ) { if (version != NULL) { version [0] = CHOLMOD_MAIN_VERSION ; version [1] = CHOLMOD_SUB_VERSION ; version [2] = CHOLMOD_SUBSUB_VERSION ; } return (CHOLMOD_VERSION) ; } Matrix/src/CHOLMOD/Core/t_cholmod_triplet.c0000644000176200001440000001054213652535054020153 0ustar liggesusers/* ========================================================================== */ /* === Core/t_cholmod_triplet =============================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Core Module. Copyright (C) 2005-2006, * Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* Template routine for cholmod_triplet. All xtypes supported */ #include "cholmod_template.h" /* ========================================================================== */ /* === t_cholmod_triplet_to_sparse ========================================== */ /* ========================================================================== */ static size_t TEMPLATE (cholmod_triplet_to_sparse) ( /* ---- input ---- */ cholmod_triplet *T, /* matrix to copy */ /* ---- in/out --- */ cholmod_sparse *R, /* output matrix */ /* --------------- */ cholmod_common *Common ) { double *Rx, *Rz, *Tx, *Tz ; Int *Wj, *Rp, *Ri, *Rnz, *Ti, *Tj ; Int i, j, p, p1, p2, pdest, pj, k, stype, nrow, ncol, nz ; size_t anz ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ /* Wj contains a copy of Rp on input [ */ Wj = Common->Iwork ; /* size MAX (nrow,ncol). (i/l/l) */ Rp = R->p ; Ri = R->i ; Rnz = R->nz ; Rx = R->x ; Rz = R->z ; Ti = T->i ; Tj = T->j ; Tx = T->x ; Tz = T->z ; nz = T->nnz ; nrow = T->nrow ; ncol = T->ncol ; stype = SIGN (T->stype) ; /* ---------------------------------------------------------------------- */ /* construct the row form */ /* ---------------------------------------------------------------------- */ /* if Ti is jumbled, this part dominates the run time */ if (stype > 0) { for (k = 0 ; k < nz ; k++) { i = Ti [k] ; j = Tj [k] ; if (i < j) { /* place triplet (j,i,x) in column i of R */ p = Wj [i]++ ; Ri [p] = j ; } else { /* place triplet (i,j,x) in column j of R */ p = Wj [j]++ ; Ri [p] = i ; } ASSIGN (Rx, Rz, p, Tx, Tz, k) ; } } else if (stype < 0) { for (k = 0 ; k < nz ; k++) { i = Ti [k] ; j = Tj [k] ; if (i > j) { /* place triplet (j,i,x) in column i of R */ p = Wj [i]++ ; Ri [p] = j ; } else { /* place triplet (i,j,x) in column j of R */ p = Wj [j]++ ; Ri [p] = i ; } ASSIGN (Rx, Rz, p, Tx, Tz, k) ; } } else { for (k = 0 ; k < nz ; k++) { /* place triplet (i,j,x) in column i of R */ p = Wj [Ti [k]]++ ; Ri [p] = Tj [k] ; ASSIGN (Rx, Rz, p, Tx, Tz, k) ; } } /* done using Wj (i/l/l) as temporary row pointers ] */ /* ---------------------------------------------------------------------- */ /* sum up duplicates */ /* ---------------------------------------------------------------------- */ /* use Wj (i/l/l) of size ncol to keep track of duplicates in each row [ */ for (j = 0 ; j < ncol ; j++) { Wj [j] = EMPTY ; } anz = 0 ; for (i = 0 ; i < nrow ; i++) { p1 = Rp [i] ; p2 = Rp [i+1] ; pdest = p1 ; /* at this point Wj [j] < p1 holds true for all columns j, because * Ri/Rx is stored in row oriented manner */ for (p = p1 ; p < p2 ; p++) { j = Ri [p] ; pj = Wj [j] ; if (pj >= p1) { /* this column index j is already in row i at position pj; * sum up the duplicate entry */ /* Rx [pj] += Rx [p] ; */ ASSEMBLE (Rx, Rz, pj, Rx, Rz, p) ; } else { /* keep the entry and keep track in Wj [j] for case above */ Wj [j] = pdest ; if (pdest != p) { Ri [pdest] = j ; ASSIGN (Rx, Rz, pdest, Rx, Rz, p) ; } pdest++ ; } } Rnz [i] = pdest - p1 ; anz += (pdest - p1) ; } /* done using Wj to keep track of duplicate entries in each row ] */ /* ---------------------------------------------------------------------- */ /* return number of entries after summing up duplicates */ /* ---------------------------------------------------------------------- */ return (anz) ; } #undef PATTERN #undef REAL #undef COMPLEX #undef ZOMPLEX Matrix/src/CHOLMOD/Core/cholmod_sparse.c0000644000176200001440000004243113652535054017444 0ustar liggesusers/* ========================================================================== */ /* === Core/cholmod_sparse ================================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Core Module. Copyright (C) 2005-2006, * Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* Core utility routines for the cholmod_sparse object: * * A sparse matrix is held in compressed column form. In the basic type * ("packed", which corresponds to a MATLAB sparse matrix), an n-by-n matrix * with nz entries is held in three arrays: p of size n+1, i of size nz, and x * of size nz. Row indices of column j are held in i [p [j] ... p [j+1]-1] and * in the same locations in x. There may be no duplicate entries in a column. * Row indices in each column may be sorted or unsorted (CHOLMOD keeps track). * * Primary routines: * ----------------- * cholmod_allocate_sparse allocate a sparse matrix * cholmod_free_sparse free a sparse matrix * * Secondary routines: * ------------------- * cholmod_reallocate_sparse change the size (# entries) of sparse matrix * cholmod_nnz number of nonzeros in a sparse matrix * cholmod_speye sparse identity matrix * cholmod_spzeros sparse zero matrix * cholmod_copy_sparse create a copy of a sparse matrix * * All xtypes are supported (pattern, real, complex, and zomplex) */ #include "cholmod_internal.h" #include "cholmod_core.h" /* ========================================================================== */ /* === cholmod_allocate_sparse ============================================== */ /* ========================================================================== */ /* Allocate space for a matrix. A->i and A->x are not initialized. A->p * (and A->nz if A is not packed) are set to zero, so a matrix containing no * entries (all zero) is returned. See also cholmod_spzeros. * * workspace: none */ cholmod_sparse *CHOLMOD(allocate_sparse) ( /* ---- input ---- */ size_t nrow, /* # of rows of A */ size_t ncol, /* # of columns of A */ size_t nzmax, /* max # of nonzeros of A */ int sorted, /* TRUE if columns of A sorted, FALSE otherwise */ int packed, /* TRUE if A will be packed, FALSE otherwise */ int stype, /* stype of A */ int xtype, /* CHOLMOD_PATTERN, _REAL, _COMPLEX, or _ZOMPLEX */ /* --------------- */ cholmod_common *Common ) { cholmod_sparse *A ; Int *Ap, *Anz ; size_t nzmax0 ; Int j ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; if (stype != 0 && nrow != ncol) { ERROR (CHOLMOD_INVALID, "rectangular matrix with stype != 0 invalid") ; return (NULL) ; } if (xtype < CHOLMOD_PATTERN || xtype > CHOLMOD_ZOMPLEX) { ERROR (CHOLMOD_INVALID, "xtype invalid") ; return (NULL) ; } /* ensure the dimensions do not cause integer overflow */ (void) CHOLMOD(add_size_t) (ncol, 2, &ok) ; if (!ok || nrow > Int_max || ncol > Int_max || nzmax > Int_max) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (NULL) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate header */ /* ---------------------------------------------------------------------- */ A = CHOLMOD(malloc) (sizeof (cholmod_sparse), 1, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } PRINT1 (("cholmod_allocate_sparse %d-by-%d nzmax %d sorted %d packed %d" " xtype %d\n", nrow, ncol, nzmax, sorted, packed, xtype)) ; nzmax = MAX (1, nzmax) ; A->nrow = nrow ; A->ncol = ncol ; A->nzmax = nzmax ; A->packed = packed ; /* default is packed (A->nz not present) */ A->stype = stype ; A->itype = ITYPE ; A->xtype = xtype ; A->dtype = DTYPE ; A->nz = NULL ; A->p = NULL ; A->i = NULL ; A->x = NULL ; A->z = NULL ; /* A 1-by-m matrix always has sorted columns */ A->sorted = (nrow <= 1) ? TRUE : sorted ; /* ---------------------------------------------------------------------- */ /* allocate the matrix itself */ /* ---------------------------------------------------------------------- */ /* allocate O(ncol) space */ A->p = CHOLMOD(malloc) (((size_t) ncol)+1, sizeof (Int), Common) ; if (!packed) { A->nz = CHOLMOD(malloc) (ncol, sizeof (Int), Common) ; } /* allocate O(nz) space */ nzmax0 = 0 ; CHOLMOD(realloc_multiple) (nzmax, 1, xtype, &(A->i), NULL, &(A->x), &(A->z), &nzmax0, Common) ; if (Common->status < CHOLMOD_OK) { CHOLMOD(free_sparse) (&A, Common) ; return (NULL) ; /* out of memory */ } /* ---------------------------------------------------------------------- */ /* initialize A->p and A->nz so that A is an empty matrix */ /* ---------------------------------------------------------------------- */ Ap = A->p ; for (j = 0 ; j <= (Int) ncol ; j++) { Ap [j] = 0 ; } if (!packed) { Anz = A->nz ; for (j = 0 ; j < (Int) ncol ; j++) { Anz [j] = 0 ; } } return (A) ; } /* ========================================================================== */ /* === cholmod_free_sparse ================================================== */ /* ========================================================================== */ /* free a sparse matrix * * workspace: none */ int CHOLMOD(free_sparse) ( /* ---- in/out --- */ cholmod_sparse **AHandle, /* matrix to deallocate, NULL on output */ /* --------------- */ cholmod_common *Common ) { Int n, nz ; cholmod_sparse *A ; RETURN_IF_NULL_COMMON (FALSE) ; if (AHandle == NULL) { /* nothing to do */ return (TRUE) ; } A = *AHandle ; if (A == NULL) { /* nothing to do */ return (TRUE) ; } n = A->ncol ; nz = A->nzmax ; A->p = CHOLMOD(free) (n+1, sizeof (Int), A->p, Common) ; A->i = CHOLMOD(free) (nz, sizeof (Int), A->i, Common) ; A->nz = CHOLMOD(free) (n, sizeof (Int), A->nz, Common) ; switch (A->xtype) { case CHOLMOD_REAL: A->x = CHOLMOD(free) (nz, sizeof (double), A->x, Common) ; break ; case CHOLMOD_COMPLEX: A->x = CHOLMOD(free) (nz, 2*sizeof (double), A->x, Common) ; break ; case CHOLMOD_ZOMPLEX: A->x = CHOLMOD(free) (nz, sizeof (double), A->x, Common) ; A->z = CHOLMOD(free) (nz, sizeof (double), A->z, Common) ; break ; } *AHandle = CHOLMOD(free) (1, sizeof (cholmod_sparse), (*AHandle), Common) ; return (TRUE) ; } /* ========================================================================== */ /* === cholmod_reallocate_sparse ============================================ */ /* ========================================================================== */ /* Change the size of A->i, A->x, and A->z, or allocate them if their current * size is zero. A->x and A->z are not modified if A->xtype is CHOLMOD_PATTERN. * A->z is not modified unless A->xtype is CHOLMOD_ZOMPLEX. * * workspace: none */ int CHOLMOD(reallocate_sparse) ( /* ---- input ---- */ size_t nznew, /* new # of entries in A */ /* ---- in/out --- */ cholmod_sparse *A, /* matrix to reallocate */ /* --------------- */ cholmod_common *Common ) { /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; Common->status = CHOLMOD_OK ; PRINT1 (("realloc matrix %d to %d, xtype: %d\n", A->nzmax, nznew, A->xtype)) ; /* ---------------------------------------------------------------------- */ /* resize the matrix */ /* ---------------------------------------------------------------------- */ CHOLMOD(realloc_multiple) (MAX (1,nznew), 1, A->xtype, &(A->i), NULL, &(A->x), &(A->z), &(A->nzmax), Common) ; return (Common->status == CHOLMOD_OK) ; } /* ========================================================================== */ /* === cholmod_speye ======================================================== */ /* ========================================================================== */ /* Return a sparse identity matrix. */ cholmod_sparse *CHOLMOD(speye) ( /* ---- input ---- */ size_t nrow, /* # of rows of A */ size_t ncol, /* # of columns of A */ int xtype, /* CHOLMOD_PATTERN, _REAL, _COMPLEX, or _ZOMPLEX */ /* --------------- */ cholmod_common *Common ) { double *Ax, *Az ; cholmod_sparse *A ; Int *Ap, *Ai ; Int j, n ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate the matrix */ /* ---------------------------------------------------------------------- */ n = MIN (nrow, ncol) ; A = CHOLMOD(allocate_sparse) (nrow, ncol, n, TRUE, TRUE, 0, xtype, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory or inputs invalid */ } /* ---------------------------------------------------------------------- */ /* create the identity matrix */ /* ---------------------------------------------------------------------- */ Ap = A->p ; Ai = A->i ; Ax = A->x ; Az = A->z ; for (j = 0 ; j < n ; j++) { Ap [j] = j ; } for (j = n ; j <= ((Int) ncol) ; j++) { Ap [j] = n ; } for (j = 0 ; j < n ; j++) { Ai [j] = j ; } switch (xtype) { case CHOLMOD_REAL: for (j = 0 ; j < n ; j++) { Ax [j] = 1 ; } break ; case CHOLMOD_COMPLEX: for (j = 0 ; j < n ; j++) { Ax [2*j ] = 1 ; Ax [2*j+1] = 0 ; } break ; case CHOLMOD_ZOMPLEX: for (j = 0 ; j < n ; j++) { Ax [j] = 1 ; } for (j = 0 ; j < n ; j++) { Az [j] = 0 ; } break ; } return (A) ; } /* ========================================================================== */ /* === cholmod_spzeros ====================================================== */ /* ========================================================================== */ /* Return a sparse zero matrix. */ cholmod_sparse *CHOLMOD(spzeros) ( /* ---- input ---- */ size_t nrow, /* # of rows of A */ size_t ncol, /* # of columns of A */ size_t nzmax, /* max # of nonzeros of A */ int xtype, /* CHOLMOD_PATTERN, _REAL, _COMPLEX, or _ZOMPLEX */ /* --------------- */ cholmod_common *Common ) { /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate the matrix */ /* ---------------------------------------------------------------------- */ return (CHOLMOD(allocate_sparse) (nrow, ncol, nzmax, TRUE, TRUE, 0, xtype, Common)) ; } /* ========================================================================== */ /* === cholmod_nnz ========================================================== */ /* ========================================================================== */ /* Return the number of entries in a sparse matrix. * * workspace: none * integer overflow cannot occur, since the matrix is already allocated. */ SuiteSparse_long CHOLMOD(nnz) ( /* ---- input ---- */ cholmod_sparse *A, /* --------------- */ cholmod_common *Common ) { Int *Ap, *Anz ; size_t nz ; Int j, ncol ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (EMPTY) ; RETURN_IF_NULL (A, EMPTY) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, EMPTY) ; Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* return nnz (A) */ /* ---------------------------------------------------------------------- */ ncol = A->ncol ; if (A->packed) { Ap = A->p ; RETURN_IF_NULL (Ap, EMPTY) ; nz = Ap [ncol] ; } else { Anz = A->nz ; RETURN_IF_NULL (Anz, EMPTY) ; nz = 0 ; for (j = 0 ; j < ncol ; j++) { nz += MAX (0, Anz [j]) ; } } return (nz) ; } /* ========================================================================== */ /* === cholmod_copy_sparse ================================================== */ /* ========================================================================== */ /* C = A. Create an exact copy of a sparse matrix, with one exception. * Entries in unused space are not copied (they might not be initialized, * and copying them would cause program checkers such as purify and * valgrind to complain). The xtype of the resulting matrix C is the same as * the xtype of the input matrix A. * * See also Core/cholmod_copy, which copies a matrix with possible changes * in stype, presence of diagonal entries, pattern vs. numerical values, * real and/or imaginary parts, and so on. */ cholmod_sparse *CHOLMOD(copy_sparse) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to copy */ /* --------------- */ cholmod_common *Common ) { double *Ax, *Cx, *Az, *Cz ; Int *Ap, *Ai, *Anz, *Cp, *Ci, *Cnz ; cholmod_sparse *C ; Int p, pend, j, ncol, packed, nzmax, nz, xtype ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (A, NULL) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, NULL) ; if (A->stype != 0 && A->nrow != A->ncol) { ERROR (CHOLMOD_INVALID, "rectangular matrix with stype != 0 invalid") ; return (NULL) ; } Common->status = CHOLMOD_OK ; ASSERT (CHOLMOD(dump_sparse) (A, "A original", Common) >= 0) ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ ncol = A->ncol ; nzmax = A->nzmax ; packed = A->packed ; Ap = A->p ; Ai = A->i ; Ax = A->x ; Az = A->z ; Anz = A->nz ; xtype = A->xtype ; /* ---------------------------------------------------------------------- */ /* allocate the copy */ /* ---------------------------------------------------------------------- */ C = CHOLMOD(allocate_sparse) (A->nrow, A->ncol, A->nzmax, A->sorted, A->packed, A->stype, A->xtype, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } Cp = C->p ; Ci = C->i ; Cx = C->x ; Cz = C->z ; Cnz = C->nz ; /* ---------------------------------------------------------------------- */ /* copy the matrix */ /* ---------------------------------------------------------------------- */ for (j = 0 ; j <= ncol ; j++) { Cp [j] = Ap [j] ; } if (packed) { nz = Ap [ncol] ; for (p = 0 ; p < nz ; p++) { Ci [p] = Ai [p] ; } switch (xtype) { case CHOLMOD_REAL: for (p = 0 ; p < nz ; p++) { Cx [p] = Ax [p] ; } break ; case CHOLMOD_COMPLEX: for (p = 0 ; p < 2*nz ; p++) { Cx [p] = Ax [p] ; } break ; case CHOLMOD_ZOMPLEX: for (p = 0 ; p < nz ; p++) { Cx [p] = Ax [p] ; Cz [p] = Az [p] ; } break ; } } else { for (j = 0 ; j < ncol ; j++) { Cnz [j] = Anz [j] ; } switch (xtype) { case CHOLMOD_PATTERN: for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = p + Anz [j] ; for ( ; p < pend ; p++) { Ci [p] = Ai [p] ; } } break ; case CHOLMOD_REAL: for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = p + Anz [j] ; for ( ; p < pend ; p++) { Ci [p] = Ai [p] ; Cx [p] = Ax [p] ; } } break ; case CHOLMOD_COMPLEX: for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = p + Anz [j] ; for ( ; p < pend ; p++) { Ci [p] = Ai [p] ; Cx [2*p ] = Ax [2*p ] ; Cx [2*p+1] = Ax [2*p+1] ; } } break ; case CHOLMOD_ZOMPLEX: for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = p + Anz [j] ; for ( ; p < pend ; p++) { Ci [p] = Ai [p] ; Cx [p] = Ax [p] ; Cz [p] = Az [p] ; } } break ; } } /* ---------------------------------------------------------------------- */ /* return the result */ /* ---------------------------------------------------------------------- */ ASSERT (CHOLMOD(dump_sparse) (C, "C copy", Common) >= 0) ; return (C) ; } Matrix/src/CHOLMOD/Core/cholmod_factor.c0000644000176200001440000006520313652535054017427 0ustar liggesusers/* ========================================================================== */ /* === Core/cholmod_factor ================================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Core Module. Copyright (C) 2005-2013, * Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* Core utility routines for the cholmod_factor object: * * The data structure for an LL' or LDL' factorization is too complex to * describe in one sentence. This object can hold the symbolic analysis alone, * or in combination with a "simplicial" (similar to a sparse matrix) or * "supernodal" form of the numerical factorization. Only the routine to free * a factor is primary, since a factor object is created by the factorization * routine (cholmod_factorize). It must be freed with cholmod_free_factor. * * Primary routine: * ---------------- * cholmod_free_factor free a factor * * Secondary routines: * ------------------- * cholmod_allocate_factor allocate a symbolic factor (LL' or LDL') * cholmod_reallocate_factor change the # entries in a factor * cholmod_change_factor change the type of factor (e.g., LDL' to LL') * cholmod_pack_factor pack the columns of a factor * cholmod_reallocate_column resize a single column of a factor * cholmod_factor_to_sparse create a sparse matrix copy of a factor * cholmod_copy_factor create a copy of a factor * * Note that there is no cholmod_sparse_to_factor routine to create a factor * as a copy of a sparse matrix. It could be done, after a fashion, but a * lower triangular sparse matrix would not necessarily have a chordal graph, * which would break the many CHOLMOD routines that rely on this property. * * The cholmod_factor_to_sparse routine is provided so that matrix operations * in the MatrixOps module may be applied to L. Those operations operate on * cholmod_sparse objects, and they are not guaranteed to maintain the chordal * property of L. Such a modified L cannot be safely converted back to a * cholmod_factor object. */ #include "cholmod_internal.h" #include "cholmod_core.h" /* ========================================================================== */ /* === cholmod_allocate_factor ============================================== */ /* ========================================================================== */ /* Allocate a simplicial symbolic factor, with L->Perm and L->ColCount allocated * and initialized to "empty" values (Perm [k] = k, and ColCount[k] = 1). * The integer and numerical parts of L are not allocated. L->xtype is returned * as CHOLMOD_PATTERN and L->is_super are returned as FALSE. L->is_ll is also * returned FALSE, but this may be modified when the matrix is factorized. * * This is sufficient (but far from ideal) for input to cholmod_factorize, * since the simplicial LL' or LDL' factorization (cholmod_rowfac) can * reallocate the columns of L as needed. The primary purpose of this routine * is to allocate space for a symbolic factorization, for the "expert" user to * do his or her own symbolic analysis. The typical user should use * cholmod_analyze instead of this routine. * * workspace: none */ cholmod_factor *CHOLMOD(allocate_factor) ( /* ---- input ---- */ size_t n, /* L is n-by-n */ /* --------------- */ cholmod_common *Common ) { Int j ; Int *Perm, *ColCount ; cholmod_factor *L ; int ok = TRUE ; RETURN_IF_NULL_COMMON (FALSE) ; Common->status = CHOLMOD_OK ; /* ensure the dimension does not cause integer overflow */ (void) CHOLMOD(add_size_t) (n, 2, &ok) ; if (!ok || n > Int_max) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (NULL) ; } L = CHOLMOD(malloc) (sizeof (cholmod_factor), 1, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } L->n = n ; L->is_ll = FALSE ; L->is_super = FALSE ; L->is_monotonic = TRUE ; L->itype = ITYPE ; L->xtype = CHOLMOD_PATTERN ; L->dtype = DTYPE ; /* allocate the purely symbolic part of L */ L->ordering = CHOLMOD_NATURAL ; L->Perm = CHOLMOD(malloc) (n, sizeof (Int), Common) ; L->IPerm = NULL ; /* only created by cholmod_solve2 when needed */ L->ColCount = CHOLMOD(malloc) (n, sizeof (Int), Common) ; /* simplicial part of L is empty */ L->nzmax = 0 ; L->p = NULL ; L->i = NULL ; L->x = NULL ; L->z = NULL ; L->nz = NULL ; L->next = NULL ; L->prev = NULL ; /* supernodal part of L is also empty */ L->nsuper = 0 ; L->ssize = 0 ; L->xsize = 0 ; L->maxesize = 0 ; L->maxcsize = 0 ; L->super = NULL ; L->pi = NULL ; L->px = NULL ; L->s = NULL ; L->useGPU = 0; /* L has not been factorized */ L->minor = n ; if (Common->status < CHOLMOD_OK) { CHOLMOD(free_factor) (&L, Common) ; return (NULL) ; /* out of memory */ } /* initialize Perm and ColCount */ Perm = L->Perm ; for (j = 0 ; j < ((Int) n) ; j++) { Perm [j] = j ; } ColCount = L->ColCount ; for (j = 0 ; j < ((Int) n) ; j++) { ColCount [j] = 1 ; } return (L) ; } /* ========================================================================== */ /* === cholmod_free_factor ================================================== */ /* ========================================================================== */ /* Free a factor object. * * workspace: none */ int CHOLMOD(free_factor) ( /* ---- in/out --- */ cholmod_factor **LHandle, /* factor to free, NULL on output */ /* --------------- */ cholmod_common *Common ) { Int n, lnz, xs, ss, s ; cholmod_factor *L ; RETURN_IF_NULL_COMMON (FALSE) ; if (LHandle == NULL) { /* nothing to do */ return (TRUE) ; } L = *LHandle ; if (L == NULL) { /* nothing to do */ return (TRUE) ; } n = L->n ; lnz = L->nzmax ; s = L->nsuper + 1 ; xs = (L->is_super) ? ((Int) (L->xsize)) : (lnz) ; ss = L->ssize ; /* symbolic part of L */ CHOLMOD(free) (n, sizeof (Int), L->Perm, Common) ; CHOLMOD(free) (n, sizeof (Int), L->IPerm, Common) ; CHOLMOD(free) (n, sizeof (Int), L->ColCount, Common) ; /* simplicial form of L */ CHOLMOD(free) (n+1, sizeof (Int), L->p, Common) ; CHOLMOD(free) (lnz, sizeof (Int), L->i, Common) ; CHOLMOD(free) (n, sizeof (Int), L->nz, Common) ; CHOLMOD(free) (n+2, sizeof (Int), L->next, Common) ; CHOLMOD(free) (n+2, sizeof (Int), L->prev, Common) ; /* supernodal form of L */ CHOLMOD(free) (s, sizeof (Int), L->pi, Common) ; CHOLMOD(free) (s, sizeof (Int), L->px, Common) ; CHOLMOD(free) (s, sizeof (Int), L->super, Common) ; CHOLMOD(free) (ss, sizeof (Int), L->s, Common) ; /* numerical values for both simplicial and supernodal L */ if (L->xtype == CHOLMOD_REAL) { CHOLMOD(free) (xs, sizeof (double), L->x, Common) ; } else if (L->xtype == CHOLMOD_COMPLEX) { CHOLMOD(free) (xs, 2*sizeof (double), L->x, Common) ; } else if (L->xtype == CHOLMOD_ZOMPLEX) { CHOLMOD(free) (xs, sizeof (double), L->x, Common) ; CHOLMOD(free) (xs, sizeof (double), L->z, Common) ; } *LHandle = CHOLMOD(free) (1, sizeof (cholmod_factor), (*LHandle), Common) ; return (TRUE) ; } /* ========================================================================== */ /* === cholmod_reallocate_factor ============================================ */ /* ========================================================================== */ /* Change the size of L->i and L->x, or allocate them if their current size * is zero. L must be simplicial. * * workspace: none */ int CHOLMOD(reallocate_factor) ( /* ---- input ---- */ size_t nznew, /* new # of entries in L */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ /* --------------- */ cholmod_common *Common ) { /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ; PRINT1 (("realloc factor: xtype %d\n", L->xtype)) ; if (L->is_super) { /* L must be simplicial, and not symbolic */ ERROR (CHOLMOD_INVALID, "L invalid") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; PRINT1 (("realloc factor %g to %g\n", (double) L->nzmax, (double) nznew)) ; /* ---------------------------------------------------------------------- */ /* resize (or allocate) the L->i and L->x components of the factor */ /* ---------------------------------------------------------------------- */ CHOLMOD(realloc_multiple) (nznew, 1, L->xtype, &(L->i), NULL, &(L->x), &(L->z), &(L->nzmax), Common) ; return (Common->status == CHOLMOD_OK) ; } /* ========================================================================== */ /* === cholmod_reallocate_column =========================================== */ /* ========================================================================== */ /* Column j needs more space, reallocate it at the end of L->i and L->x. * If the reallocation fails, the factor is converted to a simplicial * symbolic factor (no pattern, just L->Perm and L->ColCount). * * workspace: none */ int CHOLMOD(reallocate_column) ( /* ---- input ---- */ size_t j, /* the column to reallocate */ size_t need, /* required size of column j */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ /* --------------- */ cholmod_common *Common ) { double xneed ; double *Lx, *Lz ; Int *Lp, *Lprev, *Lnext, *Li, *Lnz ; Int n, pold, pnew, len, k, tail ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ; if (L->is_super) { ERROR (CHOLMOD_INVALID, "L must be simplicial") ; return (FALSE) ; } n = L->n ; if (j >= L->n || need == 0) { ERROR (CHOLMOD_INVALID, "j invalid") ; return (FALSE) ; /* j out of range */ } Common->status = CHOLMOD_OK ; DEBUG (CHOLMOD(dump_factor) (L, "start colrealloc", Common)) ; /* ---------------------------------------------------------------------- */ /* increase the size of L if needed */ /* ---------------------------------------------------------------------- */ /* head = n+1 ; */ tail = n ; Lp = L->p ; Lnz = L->nz ; Lprev = L->prev ; Lnext = L->next ; ASSERT (Lnz != NULL) ; ASSERT (Lnext != NULL && Lprev != NULL) ; PRINT1 (("col %g need %g\n", (double) j, (double) need)) ; /* column j cannot have more than n-j entries if all entries are present */ need = MIN (need, n-j) ; /* compute need in double to avoid integer overflow */ if (Common->grow1 >= 1.0) { xneed = (double) need ; xneed = Common->grow1 * xneed + Common->grow2 ; xneed = MIN (xneed, n-j) ; need = (Int) xneed ; } PRINT1 (("really new need %g current %g\n", (double) need, (double) (Lp [Lnext [j]] - Lp [j]))) ; ASSERT (need >= 1 && need <= n-j) ; if (Lp [Lnext [j]] - Lp [j] >= (Int) need) { /* no need to reallocate the column, it's already big enough */ PRINT1 (("colrealloc: quick return %g %g\n", (double) (Lp [Lnext [j]] - Lp [j]), (double) need)) ; return (TRUE) ; } if (Lp [tail] + need > L->nzmax) { /* use double to avoid integer overflow */ xneed = (double) need ; if (Common->grow0 < 1.2) /* fl. pt. compare, false if NaN */ { /* if grow0 is less than 1.2 or NaN, don't use it */ xneed = 1.2 * (((double) L->nzmax) + xneed + 1) ; } else { xneed = Common->grow0 * (((double) L->nzmax) + xneed + 1) ; } if (xneed > Size_max || !CHOLMOD(reallocate_factor) ((Int) xneed, L, Common)) { /* out of memory, convert to simplicial symbolic */ CHOLMOD(change_factor) (CHOLMOD_PATTERN, L->is_ll, FALSE, TRUE, TRUE, L, Common) ; ERROR (CHOLMOD_OUT_OF_MEMORY, "out of memory; L now symbolic") ; return (FALSE) ; /* out of memory */ } PRINT1 (("\n=== GROW L from %g to %g\n", (double) L->nzmax, (double) xneed)) ; /* pack all columns so that each column has at most grow2 free space */ CHOLMOD(pack_factor) (L, Common) ; ASSERT (Common->status == CHOLMOD_OK) ; Common->nrealloc_factor++ ; } /* ---------------------------------------------------------------------- */ /* reallocate the column */ /* ---------------------------------------------------------------------- */ Common->nrealloc_col++ ; Li = L->i ; Lx = L->x ; Lz = L->z ; /* remove j from its current position in the list */ Lnext [Lprev [j]] = Lnext [j] ; Lprev [Lnext [j]] = Lprev [j] ; /* place j at the end of the list */ Lnext [Lprev [tail]] = j ; Lprev [j] = Lprev [tail] ; Lnext [j] = n ; Lprev [tail] = j ; /* L is no longer monotonic; columns are out-of-order */ L->is_monotonic = FALSE ; /* allocate space for column j */ pold = Lp [j] ; pnew = Lp [tail] ; Lp [j] = pnew ; Lp [tail] += need ; /* copy column j to the new space */ len = Lnz [j] ; for (k = 0 ; k < len ; k++) { Li [pnew + k] = Li [pold + k] ; } if (L->xtype == CHOLMOD_REAL) { for (k = 0 ; k < len ; k++) { Lx [pnew + k] = Lx [pold + k] ; } } else if (L->xtype == CHOLMOD_COMPLEX) { for (k = 0 ; k < len ; k++) { Lx [2*(pnew + k) ] = Lx [2*(pold + k) ] ; Lx [2*(pnew + k)+1] = Lx [2*(pold + k)+1] ; } } else if (L->xtype == CHOLMOD_ZOMPLEX) { for (k = 0 ; k < len ; k++) { Lx [pnew + k] = Lx [pold + k] ; Lz [pnew + k] = Lz [pold + k] ; } } DEBUG (CHOLMOD(dump_factor) (L, "colrealloc done", Common)) ; /* successful reallocation of column j of L */ return (TRUE) ; } /* ========================================================================== */ /* === cholmod_pack_factor ================================================== */ /* ========================================================================== */ /* Pack the columns of a simplicial LDL' or LL' factor. This can be followed * by a call to cholmod_reallocate_factor to reduce the size of L to the exact * size required by the factor, if desired. Alternatively, you can leave the * size of L->i and L->x the same, to allow space for future updates/rowadds. * * Each column is reduced in size so that it has at most Common->grow2 free * space at the end of the column. * * Does nothing and returns silently if given any other type of factor. * * Does NOT force the columns of L to be monotonic. It thus differs from * cholmod_change_factor (xtype, -, FALSE, TRUE, TRUE, L, Common), which * packs the columns and ensures that they appear in monotonic order. */ int CHOLMOD(pack_factor) ( /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ /* --------------- */ cholmod_common *Common ) { double *Lx, *Lz ; Int *Lp, *Li, *Lnz, *Lnext ; Int pnew, j, k, pold, len, n, head, tail, grow2 ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; Common->status = CHOLMOD_OK ; DEBUG (CHOLMOD(dump_factor) (L, "start pack", Common)) ; PRINT1 (("PACK factor %d\n", L->is_super)) ; if (L->xtype == CHOLMOD_PATTERN || L->is_super) { /* nothing to do unless L is simplicial numeric */ return (TRUE) ; } /* ---------------------------------------------------------------------- */ /* pack */ /* ---------------------------------------------------------------------- */ grow2 = Common->grow2 ; PRINT1 (("\nPACK grow2 "ID"\n", grow2)) ; pnew = 0 ; n = L->n ; Lp = L->p ; Li = L->i ; Lx = L->x ; Lz = L->z ; Lnz = L->nz ; Lnext = L->next ; head = n+1 ; tail = n ; for (j = Lnext [head] ; j != tail ; j = Lnext [j]) { /* pack column j */ pold = Lp [j] ; len = Lnz [j] ; ASSERT (len > 0) ; PRINT2 (("col "ID" pnew "ID" pold "ID"\n", j, pnew, pold)) ; if (pnew < pold) { PRINT2 ((" pack this column\n")) ; for (k = 0 ; k < len ; k++) { Li [pnew + k] = Li [pold + k] ; } if (L->xtype == CHOLMOD_REAL) { for (k = 0 ; k < len ; k++) { Lx [pnew + k] = Lx [pold + k] ; } } else if (L->xtype == CHOLMOD_COMPLEX) { for (k = 0 ; k < len ; k++) { Lx [2*(pnew + k) ] = Lx [2*(pold + k) ] ; Lx [2*(pnew + k)+1] = Lx [2*(pold + k)+1] ; } } else if (L->xtype == CHOLMOD_ZOMPLEX) { for (k = 0 ; k < len ; k++) { Lx [pnew + k] = Lx [pold + k] ; Lz [pnew + k] = Lz [pold + k] ; } } Lp [j] = pnew ; } len = MIN (len + grow2, n - j) ; pnew = MIN (Lp [j] + len, Lp [Lnext [j]]) ; } PRINT2 (("final pnew = "ID"\n", pnew)) ; return (TRUE) ; } /* ========================================================================== */ /* === cholmod_factor_to_sparse ============================================= */ /* ========================================================================== */ /* Constructs a column-oriented sparse matrix containing the pattern and values * of a simplicial or supernodal numerical factor, and then converts the factor * into a simplicial symbolic factor. If L is already packed, monotonic, * and simplicial (which is the case when cholmod_factorize uses the simplicial * Cholesky factorization algorithm) then this routine requires only O(1) * memory and takes O(1) time. * * Only operates on numeric factors (real, complex, or zomplex). Does not * change the numeric L->xtype (the resulting sparse matrix has the same xtype * as L). If this routine fails, L is left unmodified. */ cholmod_sparse *CHOLMOD(factor_to_sparse) ( /* ---- in/out --- */ cholmod_factor *L, /* factor to copy, converted to symbolic on output */ /* --------------- */ cholmod_common *Common ) { cholmod_sparse *Lsparse ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (L, NULL) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, NULL) ; Common->status = CHOLMOD_OK ; DEBUG (CHOLMOD(dump_factor) (L, "start convert to matrix", Common)) ; /* ---------------------------------------------------------------------- */ /* convert to packed, monotonic, simplicial, numeric */ /* ---------------------------------------------------------------------- */ /* leave as LL or LDL' */ if (!CHOLMOD(change_factor) (L->xtype, L->is_ll, FALSE, TRUE, TRUE, L, Common)) { ERROR (CHOLMOD_INVALID, "cannot convert L") ; return (NULL) ; } /* ---------------------------------------------------------------------- */ /* create Lsparse */ /* ---------------------------------------------------------------------- */ /* allocate the header for Lsparse, the sparse matrix version of L */ Lsparse = CHOLMOD(malloc) (sizeof (cholmod_sparse), 1, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } /* transfer the contents from L to Lsparse */ Lsparse->nrow = L->n ; Lsparse->ncol = L->n ; Lsparse->p = L->p ; Lsparse->i = L->i ; Lsparse->x = L->x ; Lsparse->z = L->z ; Lsparse->nz = NULL ; Lsparse->stype = 0 ; Lsparse->itype = L->itype ; Lsparse->xtype = L->xtype ; Lsparse->dtype = L->dtype ; Lsparse->sorted = TRUE ; Lsparse->packed = TRUE ; Lsparse->nzmax = L->nzmax ; ASSERT (CHOLMOD(dump_sparse) (Lsparse, "Lsparse", Common) >= 0) ; /* ---------------------------------------------------------------------- */ /* convert L to symbolic, but do not free contents transfered to Lsparse */ /* ---------------------------------------------------------------------- */ L->p = NULL ; L->i = NULL ; L->x = NULL ; L->z = NULL ; L->xtype = CHOLMOD_PATTERN ; CHOLMOD(change_factor) (CHOLMOD_PATTERN, FALSE, FALSE, TRUE, TRUE, L, Common) ; return (Lsparse) ; } /* ========================================================================== */ /* === cholmod_copy_factor ================================================== */ /* ========================================================================== */ /* Create an exact copy of a factor, with one exception: * * Entries in unused space are not copied (they might not be initialized, * and copying them would cause program checkers such as purify and * valgrind to complain). * * Note that a supernodal L cannot be zomplex. */ cholmod_factor *CHOLMOD(copy_factor) ( /* ---- input ---- */ cholmod_factor *L, /* factor to copy */ /* --------------- */ cholmod_common *Common ) { cholmod_factor *L2 ; double *Lx, *L2x, *Lz, *L2z ; Int *Perm, *ColCount, *Lp, *Li, *Lnz, *Lnext, *Lprev, *Lsuper, *Lpi, *Lpx, *Ls, *Perm2, *ColCount2, *L2p, *L2i, *L2nz, *L2next, *L2prev, *L2super, *L2pi, *L2px, *L2s ; Int n, j, p, pend, s, xsize, ssize, nsuper ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (L, NULL) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, NULL) ; Common->status = CHOLMOD_OK ; DEBUG (CHOLMOD(dump_factor) (L, "start copy", Common)) ; n = L->n ; /* ---------------------------------------------------------------------- */ /* allocate a simplicial symbolic factor */ /* ---------------------------------------------------------------------- */ /* allocates L2->Perm and L2->ColCount */ L2 = CHOLMOD(allocate_factor) (n, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } ASSERT (L2->xtype == CHOLMOD_PATTERN && !(L2->is_super)) ; Perm = L->Perm ; ColCount = L->ColCount ; Perm2 = L2->Perm ; ColCount2 = L2->ColCount ; L2->ordering = L->ordering ; for (j = 0 ; j < n ; j++) { Perm2 [j] = Perm [j] ; } for (j = 0 ; j < n ; j++) { ColCount2 [j] = ColCount [j] ; } L2->is_ll = L->is_ll ; /* ---------------------------------------------------------------------- */ /* copy the rest of the factor */ /* ---------------------------------------------------------------------- */ if (L->xtype != CHOLMOD_PATTERN && !(L->super)) { /* ------------------------------------------------------------------ */ /* allocate a simplicial numeric factor */ /* ------------------------------------------------------------------ */ /* allocate L2->p, L2->nz, L2->prev, L2->next, L2->i, and L2->x. * packed = -1 so that cholmod_change_factor allocates space of * size L2->nzmax */ L2->nzmax = L->nzmax ; if (!CHOLMOD(change_factor) (L->xtype, L->is_ll, FALSE, -1, TRUE, L2, Common)) { CHOLMOD(free_factor) (&L2, Common) ; return (NULL) ; /* out of memory */ } ASSERT (MAX (1, L->nzmax) == L2->nzmax) ; /* ------------------------------------------------------------------ */ /* copy the contents of a simplicial numeric factor */ /* ------------------------------------------------------------------ */ Lp = L->p ; Li = L->i ; Lx = L->x ; Lz = L->z ; Lnz = L->nz ; Lnext = L->next ; Lprev = L->prev ; L2p = L2->p ; L2i = L2->i ; L2x = L2->x ; L2z = L2->z ; L2nz = L2->nz ; L2next = L2->next ; L2prev = L2->prev ; L2->xtype = L->xtype ; L2->dtype = L->dtype ; for (j = 0 ; j <= n ; j++) { L2p [j] = Lp [j] ; } for (j = 0 ; j < n+2 ; j++) { L2prev [j] = Lprev [j] ; } for (j = 0 ; j < n+2 ; j++) { L2next [j] = Lnext [j] ; } for (j = 0 ; j < n ; j++) { L2nz [j] = Lnz [j] ; } for (j = 0 ; j < n ; j++) { p = Lp [j] ; pend = p + Lnz [j] ; for ( ; p < pend ; p++) { L2i [p] = Li [p] ; } p = Lp [j] ; if (L->xtype == CHOLMOD_REAL) { for ( ; p < pend ; p++) { L2x [p] = Lx [p] ; } } else if (L->xtype == CHOLMOD_COMPLEX) { for ( ; p < pend ; p++) { L2x [2*p ] = Lx [2*p ] ; L2x [2*p+1] = Lx [2*p+1] ; } } else if (L->xtype == CHOLMOD_ZOMPLEX) { for ( ; p < pend ; p++) { L2x [p] = Lx [p] ; L2z [p] = Lz [p] ; } } } } else if (L->is_super) { /* ------------------------------------------------------------------ */ /* copy a supernodal factor */ /* ------------------------------------------------------------------ */ xsize = L->xsize ; ssize = L->ssize ; nsuper = L->nsuper ; L2->xsize = xsize ; L2->ssize = ssize ; L2->nsuper = nsuper ; /* allocate L2->super, L2->pi, L2->px, and L2->s. Allocate L2->x if * L is numeric */ if (!CHOLMOD(change_factor) (L->xtype, TRUE, TRUE, TRUE, TRUE, L2, Common)) { CHOLMOD(free_factor) (&L2, Common) ; return (NULL) ; /* out of memory */ } ASSERT (L2->s != NULL) ; /* ------------------------------------------------------------------ */ /* copy the contents of a supernodal factor */ /* ------------------------------------------------------------------ */ Lsuper = L->super ; Lpi = L->pi ; Lpx = L->px ; Ls = L->s ; Lx = L->x ; L2super = L2->super ; L2pi = L2->pi ; L2px = L2->px ; L2s = L2->s ; L2x = L2->x ; L2->maxcsize = L->maxcsize ; L2->maxesize = L->maxesize ; for (s = 0 ; s <= nsuper ; s++) { L2super [s] = Lsuper [s] ; } for (s = 0 ; s <= nsuper ; s++) { L2pi [s] = Lpi [s] ; } for (s = 0 ; s <= nsuper ; s++) { L2px [s] = Lpx [s] ; } L2s [0] = 0 ; for (p = 0 ; p < ssize ; p++) { L2s [p] = Ls [p] ; } if (L->xtype == CHOLMOD_REAL) { for (p = 0 ; p < xsize ; p++) { L2x [p] = Lx [p] ; } } else if (L->xtype == CHOLMOD_COMPLEX) { for (p = 0 ; p < 2*xsize ; p++) { L2x [p] = Lx [p] ; } } } L2->minor = L->minor ; L2->is_monotonic = L->is_monotonic ; DEBUG (CHOLMOD(dump_factor) (L2, "L2 got copied", Common)) ; ASSERT (L2->xtype == L->xtype && L2->is_super == L->is_super) ; return (L2) ; } Matrix/src/CHOLMOD/Core/t_cholmod_dense.c0000644000176200001440000001565013652535054017573 0ustar liggesusers/* ========================================================================== */ /* === Core/t_cholmod_dense ================================================= */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Core Module. Copyright (C) 2005-2006, * Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* Template routine for cholmod_dense. All xtypes supported, except that there * are no dense matrices with an xtype of pattern. */ #include "cholmod_template.h" /* ========================================================================== */ /* === t_cholmod_sparse_to_dense ============================================ */ /* ========================================================================== */ static cholmod_dense *TEMPLATE (cholmod_sparse_to_dense) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to copy */ /* --------------- */ cholmod_common *Common ) { double *Ax, *Xx, *Az, *Xz ; Int *Ap, *Ai, *Anz ; cholmod_dense *X ; Int i, j, p, pend, nrow, ncol, packed ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ nrow = A->nrow ; ncol = A->ncol ; packed = A->packed ; Ap = A->p ; Ai = A->i ; Ax = A->x ; Az = A->z ; Anz = A->nz ; /* ---------------------------------------------------------------------- */ /* allocate result */ /* ---------------------------------------------------------------------- */ X = CHOLMOD(zeros) (nrow, ncol, XTYPE2, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } Xx = X->x ; Xz = X->z ; /* ---------------------------------------------------------------------- */ /* copy into dense matrix */ /* ---------------------------------------------------------------------- */ if (A->stype < 0) { /* A is symmetric with lower stored, but both parts of X are present */ for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i >= j) { ASSIGN2 (Xx, Xz, i+j*nrow, Ax, Az, p) ; ASSIGN2_CONJ (Xx, Xz, j+i*nrow, Ax, Az, p) ; } } } } else if (A->stype > 0) { /* A is symmetric with upper stored, but both parts of X are present */ for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i <= j) { ASSIGN2 (Xx, Xz, i+j*nrow, Ax, Az, p) ; ASSIGN2_CONJ (Xx, Xz, j+i*nrow, Ax, Az, p) ; } } } } else { /* both parts of A and X are present */ for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; ASSIGN2 (Xx, Xz, i+j*nrow, Ax, Az, p) ; } } } return (X) ; } #ifndef PATTERN /* There are no dense matrices of xtype CHOLMOD_PATTERN */ /* ========================================================================== */ /* === t_cholmod_dense_to_sparse ============================================ */ /* ========================================================================== */ static cholmod_sparse *TEMPLATE (cholmod_dense_to_sparse) ( /* ---- input ---- */ cholmod_dense *X, /* matrix to copy */ int values, /* TRUE if values to be copied, FALSE otherwise */ /* --------------- */ cholmod_common *Common ) { double *Xx, *Cx, *Xz, *Cz ; Int *Ci, *Cp ; cholmod_sparse *C ; Int i, j, p, d, nrow, ncol, nz ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ nrow = X->nrow ; ncol = X->ncol ; d = X->d ; Xx = X->x ; Xz = X->z ; /* ---------------------------------------------------------------------- */ /* count the number of nonzeros in the result */ /* ---------------------------------------------------------------------- */ nz = 0 ; for (j = 0 ; j < ncol ; j++) { for (i = 0 ; i < nrow ; i++) { if (ENTRY_IS_NONZERO (Xx, Xz, i+j*d)) { nz++ ; } } } /* ---------------------------------------------------------------------- */ /* allocate the result C */ /* ---------------------------------------------------------------------- */ C = CHOLMOD(allocate_sparse) (nrow, ncol, nz, TRUE, TRUE, 0, values ? XTYPE : CHOLMOD_PATTERN, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } Cp = C->p ; Ci = C->i ; Cx = C->x ; Cz = C->z ; /* ---------------------------------------------------------------------- */ /* copy the dense matrix X into the sparse matrix C */ /* ---------------------------------------------------------------------- */ p = 0 ; for (j = 0 ; j < ncol ; j++) { Cp [j] = p ; for (i = 0 ; i < nrow ; i++) { if (ENTRY_IS_NONZERO (Xx, Xz, i+j*d)) { Ci [p] = i ; if (values) { ASSIGN (Cx, Cz, p, Xx, Xz, i+j*d) ; } p++ ; } } } ASSERT (p == nz) ; Cp [ncol] = nz ; /* ---------------------------------------------------------------------- */ /* return result */ /* ---------------------------------------------------------------------- */ ASSERT (CHOLMOD(dump_sparse) (C, "C", Common) >= 0) ; return (C) ; } /* ========================================================================== */ /* === t_cholmod_copy_dense2 ================================================ */ /* ========================================================================== */ /* Y = X, where X and Y are both already allocated. */ static int TEMPLATE (cholmod_copy_dense2) ( /* ---- input ---- */ cholmod_dense *X, /* matrix to copy */ /* ---- output --- */ cholmod_dense *Y /* copy of matrix X */ ) { double *Xx, *Xz, *Yx, *Yz ; Int i, j, nrow, ncol, dy, dx ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ Xx = X->x ; Xz = X->z ; Yx = Y->x ; Yz = Y->z ; dx = X->d ; dy = Y->d ; nrow = X->nrow ; ncol = X->ncol ; /* ---------------------------------------------------------------------- */ /* copy */ /* ---------------------------------------------------------------------- */ CLEAR (Yx, Yz, 0) ; for (j = 0 ; j < ncol ; j++) { for (i = 0 ; i < nrow ; i++) { ASSIGN (Yx, Yz, i+j*dy, Xx, Xz, i+j*dx) ; } } return (TRUE) ; } #endif #undef PATTERN #undef REAL #undef COMPLEX #undef ZOMPLEX Matrix/src/CHOLMOD/Core/License.txt0000644000176200001440000000207211770402705016411 0ustar liggesusersCHOLMOD/Core Module. Copyright (C) 2005-2006, Univ. of Florida. Author: Timothy A. Davis CHOLMOD is also available under other licenses; contact authors for details. http://www.suitesparse.com Note that this license is for the CHOLMOD/Core module only. All CHOLMOD modules are licensed separately. -------------------------------------------------------------------------------- This Module is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This Module 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this Module; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Matrix/src/CHOLMOD/Core/cholmod_memory.c0000644000176200001440000004064413652535054017463 0ustar liggesusers/* ========================================================================== */ /* === Core/cholmod_memory ================================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Core Module. Copyright (C) 2005-2013, * Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* Core memory management routines: * * Primary routines: * ----------------- * cholmod_malloc malloc wrapper * cholmod_free free wrapper * * Secondary routines: * ------------------- * cholmod_calloc calloc wrapper * cholmod_realloc realloc wrapper * cholmod_realloc_multiple realloc wrapper for multiple objects * * The user may make use of these, just like malloc and free. You can even * malloc an object and safely free it with cholmod_free, and visa versa * (except that the memory usage statistics will be corrupted). These routines * do differ from malloc and free. If cholmod_free is given a NULL pointer, * for example, it does nothing (unlike the ANSI free). cholmod_realloc does * not return NULL if given a non-NULL pointer and a nonzero size, even if it * fails (it sets an error code in Common->status instead). * * CHOLMOD keeps track of the amount of memory it has allocated, and so the * cholmod_free routine includes as a parameter the size of the object being * freed. This is only used for memory usage statistics, which are very useful * in finding memory leaks in your program. If you, the user of CHOLMOD, pass * the wrong size, the only consequence is that the memory usage statistics * will be invalid. This will causes assertions to fail if CHOLMOD is * compiled with debugging enabled, but otherwise it will cause no errors. * * The cholmod_free_* routines for each CHOLMOD object keep track of the size * of the blocks they free, so they do not require you to pass their sizes * as a parameter. * * If a block of size zero is requested, these routines allocate a block of * size one instead. */ #include "cholmod_internal.h" #include "cholmod_core.h" /* ========================================================================== */ /* === cholmod_add_size_t =================================================== */ /* ========================================================================== */ /* Safely compute a+b, and check for integer overflow. If overflow occurs, * return 0 and set OK to FALSE. Also return 0 if OK is FALSE on input. */ size_t CHOLMOD(add_size_t) (size_t a, size_t b, int *ok) { size_t s = a + b ; (*ok) = (*ok) && (s >= a) ; return ((*ok) ? s : 0) ; } /* ========================================================================== */ /* === cholmod_mult_size_t ================================================== */ /* ========================================================================== */ /* Safely compute a*k, where k should be small, and check for integer overflow. * If overflow occurs, return 0 and set OK to FALSE. Also return 0 if OK is * FALSE on input. */ size_t CHOLMOD(mult_size_t) (size_t a, size_t k, int *ok) { size_t p = 0, s ; while (*ok) { if (k % 2) { p = p + a ; (*ok) = (*ok) && (p >= a) ; } k = k / 2 ; if (!k) return (p) ; s = a + a ; (*ok) = (*ok) && (s >= a) ; a = s ; } return (0) ; } /* ========================================================================== */ /* === cholmod_malloc ======================================================= */ /* ========================================================================== */ /* Wrapper around malloc routine. Allocates space of size MAX(1,n)*size, where * size is normally a sizeof (...). * * This routine, cholmod_calloc, and cholmod_realloc do not set Common->status * to CHOLMOD_OK on success, so that a sequence of cholmod_malloc's, _calloc's, * or _realloc's can be used. If any of them fails, the Common->status will * hold the most recent error status. * * Usage, for a pointer to int: * * p = cholmod_malloc (n, sizeof (int), Common) * * Uses a pointer to the malloc routine (or its equivalent) defined in Common. */ void *CHOLMOD(malloc) /* returns pointer to the newly malloc'd block */ ( /* ---- input ---- */ size_t n, /* number of items */ size_t size, /* size of each item */ /* --------------- */ cholmod_common *Common ) { void *p ; size_t s ; /* int ok = TRUE ; */ RETURN_IF_NULL_COMMON (NULL) ; if (size == 0) { ERROR (CHOLMOD_INVALID, "sizeof(item) must be > 0") ; p = NULL ; } else if (n >= (Size_max / size) || n >= Int_max) { /* object is too big to allocate without causing integer overflow */ ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; p = NULL ; } else { /* call malloc, or its equivalent */ p = SuiteSparse_malloc (n, size) ; if (p == NULL) { /* failure: out of memory */ ERROR (CHOLMOD_OUT_OF_MEMORY, "out of memory") ; } else { /* success: increment the count of objects allocated */ Common->malloc_count++ ; Common->memory_inuse += (n * size) ; Common->memory_usage = MAX (Common->memory_usage, Common->memory_inuse) ; PRINTM (("cholmod_malloc %p %g cnt: %g inuse %g\n", p, (double) n*size, (double) Common->malloc_count, (double) Common->memory_inuse)) ; } } return (p) ; } /* ========================================================================== */ /* === cholmod_free ========================================================= */ /* ========================================================================== */ /* Wrapper around free routine. Returns NULL, which can be assigned to the * pointer being freed, as in: * * p = cholmod_free (n, sizeof (int), p, Common) ; * * In CHOLMOD, the syntax: * * cholmod_free (n, sizeof (int), p, Common) ; * * is used if p is a local pointer and the routine is returning shortly. * Uses a pointer to the free routine (or its equivalent) defined in Common. * Nothing is freed if the pointer is NULL. */ void *CHOLMOD(free) /* always returns NULL */ ( /* ---- input ---- */ size_t n, /* number of items */ size_t size, /* size of each item */ /* ---- in/out --- */ void *p, /* block of memory to free */ /* --------------- */ cholmod_common *Common ) { RETURN_IF_NULL_COMMON (NULL) ; if (p != NULL) { /* only free the object if the pointer is not NULL */ /* call free, or its equivalent */ SuiteSparse_free (p) ; Common->malloc_count-- ; Common->memory_inuse -= (n * size) ; PRINTM (("cholmod_free %p %g cnt: %g inuse %g\n", p, (double) n*size, (double) Common->malloc_count, (double) Common->memory_inuse)) ; /* This assertion will fail if the user calls cholmod_malloc and * cholmod_free with mismatched memory sizes. It shouldn't fail * otherwise. */ ASSERT (IMPLIES (Common->malloc_count == 0, Common->memory_inuse == 0)); } /* return NULL, and the caller should assign this to p. This avoids * freeing the same pointer twice. */ return (NULL) ; } /* ========================================================================== */ /* === cholmod_calloc ======================================================= */ /* ========================================================================== */ /* Wrapper around calloc routine. * * Uses a pointer to the calloc routine (or its equivalent) defined in Common. * This routine is identical to malloc, except that it zeros the newly allocated * block to zero. */ void *CHOLMOD(calloc) /* returns pointer to the newly calloc'd block */ ( /* ---- input ---- */ size_t n, /* number of items */ size_t size, /* size of each item */ /* --------------- */ cholmod_common *Common ) { void *p ; RETURN_IF_NULL_COMMON (NULL) ; if (size == 0) { ERROR (CHOLMOD_INVALID, "sizeof(item) must be > 0") ; p = NULL ; } else if (n >= (Size_max / size) || n >= Int_max) { /* object is too big to allocate without causing integer overflow */ ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; p = NULL ; } else { /* call calloc, or its equivalent */ p = SuiteSparse_calloc (n, size) ; if (p == NULL) { /* failure: out of memory */ ERROR (CHOLMOD_OUT_OF_MEMORY, "out of memory") ; } else { /* success: increment the count of objects allocated */ Common->malloc_count++ ; Common->memory_inuse += (n * size) ; Common->memory_usage = MAX (Common->memory_usage, Common->memory_inuse) ; PRINTM (("cholmod_malloc %p %g cnt: %g inuse %g\n", p, (double) n*size, (double) Common->malloc_count, (double) Common->memory_inuse)) ; } } return (p) ; } /* ========================================================================== */ /* === cholmod_realloc ====================================================== */ /* ========================================================================== */ /* Wrapper around realloc routine. Given a pointer p to a block of size * (*n)*size memory, it changes the size of the block pointed to by p to be * MAX(1,nnew)*size in size. It may return a pointer different than p. This * should be used as (for a pointer to int): * * p = cholmod_realloc (nnew, sizeof (int), p, *n, Common) ; * * If p is NULL, this is the same as p = cholmod_malloc (...). * A size of nnew=0 is treated as nnew=1. * * If the realloc fails, p is returned unchanged and Common->status is set * to CHOLMOD_OUT_OF_MEMORY. If successful, Common->status is not modified, * and p is returned (possibly changed) and pointing to a large block of memory. * * Uses a pointer to the realloc routine (or its equivalent) defined in Common. */ void *CHOLMOD(realloc) /* returns pointer to reallocated block */ ( /* ---- input ---- */ size_t nnew, /* requested # of items in reallocated block */ size_t size, /* size of each item */ /* ---- in/out --- */ void *p, /* block of memory to realloc */ size_t *n, /* current size on input, nnew on output if successful*/ /* --------------- */ cholmod_common *Common ) { size_t nold = (*n) ; void *pnew ; size_t s ; int ok = TRUE ; RETURN_IF_NULL_COMMON (NULL) ; if (size == 0) { ERROR (CHOLMOD_INVALID, "sizeof(item) must be > 0") ; p = NULL ; } else if (p == NULL) { /* A fresh object is being allocated. */ PRINT1 (("realloc fresh: %d %d\n", nnew, size)) ; p = CHOLMOD(malloc) (nnew, size, Common) ; *n = (p == NULL) ? 0 : nnew ; } else if (nold == nnew) { /* Nothing to do. Do not change p or n. */ PRINT1 (("realloc nothing: %d %d\n", nnew, size)) ; } else if (nnew >= (Size_max / size) || nnew >= Int_max) { /* failure: nnew is too big. Do not change p or n. */ ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; } else { /* The object exists, and is changing to some other nonzero size. */ /* call realloc, or its equivalent */ PRINT1 (("realloc : %d to %d, %d\n", nold, nnew, size)) ; pnew = SuiteSparse_realloc (nnew, nold, size, p, &ok) ; if (ok) { /* success: return revised p and change the size of the block */ PRINTM (("cholmod_free %p %g cnt: %g inuse %g\n" "cholmod_malloc %p %g cnt: %g inuse %g\n", p, (double) nold*size, (double) Common->malloc_count-1, (double) (Common->memory_inuse - nold*size), pnew, (double) nnew*size, (double) Common->malloc_count, (double) (Common->memory_inuse + (nnew-nold)*size))) ; p = pnew ; *n = nnew ; Common->memory_inuse += ((nnew-nold) * size) ; } else { /* Increasing the size of the block has failed. * Do not change n. */ ERROR (CHOLMOD_OUT_OF_MEMORY, "out of memory") ; } Common->memory_usage = MAX (Common->memory_usage, Common->memory_inuse); } return (p) ; } /* ========================================================================== */ /* === cholmod_realloc_multiple ============================================= */ /* ========================================================================== */ /* reallocate multiple blocks of memory, all of the same size (up to two integer * and two real blocks). Either reallocations all succeed, or all are returned * in the original size (they are freed if the original size is zero). The nnew * blocks are of size 1 or more. */ int CHOLMOD(realloc_multiple) ( /* ---- input ---- */ size_t nnew, /* requested # of items in reallocated blocks */ int nint, /* number of int/SuiteSparse_long blocks */ int xtype, /* CHOLMOD_PATTERN, _REAL, _COMPLEX, or _ZOMPLEX */ /* ---- in/out --- */ void **Iblock, /* int or SuiteSparse_long block */ void **Jblock, /* int or SuiteSparse_long block */ void **Xblock, /* complex or double block */ void **Zblock, /* zomplex case only: double block */ size_t *nold_p, /* current size of the I,J,X,Z blocks on input, * nnew on output if successful */ /* --------------- */ cholmod_common *Common ) { double *xx, *zz ; size_t i, j, x, z, nold ; RETURN_IF_NULL_COMMON (FALSE) ; if (xtype < CHOLMOD_PATTERN || xtype > CHOLMOD_ZOMPLEX) { ERROR (CHOLMOD_INVALID, "invalid xtype") ; return (FALSE) ; } nold = *nold_p ; if (nint < 1 && xtype == CHOLMOD_PATTERN) { /* nothing to do */ return (TRUE) ; } i = nold ; j = nold ; x = nold ; z = nold ; if (nint > 0) { *Iblock = CHOLMOD(realloc) (nnew, sizeof (Int), *Iblock, &i, Common) ; } if (nint > 1) { *Jblock = CHOLMOD(realloc) (nnew, sizeof (Int), *Jblock, &j, Common) ; } switch (xtype) { case CHOLMOD_REAL: *Xblock = CHOLMOD(realloc) (nnew, sizeof (double), *Xblock, &x, Common) ; break ; case CHOLMOD_COMPLEX: *Xblock = CHOLMOD(realloc) (nnew, 2*sizeof (double), *Xblock, &x, Common) ; break ; case CHOLMOD_ZOMPLEX: *Xblock = CHOLMOD(realloc) (nnew, sizeof (double), *Xblock, &x, Common) ; *Zblock = CHOLMOD(realloc) (nnew, sizeof (double), *Zblock, &z, Common) ; break ; } if (Common->status < CHOLMOD_OK) { /* one or more realloc's failed. Resize all back down to nold. */ if (nold == 0) { if (nint > 0) { *Iblock = CHOLMOD(free) (i, sizeof (Int), *Iblock, Common) ; } if (nint > 1) { *Jblock = CHOLMOD(free) (j, sizeof (Int), *Jblock, Common) ; } switch (xtype) { case CHOLMOD_REAL: *Xblock = CHOLMOD(free) (x, sizeof (double), *Xblock, Common) ; break ; case CHOLMOD_COMPLEX: *Xblock = CHOLMOD(free) (x, 2*sizeof (double), *Xblock, Common) ; break ; case CHOLMOD_ZOMPLEX: *Xblock = CHOLMOD(free) (x, sizeof (double), *Xblock, Common) ; *Zblock = CHOLMOD(free) (x, sizeof (double), *Zblock, Common) ; break ; } } else { if (nint > 0) { *Iblock = CHOLMOD(realloc) (nold, sizeof (Int), *Iblock, &i, Common) ; } if (nint > 1) { *Jblock = CHOLMOD(realloc) (nold, sizeof (Int), *Jblock, &j, Common) ; } switch (xtype) { case CHOLMOD_REAL: *Xblock = CHOLMOD(realloc) (nold, sizeof (double), *Xblock, &x, Common) ; break ; case CHOLMOD_COMPLEX: *Xblock = CHOLMOD(realloc) (nold, 2*sizeof (double), *Xblock, &x, Common) ; break ; case CHOLMOD_ZOMPLEX: *Xblock = CHOLMOD(realloc) (nold, sizeof (double), *Xblock, &x, Common) ; *Zblock = CHOLMOD(realloc) (nold, sizeof (double), *Zblock, &z, Common) ; break ; } } return (FALSE) ; } if (nold == 0) { /* New space was allocated. Clear the first entry so that valgrind * doesn't complain about its access in change_complexity * (Core/cholmod_complex.c). */ xx = *Xblock ; zz = *Zblock ; switch (xtype) { case CHOLMOD_REAL: xx [0] = 0 ; break ; case CHOLMOD_COMPLEX: xx [0] = 0 ; xx [1] = 0 ; break ; case CHOLMOD_ZOMPLEX: xx [0] = 0 ; zz [0] = 0 ; break ; } } /* all realloc's succeeded, change size to reflect realloc'ed size. */ *nold_p = nnew ; return (TRUE) ; } Matrix/src/CHOLMOD/Core/cholmod_add.c0000644000176200001440000001767713652535054016715 0ustar liggesusers/* ========================================================================== */ /* === Core/cholmod_add ===================================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Core Module. Copyright (C) 2005-2006, * Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* C = alpha*A + beta*B, or spones(A+B). Result is packed, with sorted or * unsorted columns. This routine is much faster and takes less memory if C * is allowed to have unsorted columns. * * If A and B are both symmetric (in upper form) then C is the same. Likewise, * if A and B are both symmetric (in lower form) then C is the same. * Otherwise, C is unsymmetric. A and B must have the same dimension. * * workspace: Flag (nrow), W (nrow) if values, Iwork (max (nrow,ncol)). * allocates temporary copies for A and B if they are symmetric. * allocates temporary copy of C if it is to be returned sorted. * * A and B can have an xtype of pattern or real. Complex or zomplex cases * are supported only if the "values" input parameter is FALSE. */ #include "cholmod_internal.h" #include "cholmod_core.h" cholmod_sparse *CHOLMOD(add) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to add */ cholmod_sparse *B, /* matrix to add */ double alpha [2], /* scale factor for A */ double beta [2], /* scale factor for B */ int values, /* if TRUE compute the numerical values of C */ int sorted, /* if TRUE, sort columns of C */ /* --------------- */ cholmod_common *Common ) { double *Ax, *Bx, *Cx, *W ; Int apacked, up, lo, nrow, ncol, bpacked, nzmax, pa, paend, pb, pbend, i, j, p, mark, nz ; Int *Ap, *Ai, *Anz, *Bp, *Bi, *Bnz, *Flag, *Cp, *Ci ; cholmod_sparse *A2, *B2, *C ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (A, NULL) ; RETURN_IF_NULL (B, NULL) ; values = values && (A->xtype != CHOLMOD_PATTERN) && (B->xtype != CHOLMOD_PATTERN) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ; RETURN_IF_XTYPE_INVALID (B, CHOLMOD_PATTERN, values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ; if (A->nrow != B->nrow || A->ncol != B->ncol) { /* A and B must have the same dimensions */ ERROR (CHOLMOD_INVALID, "A and B dimesions do not match") ; return (NULL) ; } /* A and B must have the same numerical type if values is TRUE (both must * be CHOLMOD_REAL, this is implicitly checked above) */ Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ nrow = A->nrow ; ncol = A->ncol ; CHOLMOD(allocate_work) (nrow, MAX (nrow,ncol), values ? nrow : 0, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ if (nrow <= 1) { /* C will be implicitly sorted, so no need to sort it here */ sorted = FALSE ; } /* convert A or B to unsymmetric, if necessary */ A2 = NULL ; B2 = NULL ; if (A->stype != B->stype) { if (A->stype) { /* workspace: Iwork (max (nrow,ncol)) */ A2 = CHOLMOD(copy) (A, 0, values, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } A = A2 ; } if (B->stype) { /* workspace: Iwork (max (nrow,ncol)) */ B2 = CHOLMOD(copy) (B, 0, values, Common) ; if (Common->status < CHOLMOD_OK) { CHOLMOD(free_sparse) (&A2, Common) ; return (NULL) ; /* out of memory */ } B = B2 ; } } /* get the A matrix */ ASSERT (A->stype == B->stype) ; up = (A->stype > 0) ; lo = (A->stype < 0) ; Ap = A->p ; Anz = A->nz ; Ai = A->i ; Ax = A->x ; apacked = A->packed ; /* get the B matrix */ Bp = B->p ; Bnz = B->nz ; Bi = B->i ; Bx = B->x ; bpacked = B->packed ; /* get workspace */ W = Common->Xwork ; /* size nrow, used if values is TRUE */ Flag = Common->Flag ; /* size nrow, Flag [0..nrow-1] < mark on input */ /* ---------------------------------------------------------------------- */ /* allocate the result C */ /* ---------------------------------------------------------------------- */ /* If integer overflow occurs, nzmax < 0 and the allocate fails properly * (likewise in most other matrix manipulation routines). */ nzmax = CHOLMOD(nnz) (A, Common) + CHOLMOD(nnz) (B, Common) ; C = CHOLMOD(allocate_sparse) (nrow, ncol, nzmax, FALSE, TRUE, SIGN (A->stype), values ? A->xtype : CHOLMOD_PATTERN, Common) ; if (Common->status < CHOLMOD_OK) { CHOLMOD(free_sparse) (&A2, Common) ; CHOLMOD(free_sparse) (&B2, Common) ; return (NULL) ; /* out of memory */ } Cp = C->p ; Ci = C->i ; Cx = C->x ; /* ---------------------------------------------------------------------- */ /* compute C = alpha*A + beta*B */ /* ---------------------------------------------------------------------- */ nz = 0 ; for (j = 0 ; j < ncol ; j++) { Cp [j] = nz ; /* clear the Flag array */ /* mark = CHOLMOD(clear_flag) (Common) ; */ CHOLMOD_CLEAR_FLAG (Common) ; mark = Common->mark ; /* scatter B into W */ pb = Bp [j] ; pbend = (bpacked) ? (Bp [j+1]) : (pb + Bnz [j]) ; for (p = pb ; p < pbend ; p++) { i = Bi [p] ; if ((up && i > j) || (lo && i < j)) { continue ; } Flag [i] = mark ; if (values) { W [i] = beta [0] * Bx [p] ; } } /* add A and gather from W into C(:,j) */ pa = Ap [j] ; paend = (apacked) ? (Ap [j+1]) : (pa + Anz [j]) ; for (p = pa ; p < paend ; p++) { i = Ai [p] ; if ((up && i > j) || (lo && i < j)) { continue ; } Flag [i] = EMPTY ; Ci [nz] = i ; if (values) { Cx [nz] = W [i] + alpha [0] * Ax [p] ; W [i] = 0 ; } nz++ ; } /* gather remaining entries into C(:,j), using pattern of B */ for (p = pb ; p < pbend ; p++) { i = Bi [p] ; if ((up && i > j) || (lo && i < j)) { continue ; } if (Flag [i] == mark) { Ci [nz] = i ; if (values) { Cx [nz] = W [i] ; W [i] = 0 ; } nz++ ; } } } Cp [ncol] = nz ; /* ---------------------------------------------------------------------- */ /* reduce C in size and free temporary matrices */ /* ---------------------------------------------------------------------- */ ASSERT (MAX (1,nz) <= C->nzmax) ; CHOLMOD(reallocate_sparse) (nz, C, Common) ; ASSERT (Common->status >= CHOLMOD_OK) ; /* clear the Flag array */ mark = CHOLMOD(clear_flag) (Common) ; CHOLMOD(free_sparse) (&A2, Common) ; CHOLMOD(free_sparse) (&B2, Common) ; /* ---------------------------------------------------------------------- */ /* sort C, if requested */ /* ---------------------------------------------------------------------- */ if (sorted) { /* workspace: Iwork (max (nrow,ncol)) */ if (!CHOLMOD(sort) (C, Common)) { CHOLMOD(free_sparse) (&C, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } } } /* ---------------------------------------------------------------------- */ /* return result */ /* ---------------------------------------------------------------------- */ ASSERT (CHOLMOD(dump_sparse) (C, "add", Common) >= 0) ; return (C) ; } Matrix/src/CHOLMOD/Core/cholmod_transpose.c0000644000176200001440000007477613652535054020206 0ustar liggesusers/* ========================================================================== */ /* === Core/cholmod_transpose =============================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Core Module. Copyright (C) 2005-2006, * Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* Core utility routines for the cholmod_sparse object to * compute the transpose or permuted transpose of a matrix: * * Primary routines: * ----------------- * cholmod_transpose transpose sparse matrix * cholmod_ptranspose transpose and permute sparse matrix * cholmod_sort sort row indices in each column of sparse matrix * * Secondary routines: * ------------------- * cholmod_transpose_unsym transpose unsymmetric sparse matrix * cholmod_transpose_sym transpose symmetric sparse matrix * * All xtypes (pattern, real, complex, and zomplex) are supported. * * --------------------------------------- * Unsymmetric case: A->stype is zero. * --------------------------------------- * * Computes F = A', F = A (:,f)' or F = A (p,f)', except that the indexing by * f does not work the same as the MATLAB notation (see below). A->stype * is zero, which denotes that both the upper and lower triangular parts of * A are present (and used). A may in fact be symmetric in pattern and/or * value; A->stype just denotes which part of A are stored. A may be * rectangular. * * p is a permutation of 0:m-1, and f is a subset of 0:n-1, where A is m-by-n. * There can be no duplicate entries in p or f. * * The set f is held in fset and fsize. * fset = NULL means ":" in MATLAB. fsize is ignored. * fset != NULL means f = fset [0..fsize-1]. * fset != NULL and fsize = 0 means f is the empty set. * * Columns not in the set f are considered to be zero. That is, * if A is 5-by-10 then F = A (:,[3 4])' is not 2-by-5, but 10-by-5, and rows * 3 and 4 of F are equal to columns 3 and 4 of A (the other rows of F are * zero). More precisely, in MATLAB notation: * * [m n] = size (A) ; * F = A ; * notf = ones (1,n) ; * notf (f) = 0 ; * F (:, find (notf)) = 0 * F = F' * * If you want the MATLAB equivalent F=A(p,f) operation, use cholmod_submatrix * instead (which does not compute the transpose). * * F->nzmax must be large enough to hold the matrix F. It is not modified. * If F->nz is present then F->nz [j] = # of entries in column j of F. * * A can be sorted or unsorted, with packed or unpacked columns. * * If f is present and not sorted in ascending order, then F is unsorted * (that is, it may contain columns whose row indices do not appear in * ascending order). Otherwise, F is sorted (the row indices in each * column of F appear in strictly ascending order). * * F is returned in packed or unpacked form, depending on F->packed on input. * If F->packed is false, then F is returned in unpacked form (F->nz must be * present). Each row i of F is large enough to hold all the entries in row i * of A, even if f is provided. That is, F->i and * F->x [F->p [i] .. F->p [i] + F->nz [i] - 1] contain all entries in A (i,f), * but F->p [i+1] - F->p [i] is equal to the number of nonzeros in A (i,:), * not just A (i,f). * * The cholmod_transpose_unsym routine is the only operation in CHOLMOD that * can produce an unpacked matrix. * * --------------------------------------- * Symmetric case: A->stype is nonzero. * --------------------------------------- * * Computes F = A' or F = A(p,p)', the transpose or permuted transpose, where * A->stype is nonzero. * * If A->stype > 0, then A is a symmetric matrix where just the upper part * of the matrix is stored. Entries in the lower triangular part may be * present, but are ignored. A must be square. If F=A', then F is returned * sorted; otherwise F is unsorted for the F=A(p,p)' case. * * There can be no duplicate entries in p. * The fset and fsize parameters are not used. * * Three kinds of transposes are available, depending on the "values" parameter: * 0: do not transpose the numerical values; create a CHOLMOD_PATTERN matrix * 1: array transpose * 2: complex conjugate transpose (same as 2 if input is real or pattern) * * ----------------------------------------------------------------------------- * * For cholmod_transpose_unsym and cholmod_transpose_sym, the output matrix * F must already be pre-allocated by the caller, with the correct dimensions. * If F is not valid or has the wrong dimensions, it is not modified. * Otherwise, if F is too small, the transpose is not computed; the contents * of F->p contain the column pointers of the resulting matrix, where * F->p [F->ncol] > F->nzmax. In this case, the remaining contents of F are * not modified. F can still be properly free'd with cholmod_free_sparse. */ #include "cholmod_internal.h" #include "cholmod_core.h" /* ========================================================================== */ /* === TEMPLATE ============================================================= */ /* ========================================================================== */ #define PATTERN #include "t_cholmod_transpose.c" #define REAL #include "t_cholmod_transpose.c" #define COMPLEX #include "t_cholmod_transpose.c" #define COMPLEX #define NCONJUGATE #include "t_cholmod_transpose.c" #define ZOMPLEX #include "t_cholmod_transpose.c" #define ZOMPLEX #define NCONJUGATE #include "t_cholmod_transpose.c" /* ========================================================================== */ /* === cholmod_transpose_unsym ============================================== */ /* ========================================================================== */ /* Compute F = A', A (:,f)', or A (p,f)', where A is unsymmetric and F is * already allocated. See cholmod_transpose for a simpler routine. * * workspace: * Iwork (MAX (nrow,ncol)) if fset is present * Iwork (nrow) if fset is NULL * * The xtype of A and F must match, unless values is zero or F->xtype is * CHOLMOD_PATTERN (in which case only the pattern of A is transpose into F). */ int CHOLMOD(transpose_unsym) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to transpose */ int values, /* 2: complex conj. transpose, 1: array transpose, 0: do not transpose the numerical values */ Int *Perm, /* size nrow, if present (can be NULL) */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ /* ---- output --- */ cholmod_sparse *F, /* F = A', A(:,f)', or A(p,f)' */ /* --------------- */ cholmod_common *Common ) { Int *Fp, *Fnz, *Ap, *Ai, *Anz, *Wi ; Int nrow, ncol, permute, use_fset, Apacked, Fpacked, p, pend, i, j, k, Fsorted, nf, jj, jlast ; size_t s ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (F, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (F, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; if (A->nrow != F->ncol || A->ncol != F->nrow) { ERROR (CHOLMOD_INVALID, "F has the wrong dimensions") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ nf = fsize ; use_fset = (fset != NULL) ; nrow = A->nrow ; ncol = A->ncol ; Ap = A->p ; /* size A->ncol+1, column pointers of A */ Ai = A->i ; /* size nz = Ap [A->ncol], row indices of A */ Anz = A->nz ; Apacked = A->packed ; ASSERT (IMPLIES (!Apacked, Anz != NULL)) ; permute = (Perm != NULL) ; Fp = F->p ; /* size A->nrow+1, row pointers of F */ Fnz = F->nz ; Fpacked = F->packed ; ASSERT (IMPLIES (!Fpacked, Fnz != NULL)) ; nf = (use_fset) ? nf : ncol ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* s = nrow + ((fset != NULL) ? ncol : 0) */ s = CHOLMOD(add_size_t) (nrow, ((fset != NULL) ? ncol : 0), &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (FALSE) ; } CHOLMOD(allocate_work) (0, s, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; /* out of memory */ } Wi = Common->Iwork ; /* size nrow (i/l/l) */ /* ---------------------------------------------------------------------- */ /* check Perm and fset */ /* ---------------------------------------------------------------------- */ if (permute) { for (i = 0 ; i < nrow ; i++) { Wi [i] = 1 ; } for (k = 0 ; k < nrow ; k++) { i = Perm [k] ; if (i < 0 || i > nrow || Wi [i] == 0) { ERROR (CHOLMOD_INVALID, "invalid permutation") ; return (FALSE) ; } Wi [i] = 0 ; } } if (use_fset) { for (j = 0 ; j < ncol ; j++) { Wi [j] = 1 ; } for (k = 0 ; k < nf ; k++) { j = fset [k] ; if (j < 0 || j > ncol || Wi [j] == 0) { ERROR (CHOLMOD_INVALID, "invalid fset") ; return (FALSE) ; } Wi [j] = 0 ; } } /* Perm and fset are now valid */ ASSERT (CHOLMOD(dump_perm) (Perm, nrow, nrow, "Perm", Common)) ; ASSERT (CHOLMOD(dump_perm) (fset, nf, ncol, "fset", Common)) ; /* ---------------------------------------------------------------------- */ /* count the entries in each row of A or A(:,f) */ /* ---------------------------------------------------------------------- */ for (i = 0 ; i < nrow ; i++) { Wi [i] = 0 ; } jlast = EMPTY ; Fsorted = TRUE ; if (use_fset) { /* count entries in each row of A(:,f) */ for (jj = 0 ; jj < nf ; jj++) { j = fset [jj] ; if (j <= jlast) { Fsorted = FALSE ; } p = Ap [j] ; pend = (Apacked) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { Wi [Ai [p]]++ ; } jlast = j ; } /* save the nz counts if F is unpacked, and recount all of A */ if (!Fpacked) { if (permute) { for (i = 0 ; i < nrow ; i++) { Fnz [i] = Wi [Perm [i]] ; } } else { for (i = 0 ; i < nrow ; i++) { Fnz [i] = Wi [i] ; } } for (i = 0 ; i < nrow ; i++) { Wi [i] = 0 ; } /* count entries in each row of A */ for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = (Apacked) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { Wi [Ai [p]]++ ; } } } } else { /* count entries in each row of A */ for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = (Apacked) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { Wi [Ai [p]]++ ; } } /* save the nz counts if F is unpacked */ if (!Fpacked) { if (permute) { for (i = 0 ; i < nrow ; i++) { Fnz [i] = Wi [Perm [i]] ; } } else { for (i = 0 ; i < nrow ; i++) { Fnz [i] = Wi [i] ; } } } } /* ---------------------------------------------------------------------- */ /* compute the row pointers */ /* ---------------------------------------------------------------------- */ p = 0 ; if (permute) { for (i = 0 ; i < nrow ; i++) { Fp [i] = p ; p += Wi [Perm [i]] ; } for (i = 0 ; i < nrow ; i++) { Wi [Perm [i]] = Fp [i] ; } } else { for (i = 0 ; i < nrow ; i++) { Fp [i] = p ; p += Wi [i] ; } for (i = 0 ; i < nrow ; i++) { Wi [i] = Fp [i] ; } } Fp [nrow] = p ; if (p > (Int) (F->nzmax)) { ERROR (CHOLMOD_INVALID, "F is too small") ; return (FALSE) ; } /* ---------------------------------------------------------------------- */ /* transpose matrix, using template routine */ /* ---------------------------------------------------------------------- */ ok = FALSE ; if (values == 0 || F->xtype == CHOLMOD_PATTERN) { ok = p_cholmod_transpose_unsym (A, Perm, fset, nf, F, Common) ; } else if (F->xtype == CHOLMOD_REAL) { ok = r_cholmod_transpose_unsym (A, Perm, fset, nf, F, Common) ; } else if (F->xtype == CHOLMOD_COMPLEX) { if (values == 1) { /* array transpose */ ok = ct_cholmod_transpose_unsym (A, Perm, fset, nf, F, Common) ; } else { /* complex conjugate transpose */ ok = c_cholmod_transpose_unsym (A, Perm, fset, nf, F, Common) ; } } else if (F->xtype == CHOLMOD_ZOMPLEX) { if (values == 1) { /* array transpose */ ok = zt_cholmod_transpose_unsym (A, Perm, fset, nf, F, Common) ; } else { /* complex conjugate transpose */ ok = z_cholmod_transpose_unsym (A, Perm, fset, nf, F, Common) ; } } /* ---------------------------------------------------------------------- */ /* finalize result F */ /* ---------------------------------------------------------------------- */ if (ok) { F->sorted = Fsorted ; } ASSERT (CHOLMOD(dump_sparse) (F, "output F unsym", Common) >= 0) ; return (ok) ; } /* ========================================================================== */ /* === cholmod_transpose_sym ================================================ */ /* ========================================================================== */ /* Compute F = A' or A (p,p)', where A is symmetric and F is already allocated. * See cholmod_transpose for a simpler routine. * * workspace: Iwork (nrow) if Perm NULL, Iwork (2*nrow) if Perm non-NULL. */ int CHOLMOD(transpose_sym) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to transpose */ int values, /* 2: complex conj. transpose, 1: array transpose, 0: do not transpose the numerical values */ Int *Perm, /* size nrow, if present (can be NULL) */ /* ---- output --- */ cholmod_sparse *F, /* F = A' or A(p,p)' */ /* --------------- */ cholmod_common *Common ) { Int *Ap, *Anz, *Ai, *Fp, *Wi, *Pinv, *Iwork ; Int p, pend, packed, upper, permute, jold, n, i, j, k, iold ; size_t s ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (F, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (F, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; if (A->nrow != A->ncol || A->stype == 0) { /* this routine handles square symmetric matrices only */ ERROR (CHOLMOD_INVALID, "matrix must be symmetric") ; return (FALSE) ; } if (A->nrow != F->ncol || A->ncol != F->nrow) { ERROR (CHOLMOD_INVALID, "F has the wrong dimensions") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ permute = (Perm != NULL) ; n = A->nrow ; Ap = A->p ; /* size A->ncol+1, column pointers of A */ Ai = A->i ; /* size nz = Ap [A->ncol], row indices of A */ Anz = A->nz ; packed = A->packed ; ASSERT (IMPLIES (!packed, Anz != NULL)) ; upper = (A->stype > 0) ; Fp = F->p ; /* size A->nrow+1, row pointers of F */ /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* s = (Perm != NULL) ? 2*n : n */ s = CHOLMOD(add_size_t) (n, ((Perm != NULL) ? n : 0), &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (FALSE) ; } CHOLMOD(allocate_work) (0, s, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; /* out of memory */ } /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ Iwork = Common->Iwork ; Wi = Iwork ; /* size n (i/l/l) */ Pinv = Iwork + n ; /* size n (i/i/l) , unused if Perm NULL */ /* ---------------------------------------------------------------------- */ /* check Perm and construct inverse permutation */ /* ---------------------------------------------------------------------- */ if (permute) { for (i = 0 ; i < n ; i++) { Pinv [i] = EMPTY ; } for (k = 0 ; k < n ; k++) { i = Perm [k] ; if (i < 0 || i > n || Pinv [i] != EMPTY) { ERROR (CHOLMOD_INVALID, "invalid permutation") ; return (FALSE) ; } Pinv [i] = k ; } } /* Perm is now valid */ ASSERT (CHOLMOD(dump_perm) (Perm, n, n, "Perm", Common)) ; /* ---------------------------------------------------------------------- */ /* count the entries in each row of F */ /* ---------------------------------------------------------------------- */ for (i = 0 ; i < n ; i++) { Wi [i] = 0 ; } if (packed) { if (permute) { if (upper) { /* packed, permuted, upper */ for (j = 0 ; j < n ; j++) { jold = Perm [j] ; pend = Ap [jold+1] ; for (p = Ap [jold] ; p < pend ; p++) { iold = Ai [p] ; if (iold <= jold) { i = Pinv [iold] ; Wi [MIN (i, j)]++ ; } } } } else { /* packed, permuted, lower */ for (j = 0 ; j < n ; j++) { jold = Perm [j] ; pend = Ap [jold+1] ; for (p = Ap [jold] ; p < pend ; p++) { iold = Ai [p] ; if (iold >= jold) { i = Pinv [iold] ; Wi [MAX (i, j)]++ ; } } } } } else { if (upper) { /* packed, unpermuted, upper */ for (j = 0 ; j < n ; j++) { pend = Ap [j+1] ; for (p = Ap [j] ; p < pend ; p++) { i = Ai [p] ; if (i <= j) { Wi [i]++ ; } } } } else { /* packed, unpermuted, lower */ for (j = 0 ; j < n ; j++) { pend = Ap [j+1] ; for (p = Ap [j] ; p < pend ; p++) { i = Ai [p] ; if (i >= j) { Wi [i]++ ; } } } } } } else { if (permute) { if (upper) { /* unpacked, permuted, upper */ for (j = 0 ; j < n ; j++) { jold = Perm [j] ; p = Ap [jold] ; pend = p + Anz [jold] ; for ( ; p < pend ; p++) { iold = Ai [p] ; if (iold <= jold) { i = Pinv [iold] ; Wi [MIN (i, j)]++ ; } } } } else { /* unpacked, permuted, lower */ for (j = 0 ; j < n ; j++) { jold = Perm [j] ; p = Ap [jold] ; pend = p + Anz [jold] ; for ( ; p < pend ; p++) { iold = Ai [p] ; if (iold >= jold) { i = Pinv [iold] ; Wi [MAX (i, j)]++ ; } } } } } else { if (upper) { /* unpacked, unpermuted, upper */ for (j = 0 ; j < n ; j++) { p = Ap [j] ; pend = p + Anz [j] ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i <= j) { Wi [i]++ ; } } } } else { /* unpacked, unpermuted, lower */ for (j = 0 ; j < n ; j++) { p = Ap [j] ; pend = p + Anz [j] ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i >= j) { Wi [i]++ ; } } } } } } /* ---------------------------------------------------------------------- */ /* compute the row pointers */ /* ---------------------------------------------------------------------- */ p = 0 ; for (i = 0 ; i < n ; i++) { Fp [i] = p ; p += Wi [i] ; } Fp [n] = p ; for (i = 0 ; i < n ; i++) { Wi [i] = Fp [i] ; } if (p > (Int) (F->nzmax)) { ERROR (CHOLMOD_INVALID, "F is too small") ; return (FALSE) ; } /* ---------------------------------------------------------------------- */ /* transpose matrix, using template routine */ /* ---------------------------------------------------------------------- */ ok = FALSE ; if (values == 0 || F->xtype == CHOLMOD_PATTERN) { PRINT2 (("\n:::: p_transpose_sym Perm %p\n", Perm)) ; ok = p_cholmod_transpose_sym (A, Perm, F, Common) ; } else if (F->xtype == CHOLMOD_REAL) { PRINT2 (("\n:::: r_transpose_sym Perm %p\n", Perm)) ; ok = r_cholmod_transpose_sym (A, Perm, F, Common) ; } else if (F->xtype == CHOLMOD_COMPLEX) { if (values == 1) { /* array transpose */ PRINT2 (("\n:::: ct_transpose_sym Perm %p\n", Perm)) ; ok = ct_cholmod_transpose_sym (A, Perm, F, Common) ; } else { /* complex conjugate transpose */ PRINT2 (("\n:::: c_transpose_sym Perm %p\n", Perm)) ; ok = c_cholmod_transpose_sym (A, Perm, F, Common) ; } } else if (F->xtype == CHOLMOD_ZOMPLEX) { if (values == 1) { /* array transpose */ PRINT2 (("\n:::: zt_transpose_sym Perm %p\n", Perm)) ; ok = zt_cholmod_transpose_sym (A, Perm, F, Common) ; } else { /* complex conjugate transpose */ PRINT2 (("\n:::: z_transpose_sym Perm %p\n", Perm)) ; ok = z_cholmod_transpose_sym (A, Perm, F, Common) ; } } /* ---------------------------------------------------------------------- */ /* finalize result F */ /* ---------------------------------------------------------------------- */ /* F is sorted if there is no permutation vector */ if (ok) { F->sorted = !permute ; F->packed = TRUE ; F->stype = - SIGN (A->stype) ; /* flip the stype */ ASSERT (CHOLMOD(dump_sparse) (F, "output F sym", Common) >= 0) ; } return (ok) ; } /* ========================================================================== */ /* === cholmod_transpose ==================================================== */ /* ========================================================================== */ /* Returns A'. See also cholmod_ptranspose below. */ cholmod_sparse *CHOLMOD(transpose) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to transpose */ int values, /* 2: complex conj. transpose, 1: array transpose, 0: do not transpose the numerical values (returns its result as CHOLMOD_PATTERN) */ /* --------------- */ cholmod_common *Common ) { return (CHOLMOD(ptranspose) (A, values, NULL, NULL, 0, Common)) ; } /* ========================================================================== */ /* === cholmod_ptranspose =================================================== */ /* ========================================================================== */ /* Return A' or A(p,p)' if A is symmetric. Return A', A(:,f)', or A(p,f)' if * A is unsymmetric. * * workspace: * Iwork (MAX (nrow,ncol)) if unsymmetric and fset is non-NULL * Iwork (nrow) if unsymmetric and fset is NULL * Iwork (2*nrow) if symmetric and Perm is non-NULL. * Iwork (nrow) if symmetric and Perm is NULL. * * A simple worst-case upper bound on the workspace is nrow+ncol. */ cholmod_sparse *CHOLMOD(ptranspose) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to transpose */ int values, /* 2: complex conj. transpose, 1: array transpose, 0: do not transpose the numerical values */ Int *Perm, /* if non-NULL, F = A(p,f) or A(p,p) */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ /* --------------- */ cholmod_common *Common ) { Int *Ap, *Anz ; cholmod_sparse *F ; Int nrow, ncol, use_fset, j, jj, fnz, packed, stype, nf, xtype ; size_t ineed ; int ok = TRUE ; nf = fsize ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, NULL) ; stype = A->stype ; Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ nrow = A->nrow ; ncol = A->ncol ; if (stype != 0) { use_fset = FALSE ; if (Perm != NULL) { ineed = CHOLMOD(mult_size_t) (A->nrow, 2, &ok) ; } else { ineed = A->nrow ; } } else { use_fset = (fset != NULL) ; if (use_fset) { ineed = MAX (A->nrow, A->ncol) ; } else { ineed = A->nrow ; } } if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (NULL) ; } CHOLMOD(allocate_work) (0, ineed, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ Ap = A->p ; Anz = A->nz ; packed = A->packed ; ASSERT (IMPLIES (!packed, Anz != NULL)) ; xtype = values ? A->xtype : CHOLMOD_PATTERN ; /* ---------------------------------------------------------------------- */ /* allocate F */ /* ---------------------------------------------------------------------- */ /* determine # of nonzeros in F */ if (stype != 0) { /* F=A' or F=A(p,p)', fset is ignored */ fnz = CHOLMOD(nnz) (A, Common) ; } else { nf = (use_fset) ? nf : ncol ; if (use_fset) { fnz = 0 ; /* F=A(:,f)' or F=A(p,f)' */ for (jj = 0 ; jj < nf ; jj++) { /* The fset is not yet checked; it will be thoroughly checked * in cholmod_transpose_unsym. For now, just make sure we don't * access Ap and Anz out of bounds. */ j = fset [jj] ; if (j >= 0 && j < ncol) { fnz += packed ? (Ap [j+1] - Ap [j]) : MAX (0, Anz [j]) ; } } } else { /* F=A' or F=A(p,:)' */ fnz = CHOLMOD(nnz) (A, Common) ; } } /* F is ncol-by-nrow, fnz nonzeros, sorted unless f is present and unsorted, * packed, of opposite stype as A, and with/without numerical values */ F = CHOLMOD(allocate_sparse) (ncol, nrow, fnz, TRUE, TRUE, -SIGN(stype), xtype, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } /* ---------------------------------------------------------------------- */ /* transpose and optionally permute the matrix A */ /* ---------------------------------------------------------------------- */ if (stype != 0) { /* F = A (p,p)', using upper or lower triangular part of A only */ ok = CHOLMOD(transpose_sym) (A, values, Perm, F, Common) ; } else { /* F = A (p,f)' */ ok = CHOLMOD(transpose_unsym) (A, values, Perm, fset, nf, F, Common) ; } /* ---------------------------------------------------------------------- */ /* return the matrix F, or NULL if an error occured */ /* ---------------------------------------------------------------------- */ if (!ok) { CHOLMOD(free_sparse) (&F, Common) ; } return (F) ; } /* ========================================================================== */ /* === cholmod_sort ========================================================= */ /* ========================================================================== */ /* Sort the columns of A, in place. Returns A in packed form, even if it * starts as unpacked. Removes entries in the ignored part of a symmetric * matrix. * * workspace: Iwork (max (nrow,ncol)). Allocates additional workspace for a * temporary copy of A'. */ int CHOLMOD(sort) ( /* ---- in/out --- */ cholmod_sparse *A, /* matrix to sort */ /* --------------- */ cholmod_common *Common ) { Int *Ap ; cholmod_sparse *F ; Int anz, ncol, nrow, stype ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; Common->status = CHOLMOD_OK ; nrow = A->nrow ; if (nrow <= 1) { /* a 1-by-n sparse matrix must be sorted */ A->sorted = TRUE ; return (TRUE) ; } /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ ncol = A->ncol ; CHOLMOD(allocate_work) (0, MAX (nrow, ncol), 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; /* out of memory */ } /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ anz = CHOLMOD(nnz) (A, Common) ; stype = A->stype ; /* ---------------------------------------------------------------------- */ /* sort the columns of the matrix */ /* ---------------------------------------------------------------------- */ /* allocate workspace for transpose: ncol-by-nrow, same # of nonzeros as A, * sorted, packed, same stype as A, and of the same numeric type as A. */ F = CHOLMOD(allocate_sparse) (ncol, nrow, anz, TRUE, TRUE, stype, A->xtype, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; /* out of memory */ } if (stype != 0) { /* F = A', upper or lower triangular part only */ CHOLMOD(transpose_sym) (A, 1, NULL, F, Common) ; A->packed = TRUE ; /* A = F' */ CHOLMOD(transpose_sym) (F, 1, NULL, A, Common) ; } else { /* F = A' */ CHOLMOD(transpose_unsym) (A, 1, NULL, NULL, 0, F, Common) ; A->packed = TRUE ; /* A = F' */ CHOLMOD(transpose_unsym) (F, 1, NULL, NULL, 0, A, Common) ; } ASSERT (A->sorted && A->packed) ; ASSERT (CHOLMOD(dump_sparse) (A, "Asorted", Common) >= 0) ; /* ---------------------------------------------------------------------- */ /* reduce A in size, if needed. This must succeed. */ /* ---------------------------------------------------------------------- */ Ap = A->p ; anz = Ap [ncol] ; ASSERT ((size_t) anz <= A->nzmax) ; CHOLMOD(reallocate_sparse) (anz, A, Common) ; ASSERT (Common->status >= CHOLMOD_OK) ; /* ---------------------------------------------------------------------- */ /* free workspace */ /* ---------------------------------------------------------------------- */ CHOLMOD(free_sparse) (&F, Common) ; return (TRUE) ; } Matrix/src/CHOLMOD/Core/cholmod_triplet.c0000644000176200001440000005551013652535054017634 0ustar liggesusers/* ========================================================================== */ /* === Core/cholmod_triplet ================================================= */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Core Module. Copyright (C) 2005-2006, * Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* Core utility routines for the cholmod_triplet object: * * A sparse matrix held in triplet form is the simplest one for a user to * create. It consists of a list of nz entries in arbitrary order, held in * three arrays: i, j, and x, each of length nk. The kth entry is in row i[k], * column j[k], with value x[k]. There may be duplicate values; if A(i,j) * appears more than once, its value is the sum of the entries with those row * and column indices. * * Primary routines: * ----------------- * cholmod_allocate_triplet allocate a triplet matrix * cholmod_free_triplet free a triplet matrix * * Secondary routines: * ------------------- * cholmod_reallocate_triplet reallocate a triplet matrix * cholmod_sparse_to_triplet create a triplet matrix copy of a sparse matrix * cholmod_triplet_to_sparse create a sparse matrix copy of a triplet matrix * cholmod_copy_triplet create a copy of a triplet matrix * * The relationship between an m-by-n cholmod_sparse matrix A and a * cholmod_triplet matrix (i, j, and x) is identical to how they are used in * the MATLAB "sparse" and "find" functions: * * [i j x] = find (A) * [m n] = size (A) * A = sparse (i,j,x,m,n) * * with the exception that the cholmod_sparse matrix may be "unpacked", may * have either sorted or unsorted columns (depending on the option selected), * and may be symmetric with just the upper or lower triangular part stored. * Likewise, the cholmod_triplet matrix may contain just the entries in the * upper or lower triangular part of a symmetric matrix. * * MATLAB sparse matrices are always "packed", always have sorted columns, * and always store both parts of a symmetric matrix. In some cases, MATLAB * behaves like CHOLMOD by ignoring entries in the upper or lower triangular * part of a matrix that is otherwise assumed to be symmetric (such as the * input to chol). In CHOLMOD, that option is a characteristic of the object. * In MATLAB, that option is based on how a matrix is used as the input to * a function. * * The triplet matrix is provided to give the user a simple way of constructing * a sparse matrix. There are very few operations supported for triplet * matrices. The assumption is that they will be converted to cholmod_sparse * matrix form first. * * Adding two triplet matrices simply involves concatenating the contents of * the three arrays (i, j, and x). To permute a triplet matrix, just replace * the row and column indices with their permuted values. For example, if * P is a permutation vector, then P [k] = j means row/column j is the kth * row/column in C=P*A*P'. In MATLAB notation, C=A(p,p). If Pinv is an array * of size n and T is the triplet form of A, then: * * Ti = T->i ; * Tj = T->j ; * for (k = 0 ; k < n ; k++) Pinv [P [k]] = k ; * for (k = 0 ; k < nz ; k++) Ti [k] = Pinv [Ti [k]] ; * for (k = 0 ; k < nz ; k++) Tj [k] = Pinv [Tj [k]] ; * * overwrites T with the triplet form of C=P*A*P'. The conversion * * C = cholmod_triplet_to_sparse (T, 0, &Common) ; * * will then return the matrix C = P*A*P'. * * Note that T->stype > 0 means that entries in the lower triangular part of * T are transposed into the upper triangular part when T is converted to * sparse matrix (cholmod_sparse) form with cholmod_triplet_to_sparse. The * opposite is true for T->stype < 0. * * Since the triplet matrix T is so simple to generate, it's quite easy * to remove entries that you do not want, prior to converting T to the * cholmod_sparse form. So if you include these entries in T, CHOLMOD * assumes that there must be a reason (such as the one above). Thus, * no entry in a triplet matrix is ever ignored. * * Other operations, such as extacting a submatrix, horizontal and vertical * concatenation, multiply a triplet matrix times a dense matrix, are also * simple. Multiplying two triplet matrices is not trivial; the simplest * method is to convert them to cholmod_sparse matrices first. * * Supports all xtypes (pattern, real, complex, and zomplex). */ #include "cholmod_internal.h" #include "cholmod_core.h" /* ========================================================================== */ /* === TEMPLATE ============================================================= */ /* ========================================================================== */ #define PATTERN #include "t_cholmod_triplet.c" #define REAL #include "t_cholmod_triplet.c" #define COMPLEX #include "t_cholmod_triplet.c" #define ZOMPLEX #include "t_cholmod_triplet.c" /* ========================================================================== */ /* === cholmod_allocate_triplet ============================================= */ /* ========================================================================== */ /* allocate space for a triplet matrix * * workspace: none */ cholmod_triplet *CHOLMOD(allocate_triplet) ( /* ---- input ---- */ size_t nrow, /* # of rows of T */ size_t ncol, /* # of columns of T */ size_t nzmax, /* max # of nonzeros of T */ int stype, /* stype of T */ int xtype, /* CHOLMOD_PATTERN, _REAL, _COMPLEX, or _ZOMPLEX */ /* --------------- */ cholmod_common *Common ) { cholmod_triplet *T ; size_t nzmax0 ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; if (xtype < CHOLMOD_PATTERN || xtype > CHOLMOD_ZOMPLEX) { ERROR (CHOLMOD_INVALID, "xtype invalid") ; return (NULL) ; } /* ensure the dimensions do not cause integer overflow */ (void) CHOLMOD(add_size_t) (ncol, 2, &ok) ; if (!ok || nrow > Int_max || ncol > Int_max || nzmax > Int_max) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (NULL) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate header */ /* ---------------------------------------------------------------------- */ T = CHOLMOD(malloc) (sizeof (cholmod_triplet), 1, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } PRINT1 (("cholmod_allocate_triplet %d-by-%d nzmax %d xtype %d\n", nrow, ncol, nzmax, xtype)) ; nzmax = MAX (1, nzmax) ; T->nrow = nrow ; T->ncol = ncol ; T->nzmax = nzmax ; T->nnz = 0 ; T->stype = stype ; T->itype = ITYPE ; T->xtype = xtype ; T->dtype = DTYPE ; T->j = NULL ; T->i = NULL ; T->x = NULL ; T->z = NULL ; /* ---------------------------------------------------------------------- */ /* allocate the matrix itself */ /* ---------------------------------------------------------------------- */ nzmax0 = 0 ; CHOLMOD(realloc_multiple) (nzmax, 2, xtype, &(T->i), &(T->j), &(T->x), &(T->z), &nzmax0, Common) ; if (Common->status < CHOLMOD_OK) { CHOLMOD(free_triplet) (&T, Common) ; return (NULL) ; /* out of memory */ } return (T) ; } /* ========================================================================== */ /* === cholmod_free_triplet ================================================= */ /* ========================================================================== */ /* free a triplet matrix * * workspace: none */ int CHOLMOD(free_triplet) ( /* ---- in/out --- */ cholmod_triplet **THandle, /* matrix to deallocate, NULL on output */ /* --------------- */ cholmod_common *Common ) { Int nz ; cholmod_triplet *T ; RETURN_IF_NULL_COMMON (FALSE) ; if (THandle == NULL) { /* nothing to do */ return (TRUE) ; } T = *THandle ; if (T == NULL) { /* nothing to do */ return (TRUE) ; } nz = T->nzmax ; T->j = CHOLMOD(free) (nz, sizeof (Int), T->j, Common) ; T->i = CHOLMOD(free) (nz, sizeof (Int), T->i, Common) ; if (T->xtype == CHOLMOD_REAL) { T->x = CHOLMOD(free) (nz, sizeof (double), T->x, Common) ; } else if (T->xtype == CHOLMOD_COMPLEX) { T->x = CHOLMOD(free) (nz, 2*sizeof (double), T->x, Common) ; } else if (T->xtype == CHOLMOD_ZOMPLEX) { T->x = CHOLMOD(free) (nz, sizeof (double), T->x, Common) ; T->z = CHOLMOD(free) (nz, sizeof (double), T->z, Common) ; } *THandle = CHOLMOD(free) (1, sizeof (cholmod_triplet), (*THandle), Common) ; return (TRUE) ; } /* ========================================================================== */ /* === cholmod_reallocate_triplet =========================================== */ /* ========================================================================== */ /* Change the size of T->i, T->j, and T->x, or allocate them if their current * size is zero. T->x is not modified if T->xtype is CHOLMOD_PATTERN. * * workspace: none */ int CHOLMOD(reallocate_triplet) ( /* ---- input ---- */ size_t nznew, /* new # of entries in T */ /* ---- in/out --- */ cholmod_triplet *T, /* triplet matrix to modify */ /* --------------- */ cholmod_common *Common ) { /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (T, FALSE) ; RETURN_IF_XTYPE_INVALID (T, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; Common->status = CHOLMOD_OK ; PRINT1 (("realloc triplet %d to %d, xtype: %d\n", T->nzmax, nznew, T->xtype)) ; /* ---------------------------------------------------------------------- */ /* resize the matrix */ /* ---------------------------------------------------------------------- */ CHOLMOD(realloc_multiple) (MAX (1,nznew), 2, T->xtype, &(T->i), &(T->j), &(T->x), &(T->z), &(T->nzmax), Common) ; return (Common->status == CHOLMOD_OK) ; } /* ========================================================================== */ /* === cholmod_triplet_to_sparse ============================================ */ /* ========================================================================== */ /* Convert a set of triplets into a cholmod_sparse matrix. In MATLAB notation, * for unsymmetric matrices: * * A = sparse (Ti, Tj, Tx, nrow, ncol, nzmax) ; * * For the symmetric upper case: * * A = sparse (min(Ti,Tj), max(Ti,Tj), Tx, nrow, ncol, nzmax) ; * * For the symmetric lower case: * * A = sparse (max(Ti,Tj), min(Ti,Tj), Tx, nrow, ncol, nzmax) ; * * If Tx is NULL, then A->x is not allocated, and only the pattern of A is * computed. A is returned in packed form, and can be of any stype * (upper/lower/unsymmetric). It has enough space to hold the values in T, * or nzmax, whichever is larger. * * workspace: Iwork (max (nrow,ncol)) * allocates a temporary copy of its output matrix. * * The resulting sparse matrix has the same xtype as the input triplet matrix. */ cholmod_sparse *CHOLMOD(triplet_to_sparse) ( /* ---- input ---- */ cholmod_triplet *T, /* matrix to copy */ size_t nzmax, /* allocate at least this much space in output matrix */ /* --------------- */ cholmod_common *Common ) { cholmod_sparse *R, *A = NULL ; Int *Wj, *Rp, *Ri, *Rnz, *Ti, *Tj ; Int i, j, p, k, stype, nrow, ncol, nz, ok ; size_t anz = 0 ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (T, NULL) ; Ti = T->i ; Tj = T->j ; RETURN_IF_NULL (Ti, NULL) ; RETURN_IF_NULL (Tj, NULL) ; RETURN_IF_XTYPE_INVALID (T, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, NULL) ; stype = SIGN (T->stype) ; if (stype && T->nrow != T->ncol) { /* inputs invalid */ ERROR (CHOLMOD_INVALID, "matrix invalid") ; return (NULL) ; } Common->status = CHOLMOD_OK ; DEBUG (CHOLMOD(dump_triplet) (T, "T", Common)) ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ nrow = T->nrow ; ncol = T->ncol ; nz = T->nnz ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ CHOLMOD(allocate_work) (0, MAX (nrow, ncol), 0, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } /* ---------------------------------------------------------------------- */ /* allocate temporary matrix R */ /* ---------------------------------------------------------------------- */ R = CHOLMOD(allocate_sparse) (ncol, nrow, nz, FALSE, FALSE, -stype, T->xtype, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } Rp = R->p ; Ri = R->i ; Rnz = R->nz ; /* ---------------------------------------------------------------------- */ /* count the entries in each row of A (also counting duplicates) */ /* ---------------------------------------------------------------------- */ for (i = 0 ; i < nrow ; i++) { Rnz [i] = 0 ; } if (stype > 0) { for (k = 0 ; k < nz ; k++) { i = Ti [k] ; j = Tj [k] ; if (i < 0 || i >= nrow || j < 0 || j >= ncol) { ERROR (CHOLMOD_INVALID, "index out of range") ; break ; } /* A will be symmetric with just the upper triangular part stored. * Create a matrix R that is lower triangular. Entries in the * upper part of R are transposed to the lower part. */ Rnz [MIN (i,j)]++ ; } } else if (stype < 0) { for (k = 0 ; k < nz ; k++) { i = Ti [k] ; j = Tj [k] ; if (i < 0 || i >= nrow || j < 0 || j >= ncol) { ERROR (CHOLMOD_INVALID, "index out of range") ; break ; } /* A will be symmetric with just the lower triangular part stored. * Create a matrix R that is upper triangular. Entries in the * lower part of R are transposed to the upper part. */ Rnz [MAX (i,j)]++ ; } } else { for (k = 0 ; k < nz ; k++) { i = Ti [k] ; j = Tj [k] ; if (i < 0 || i >= nrow || j < 0 || j >= ncol) { ERROR (CHOLMOD_INVALID, "index out of range") ; break ; } /* constructing an unsymmetric matrix */ Rnz [i]++ ; } } if (Common->status < CHOLMOD_OK) { /* triplet matrix is invalid */ CHOLMOD(free_sparse) (&R, Common) ; return (NULL) ; } /* ---------------------------------------------------------------------- */ /* construct the row pointers */ /* ---------------------------------------------------------------------- */ p = 0 ; for (i = 0 ; i < nrow ; i++) { Rp [i] = p ; p += Rnz [i] ; } Rp [nrow] = p ; /* use Wj (i/l/l) as temporary row pointers */ Wj = Common->Iwork ; /* size MAX (nrow,ncol) FUTURE WORK: (i/l/l) */ for (i = 0 ; i < nrow ; i++) { Wj [i] = Rp [i] ; } /* ---------------------------------------------------------------------- */ /* construct triplet matrix, using template routine */ /* ---------------------------------------------------------------------- */ switch (T->xtype) { case CHOLMOD_PATTERN: anz = p_cholmod_triplet_to_sparse (T, R, Common) ; break ; case CHOLMOD_REAL: anz = r_cholmod_triplet_to_sparse (T, R, Common) ; break ; case CHOLMOD_COMPLEX: anz = c_cholmod_triplet_to_sparse (T, R, Common) ; break ; case CHOLMOD_ZOMPLEX: anz = z_cholmod_triplet_to_sparse (T, R, Common) ; break ; } /* ---------------------------------------------------------------------- */ /* A = R' (array transpose, not complex conjugate transpose) */ /* ---------------------------------------------------------------------- */ /* workspace: Iwork (R->nrow), which is A->ncol */ ASSERT (CHOLMOD(dump_sparse) (R, "R", Common) >= 0) ; A = CHOLMOD(allocate_sparse) (nrow, ncol, MAX (anz, nzmax), TRUE, TRUE, stype, T->xtype, Common) ; if (stype) { ok = CHOLMOD(transpose_sym) (R, 1, NULL, A, Common) ; } else { ok = CHOLMOD(transpose_unsym) (R, 1, NULL, NULL, 0, A, Common) ; } CHOLMOD(free_sparse) (&R, Common) ; if (Common->status < CHOLMOD_OK) { CHOLMOD(free_sparse) (&A, Common) ; } /* ---------------------------------------------------------------------- */ /* return result */ /* ---------------------------------------------------------------------- */ ASSERT (CHOLMOD(dump_sparse) (A, "A = triplet(T) result", Common) >= 0) ; return (A) ; } /* ========================================================================== */ /* === cholmod_sparse_to_triplet ============================================ */ /* ========================================================================== */ /* Converts a sparse column-oriented matrix to triplet form. * The resulting triplet matrix has the same xtype as the sparse matrix. * * workspace: none */ cholmod_triplet *CHOLMOD(sparse_to_triplet) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to copy */ /* --------------- */ cholmod_common *Common ) { double *Ax, *Az, *Tx, *Tz ; Int *Ap, *Ai, *Ti, *Tj, *Anz ; cholmod_triplet *T ; Int i, xtype, p, pend, k, j, nrow, ncol, nz, stype, packed, up, lo, both ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (A, NULL) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, NULL) ; stype = SIGN (A->stype) ; nrow = A->nrow ; ncol = A->ncol ; if (stype && nrow != ncol) { /* inputs invalid */ ERROR (CHOLMOD_INVALID, "matrix invalid") ; return (NULL) ; } Ax = A->x ; Az = A->z ; xtype = A->xtype ; Common->status = CHOLMOD_OK ; ASSERT (CHOLMOD(dump_sparse) (A, "A", Common) >= 0) ; /* ---------------------------------------------------------------------- */ /* allocate triplet matrix */ /* ---------------------------------------------------------------------- */ nz = CHOLMOD(nnz) (A, Common) ; T = CHOLMOD(allocate_triplet) (nrow, ncol, nz, A->stype, A->xtype, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } /* ---------------------------------------------------------------------- */ /* convert to a sparse matrix */ /* ---------------------------------------------------------------------- */ Ap = A->p ; Ai = A->i ; Anz = A->nz ; packed = A->packed ; Ti = T->i ; Tj = T->j ; Tx = T->x ; Tz = T->z ; T->stype = A->stype ; both = (A->stype == 0) ; up = (A->stype > 0) ; lo = (A->stype < 0) ; k = 0 ; for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; if (both || (up && i <= j) || (lo && i >= j)) { Ti [k] = Ai [p] ; Tj [k] = j ; if (xtype == CHOLMOD_REAL) { Tx [k] = Ax [p] ; } else if (xtype == CHOLMOD_COMPLEX) { Tx [2*k ] = Ax [2*p ] ; Tx [2*k+1] = Ax [2*p+1] ; } else if (xtype == CHOLMOD_ZOMPLEX) { Tx [k] = Ax [p] ; Tz [k] = Az [p] ; } k++ ; ASSERT (k <= nz) ; } } } T->nnz = k ; /* ---------------------------------------------------------------------- */ /* return result */ /* ---------------------------------------------------------------------- */ ASSERT (CHOLMOD(dump_triplet) (T, "T", Common)) ; return (T) ; } /* ========================================================================== */ /* === cholmod_copy_triplet ================================================= */ /* ========================================================================== */ /* Create an exact copy of a triplet matrix, except that entries in unused * space are not copied (they might not be initialized, and copying them would * cause program checkers such as purify and valgrind to complain). * The output triplet matrix has the same xtype as the input triplet matrix. */ cholmod_triplet *CHOLMOD(copy_triplet) ( /* ---- input ---- */ cholmod_triplet *T, /* matrix to copy */ /* --------------- */ cholmod_common *Common ) { double *Tx, *Tz, *Cx, *Cz ; Int *Ci, *Cj, *Ti, *Tj ; cholmod_triplet *C ; Int xtype, k, nz ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (T, NULL) ; RETURN_IF_XTYPE_INVALID (T, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, NULL) ; nz = T->nnz ; Ti = T->i ; Tj = T->j ; Tx = T->x ; Tz = T->z ; xtype = T->xtype ; RETURN_IF_NULL (Ti, NULL) ; RETURN_IF_NULL (Tj, NULL) ; Common->status = CHOLMOD_OK ; DEBUG (CHOLMOD(dump_triplet) (T, "T input", Common)) ; /* ---------------------------------------------------------------------- */ /* allocate copy */ /* ---------------------------------------------------------------------- */ C = CHOLMOD(allocate_triplet) (T->nrow, T->ncol, T->nzmax, T->stype, xtype, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } /* ---------------------------------------------------------------------- */ /* copy the triplet matrix */ /* ---------------------------------------------------------------------- */ Ci = C->i ; Cj = C->j ; Cx = C->x ; Cz = C->z ; C->nnz = nz ; for (k = 0 ; k < nz ; k++) { Ci [k] = Ti [k] ; } for (k = 0 ; k < nz ; k++) { Cj [k] = Tj [k] ; } if (xtype == CHOLMOD_REAL) { for (k = 0 ; k < nz ; k++) { Cx [k] = Tx [k] ; } } else if (xtype == CHOLMOD_COMPLEX) { for (k = 0 ; k < nz ; k++) { Cx [2*k ] = Tx [2*k ] ; Cx [2*k+1] = Tx [2*k+1] ; } } else if (xtype == CHOLMOD_ZOMPLEX) { for (k = 0 ; k < nz ; k++) { Cx [k] = Tx [k] ; Cz [k] = Tz [k] ; } } /* ---------------------------------------------------------------------- */ /* return the result */ /* ---------------------------------------------------------------------- */ ASSERT (CHOLMOD(dump_triplet) (C, "C triplet copy", Common)) ; return (C) ; } Matrix/src/CHOLMOD/Core/t_cholmod_change_factor.c0000644000176200001440000003715213652535054021261 0ustar liggesusers/* ========================================================================== */ /* === Core/t_cholmod_change_factor ========================================= */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Core Module. Copyright (C) 2005-2006, * Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* Template routine for cholmod_change_factor. All xtypes supported. */ #include "cholmod_template.h" /* ========================================================================== */ /* === t_change_simplicial_numeric ========================================== */ /* ========================================================================== */ static void TEMPLATE (change_simplicial_numeric) ( cholmod_factor *L, Int to_ll, Int to_packed, Int *newLi, double *newLx, double *newLz, Int lnz, Int grow, double grow1, Int grow2, Int make_ll, Int make_monotonic, Int make_ldl, cholmod_common *Common ) { double xlen, dj [1], ljj [1], lj2 [1] ; double *Lx, *Lz ; Int *Lp, *Li, *Lnz ; Int n, j, len, pnew, pold, k, p, pend ; n = L->n ; Lp = L->p ; Li = L->i ; Lx = L->x ; Lz = L->z ; Lnz = L->nz ; if (make_ll) { L->minor = n ; } if (make_monotonic) { /* ------------------------------------------------------------------ */ /* reorder the columns to make them monotonic */ /* ------------------------------------------------------------------ */ pnew = 0 ; for (j = 0 ; j < n ; j++) { /* copy and pack column j */ len = Lnz [j] ; PRINT2 (("j: "ID" Lnz[j] "ID" len "ID" p "ID"\n", j, Lnz [j], len, pnew)) ; pold = Lp [j] ; ASSERT (Li [pold] == j) ; if (make_ll) { /* ---------------------------------------------------------- */ /* copy and convert LDL' to LL' */ /* ---------------------------------------------------------- */ /* dj = Lx [pold] ; */ ASSIGN_REAL (dj,0, Lx,pold) ; if (IS_LE_ZERO (dj [0])) { /* Conversion has failed; matrix is not positive definite. * Do not modify the column so that the LDL' factorization * can be restored if desired, by converting back to LDL'. * Continue the conversion, but flag the error. */ if (L->minor == (size_t) n) { ERROR (CHOLMOD_NOT_POSDEF, "L not positive definite") ; L->minor = j ; } for (k = 0 ; k < len ; k++) { newLi [pnew + k] = Li [pold + k] ; /* newLx [pnew + k] = Lx [pold + k] ; */ ASSIGN (newLx, newLz, pnew+k, Lx, Lz, pold+k) ; } } else { ljj [0] = sqrt (dj [0]) ; newLi [pnew] = j ; /* newLx [pnew] = ljj ; */ ASSIGN_REAL (newLx, pnew, ljj, 0) ; CLEAR_IMAG (newLx, newLz, pnew) ; for (k = 1 ; k < len ; k++) { newLi [pnew + k] = Li [pold + k] ; /* newLx [pnew + k] = Lx [pold + k] * ljj ; */ MULT_REAL (newLx, newLz, pnew+k, Lx, Lz, pold+k, ljj,0); } } } else if (make_ldl) { /* ---------------------------------------------------------- */ /* copy and convert LL' to LDL' */ /* ---------------------------------------------------------- */ /* ljj = Lx [pold] ; */ ASSIGN_REAL (ljj, 0, Lx, pold) ; if (ljj [0] <= 0) { /* matrix is not positive-definite; copy column as-is */ for (k = 0 ; k < len ; k++) { newLi [pnew + k] = Li [pold + k] ; /* newLx [pnew + k] = Lx [pold + k] ; */ ASSIGN (newLx, newLz, pnew+k, Lx, Lz, pold+k) ; } } else { newLi [pnew] = j ; /* newLx [pnew] = ljj*ljj ; */ lj2 [0] = ljj [0] * ljj [0] ; ASSIGN_REAL (newLx, pnew, lj2, 0) ; CLEAR_IMAG (newLx, newLz, pnew) ; for (k = 1 ; k < len ; k++) { newLi [pnew + k] = Li [pold + k] ; /* newLx [pnew + k] = Lx [pold + k] / ljj ; */ DIV_REAL (newLx, newLz, pnew+k, Lx, Lz, pold+k, ljj,0) ; } } } else { /* ---------------------------------------------------------- */ /* copy and leave LL' or LDL' as-is */ /* ---------------------------------------------------------- */ for (k = 0 ; k < len ; k++) { newLi [pnew + k] = Li [pold + k] ; /* newLx [pnew + k] = Lx [pold + k] ; */ ASSIGN (newLx, newLz, pnew+k, Lx, Lz, pold+k) ; } } Lp [j] = pnew ; /* compute len in double to avoid integer overflow */ if (grow) { xlen = (double) len ; xlen = grow1 * xlen + grow2 ; xlen = MIN (xlen, n-j) ; len = (Int) xlen ; } ASSERT (len >= Lnz [j] && len <= n-j) ; pnew += len ; ASSERT (pnew > 0) ; /* integer overflow case already covered */ } Lp [n] = pnew ; PRINT1 (("final pnew = "ID", lnz "ID" lnzmax %g\n", pnew, lnz, (double) L->nzmax)) ; ASSERT (pnew <= lnz) ; /* free the old L->i and L->x and replace with the new ones */ CHOLMOD(free) (L->nzmax, sizeof (Int), L->i, Common) ; #ifdef REAL CHOLMOD(free) (L->nzmax, sizeof (double), L->x, Common) ; #elif defined (COMPLEX) CHOLMOD(free) (L->nzmax, 2*sizeof (double), L->x, Common) ; #else CHOLMOD(free) (L->nzmax, sizeof (double), L->x, Common) ; CHOLMOD(free) (L->nzmax, sizeof (double), L->z, Common) ; #endif L->i = newLi ; L->x = newLx ; L->z = newLz ; L->nzmax = lnz ; /* reconstruct the link list */ natural_list (L) ; } else if (to_packed) { /* ------------------------------------------------------------------ */ /* already monotonic, just pack the columns of L */ /* ------------------------------------------------------------------ */ pnew = 0 ; if (make_ll) { /* -------------------------------------------------------------- */ /* pack and convert LDL' to LL' */ /* -------------------------------------------------------------- */ for (j = 0 ; j < n ; j++) { /* pack column j */ pold = Lp [j] ; len = Lnz [j] ; ASSERT (len > 0) ; ASSERT (Li [pold] == j) ; PRINT2 (("col "ID" pnew "ID" pold "ID"\n", j, pnew, pold)) ; /* dj = Lx [pold] ; */ ASSIGN_REAL (dj,0, Lx,pold) ; if (IS_LE_ZERO (dj [0])) { /* Conversion has failed; matrix is not positive definite. * Do not modify the column so that the LDL' factorization * can be restored if desired, by converting back to LDL'. * Continue the conversion, but flag the error. */ if (L->minor == (size_t) n) { ERROR (CHOLMOD_NOT_POSDEF, "L not positive definite") ; L->minor = j ; } for (k = 0 ; k < len ; k++) { Li [pnew + k] = Li [pold + k] ; /* Lx [pnew + k] = Lx [pold + k] ; */ ASSIGN (Lx, Lz, pnew+k, Lx, Lz, pold+k) ; } } else { ljj [0] = sqrt (dj [0]) ; Li [pnew] = j ; /* Lx [pnew] = ljj ; */ ASSIGN_REAL (Lx, pnew, ljj, 0) ; CLEAR_IMAG (Lx, Lz, pnew) ; for (k = 1 ; k < len ; k++) { Li [pnew + k] = Li [pold + k] ; /* Lx [pnew + k] = Lx [pold + k] * ljj ; */ MULT_REAL (Lx, Lz, pnew+k, Lx, Lz, pold+k, ljj,0) ; } } Lp [j] = pnew ; pnew += len ; } } else if (make_ldl) { /* -------------------------------------------------------------- */ /* pack and convert LL' to LDL' */ /* -------------------------------------------------------------- */ for (j = 0 ; j < n ; j++) { /* pack column j */ pold = Lp [j] ; len = Lnz [j] ; /* ljj = Lx [pold] ; */ ASSIGN_REAL (ljj, 0, Lx, pold) ; ASSERT (len > 0) ; PRINT2 (("col "ID" pnew "ID" pold "ID"\n", j, pnew, pold)) ; if (ljj [0] <= 0) { /* matrix is not positive-definite; pack column as-is */ for (k = 0 ; k < len ; k++) { Li [pnew + k] = Li [pold + k] ; /* Lx [pnew + k] = Lx [pold + k] ; */ ASSIGN (Lx, Lz, pnew+k, Lx, Lz, pold+k) ; } } else { Li [pnew] = Li [pold] ; /* Lx [pnew] = ljj*ljj ; */ lj2 [0] = ljj [0] * ljj [0] ; ASSIGN_REAL (Lx, pnew, lj2, 0) ; CLEAR_IMAG (Lx, Lz, pnew) ; for (k = 1 ; k < len ; k++) { Li [pnew + k] = Li [pold + k] ; /* Lx [pnew + k] = Lx [pold + k] / ljj ; */ DIV_REAL (Lx, Lz, pnew+k, Lx, Lz, pold+k, ljj,0) ; } } Lp [j] = pnew ; pnew += len ; } } else { /* ---------------------------------------------------------- */ /* pack and leave LL' or LDL' as-is */ /* ---------------------------------------------------------- */ for (j = 0 ; j < n ; j++) { /* pack column j */ pold = Lp [j] ; len = Lnz [j] ; ASSERT (len > 0) ; PRINT2 (("col "ID" pnew "ID" pold "ID"\n", j, pnew, pold)) ; if (pnew < pold) { PRINT2 ((" pack this column\n")) ; for (k = 0 ; k < len ; k++) { Li [pnew + k] = Li [pold + k] ; /* Lx [pnew + k] = Lx [pold + k] ; */ ASSIGN (Lx, Lz, pnew+k, Lx, Lz, pold+k) ; } Lp [j] = pnew ; } pnew += len ; } } Lp [n] = pnew ; PRINT2 (("Lp [n] = "ID"\n", pnew)) ; } else if (make_ll) { /* ------------------------------------------------------------------ */ /* convert LDL' to LL', but do so in-place */ /* ------------------------------------------------------------------ */ for (j = 0 ; j < n ; j++) { p = Lp [j] ; pend = p + Lnz [j] ; /* dj = Lx [p] ; */ ASSIGN_REAL (dj,0, Lx,p) ; if (IS_LE_ZERO (dj [0])) { /* Conversion has failed; matrix is not positive definite. * Do not modify the column so that the LDL' factorization * can be restored if desired, by converting back to LDL'. * Continue the conversion, but flag the error. */ if (L->minor == (size_t) n) { ERROR (CHOLMOD_NOT_POSDEF, "L not positive definite") ; L->minor = j ; } } else { ljj [0] = sqrt (dj [0]) ; /* Lx [p] = ljj ; */ ASSIGN_REAL (Lx,p, ljj,0) ; CLEAR_IMAG (Lx, Lz, p) ; for (p++ ; p < pend ; p++) { /* Lx [p] *= ljj ; */ MULT_REAL (Lx,Lz,p, Lx,Lz,p, ljj,0) ; } } } } else if (make_ldl) { /* ------------------------------------------------------------------ */ /* convert LL' to LDL', but do so in-place */ /* ------------------------------------------------------------------ */ for (j = 0 ; j < n ; j++) { p = Lp [j] ; pend = p + Lnz [j] ; /* ljj = Lx [p] ; */ ASSIGN_REAL (ljj, 0, Lx, p) ; if (ljj [0] > 0) { /* Lx [p] = ljj*ljj ; */ lj2 [0] = ljj [0] * ljj [0] ; ASSIGN_REAL (Lx, p, lj2, 0) ; CLEAR_IMAG (Lx, Lz, p) ; for (p++ ; p < pend ; p++) { /* Lx [p] /= ljj ; */ DIV_REAL (Lx,Lz,p, Lx,Lz,p, ljj,0) ; } } } } L->is_ll = to_ll ; DEBUG (CHOLMOD(dump_factor) (L, "done change simplicial numeric", Common)) ; } /* ========================================================================== */ /* === t_ll_super_to_simplicial_numeric ===================================== */ /* ========================================================================== */ /* A supernodal L can only be real or complex, not zomplex */ #ifndef ZOMPLEX static void TEMPLATE (ll_super_to_simplicial_numeric) ( cholmod_factor *L, Int to_packed, Int to_ll, cholmod_common *Common ) { double ljj [1], lj2 [1] ; double *Lx ; Int *Ls, *Lpi, *Lpx, *Super, *Lp, *Li, *Lnz ; Int n, lnz, s, nsuper, p, psi, psx, psend, nsrow, nscol, ii, jj, j, k1, k2, q ; L->is_ll = to_ll ; Lp = L->p ; Li = L->i ; Lx = L->x ; Lnz = L->nz ; lnz = L->nzmax ; n = L->n ; nsuper = L->nsuper ; Lpi = L->pi ; Lpx = L->px ; Ls = L->s ; Super = L->super ; p = 0 ; for (s = 0 ; s < nsuper ; s++) { k1 = Super [s] ; k2 = Super [s+1] ; psi = Lpi [s] ; psend = Lpi [s+1] ; psx = Lpx [s] ; nsrow = psend - psi ; nscol = k2 - k1 ; for (jj = 0 ; jj < nscol ; jj++) { /* column j of L starts here */ j = jj + k1 ; if (to_ll) { if (to_packed) { /* ------------------------------------------------------ */ /* convert to LL' packed */ /* ------------------------------------------------------ */ Lp [j] = p ; PRINT2 (("Col j "ID" p "ID"\n", j, p)) ; for (ii = jj ; ii < nsrow ; ii++) { /* get L(i,j) from supernode and store in column j */ ASSERT (p < (Int) (L->xsize) && p <= psx+ii+jj*nsrow) ; Li [p] = Ls [psi + ii] ; /* Lx [p] = Lx [psx + ii + jj*nsrow] ; */ q = psx + ii + jj*nsrow ; ASSIGN (Lx,-,p, Lx,-,q) ; PRINT2 ((" i "ID" ", Li [p])) ; XPRINT2 (Lx,-,q) ; PRINT2 (("\n")) ; p++ ; } Lnz [j] = p - Lp [j] ; } else { /* ------------------------------------------------------ */ /* convert to LL' unpacked */ /* ------------------------------------------------------ */ p = psx + jj + jj*nsrow ; Lp [j] = p ; Li [p] = j ; Lnz [j] = nsrow - jj ; p++ ; for (ii = jj + 1 ; ii < nsrow ; ii++) { /* get L(i,j) from supernode and store in column j */ Li [psx + ii + jj*nsrow] = Ls [psi + ii] ; } } } else { if (to_packed) { /* ------------------------------------------------------ */ /* convert to LDL' packed */ /* ------------------------------------------------------ */ Lp [j] = p ; PRINT2 (("Col j "ID" p "ID"\n", Lp [j], p)) ; /* ljj = Lx [psx + jj + jj*nsrow] ; */ ASSIGN_REAL (ljj, 0, Lx, psx + jj + jj*nsrow) ; if (ljj [0] <= 0) { /* the matrix is not positive definite; do not divide */ /* Lx [p] = ljj ; */ ASSIGN_REAL (Lx, p, ljj, 0) ; CLEAR_IMAG (Lx, Lz, p) ; ljj [0] = 1 ; } else { lj2 [0] = ljj [0] * ljj [0] ; /* Lx [p] = ljj*ljj ; */ ASSIGN_REAL (Lx, p, lj2, 0) ; CLEAR_IMAG (Lx, Lz, p) ; } Li [p] = j ; p++ ; for (ii = jj + 1 ; ii < nsrow ; ii++) { /* get L(i,j) from supernode and store in column j */ ASSERT (p < (Int) (L->xsize) && p <= psx+ii+jj*nsrow) ; Li [p] = Ls [psi + ii] ; /* Lx [p] = Lx [psx + ii + jj*nsrow] / ljj ; */ q = psx + ii + jj*nsrow ; DIV_REAL (Lx, Lz, p, Lx, Lz, q, ljj,0) ; PRINT2 ((" i "ID" %g\n", Li [p], Lx [p])) ; p++ ; } Lnz [j] = p - Lp [j] ; } else { /* ------------------------------------------------------ */ /* convert to LDL' unpacked */ /* ------------------------------------------------------ */ p = psx + jj + jj*nsrow ; Lp [j] = p ; /* ljj = Lx [p] ; */ ASSIGN_REAL (ljj,0, Lx,p) ; if (ljj [0] <= 0) { /* the matrix is not positive definite; do not divide */ /* Lx [p] = ljj ; */ ASSIGN_REAL (Lx, p, ljj, 0) ; CLEAR_IMAG (Lx, Lz, p) ; ljj [0] = 1 ; } else { lj2 [0] = ljj [0] * ljj [0] ; /* Lx [p] = ljj*ljj ; */ ASSIGN_REAL (Lx, p, lj2, 0) ; CLEAR_IMAG (Lx, Lz, p) ; } Li [p] = j ; Lnz [j] = nsrow - jj ; p++ ; for (ii = jj + 1 ; ii < nsrow ; ii++) { /* get L(i,j) from supernode and store in column j */ Li [psx + ii + jj*nsrow] = Ls [psi + ii] ; /* Lx [psx + ii + jj*nsrow] /= ljj ; */ q = psx + ii + jj*nsrow ; DIV_REAL (Lx, Lz, q, Lx, Lz, q, ljj,0) ; } } } } } if (to_packed) { Lp [n] = p ; PRINT1 (("Final Lp "ID" n "ID" lnz "ID"\n", p, n, lnz)) ; ASSERT (Lp [n] == lnz) ; ASSERT (lnz <= (Int) (L->xsize)) ; /* reduce size of L->x to match L->i. This cannot fail. */ L->x = CHOLMOD(realloc) (lnz, #ifdef COMPLEX 2 * #endif sizeof (double), L->x, &(L->xsize), Common) ; ASSERT (lnz == (Int) (L->xsize)) ; Common->status = CHOLMOD_OK ; } else { Lp [n] = Lpx [nsuper] ; ASSERT (MAX (1,Lp [n]) == (Int) (L->xsize)) ; ASSERT (MAX (1,Lp [n]) == (Int) (L->nzmax)) ; } } #endif #undef PATTERN #undef REAL #undef COMPLEX #undef ZOMPLEX Matrix/src/CHOLMOD/Core/cholmod_error.c0000644000176200001440000000647713652535054017312 0ustar liggesusers/* ========================================================================== */ /* === Core/cholmod_error =================================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Core Module. Copyright (C) 2005-2006, * Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* CHOLMOD error-handling routine. */ #include "cholmod_internal.h" #include "cholmod_core.h" /* ========================================================================== */ /* ==== cholmod_error ======================================================= */ /* ========================================================================== */ /* An error has occurred. Set the status, optionally print an error message, * and call the user error-handling routine (if it exists). If * Common->try_catch is TRUE, then CHOLMOD is inside a try/catch block. * The status is set, but no message is printed and the user error handler * is not called. This is not (yet) an error, since CHOLMOD may recover. * * In the current version, this try/catch mechanism is used internally only in * cholmod_analyze, which tries multiple ordering methods and picks the best * one. If one or more ordering method fails, it keeps going. Only one * ordering needs to succeed for cholmod_analyze to succeed. */ int CHOLMOD(error) ( /* ---- input ---- */ int status, /* error status */ const char *file, /* name of source code file where error occured */ int line, /* line number in source code file where error occured*/ const char *message, /* error message */ /* --------------- */ cholmod_common *Common ) { RETURN_IF_NULL_COMMON (FALSE) ; Common->status = status ; if (!(Common->try_catch)) { #ifndef NPRINT /* print a warning or error message */ if (SuiteSparse_config.printf_func != NULL) { if (status > 0 && Common->print > 1) { SuiteSparse_config.printf_func ("CHOLMOD warning:") ; if (message != NULL) { SuiteSparse_config.printf_func (" %s.", message) ; } if (file != NULL) { SuiteSparse_config.printf_func (" file: %s", file) ; SuiteSparse_config.printf_func (" line: %d", line) ; } SuiteSparse_config.printf_func ("\n") ; fflush (stdout) ; fflush (stderr) ; } else if (Common->print > 0) { SuiteSparse_config.printf_func ("CHOLMOD error:") ; if (message != NULL) { SuiteSparse_config.printf_func (" %s.", message) ; } if (file != NULL) { SuiteSparse_config.printf_func (" file: %s", file) ; SuiteSparse_config.printf_func (" line: %d", line) ; } SuiteSparse_config.printf_func ("\n") ; fflush (stdout) ; fflush (stderr) ; } } #endif /* call the user error handler, if it exists */ if (Common->error_handler != NULL) { Common->error_handler (status, file, line, message) ; } } return (TRUE) ; } Matrix/src/CHOLMOD/Core/cholmod_change_factor.c0000644000176200001440000011301413652535054020726 0ustar liggesusers/* ========================================================================== */ /* === Core/cholmod_change_factor =========================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Core Module. Copyright (C) 2005-2006, * Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* Change the numeric/symbolic, LL/LDL, simplicial/super, packed/unpacked, * monotonic/non-monotonic status of a cholmod_factor object. * * There are four basic classes of factor types: * * (1) simplicial symbolic: Consists of two size-n arrays: the fill-reducing * permutation (L->Perm) and the nonzero count for each column of L * (L->ColCount). All other factor types also include this information. * L->ColCount may be exact (obtained from the analysis routines), or * it may be a guess. During factorization, and certainly after update/ * downdate, the columns of L can have a different number of nonzeros. * L->ColCount is used to allocate space. L->ColCount is exact for the * supernodal factorizations. The nonzero pattern of L is not kept. * * (2) simplicial numeric: These represent L in a compressed column form. The * variants of this type are: * * LDL': L is unit diagonal. Row indices in column j are located in * L->i [L->p [j] ... L->p [j] + L->nz [j]], and corresponding numeric * values are in the same locations in L->x. The total number of * entries is the sum of L->nz [j]. The unit diagonal is not stored; * D is stored on the diagonal of L instead. L->p may or may not be * monotonic. The order of storage of the columns in L->i and L->x is * given by a doubly-linked list (L->prev and L->next). L->p is of * size n+1, but only the first n entries are used (it is used if L * is converted to a sparse matrix via cholmod_factor_to_sparse). * * For the complex case, L->x is stored interleaved with real/imag * parts, and is of size 2*lnz*sizeof(double). For the zomplex case, * L->x is of size lnz*sizeof(double) and holds the real part; L->z * is the same size and holds the imaginary part. * * LL': This is identical to the LDL' form, except that the non-unit * diagonal of L is stored as the first entry in each column of L. * * (3) supernodal symbolic: A representation of the nonzero pattern of the * supernodes for a supernodal factorization. There are L->nsuper * supernodes. Columns L->super [k] to L->super [k+1]-1 are in the kth * supernode. The row indices for the kth supernode are in * L->s [L->pi [k] ... L->pi [k+1]-1]. The numerical values are not * allocated (L->x), but when they are they will be located in * L->x [L->px [k] ... L->px [k+1]-1], and the L->px array is defined * in this factor type. * * For the complex case, L->x is stored interleaved with real/imag parts, * and is of size 2*L->xsize*sizeof(double). The zomplex supernodal case * is not supported, since it is not compatible with LAPACK and the BLAS. * * (4) supernodal numeric: Always an LL' factorization. L is non-unit * diagonal. L->x contains the numerical values of the supernodes, as * described above for the supernodal symbolic factor. * For the complex case, L->x is stored interleaved, and is of size * 2*L->xsize*sizeof(double). The zomplex supernodal case is not * supported, since it is not compatible with LAPACK and the BLAS. * * FUTURE WORK: support a supernodal LDL' factor. * * * In all cases, the row indices in each column (L->i for simplicial L and * L->s for supernodal L) are kept sorted from low indices to high indices. * This means the diagonal of L (or D for LDL' factors) is always kept as the * first entry in each column. * * The cholmod_change_factor routine can do almost all possible conversions. * It cannot do the following conversions: * * (1) Simplicial numeric types cannot be converted to a supernodal * symbolic type. This would simultaneously deallocate the * simplicial pattern and numeric values and reallocate uninitialized * space for the supernodal pattern. This isn't useful for the user, * and not needed by CHOLMOD's own routines either. * * (2) Only a symbolic factor (simplicial to supernodal) can be converted * to a supernodal numeric factor. * * Some conversions are meant only to be used internally by other CHOLMOD * routines, and should not be performed by the end user. They allocate space * whose contents are undefined: * * (1) converting from simplicial symbolic to supernodal symbolic. * (2) converting any factor to supernodal numeric. * * workspace: no conversion routine uses workspace in Common. No temporary * workspace is allocated. * * Supports all xtypes, except that there is no supernodal zomplex L. * * The to_xtype parameter is used only when converting from symbolic to numeric * or numeric to symbolic. It cannot be used to convert a numeric xtype (real, * complex, or zomplex) to a different numeric xtype. For that conversion, * use cholmod_factor_xtype instead. */ #include "cholmod_internal.h" #include "cholmod_core.h" static void natural_list (cholmod_factor *L) ; /* ========================================================================== */ /* === TEMPLATE ============================================================= */ /* ========================================================================== */ #define REAL #include "t_cholmod_change_factor.c" #define COMPLEX #include "t_cholmod_change_factor.c" #define ZOMPLEX #include "t_cholmod_change_factor.c" /* ========================================================================== */ /* === L_is_packed ========================================================== */ /* ========================================================================== */ /* Return TRUE if the columns of L are packed, FALSE otherwise. For debugging * only. */ #ifndef NDEBUG static int L_is_packed (cholmod_factor *L, cholmod_common *Common) { Int j ; Int *Lnz = L->nz ; Int *Lp = L->p ; Int n = L->n ; if (L->xtype == CHOLMOD_PATTERN || L->is_super) { return (TRUE) ; } if (Lnz == NULL || Lp == NULL) { return (TRUE) ; } for (j = 0 ; j < n ; j++) { PRINT3 (("j: "ID" Lnz "ID" Lp[j+1] "ID" Lp[j] "ID"\n", j, Lnz [j], Lp [j+1], Lp [j])) ; if (Lnz [j] != (Lp [j+1] - Lp [j])) { PRINT2 (("L is not packed\n")) ; return (FALSE) ; } } return (TRUE) ; } #endif /* ========================================================================== */ /* === natural_list ========================================================= */ /* ========================================================================== */ /* Create a naturally-ordered doubly-linked list of columns. */ static void natural_list (cholmod_factor *L) { Int head, tail, n, j ; Int *Lnext, *Lprev ; Lnext = L->next ; Lprev = L->prev ; ASSERT (Lprev != NULL && Lnext != NULL) ; n = L->n ; head = n+1 ; tail = n ; Lnext [head] = 0 ; Lprev [head] = EMPTY ; Lnext [tail] = EMPTY ; Lprev [tail] = n-1 ; for (j = 0 ; j < n ; j++) { Lnext [j] = j+1 ; Lprev [j] = j-1 ; } Lprev [0] = head ; L->is_monotonic = TRUE ; } /* ========================================================================== */ /* === allocate_simplicial_numeric ========================================== */ /* ========================================================================== */ /* Allocate O(n) arrays for simplicial numeric factorization. Initializes * the link lists only. Does not allocate the L->i, L->x, or L->z arrays. */ static int allocate_simplicial_numeric ( cholmod_factor *L, cholmod_common *Common ) { Int n ; Int *Lp, *Lnz, *Lprev, *Lnext ; size_t n1, n2 ; PRINT1 (("Allocate simplicial\n")) ; ASSERT (L->xtype == CHOLMOD_PATTERN || L->is_super) ; ASSERT (L->p == NULL) ; ASSERT (L->nz == NULL) ; ASSERT (L->prev == NULL) ; ASSERT (L->next == NULL) ; n = L->n ; /* this cannot cause size_t overflow */ n1 = ((size_t) n) + 1 ; n2 = ((size_t) n) + 2 ; Lp = CHOLMOD(malloc) (n1, sizeof (Int), Common) ; Lnz = CHOLMOD(malloc) (n, sizeof (Int), Common) ; Lprev = CHOLMOD(malloc) (n2, sizeof (Int), Common) ; Lnext = CHOLMOD(malloc) (n2, sizeof (Int), Common) ; if (Common->status < CHOLMOD_OK) { CHOLMOD(free) (n1, sizeof (Int), Lp, Common) ; CHOLMOD(free) (n, sizeof (Int), Lnz, Common) ; CHOLMOD(free) (n2, sizeof (Int), Lprev, Common) ; CHOLMOD(free) (n2, sizeof (Int), Lnext, Common) ; PRINT1 (("Allocate simplicial failed\n")) ; return (FALSE) ; /* out of memory */ } /* ============================================== commit the changes to L */ L->p = Lp ; L->nz = Lnz ; L->prev = Lprev ; L->next = Lnext ; /* initialize a doubly linked list for columns in natural order */ natural_list (L) ; PRINT1 (("Allocate simplicial done\n")) ; return (TRUE) ; } /* ========================================================================== */ /* === simplicial_symbolic_to_super_symbolic ================================ */ /* ========================================================================== */ /* Convert a simplicial symbolic factor supernodal symbolic factor. Does not * initialize the new space. */ static int simplicial_symbolic_to_super_symbolic ( cholmod_factor *L, cholmod_common *Common ) { Int nsuper, xsize, ssize ; Int *Lsuper, *Lpi, *Lpx, *Ls ; size_t nsuper1 ; ASSERT (L->xtype == CHOLMOD_PATTERN && !(L->is_super)) ; xsize = L->xsize ; ssize = L->ssize ; nsuper = L->nsuper ; nsuper1 = ((size_t) nsuper) + 1 ; PRINT1 (("simple sym to super sym: ssize "ID" xsize "ID" nsuper "ID"" " status %d\n", ssize, xsize, nsuper, Common->status)) ; /* O(nsuper) arrays, where nsuper <= n */ Lsuper = CHOLMOD(malloc) (nsuper1, sizeof (Int), Common) ; Lpi = CHOLMOD(malloc) (nsuper1, sizeof (Int), Common) ; Lpx = CHOLMOD(malloc) (nsuper1, sizeof (Int), Common) ; /* O(ssize) array, where ssize <= nnz(L), and usually much smaller */ Ls = CHOLMOD(malloc) (ssize, sizeof (Int), Common) ; if (Common->status < CHOLMOD_OK) { CHOLMOD(free) (nsuper1, sizeof (Int), Lsuper, Common) ; CHOLMOD(free) (nsuper1, sizeof (Int), Lpi, Common) ; CHOLMOD(free) (nsuper1, sizeof (Int), Lpx, Common) ; CHOLMOD(free) (ssize, sizeof (Int), Ls, Common) ; return (FALSE) ; /* out of memory */ } /* ============================================== commit the changes to L */ ASSERT (Lsuper != NULL && Lpi != NULL && Lpx != NULL && Ls != NULL) ; L->maxcsize = 0 ; L->maxesize = 0 ; L->super = Lsuper ; L->pi = Lpi ; L->px = Lpx ; L->s = Ls ; Ls [0] = EMPTY ; /* supernodal pattern undefined */ L->is_super = TRUE ; L->is_ll = TRUE ; /* supernodal LDL' not supported */ L->xtype = CHOLMOD_PATTERN ; L->dtype = DTYPE ; L->minor = L->n ; return (TRUE) ; } /* ========================================================================== */ /* === any_to_simplicial_symbolic =========================================== */ /* ========================================================================== */ /* Convert any factor L to a simplicial symbolic factor, leaving only L->Perm * and L->ColCount. Cannot fail. Any of the components of L (except Perm and * ColCount) may already be free'd. */ static void any_to_simplicial_symbolic ( cholmod_factor *L, int to_ll, cholmod_common *Common ) { Int n, lnz, xs, ss, s, e ; size_t n1, n2 ; /* ============================================== commit the changes to L */ n = L->n ; lnz = L->nzmax ; s = L->nsuper + 1 ; xs = (L->is_super) ? ((Int) (L->xsize)) : (lnz) ; e = (L->xtype == CHOLMOD_COMPLEX ? 2 : 1) ; ss = L->ssize ; /* this cannot cause size_t overflow */ n1 = ((size_t) n) + 1 ; n2 = ((size_t) n) + 2 ; /* free all but the symbolic analysis (Perm and ColCount) */ L->p = CHOLMOD(free) (n1, sizeof (Int), L->p, Common) ; L->i = CHOLMOD(free) (lnz, sizeof (Int), L->i, Common) ; L->x = CHOLMOD(free) (xs, e*sizeof (double), L->x, Common) ; L->z = CHOLMOD(free) (lnz, sizeof (double), L->z, Common) ; L->nz = CHOLMOD(free) (n, sizeof (Int), L->nz, Common) ; L->next = CHOLMOD(free) (n2, sizeof (Int), L->next, Common) ; L->prev = CHOLMOD(free) (n2, sizeof (Int), L->prev, Common) ; L->super = CHOLMOD(free) (s, sizeof (Int), L->super, Common) ; L->pi = CHOLMOD(free) (s, sizeof (Int), L->pi, Common) ; L->px = CHOLMOD(free) (s, sizeof (Int), L->px, Common) ; L->s = CHOLMOD(free) (ss, sizeof (Int), L->s, Common) ; L->nzmax = 0 ; L->is_super = FALSE ; L->xtype = CHOLMOD_PATTERN ; L->dtype = DTYPE ; L->minor = n ; L->is_ll = to_ll ; } /* ========================================================================== */ /* === ll_super_to_super_symbolic =========================================== */ /* ========================================================================== */ /* Convert a numerical supernodal L to symbolic supernodal. Cannot fail. */ static void ll_super_to_super_symbolic ( cholmod_factor *L, cholmod_common *Common ) { /* ============================================== commit the changes to L */ /* free all but the supernodal numerical factor */ ASSERT (L->xtype != CHOLMOD_PATTERN && L->is_super && L->is_ll) ; DEBUG (CHOLMOD(dump_factor) (L, "start to super symbolic", Common)) ; L->x = CHOLMOD(free) (L->xsize, (L->xtype == CHOLMOD_COMPLEX ? 2 : 1) * sizeof (double), L->x, Common) ; L->xtype = CHOLMOD_PATTERN ; L->dtype = DTYPE ; L->minor = L->n ; L->is_ll = TRUE ; /* supernodal LDL' not supported */ DEBUG (CHOLMOD(dump_factor) (L, "done to super symbolic", Common)) ; } /* ========================================================================== */ /* === simplicial_symbolic_to_simplicial_numeric ============================ */ /* ========================================================================== */ /* Convert a simplicial symbolic L to a simplicial numeric L; allocate space * for L using L->ColCount from symbolic analysis, and set L to identity. * * If packed < 0, then this routine is creating a copy of another factor * (via cholmod_copy_factor). In this case, the space is not initialized. */ static void simplicial_symbolic_to_simplicial_numeric ( cholmod_factor *L, int to_ll, int packed, int to_xtype, cholmod_common *Common ) { double grow0, grow1, xlen, xlnz ; double *Lx, *Lz ; Int *Li, *Lp, *Lnz, *ColCount ; Int n, grow, grow2, p, j, lnz, len, ok, e ; ASSERT (L->xtype == CHOLMOD_PATTERN && !(L->is_super)) ; if (!allocate_simplicial_numeric (L, Common)) { PRINT1 (("out of memory, allocate simplicial numeric\n")) ; return ; /* out of memory */ } ASSERT (L->ColCount != NULL && L->nz != NULL && L->p != NULL) ; ASSERT (L->x == NULL && L->z == NULL && L->i == NULL) ; ColCount = L->ColCount ; Lnz = L->nz ; Lp = L->p ; ok = TRUE ; n = L->n ; if (packed < 0) { /* ------------------------------------------------------------------ */ /* used by cholmod_copy_factor to allocate a copy of a factor object */ /* ------------------------------------------------------------------ */ lnz = L->nzmax ; L->nzmax = 0 ; } else if (packed) { /* ------------------------------------------------------------------ */ /* LDL' or LL' packed */ /* ------------------------------------------------------------------ */ PRINT1 (("convert to packed LL' or LDL'\n")) ; lnz = 0 ; for (j = 0 ; ok && j < n ; j++) { /* ensure len is in the range 1 to n-j */ len = ColCount [j] ; len = MAX (1, len) ; len = MIN (len, n-j) ; lnz += len ; ok = (lnz >= 0) ; } for (j = 0 ; j <= n ; j++) { Lp [j] = j ; } for (j = 0 ; j < n ; j++) { Lnz [j] = 1 ; } } else { /* ------------------------------------------------------------------ */ /* LDL' unpacked */ /* ------------------------------------------------------------------ */ PRINT1 (("convert to unpacked\n")) ; /* compute new lnzmax */ /* if any parameter is NaN, grow is false */ grow0 = Common->grow0 ; grow1 = Common->grow1 ; grow2 = Common->grow2 ; grow0 = IS_NAN (grow0) ? 1 : grow0 ; grow1 = IS_NAN (grow1) ? 1 : grow1 ; /* fl.pt. compare, but no NaN's: */ grow = (grow0 >= 1.0) && (grow1 >= 1.0) && (grow2 > 0) ; PRINT1 (("init, grow1 %g grow2 "ID"\n", grow1, grow2)) ; /* initialize Lp and Lnz for each column */ lnz = 0 ; for (j = 0 ; ok && j < n ; j++) { Lp [j] = lnz ; Lnz [j] = 1 ; /* ensure len is in the range 1 to n-j */ len = ColCount [j] ; len = MAX (1, len) ; len = MIN (len, n-j) ; /* compute len in double to avoid integer overflow */ PRINT1 (("ColCount ["ID"] = "ID"\n", j, len)) ; if (grow) { xlen = (double) len ; xlen = grow1 * xlen + grow2 ; xlen = MIN (xlen, n-j) ; len = (Int) xlen ; } ASSERT (len >= 1 && len <= n-j) ; lnz += len ; ok = (lnz >= 0) ; } if (ok) { Lp [n] = lnz ; if (grow) { /* add extra space */ xlnz = (double) lnz ; xlnz *= grow0 ; xlnz = MIN (xlnz, Size_max) ; xlnz = MIN (xlnz, ((double) n * (double) n + (double) n) / 2) ; lnz = (Int) xlnz ; } } } lnz = MAX (1, lnz) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; } /* allocate L->i, L->x, and L->z */ PRINT1 (("resizing from zero size to lnz "ID"\n", lnz)) ; ASSERT (L->nzmax == 0) ; e = (to_xtype == CHOLMOD_COMPLEX ? 2 : 1) ; if (!ok || !CHOLMOD(realloc_multiple) (lnz, 1, to_xtype, &(L->i), NULL, &(L->x), &(L->z), &(L->nzmax), Common)) { L->p = CHOLMOD(free) (n+1, sizeof (Int), L->p, Common) ; L->nz = CHOLMOD(free) (n, sizeof (Int), L->nz, Common) ; L->prev = CHOLMOD(free) (n+2, sizeof (Int), L->prev, Common) ; L->next = CHOLMOD(free) (n+2, sizeof (Int), L->next, Common) ; L->i = CHOLMOD(free) (lnz, sizeof (Int), L->i, Common) ; L->x = CHOLMOD(free) (lnz, e*sizeof (double), L->x, Common) ; L->z = CHOLMOD(free) (lnz, sizeof (double), L->z, Common) ; PRINT1 (("cannot realloc simplicial numeric\n")) ; return ; /* out of memory */ } /* ============================================== commit the changes to L */ /* initialize L to be the identity matrix */ L->xtype = to_xtype ; L->dtype = DTYPE ; L->minor = n ; Li = L->i ; Lx = L->x ; Lz = L->z ; #if 0 if (lnz == 1) { /* the user won't expect to access this entry, but some CHOLMOD * routines may. Set it to zero so that valgrind doesn't complain. */ switch (to_xtype) { case CHOLMOD_REAL: Lx [0] = 0 ; break ; case CHOLMOD_COMPLEX: Lx [0] = 0 ; Lx [1] = 0 ; break ; case CHOLMOD_ZOMPLEX: Lx [0] = 0 ; Lz [0] = 0 ; break ; } } #endif if (packed >= 0) { /* create the unit diagonal for either the LL' or LDL' case */ switch (L->xtype) { case CHOLMOD_REAL: for (j = 0 ; j < n ; j++) { ASSERT (Lp [j] < Lp [j+1]) ; p = Lp [j] ; Li [p] = j ; Lx [p] = 1 ; } break ; case CHOLMOD_COMPLEX: for (j = 0 ; j < n ; j++) { ASSERT (Lp [j] < Lp [j+1]) ; p = Lp [j] ; Li [p] = j ; Lx [2*p ] = 1 ; Lx [2*p+1] = 0 ; } break ; case CHOLMOD_ZOMPLEX: for (j = 0 ; j < n ; j++) { ASSERT (Lp [j] < Lp [j+1]) ; p = Lp [j] ; Li [p] = j ; Lx [p] = 1 ; Lz [p] = 0 ; } break ; } } L->is_ll = to_ll ; PRINT1 (("done convert simplicial symbolic to numeric\n")) ; } /* ========================================================================== */ /* === change_simplicial_numeric ============================================ */ /* ========================================================================== */ /* Change LL' to LDL', LDL' to LL', or leave as-is. * * If to_packed is TRUE, then the columns of L are packed and made monotonic * (to_monotonic is ignored; it is implicitly TRUE). * * If to_monotonic is TRUE but to_packed is FALSE, the columns of L are made * monotonic but not packed. * * If both to_packed and to_monotonic are FALSE, then the columns of L are * left as-is, and the conversion is done in place. * * If L is already monotonic, or if it is to be left non-monotonic, then this * conversion always succeeds. * * When converting an LDL' to LL' factorization, any column with a negative * or zero diagonal entry is not modified so that conversion back to LDL' will * succeed. This can result in a matrix L with a negative entry on the diagonal * If the kth entry on the diagonal of D is negative, it and the kth column of * L are left unchanged. A subsequent conversion back to an LDL' form will also * leave the column unchanged, so the correct LDL' factorization will be * restored. L->minor is set to the smallest k for which D (k,k) is negative. */ static void change_simplicial_numeric ( cholmod_factor *L, int to_ll, int to_packed, int to_monotonic, cholmod_common *Common ) { double grow0, grow1, xlen, xlnz ; void *newLi, *newLx, *newLz ; double *Lx, *Lz ; Int *Lp, *Li, *Lnz ; Int make_monotonic, grow2, n, j, lnz, len, grow, ok, make_ll, make_ldl ; size_t nzmax0 ; PRINT1 (("\n===Change simplicial numeric: %d %d %d\n", to_ll, to_packed, to_monotonic)) ; DEBUG (CHOLMOD(dump_factor) (L, "change simplicial numeric", Common)) ; ASSERT (L->xtype != CHOLMOD_PATTERN && !(L->is_super)) ; make_monotonic = ((to_packed || to_monotonic) && !(L->is_monotonic)) ; make_ll = (to_ll && !(L->is_ll)) ; make_ldl = (!to_ll && L->is_ll) ; n = L->n ; Lp = L->p ; Li = L->i ; Lx = L->x ; Lz = L->z ; Lnz = L->nz ; grow = FALSE ; grow0 = Common->grow0 ; grow1 = Common->grow1 ; grow2 = Common->grow2 ; grow0 = IS_NAN (grow0) ? 1 : grow0 ; grow1 = IS_NAN (grow1) ? 1 : grow1 ; ok = TRUE ; newLi = NULL ; newLx = NULL ; newLz = NULL ; lnz = 0 ; if (make_monotonic) { /* ------------------------------------------------------------------ */ /* Columns out of order, but will be reordered and optionally packed. */ /* ------------------------------------------------------------------ */ PRINT1 (("L is non-monotonic\n")) ; /* compute new L->nzmax */ if (!to_packed) { /* if any parameter is NaN, grow is false */ /* fl.pt. comparisons below are false if any parameter is NaN */ grow = (grow0 >= 1.0) && (grow1 >= 1.0) && (grow2 > 0) ; } for (j = 0 ; ok && j < n ; j++) { len = Lnz [j] ; ASSERT (len >= 1 && len <= n-j) ; /* compute len in double to avoid integer overflow */ if (grow) { xlen = (double) len ; xlen = grow1 * xlen + grow2 ; xlen = MIN (xlen, n-j) ; len = (Int) xlen ; } ASSERT (len >= Lnz [j] && len <= n-j) ; PRINT2 (("j: "ID" Lnz[j] "ID" len "ID" p "ID"\n", j, Lnz [j], len, lnz)) ; lnz += len ; ok = (lnz >= 0) ; } if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return ; } if (grow) { xlnz = (double) lnz ; xlnz *= grow0 ; xlnz = MIN (xlnz, Size_max) ; xlnz = MIN (xlnz, ((double) n * (double) n + (double) n) / 2) ; lnz = (Int) xlnz ; } lnz = MAX (1, lnz) ; PRINT1 (("final lnz "ID"\n", lnz)) ; nzmax0 = 0 ; CHOLMOD(realloc_multiple) (lnz, 1, L->xtype, &newLi, NULL, &newLx, &newLz, &nzmax0, Common) ; if (Common->status < CHOLMOD_OK) { return ; /* out of memory */ } } /* ============================================== commit the changes to L */ /* ---------------------------------------------------------------------- */ /* convert the simplicial L, using template routine */ /* ---------------------------------------------------------------------- */ switch (L->xtype) { case CHOLMOD_REAL: r_change_simplicial_numeric (L, to_ll, to_packed, newLi, newLx, newLz, lnz, grow, grow1, grow2, make_ll, make_monotonic, make_ldl, Common) ; break ; case CHOLMOD_COMPLEX: c_change_simplicial_numeric (L, to_ll, to_packed, newLi, newLx, newLz, lnz, grow, grow1, grow2, make_ll, make_monotonic, make_ldl, Common) ; break ; case CHOLMOD_ZOMPLEX: z_change_simplicial_numeric (L, to_ll, to_packed, newLi, newLx, newLz, lnz, grow, grow1, grow2, make_ll, make_monotonic, make_ldl, Common) ; break ; } DEBUG (CHOLMOD(dump_factor) (L, "L simplicial changed", Common)) ; } /* ========================================================================== */ /* === ll_super_to_simplicial_numeric ======================================= */ /* ========================================================================== */ /* Convert a supernodal numeric factorization to any simplicial numeric one. * Leaves L->xtype unchanged (real or complex, not zomplex since there is * no supernodal zomplex L). */ static void ll_super_to_simplicial_numeric ( cholmod_factor *L, int to_packed, int to_ll, cholmod_common *Common ) { Int *Ls, *Lpi, *Lpx, *Super, *Li ; Int n, lnz, s, nsuper, psi, psend, nsrow, nscol, k1, k2, erows ; DEBUG (CHOLMOD(dump_factor) (L, "start LL super to simplicial", Common)) ; PRINT1 (("super -> simplicial (%d %d)\n", to_packed, to_ll)) ; ASSERT (L->xtype != CHOLMOD_PATTERN && L->is_ll && L->is_super) ; ASSERT (L->x != NULL && L->i == NULL) ; n = L->n ; nsuper = L->nsuper ; Lpi = L->pi ; Lpx = L->px ; Ls = L->s ; Super = L->super ; /* Int overflow cannot occur since supernodal L already exists */ if (to_packed) { /* count the number of nonzeros in L. Each supernode is of the form * * l . . . For this example, nscol = 4 (# columns). nsrow = 9. * l l . . The "." entries are allocated in the supernodal * l l l . factor, but not used. They are not copied to the * l l l l simplicial factor. Some "l" and "e" entries may be * e e e e numerically zero and even symbolically zero if a * e e e e tight simplicial factorization or resymbol were * e e e e done, because of numerical cancellation and relaxed * e e e e supernode amalgamation, respectively. * e e e e */ lnz = 0 ; for (s = 0 ; s < nsuper ; s++) { k1 = Super [s] ; k2 = Super [s+1] ; psi = Lpi [s] ; psend = Lpi [s+1] ; nsrow = psend - psi ; nscol = k2 - k1 ; ASSERT (nsrow >= nscol) ; erows = nsrow - nscol ; /* lower triangular part, including the diagonal, * counting the "l" terms in the figure above. */ lnz += nscol * (nscol+1) / 2 ; /* rectangular part, below the diagonal block (the "e" terms) */ lnz += nscol * erows ; } ASSERT (lnz <= (Int) (L->xsize)) ; } else { /* Li will be the same size as Lx */ lnz = L->xsize ; } ASSERT (lnz >= 0) ; PRINT1 (("simplicial lnz = "ID" to_packed: %d to_ll: %d L->xsize %g\n", lnz, to_ll, to_packed, (double) L->xsize)) ; Li = CHOLMOD(malloc) (lnz, sizeof (Int), Common) ; if (Common->status < CHOLMOD_OK) { return ; /* out of memory */ } if (!allocate_simplicial_numeric (L, Common)) { CHOLMOD(free) (lnz, sizeof (Int), Li, Common) ; return ; /* out of memory */ } /* ============================================== commit the changes to L */ L->i = Li ; L->nzmax = lnz ; /* ---------------------------------------------------------------------- */ /* convert the supernodal L, using template routine */ /* ---------------------------------------------------------------------- */ switch (L->xtype) { case CHOLMOD_REAL: r_ll_super_to_simplicial_numeric (L, to_packed, to_ll, Common) ; break ; case CHOLMOD_COMPLEX: c_ll_super_to_simplicial_numeric (L, to_packed, to_ll, Common) ; break ; } /* ---------------------------------------------------------------------- */ /* free unused parts of L */ /* ---------------------------------------------------------------------- */ L->super = CHOLMOD(free) (nsuper+1, sizeof (Int), L->super, Common) ; L->pi = CHOLMOD(free) (nsuper+1, sizeof (Int), L->pi, Common) ; L->px = CHOLMOD(free) (nsuper+1, sizeof (Int), L->px, Common) ; L->s = CHOLMOD(free) (L->ssize, sizeof (Int), L->s, Common) ; L->ssize = 0 ; L->xsize = 0 ; L->nsuper = 0 ; L->maxesize = 0 ; L->maxcsize = 0 ; L->is_super = FALSE ; DEBUG (CHOLMOD(dump_factor) (L, "done LL super to simplicial", Common)) ; } /* ========================================================================== */ /* === super_symbolic_to_ll_super =========================================== */ /* ========================================================================== */ /* Convert a supernodal symbolic factorization to a supernodal numeric * factorization by allocating L->x. Contents of L->x are undefined. */ static int super_symbolic_to_ll_super ( int to_xtype, cholmod_factor *L, cholmod_common *Common ) { double *Lx ; Int wentry = (to_xtype == CHOLMOD_REAL) ? 1 : 2 ; PRINT1 (("convert super sym to num\n")) ; ASSERT (L->xtype == CHOLMOD_PATTERN && L->is_super) ; Lx = CHOLMOD(malloc) (L->xsize, wentry * sizeof (double), Common) ; PRINT1 (("xsize %g\n", (double) L->xsize)) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; /* out of memory */ } /* ============================================== commit the changes to L */ if (L->xsize == 1) { /* the caller won't expect to access this entry, but some CHOLMOD * routines may. Set it to zero so that valgrind doesn't complain. */ switch (to_xtype) { case CHOLMOD_REAL: Lx [0] = 0 ; break ; case CHOLMOD_COMPLEX: Lx [0] = 0 ; Lx [1] = 0 ; break ; } } L->x = Lx ; L->xtype = to_xtype ; L->dtype = DTYPE ; L->minor = L->n ; return (TRUE) ; } /* ========================================================================== */ /* === cholmod_change_factor ================================================ */ /* ========================================================================== */ /* Convert a factor L. Some conversions simply allocate uninitialized space * that meant to be filled later. * * If the conversion fails, the factor is left in its original form, with one * exception. Converting a supernodal symbolic factor to a simplicial numeric * one (with L=D=I) may leave the factor in simplicial symbolic form. * * Memory allocated for each conversion is listed below. */ int CHOLMOD(change_factor) ( /* ---- input ---- */ int to_xtype, /* convert to CHOLMOD_PATTERN, _REAL, _COMPLEX, or * _ZOMPLEX */ int to_ll, /* TRUE: convert to LL', FALSE: LDL' */ int to_super, /* TRUE: convert to supernodal, FALSE: simplicial */ int to_packed, /* TRUE: pack simplicial columns, FALSE: do not pack */ int to_monotonic, /* TRUE: put simplicial columns in order, FALSE: not */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ /* --------------- */ cholmod_common *Common ) { /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; if (to_xtype < CHOLMOD_PATTERN || to_xtype > CHOLMOD_ZOMPLEX) { ERROR (CHOLMOD_INVALID, "xtype invalid") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; PRINT1 (("-----convert from (%d,%d,%d,%d,%d) to (%d,%d,%d,%d,%d)\n", L->xtype, L->is_ll, L->is_super, L_is_packed (L, Common), L->is_monotonic, to_xtype, to_ll, to_super, to_packed, to_monotonic)) ; /* ensure all parameters are TRUE/FALSE */ to_ll = BOOLEAN (to_ll) ; to_super = BOOLEAN (to_super) ; ASSERT (BOOLEAN (L->is_ll) == L->is_ll) ; ASSERT (BOOLEAN (L->is_super) == L->is_super) ; if (to_super && to_xtype == CHOLMOD_ZOMPLEX) { ERROR (CHOLMOD_INVALID, "supernodal zomplex L not supported") ; return (FALSE) ; } /* ---------------------------------------------------------------------- */ /* convert */ /* ---------------------------------------------------------------------- */ if (to_xtype == CHOLMOD_PATTERN) { /* ------------------------------------------------------------------ */ /* convert to symbolic */ /* ------------------------------------------------------------------ */ if (!to_super) { /* -------------------------------------------------------------- */ /* convert any factor into a simplicial symbolic factor */ /* -------------------------------------------------------------- */ any_to_simplicial_symbolic (L, to_ll, Common) ; /* cannot fail */ } else { /* -------------------------------------------------------------- */ /* convert to a supernodal symbolic factor */ /* -------------------------------------------------------------- */ if (L->xtype != CHOLMOD_PATTERN && L->is_super) { /* convert from supernodal numeric to supernodal symbolic. * this preserves symbolic pattern of L, discards numeric * values */ ll_super_to_super_symbolic (L, Common) ; /* cannot fail */ } else if (L->xtype == CHOLMOD_PATTERN && !(L->is_super)) { /* convert from simplicial symbolic to supernodal symbolic. * contents of supernodal pattern are uninitialized. Not meant * for the end user. */ simplicial_symbolic_to_super_symbolic (L, Common) ; } else { /* cannot convert from simplicial numeric to supernodal * symbolic */ ERROR (CHOLMOD_INVALID, "cannot convert L to supernodal symbolic") ; } } } else { /* ------------------------------------------------------------------ */ /* convert to numeric */ /* ------------------------------------------------------------------ */ if (to_super) { /* -------------------------------------------------------------- */ /* convert to supernodal numeric factor */ /* -------------------------------------------------------------- */ if (L->xtype == CHOLMOD_PATTERN) { if (L->is_super) { /* Convert supernodal symbolic to supernodal numeric. * Contents of supernodal numeric values are uninitialized. * This is used by cholmod_super_numeric. Not meant for * the end user. */ super_symbolic_to_ll_super (to_xtype, L, Common) ; } else { /* Convert simplicial symbolic to supernodal numeric. * Contents not defined. This is used by * Core/cholmod_copy_factor only. Not meant for the end * user. */ if (!simplicial_symbolic_to_super_symbolic (L, Common)) { /* failure, convert back to simplicial symbolic */ any_to_simplicial_symbolic (L, to_ll, Common) ; } else { /* conversion to super symbolic OK, allocate numeric * part */ super_symbolic_to_ll_super (to_xtype, L, Common) ; } } } else { /* nothing to do if L is already in supernodal numeric form */ if (!(L->is_super)) { ERROR (CHOLMOD_INVALID, "cannot convert simplicial L to supernodal") ; } /* FUTURE WORK: convert to/from supernodal LL' and LDL' */ } } else { /* -------------------------------------------------------------- */ /* convert any factor to simplicial numeric */ /* -------------------------------------------------------------- */ if (L->xtype == CHOLMOD_PATTERN && !(L->is_super)) { /* ---------------------------------------------------------- */ /* convert simplicial symbolic to simplicial numeric (L=I,D=I)*/ /* ---------------------------------------------------------- */ simplicial_symbolic_to_simplicial_numeric (L, to_ll, to_packed, to_xtype, Common) ; } else if (L->xtype != CHOLMOD_PATTERN && L->is_super) { /* ---------------------------------------------------------- */ /* convert a supernodal LL' to simplicial numeric */ /* ---------------------------------------------------------- */ ll_super_to_simplicial_numeric (L, to_packed, to_ll, Common) ; } else if (L->xtype == CHOLMOD_PATTERN && L->is_super) { /* ---------------------------------------------------------- */ /* convert a supernodal symbolic to simplicial numeric (L=D=I)*/ /* ---------------------------------------------------------- */ any_to_simplicial_symbolic (L, to_ll, Common) ; /* if the following fails, it leaves the factor in simplicial * symbolic form */ simplicial_symbolic_to_simplicial_numeric (L, to_ll, to_packed, to_xtype, Common) ; } else { /* ---------------------------------------------------------- */ /* change a simplicial numeric factor */ /* ---------------------------------------------------------- */ /* change LL' to LDL', LDL' to LL', or leave as-is. pack the * columns of L, or leave as-is. Ensure the columns are * monotonic, or leave as-is. */ change_simplicial_numeric (L, to_ll, to_packed, to_monotonic, Common) ; } } } /* ---------------------------------------------------------------------- */ /* return result */ /* ---------------------------------------------------------------------- */ return (Common->status >= CHOLMOD_OK) ; } Matrix/src/CHOLMOD/Core/cholmod_band.c0000644000176200001440000002275713652535054017064 0ustar liggesusers/* ========================================================================== */ /* === Core/cholmod_band ==================================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Core Module. Copyright (C) 2005-2006, * Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* C = tril (triu (A,k1), k2) * * C is a matrix consisting of the diagonals of A from k1 to k2. * * k=0 is the main diagonal of A, k=1 is the superdiagonal, k=-1 is the * subdiagonal, and so on. If A is m-by-n, then: * * k1=-m C = tril (A,k2) * k2=n C = triu (A,k1) * k1=0 and k2=0 C = diag(A), except C is a matrix, not a vector * * Values of k1 and k2 less than -m are treated as -m, and values greater * than n are treated as n. * * A can be of any symmetry (upper, lower, or unsymmetric); C is returned in * the same form, and packed. If A->stype > 0, entries in the lower * triangular part of A are ignored, and the opposite is true if * A->stype < 0. If A has sorted columns, then so does C. * C has the same size as A. * * If inplace is TRUE, then the matrix A is modified in place. * Only packed matrices can be converted in place. * * C can be returned as a numerical valued matrix (if A has numerical values * and mode > 0), as a pattern-only (mode == 0), or as a pattern-only but with * the diagonal entries removed (mode < 0). * * workspace: none * * A can have an xtype of pattern or real. Complex and zomplex cases supported * only if mode <= 0 (in which case the numerical values are ignored). */ #include "cholmod_internal.h" #include "cholmod_core.h" static cholmod_sparse *band /* returns C, or NULL if failure */ ( /* ---- input or in/out if inplace is TRUE --- */ cholmod_sparse *A, /* ---- input ---- */ SuiteSparse_long k1, /* ignore entries below the k1-st diagonal */ SuiteSparse_long k2, /* ignore entries above the k2-nd diagonal */ int mode, /* >0: numerical, 0: pattern, <0: pattern (no diagonal) */ int inplace, /* if TRUE, then convert A in place */ /* --------------- */ cholmod_common *Common ) { double *Ax, *Cx ; Int packed, nz, j, p, pend, i, ncol, nrow, jlo, jhi, ilo, ihi, sorted, values, diag ; Int *Ap, *Anz, *Ai, *Cp, *Ci ; cholmod_sparse *C ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (A, NULL) ; values = (mode > 0) && (A->xtype != CHOLMOD_PATTERN) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ; packed = A->packed ; diag = (mode >= 0) ; if (inplace && !packed) { /* cannot operate on an unpacked matrix in place */ ERROR (CHOLMOD_INVALID, "cannot operate on unpacked matrix in-place") ; return (NULL) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ PRINT1 (("k1 %ld k2 %ld\n", k1, k2)) ; Ap = A->p ; Anz = A->nz ; Ai = A->i ; Ax = A->x ; sorted = A->sorted ; if (A->stype > 0) { /* ignore any entries in strictly lower triangular part of A */ k1 = MAX (k1, 0) ; } if (A->stype < 0) { /* ignore any entries in strictly upper triangular part of A */ k2 = MIN (k2, 0) ; } ncol = A->ncol ; nrow = A->nrow ; /* ensure k1 and k2 are in the range -nrow to +ncol to * avoid possible integer overflow if k1 and k2 are huge */ k1 = MAX (-nrow, k1) ; k1 = MIN (k1, ncol) ; k2 = MAX (-nrow, k2) ; k2 = MIN (k2, ncol) ; /* consider columns jlo to jhi. columns outside this range are empty */ jlo = MAX (k1, 0) ; jhi = MIN (k2+nrow, ncol) ; if (k1 > k2) { /* nothing to do */ jlo = ncol ; jhi = ncol ; } /* ---------------------------------------------------------------------- */ /* allocate C, or operate on A in place */ /* ---------------------------------------------------------------------- */ if (inplace) { /* convert A in place */ C = A ; } else { /* count the number of entries in the result C */ nz = 0 ; if (sorted) { for (j = jlo ; j < jhi ; j++) { ilo = j-k2 ; ihi = j-k1 ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i > ihi) { break ; } if (i >= ilo && (diag || i != j)) { nz++ ; } } } } else { for (j = jlo ; j < jhi ; j++) { ilo = j-k2 ; ihi = j-k1 ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i >= ilo && i <= ihi && (diag || i != j)) { nz++ ; } } } } /* allocate C; A will not be modified. C is sorted if A is sorted */ C = CHOLMOD(allocate_sparse) (A->nrow, ncol, nz, sorted, TRUE, A->stype, values ? A->xtype : CHOLMOD_PATTERN, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } } Cp = C->p ; Ci = C->i ; Cx = C->x ; /* ---------------------------------------------------------------------- */ /* construct C */ /* ---------------------------------------------------------------------- */ /* columns 0 to jlo-1 are empty */ for (j = 0 ; j < jlo ; j++) { Cp [j] = 0 ; } nz = 0 ; if (sorted) { if (values) { /* pattern and values */ ASSERT (diag) ; for (j = jlo ; j < jhi ; j++) { ilo = j-k2 ; ihi = j-k1 ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; Cp [j] = nz ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i > ihi) { break ; } if (i >= ilo) { Ci [nz] = i ; Cx [nz] = Ax [p] ; nz++ ; } } } } else { /* pattern only, perhaps with no diagonal */ for (j = jlo ; j < jhi ; j++) { ilo = j-k2 ; ihi = j-k1 ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; Cp [j] = nz ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i > ihi) { break ; } if (i >= ilo && (diag || i != j)) { Ci [nz++] = i ; } } } } } else { if (values) { /* pattern and values */ ASSERT (diag) ; for (j = jlo ; j < jhi ; j++) { ilo = j-k2 ; ihi = j-k1 ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; Cp [j] = nz ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i >= ilo && i <= ihi) { Ci [nz] = i ; Cx [nz] = Ax [p] ; nz++ ; } } } } else { /* pattern only, perhaps with no diagonal */ for (j = jlo ; j < jhi ; j++) { ilo = j-k2 ; ihi = j-k1 ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; Cp [j] = nz ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i >= ilo && i <= ihi && (diag || i != j)) { Ci [nz++] = i ; } } } } } /* columns jhi to ncol-1 are empty */ for (j = jhi ; j <= ncol ; j++) { Cp [j] = nz ; } /* ---------------------------------------------------------------------- */ /* reduce A in size if done in place */ /* ---------------------------------------------------------------------- */ if (inplace) { /* free the unused parts of A, and reduce A->i and A->x in size */ ASSERT (MAX (1,nz) <= A->nzmax) ; CHOLMOD(reallocate_sparse) (nz, A, Common) ; ASSERT (Common->status >= CHOLMOD_OK) ; } /* ---------------------------------------------------------------------- */ /* return the result C */ /* ---------------------------------------------------------------------- */ DEBUG (i = CHOLMOD(dump_sparse) (C, "band", Common)) ; ASSERT (IMPLIES (mode < 0, i == 0)) ; return (C) ; } /* ========================================================================== */ /* === cholmod_band ========================================================= */ /* ========================================================================== */ cholmod_sparse *CHOLMOD(band) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to extract band matrix from */ SuiteSparse_long k1, /* ignore entries below the k1-st diagonal */ SuiteSparse_long k2, /* ignore entries above the k2-nd diagonal */ int mode, /* >0: numerical, 0: pattern, <0: pattern (no diag) */ /* --------------- */ cholmod_common *Common ) { return (band (A, k1, k2, mode, FALSE, Common)) ; } /* ========================================================================== */ /* === cholmod_band_inplace ================================================= */ /* ========================================================================== */ int CHOLMOD(band_inplace) ( /* ---- input ---- */ SuiteSparse_long k1, /* ignore entries below the k1-st diagonal */ SuiteSparse_long k2, /* ignore entries above the k2-nd diagonal */ int mode, /* >0: numerical, 0: pattern, <0: pattern (no diag) */ /* ---- in/out --- */ cholmod_sparse *A, /* matrix from which entries not in band are removed */ /* --------------- */ cholmod_common *Common ) { return (band (A, k1, k2, mode, TRUE, Common) != NULL) ; } Matrix/src/CHOLMOD/Core/cholmod_dense.c0000644000176200001440000004722313652535054017251 0ustar liggesusers/* ========================================================================== */ /* === Core/cholmod_dense =================================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Core Module. Copyright (C) 2005-2013, * Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* Core utility routines for the cholmod_dense object: * * The solve routines and some of the MatrixOps and Modify routines use dense * matrices as inputs. These are held in column-major order. With a leading * dimension of d, the entry in row i and column j is held in x [i+j*d]. * * Primary routines: * ----------------- * cholmod_allocate_dense allocate a dense matrix * cholmod_free_dense free a dense matrix * * Secondary routines: * ------------------- * cholmod_zeros allocate a dense matrix of all zeros * cholmod_ones allocate a dense matrix of all ones * cholmod_eye allocate a dense identity matrix * cholmod_sparse_to_dense create a dense matrix copy of a sparse matrix * cholmod_dense_to_sparse create a sparse matrix copy of a dense matrix * cholmod_copy_dense create a copy of a dense matrix * cholmod_copy_dense2 copy a dense matrix (pre-allocated) * * All routines in this file can handle the real, complex, and zomplex cases. * Pattern-only dense matrices are not supported. cholmod_sparse_to_dense can * take a pattern-only input sparse matrix, however, and cholmod_dense_to_sparse * can generate a pattern-only output sparse matrix. */ #include "cholmod_internal.h" #include "cholmod_core.h" /* ========================================================================== */ /* === TEMPLATE ============================================================= */ /* ========================================================================== */ #define PATTERN #include "t_cholmod_dense.c" #define REAL #include "t_cholmod_dense.c" #define COMPLEX #include "t_cholmod_dense.c" #define ZOMPLEX #include "t_cholmod_dense.c" /* ========================================================================== */ /* === cholmod_allocate_dense =============================================== */ /* ========================================================================== */ /* Allocate a dense matrix with leading dimension d. The space is not * initialized. */ cholmod_dense *CHOLMOD(allocate_dense) ( /* ---- input ---- */ size_t nrow, /* # of rows of matrix */ size_t ncol, /* # of columns of matrix */ size_t d, /* leading dimension */ int xtype, /* CHOLMOD_REAL, _COMPLEX, or _ZOMPLEX */ /* --------------- */ cholmod_common *Common ) { cholmod_dense *X ; size_t nzmax, nzmax0 ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; if (d < nrow) { ERROR (CHOLMOD_INVALID, "leading dimension invalid") ; return (NULL) ; } if (xtype < CHOLMOD_REAL || xtype > CHOLMOD_ZOMPLEX) { ERROR (CHOLMOD_INVALID, "xtype invalid") ; return (NULL) ; } /* ensure the dimensions do not cause integer overflow */ (void) CHOLMOD(add_size_t) (ncol, 2, &ok) ; /* nzmax = MAX (1, d*ncol) ; */ nzmax = CHOLMOD(mult_size_t) (d, ncol, &ok) ; nzmax = MAX (1, nzmax) ; if (!ok || nrow > Int_max || ncol > Int_max || nzmax > Int_max) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (NULL) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate header */ /* ---------------------------------------------------------------------- */ X = CHOLMOD(malloc) (sizeof (cholmod_dense), 1, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } PRINT1 (("cholmod_allocate_dense %d-by-%d nzmax %d xtype %d\n", nrow, ncol, nzmax, xtype)) ; X->nrow = nrow ; X->ncol = ncol ; X->nzmax = nzmax ; X->xtype = xtype ; X->dtype = DTYPE ; X->x = NULL ; X->z = NULL ; X->d = d ; /* ---------------------------------------------------------------------- */ /* allocate the matrix itself */ /* ---------------------------------------------------------------------- */ nzmax0 = 0 ; CHOLMOD(realloc_multiple) (nzmax, 0, xtype, NULL, NULL, &(X->x), &(X->z), &nzmax0, Common) ; if (Common->status < CHOLMOD_OK) { CHOLMOD(free_dense) (&X, Common) ; return (NULL) ; /* out of memory */ } return (X) ; } /* ========================================================================== */ /* === cholmod_zeros ======================================================== */ /* ========================================================================== */ /* Allocate a dense matrix and set it to zero */ cholmod_dense *CHOLMOD(zeros) ( /* ---- input ---- */ size_t nrow, /* # of rows of matrix */ size_t ncol, /* # of columns of matrix */ int xtype, /* CHOLMOD_REAL, _COMPLEX, or _ZOMPLEX */ /* --------------- */ cholmod_common *Common ) { cholmod_dense *X ; double *Xx, *Xz ; Int i, nz ; /* ---------------------------------------------------------------------- */ /* allocate a dense matrix and set it to zero */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; X = CHOLMOD(allocate_dense) (nrow, ncol, nrow, xtype, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* NULL Common, out of memory, or inputs invalid */ } Xx = X->x ; Xz = X->z ; nz = MAX (1, X->nzmax) ; switch (xtype) { case CHOLMOD_REAL: for (i = 0 ; i < nz ; i++) { Xx [i] = 0 ; } break ; case CHOLMOD_COMPLEX: for (i = 0 ; i < 2*nz ; i++) { Xx [i] = 0 ; } break ; case CHOLMOD_ZOMPLEX: for (i = 0 ; i < nz ; i++) { Xx [i] = 0 ; } for (i = 0 ; i < nz ; i++) { Xz [i] = 0 ; } break ; } return (X) ; } /* ========================================================================== */ /* === cholmod_ones ========================================================= */ /* ========================================================================== */ /* Allocate a dense matrix and set it to zero */ cholmod_dense *CHOLMOD(ones) ( /* ---- input ---- */ size_t nrow, /* # of rows of matrix */ size_t ncol, /* # of columns of matrix */ int xtype, /* CHOLMOD_REAL, _COMPLEX, or _ZOMPLEX */ /* --------------- */ cholmod_common *Common ) { cholmod_dense *X ; double *Xx, *Xz ; Int i, nz ; /* ---------------------------------------------------------------------- */ /* allocate a dense matrix and set it to all ones */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; X = CHOLMOD(allocate_dense) (nrow, ncol, nrow, xtype, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* NULL Common, out of memory, or inputs invalid */ } Xx = X->x ; Xz = X->z ; nz = MAX (1, X->nzmax) ; switch (xtype) { case CHOLMOD_REAL: for (i = 0 ; i < nz ; i++) { Xx [i] = 1 ; } break ; case CHOLMOD_COMPLEX: for (i = 0 ; i < nz ; i++) { Xx [2*i ] = 1 ; Xx [2*i+1] = 0 ; } break ; case CHOLMOD_ZOMPLEX: for (i = 0 ; i < nz ; i++) { Xx [i] = 1 ; } for (i = 0 ; i < nz ; i++) { Xz [i] = 0 ; } break ; } return (X) ; } /* ========================================================================== */ /* === cholmod_eye ========================================================== */ /* ========================================================================== */ /* Allocate a dense matrix and set it to the identity matrix */ cholmod_dense *CHOLMOD(eye) ( /* ---- input ---- */ size_t nrow, /* # of rows of matrix */ size_t ncol, /* # of columns of matrix */ int xtype, /* CHOLMOD_REAL, _COMPLEX, or _ZOMPLEX */ /* --------------- */ cholmod_common *Common ) { cholmod_dense *X ; double *Xx, *Xz ; Int i, n, nz ; /* ---------------------------------------------------------------------- */ /* allocate a dense matrix and set it to the identity matrix */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; X = CHOLMOD(zeros) (nrow, ncol, xtype, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* NULL Common, out of memory, or inputs invalid */ } nz = MAX (1, nrow*ncol) ; Xx = X->x ; Xz = X->z ; n = MIN (nrow, ncol) ; switch (xtype) { case CHOLMOD_REAL: case CHOLMOD_ZOMPLEX: for (i = 0 ; i < n ; i++) { Xx [i + i*nrow] = 1 ; } break ; case CHOLMOD_COMPLEX: for (i = 0 ; i < n ; i++) { Xx [2 * (i + i*nrow)] = 1 ; } break ; } return (X) ; } /* ========================================================================== */ /* === cholmod_free_dense =================================================== */ /* ========================================================================== */ /* free a dense matrix * * workspace: none */ int CHOLMOD(free_dense) ( /* ---- in/out --- */ cholmod_dense **XHandle, /* dense matrix to deallocate, NULL on output */ /* --------------- */ cholmod_common *Common ) { cholmod_dense *X ; RETURN_IF_NULL_COMMON (FALSE) ; if (XHandle == NULL) { /* nothing to do */ return (TRUE) ; } X = *XHandle ; if (X == NULL) { /* nothing to do */ return (TRUE) ; } switch (X->xtype) { case CHOLMOD_REAL: X->x = CHOLMOD(free) (X->nzmax, sizeof (double), X->x, Common) ; break ; case CHOLMOD_COMPLEX: X->x = CHOLMOD(free) (X->nzmax, 2*sizeof (double), X->x, Common) ; break ; case CHOLMOD_ZOMPLEX: X->x = CHOLMOD(free) (X->nzmax, sizeof (double), X->x, Common) ; X->z = CHOLMOD(free) (X->nzmax, sizeof (double), X->z, Common) ; break ; } *XHandle = CHOLMOD(free) (1, sizeof (cholmod_dense), (*XHandle), Common) ; return (TRUE) ; } /* ========================================================================== */ /* === cholmod_ensure_dense ================================================= */ /* ========================================================================== */ /* Ensure that the input matrix has a certain size and type. If not, free * the existing matrix and reallocate one of the right size and type. * Returns a pointer to the cholmod_dense matrix, possibly reallocated. * Also modifies the input matrix handle, XHandle, if necessary. */ cholmod_dense *CHOLMOD(ensure_dense) ( /* ---- input/output ---- */ cholmod_dense **XHandle, /* matrix handle to check */ /* ---- input ---- */ size_t nrow, /* # of rows of matrix */ size_t ncol, /* # of columns of matrix */ size_t d, /* leading dimension */ int xtype, /* CHOLMOD_REAL, _COMPLEX, or _ZOMPLEX */ /* --------------- */ cholmod_common *Common ) { cholmod_dense *X ; RETURN_IF_NULL_COMMON (NULL) ; if (XHandle == NULL) { ERROR (CHOLMOD_INVALID, "matrix invalid") ; return (NULL) ; } X = *XHandle ; if (X == NULL || X->nrow != nrow || X->ncol != ncol || X->d != d || X->xtype != xtype) { /* Matrix X is not allocated, or has the wrong size. Free it and * reallocate it in the right size and shape. If an error occurs * (out of memory or inputs nrow, etc invalid), then the error is * set in cholmod_allocate_dense and X is returned as NULL. */ CHOLMOD(free_dense) (XHandle, Common) ; X = CHOLMOD(allocate_dense) (nrow, ncol, d, xtype, Common) ; *XHandle = X ; } return (X) ; } /* ========================================================================== */ /* === cholmod_sparse_to_dense ============================================== */ /* ========================================================================== */ /* Convert a sparse matrix to a dense matrix. * The output dense matrix has the same xtype as the input sparse matrix, * except that a pattern-only sparse matrix A is converted into a real dense * matrix X, with 1's and 0's. All xtypes are supported. */ cholmod_dense *CHOLMOD(sparse_to_dense) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to copy */ /* --------------- */ cholmod_common *Common ) { cholmod_dense *X = NULL ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (A, NULL) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, NULL) ; if (A->stype && A->nrow != A->ncol) { ERROR (CHOLMOD_INVALID, "matrix invalid") ; return (NULL) ; } Common->status = CHOLMOD_OK ; ASSERT (CHOLMOD(dump_sparse) (A, "A", Common) >= 0) ; /* ---------------------------------------------------------------------- */ /* convert the matrix, using template routine */ /* ---------------------------------------------------------------------- */ switch (A->xtype) { case CHOLMOD_PATTERN: X = p_cholmod_sparse_to_dense (A, Common) ; break ; case CHOLMOD_REAL: X = r_cholmod_sparse_to_dense (A, Common) ; break ; case CHOLMOD_COMPLEX: X = c_cholmod_sparse_to_dense (A, Common) ; break ; case CHOLMOD_ZOMPLEX: X = z_cholmod_sparse_to_dense (A, Common) ; break ; } return (X) ; } /* ========================================================================== */ /* === cholmod_dense_to_sparse ============================================== */ /* ========================================================================== */ /* Convert a dense matrix to a sparse matrix, similar to the MATLAB statements: * * C = sparse (X) values = TRUE * C = spones (sparse (X)) values = FALSE * * except that X must be double (it can be of many different types in MATLAB) * * The resulting sparse matrix C has the same numeric xtype as the input dense * matrix X, unless "values" is FALSE (in which case C is real, where C(i,j)=1 * if (i,j) is an entry in X. */ cholmod_sparse *CHOLMOD(dense_to_sparse) ( /* ---- input ---- */ cholmod_dense *X, /* matrix to copy */ int values, /* TRUE if values to be copied, FALSE otherwise */ /* --------------- */ cholmod_common *Common ) { cholmod_sparse *C = NULL ; DEBUG (CHOLMOD(dump_dense) (X, "X", Common)) ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (X, NULL) ; RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, NULL) ; if (X->d < X->nrow) { ERROR (CHOLMOD_INVALID, "matrix invalid") ; return (NULL) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* convert the matrix, using template routine */ /* ---------------------------------------------------------------------- */ switch (X->xtype) { case CHOLMOD_REAL: C = r_cholmod_dense_to_sparse (X, values, Common) ; break ; case CHOLMOD_COMPLEX: C = c_cholmod_dense_to_sparse (X, values, Common) ; break ; case CHOLMOD_ZOMPLEX: C = z_cholmod_dense_to_sparse (X, values, Common) ; break ; } return (C) ; } /* ========================================================================== */ /* === cholmod_copy_dense2 ================================================== */ /* ========================================================================== */ /* Y = X, where X and Y are both already allocated. The leading dimensions of * X and Y may differ, but both must be >= the # of rows in X and Y. * Entries in rows nrow to d-1 are not copied from X, since the space might not * be initialized. Y->nzmax is unchanged. X->nzmax is typically * (X->d)*(X->ncol), but a user might modify that condition outside of any * CHOLMOD routine. * * The two dense matrices X and Y must have the same numeric xtype. */ int CHOLMOD(copy_dense2) ( /* ---- input ---- */ cholmod_dense *X, /* matrix to copy */ /* ---- output --- */ cholmod_dense *Y, /* copy of matrix X */ /* --------------- */ cholmod_common *Common ) { /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (X, FALSE) ; RETURN_IF_NULL (Y, FALSE) ; RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (Y, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ; if (X->nrow != Y->nrow || X->ncol != Y->ncol || X->xtype != Y->xtype) { ERROR (CHOLMOD_INVALID, "X and Y must have same dimensions and xtype") ; return (FALSE) ; } if (X->d < X->nrow || Y->d < Y->nrow || (X->d * X->ncol) > X->nzmax || (Y->d * Y->ncol) > Y->nzmax) { ERROR (CHOLMOD_INVALID, "X and/or Y invalid") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* copy the matrix, using template routine */ /* ---------------------------------------------------------------------- */ switch (X->xtype) { case CHOLMOD_REAL: r_cholmod_copy_dense2 (X, Y) ; break ; case CHOLMOD_COMPLEX: c_cholmod_copy_dense2 (X, Y) ; break ; case CHOLMOD_ZOMPLEX: z_cholmod_copy_dense2 (X, Y) ; break ; } return (TRUE) ; } /* ========================================================================== */ /* === cholmod_copy_dense =================================================== */ /* ========================================================================== */ /* Y = X, copy a dense matrix */ cholmod_dense *CHOLMOD(copy_dense) ( /* ---- input ---- */ cholmod_dense *X, /* matrix to copy */ /* --------------- */ cholmod_common *Common ) { cholmod_dense *Y ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (X, NULL) ; RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, NULL) ; Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate result */ /* ---------------------------------------------------------------------- */ Y = CHOLMOD(allocate_dense) (X->nrow, X->ncol, X->d, X->xtype, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory or X invalid */ } /* ---------------------------------------------------------------------- */ /* Y = X */ /* ---------------------------------------------------------------------- */ /* This cannot fail (X and Y are allocated, and have the same nrow, ncol * d, and xtype) */ CHOLMOD(copy_dense2) (X, Y, Common) ; /* ---------------------------------------------------------------------- */ /* return result */ /* ---------------------------------------------------------------------- */ return (Y) ; } Matrix/src/CHOLMOD/Core/cholmod_copy.c0000644000176200001440000002675413652535054017133 0ustar liggesusers/* ========================================================================== */ /* === Core/cholmod_copy ==================================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Core Module. Copyright (C) 2005-2006, * Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* C = A, which allocates C and copies A into C, with possible change of * stype. The diagonal can optionally be removed. The numerical entries * can optionally be copied. This routine differs from cholmod_copy_sparse, * which makes an exact copy of a sparse matrix. * * A can be of any type (packed/unpacked, upper/lower/unsymmetric). C is * packed and can be of any stype (upper/lower/unsymmetric), except that if * A is rectangular C can only be unsymmetric. If the stype of A and C * differ, then the appropriate conversion is made. * * Symmetry of A (A->stype): * <0: lower: assume A is symmetric with just tril(A); the rest of A is ignored * 0 unsym: assume A is unsymmetric; consider all entries in A * >0 upper: assume A is symmetric with just triu(A); the rest of A is ignored * * Symmetry of C (stype parameter): * <0 lower: return just tril(C) * 0 unsym: return all of C * >0 upper: return just triu(C) * * In MATLAB: Using cholmod_copy: * ---------- ---------------------------- * C = A ; A unsymmetric, C unsymmetric * C = tril (A) ; A unsymmetric, C lower * C = triu (A) ; A unsymmetric, C upper * U = triu (A) ; L = tril (U',-1) ; C = L+U ; A upper, C unsymmetric * C = triu (A)' ; A upper, C lower * C = triu (A) ; A upper, C upper * L = tril (A) ; U = triu (L',1) ; C = L+U ; A lower, C unsymmetric * C = tril (A) ; A lower, C lower * C = tril (A)' ; A lower, C upper * * workspace: Iwork (max (nrow,ncol)) * * A can have an xtype of pattern or real. Complex and zomplex cases only * supported when mode <= 0 (in which case the numerical values are ignored). */ #include "cholmod_internal.h" #include "cholmod_core.h" /* ========================================================================== */ /* === copy_sym_to_unsym ==================================================== */ /* ========================================================================== */ /* Construct an unsymmetric copy of a symmetric sparse matrix. This does the * work for as C = cholmod_copy (A, 0, mode, Common) when A is symmetric. * In this case, extra space can be added to C. */ static cholmod_sparse *copy_sym_to_unsym ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to copy */ int mode, /* >0: numerical, 0: pattern, <0: pattern (no diag) * -2: pattern only, no diagonal, add 50% + n extra * space to C */ /* --------------- */ cholmod_common *Common ) { double aij ; double *Ax, *Cx ; Int *Ap, *Ai, *Anz, *Cp, *Ci, *Wj, *Iwork ; cholmod_sparse *C ; Int nrow, ncol, nz, packed, j, p, pend, i, pc, up, lo, values, diag, astype, extra ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ nrow = A->nrow ; ncol = A->ncol ; Ap = A->p ; Anz = A->nz ; Ai = A->i ; Ax = A->x ; packed = A->packed ; values = (mode > 0) && (A->xtype != CHOLMOD_PATTERN) ; diag = (mode >= 0) ; astype = SIGN (A->stype) ; up = (astype > 0) ; lo = (astype < 0) ; ASSERT (astype != 0) ; /* ---------------------------------------------------------------------- */ /* create an unsymmetric copy of a symmetric matrix */ /* ---------------------------------------------------------------------- */ Iwork = Common->Iwork ; Wj = Iwork ; /* size ncol (i/i/l) */ /* In MATLAB notation, for converting a symmetric/upper matrix: * U = triu (A) ; * L = tril (U',-1) ; * C = L + U ; * * For converting a symmetric/lower matrix to unsymmetric: * L = tril (A) ; * U = triu (L',1) ; * C = L + U ; */ ASSERT (up || lo) ; PRINT1 (("copy: convert symmetric to unsym\n")) ; /* count the number of entries in each column of C */ for (j = 0 ; j < ncol ; j++) { Wj [j] = 0 ; } for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i == j) { /* the diagonal entry A(i,i) will appear just once * (unless it is excluded with mode < 0) */ if (diag) { Wj [j]++ ; } } else if ((up && i < j) || (lo && i > j)) { /* upper case: A(i,j) is in the strictly upper part; * A(j,i) will be added to the strictly lower part of C. * lower case is the opposite. */ Wj [j]++ ; Wj [i]++ ; } } } nz = 0 ; for (j = 0 ; j < ncol ; j++) { nz += Wj [j] ; } extra = (mode == -2) ? (nz/2 + ncol) : 0 ; /* allocate C. C is sorted if and only if A is sorted */ C = CHOLMOD(allocate_sparse) (nrow, ncol, nz + extra, A->sorted, TRUE, 0, values ? A->xtype : CHOLMOD_PATTERN, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; } Cp = C->p ; Ci = C->i ; Cx = C->x ; /* construct the column pointers for C */ p = 0 ; for (j = 0 ; j < ncol ; j++) { Cp [j] = p ; p += Wj [j] ; } Cp [ncol] = p ; for (j = 0 ; j < ncol ; j++) { Wj [j] = Cp [j] ; } /* construct C */ if (values) { /* pattern and values */ ASSERT (diag) ; for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; aij = Ax [p] ; if (i == j) { /* add diagonal entry A(i,i) to column i */ pc = Wj [i]++ ; Ci [pc] = i ; Cx [pc] = aij ; } else if ((up && i < j) || (lo && i > j)) { /* add A(i,j) to column j */ pc = Wj [j]++ ; Ci [pc] = i ; Cx [pc] = aij ; /* add A(j,i) to column i */ pc = Wj [i]++ ; Ci [pc] = j ; Cx [pc] = aij ; } } } } else { /* pattern only, possibly excluding the diagonal */ for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i == j) { /* add diagonal entry A(i,i) to column i * (unless it is excluded with mode < 0) */ if (diag) { Ci [Wj [i]++] = i ; } } else if ((up && i < j) || (lo && i > j)) { /* add A(i,j) to column j */ Ci [Wj [j]++] = i ; /* add A(j,i) to column i */ Ci [Wj [i]++] = j ; } } } } /* ---------------------------------------------------------------------- */ /* return the result */ /* ---------------------------------------------------------------------- */ DEBUG (i = CHOLMOD(dump_sparse) (C, "copy_sym_to_unsym", Common)) ; PRINT1 (("mode %d nnzdiag "ID"\n", mode, i)) ; ASSERT (IMPLIES (mode < 0, i == 0)) ; return (C) ; } /* ========================================================================== */ /* === cholmod_copy ========================================================= */ /* ========================================================================== */ cholmod_sparse *CHOLMOD(copy) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to copy */ int stype, /* requested stype of C */ int mode, /* >0: numerical, 0: pattern, <0: pattern (no diag) */ /* --------------- */ cholmod_common *Common ) { cholmod_sparse *C ; Int nrow, ncol, up, lo, values, diag, astype ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (A, NULL) ; values = (mode > 0) && (A->xtype != CHOLMOD_PATTERN) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ; nrow = A->nrow ; ncol = A->ncol ; if ((stype || A->stype) && nrow != ncol) { /* inputs invalid */ ERROR (CHOLMOD_INVALID, "matrix invalid") ; return (NULL) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ CHOLMOD(allocate_work) (0, MAX (nrow,ncol), 0, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (NULL) ; } /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ diag = (mode >= 0) ; astype = SIGN (A->stype) ; stype = SIGN (stype) ; up = (astype > 0) ; lo = (astype < 0) ; /* ---------------------------------------------------------------------- */ /* copy the matrix */ /* ---------------------------------------------------------------------- */ if (astype == stype) { /* ------------------------------------------------------------------ */ /* symmetry of A and C are the same */ /* ------------------------------------------------------------------ */ /* copy A into C, keeping the same symmetry. If A is symmetric * entries in the ignored part of A are not copied into C */ C = CHOLMOD(band) (A, -nrow, ncol, mode, Common) ; } else if (!astype) { /* ------------------------------------------------------------------ */ /* convert unsymmetric matrix A into a symmetric matrix C */ /* ------------------------------------------------------------------ */ if (stype > 0) { /* C = triu (A) */ C = CHOLMOD(band) (A, 0, ncol, mode, Common) ; } else { /* C = tril (A) */ C = CHOLMOD(band) (A, -nrow, 0, mode, Common) ; } if (Common->status < CHOLMOD_OK) { /* out of memory */ return (NULL) ; } C->stype = stype ; } else if (astype == -stype) { /* ------------------------------------------------------------------ */ /* transpose a symmetric matrix */ /* ------------------------------------------------------------------ */ /* converting upper to lower or lower to upper */ /* workspace: Iwork (nrow) */ C = CHOLMOD(transpose) (A, values, Common) ; if (!diag) { /* remove diagonal, if requested */ CHOLMOD(band_inplace) (-nrow, ncol, -1, C, Common) ; } } else { /* ------------------------------------------------------------------ */ /* create an unsymmetric copy of a symmetric matrix */ /* ------------------------------------------------------------------ */ C = copy_sym_to_unsym (A, mode, Common) ; } /* ---------------------------------------------------------------------- */ /* return if error */ /* ---------------------------------------------------------------------- */ if (Common->status < CHOLMOD_OK) { /* out of memory */ return (NULL) ; } /* ---------------------------------------------------------------------- */ /* return the result */ /* ---------------------------------------------------------------------- */ DEBUG (diag = CHOLMOD(dump_sparse) (C, "copy", Common)) ; PRINT1 (("mode %d nnzdiag "ID"\n", mode, diag)) ; ASSERT (IMPLIES (mode < 0, diag == 0)) ; return (C) ; } Matrix/src/CHOLMOD/Include/0000755000176200001440000000000014154165363014765 5ustar liggesusersMatrix/src/CHOLMOD/Include/cholmod_core.h0000644000176200001440000031072613652535054017604 0ustar liggesusers/* ========================================================================== */ /* === Include/cholmod_core.h =============================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Include/cholmod_core.h. * Copyright (C) 2005-2019, Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* CHOLMOD Core module: basic CHOLMOD objects and routines. * Required by all CHOLMOD modules. Requires no other module or package. * * The CHOLMOD modules are: * * Core basic data structures and definitions * Check check/print the 5 CHOLMOD objects, & 3 types of integer vectors * Cholesky sparse Cholesky factorization * Modify sparse Cholesky update/downdate/row-add/row-delete * MatrixOps sparse matrix functions (add, multiply, norm, ...) * Supernodal supernodal sparse Cholesky factorization * Partition graph-partitioning based orderings * * The CHOLMOD objects: * -------------------- * * cholmod_common parameters, statistics, and workspace * cholmod_sparse a sparse matrix in compressed column form * cholmod_factor an LL' or LDL' factorization * cholmod_dense a dense matrix * cholmod_triplet a sparse matrix in "triplet" form * * The Core module described here defines the CHOLMOD data structures, and * basic operations on them. To create and solve a sparse linear system Ax=b, * the user must create A and b, populate them with values, and then pass them * to the routines in the CHOLMOD Cholesky module. There are two primary * methods for creating A: (1) allocate space for a column-oriented sparse * matrix and fill it with pattern and values, or (2) create a triplet form * matrix and convert it to a sparse matrix. The latter option is simpler. * * The matrices b and x are typically dense matrices, but can also be sparse. * You can allocate and free them as dense matrices with the * cholmod_allocate_dense and cholmod_free_dense routines. * * The cholmod_factor object contains the symbolic and numeric LL' or LDL' * factorization of sparse symmetric matrix. The matrix must be positive * definite for an LL' factorization. It need only be symmetric and have well- * conditioned leading submatrices for it to have an LDL' factorization * (CHOLMOD does not pivot for numerical stability). It is typically created * with the cholmod_factorize routine in the Cholesky module, but can also * be initialized to L=D=I in the Core module and then modified by the Modify * module. It must be freed with cholmod_free_factor, defined below. * * The Core routines for each object are described below. Each list is split * into two parts: the primary routines and secondary routines. * * ============================================================================ * === cholmod_common ========================================================= * ============================================================================ * * The Common object contains control parameters, statistics, and * You must call cholmod_start before calling any other CHOLMOD routine, and * must call cholmod_finish as your last call to CHOLMOD, with two exceptions: * you may call cholmod_print_common and cholmod_check_common in the Check * module after calling cholmod_finish. * * cholmod_start first call to CHOLMOD * cholmod_finish last call to CHOLMOD * ----------------------------- * cholmod_defaults restore default parameters * cholmod_maxrank maximum rank for update/downdate * cholmod_allocate_work allocate workspace in Common * cholmod_free_work free workspace in Common * cholmod_clear_flag clear Flag workspace in Common * cholmod_error called when CHOLMOD encounters an error * cholmod_dbound for internal use in CHOLMOD only * cholmod_hypot compute sqrt (x*x + y*y) accurately * cholmod_divcomplex complex division, c = a/b * * ============================================================================ * === cholmod_sparse ========================================================= * ============================================================================ * * A sparse matrix is held in compressed column form. In the basic type * ("packed", which corresponds to a MATLAB sparse matrix), an n-by-n matrix * with nz entries is held in three arrays: p of size n+1, i of size nz, and x * of size nz. Row indices of column j are held in i [p [j] ... p [j+1]-1] and * in the same locations in x. There may be no duplicate entries in a column. * Row indices in each column may be sorted or unsorted (CHOLMOD keeps track). * A->stype determines the storage mode: 0 if both upper/lower parts are stored, * -1 if A is symmetric and just tril(A) is stored, +1 if symmetric and triu(A) * is stored. * * cholmod_allocate_sparse allocate a sparse matrix * cholmod_free_sparse free a sparse matrix * ----------------------------- * cholmod_reallocate_sparse change the size (# entries) of sparse matrix * cholmod_nnz number of nonzeros in a sparse matrix * cholmod_speye sparse identity matrix * cholmod_spzeros sparse zero matrix * cholmod_transpose transpose a sparse matrix * cholmod_ptranspose transpose/permute a sparse matrix * cholmod_transpose_unsym transpose/permute an unsymmetric sparse matrix * cholmod_transpose_sym transpose/permute a symmetric sparse matrix * cholmod_sort sort row indices in each column of sparse matrix * cholmod_band C = tril (triu (A,k1), k2) * cholmod_band_inplace A = tril (triu (A,k1), k2) * cholmod_aat C = A*A' * cholmod_copy_sparse C = A, create an exact copy of a sparse matrix * cholmod_copy C = A, with possible change of stype * cholmod_add C = alpha*A + beta*B * cholmod_sparse_xtype change the xtype of a sparse matrix * * ============================================================================ * === cholmod_factor ========================================================= * ============================================================================ * * The data structure for an LL' or LDL' factorization is too complex to * describe in one sentence. This object can hold the symbolic analysis alone, * or in combination with a "simplicial" (similar to a sparse matrix) or * "supernodal" form of the numerical factorization. Only the routine to free * a factor is primary, since a factor object is created by the factorization * routine (cholmod_factorize). It must be freed with cholmod_free_factor. * * cholmod_free_factor free a factor * ----------------------------- * cholmod_allocate_factor allocate a factor (LL' or LDL') * cholmod_reallocate_factor change the # entries in a factor * cholmod_change_factor change the type of factor (e.g., LDL' to LL') * cholmod_pack_factor pack the columns of a factor * cholmod_reallocate_column resize a single column of a factor * cholmod_factor_to_sparse create a sparse matrix copy of a factor * cholmod_copy_factor create a copy of a factor * cholmod_factor_xtype change the xtype of a factor * * Note that there is no cholmod_sparse_to_factor routine to create a factor * as a copy of a sparse matrix. It could be done, after a fashion, but a * lower triangular sparse matrix would not necessarily have a chordal graph, * which would break the many CHOLMOD routines that rely on this property. * * ============================================================================ * === cholmod_dense ========================================================== * ============================================================================ * * The solve routines and some of the MatrixOps and Modify routines use dense * matrices as inputs. These are held in column-major order. With a leading * dimension of d, the entry in row i and column j is held in x [i+j*d]. * * cholmod_allocate_dense allocate a dense matrix * cholmod_free_dense free a dense matrix * ----------------------------- * cholmod_zeros allocate a dense matrix of all zeros * cholmod_ones allocate a dense matrix of all ones * cholmod_eye allocate a dense identity matrix * cholmod_sparse_to_dense create a dense matrix copy of a sparse matrix * cholmod_dense_to_sparse create a sparse matrix copy of a dense matrix * cholmod_copy_dense create a copy of a dense matrix * cholmod_copy_dense2 copy a dense matrix (pre-allocated) * cholmod_dense_xtype change the xtype of a dense matrix * cholmod_ensure_dense ensure a dense matrix has a given size and type * * ============================================================================ * === cholmod_triplet ======================================================== * ============================================================================ * * A sparse matrix held in triplet form is the simplest one for a user to * create. It consists of a list of nz entries in arbitrary order, held in * three arrays: i, j, and x, each of length nk. The kth entry is in row i[k], * column j[k], with value x[k]. There may be duplicate values; if A(i,j) * appears more than once, its value is the sum of the entries with those row * and column indices. * * cholmod_allocate_triplet allocate a triplet matrix * cholmod_triplet_to_sparse create a sparse matrix copy of a triplet matrix * cholmod_free_triplet free a triplet matrix * ----------------------------- * cholmod_reallocate_triplet change the # of entries in a triplet matrix * cholmod_sparse_to_triplet create a triplet matrix copy of a sparse matrix * cholmod_copy_triplet create a copy of a triplet matrix * cholmod_triplet_xtype change the xtype of a triplet matrix * * ============================================================================ * === memory management ====================================================== * ============================================================================ * * cholmod_malloc malloc wrapper * cholmod_calloc calloc wrapper * cholmod_free free wrapper * cholmod_realloc realloc wrapper * cholmod_realloc_multiple realloc wrapper for multiple objects * * ============================================================================ * === Core CHOLMOD prototypes ================================================ * ============================================================================ * * All CHOLMOD routines (in all modules) use the following protocol for return * values, with one exception: * * int TRUE (1) if successful, or FALSE (0) otherwise. * (exception: cholmod_divcomplex) * SuiteSparse_long a value >= 0 if successful, or -1 otherwise. * double a value >= 0 if successful, or -1 otherwise. * size_t a value > 0 if successful, or 0 otherwise. * void * a non-NULL pointer to newly allocated memory if * successful, or NULL otherwise. * cholmod_sparse * a non-NULL pointer to a newly allocated matrix * if successful, or NULL otherwise. * cholmod_factor * a non-NULL pointer to a newly allocated factor * if successful, or NULL otherwise. * cholmod_triplet * a non-NULL pointer to a newly allocated triplet * matrix if successful, or NULL otherwise. * cholmod_dense * a non-NULL pointer to a newly allocated triplet * matrix if successful, or NULL otherwise. * * The last parameter to all routines is always a pointer to the CHOLMOD * Common object. * * TRUE and FALSE are not defined here, since they may conflict with the user * program. A routine that described here returning TRUE or FALSE returns 1 * or 0, respectively. Any TRUE/FALSE parameter is true if nonzero, false if * zero. */ #ifndef CHOLMOD_CORE_H #define CHOLMOD_CORE_H /* ========================================================================== */ /* === CHOLMOD version ====================================================== */ /* ========================================================================== */ /* All versions of CHOLMOD will include the following definitions. * As an example, to test if the version you are using is 1.3 or later: * * if (CHOLMOD_VERSION >= CHOLMOD_VER_CODE (1,3)) ... * * This also works during compile-time: * * #if CHOLMOD_VERSION >= CHOLMOD_VER_CODE (1,3) * printf ("This is version 1.3 or later\n") ; * #else * printf ("This is version is earlier than 1.3\n") ; * #endif */ #define CHOLMOD_HAS_VERSION_FUNCTION #define CHOLMOD_DATE "Oct 22, 2019" #define CHOLMOD_VER_CODE(main,sub) ((main) * 1000 + (sub)) #define CHOLMOD_MAIN_VERSION 3 #define CHOLMOD_SUB_VERSION 0 #define CHOLMOD_SUBSUB_VERSION 14 #define CHOLMOD_VERSION \ CHOLMOD_VER_CODE(CHOLMOD_MAIN_VERSION,CHOLMOD_SUB_VERSION) /* ========================================================================== */ /* === non-CHOLMOD include files ============================================ */ /* ========================================================================== */ /* This is the only non-CHOLMOD include file imposed on the user program. * It required for size_t definition used here. CHOLMOD itself includes other * ANSI C89 standard #include files, but does not expose them to the user. * * CHOLMOD assumes that your C compiler is ANSI C89 compliant. It does not make * use of ANSI C99 features. */ #include #include /* ========================================================================== */ /* === CUDA BLAS for the GPU ================================================ */ /* ========================================================================== */ /* The number of OMP threads should typically be set to the number of cores */ /* per socket inthe machine being used. This maximizes memory performance. */ #ifndef CHOLMOD_OMP_NUM_THREADS #define CHOLMOD_OMP_NUM_THREADS 4 #endif /* Define buffering parameters for GPU processing */ #ifndef SUITESPARSE_GPU_EXTERN_ON #ifdef GPU_BLAS #include #endif #endif #define CHOLMOD_DEVICE_SUPERNODE_BUFFERS 6 #define CHOLMOD_HOST_SUPERNODE_BUFFERS 8 #define CHOLMOD_DEVICE_STREAMS 2 /* ========================================================================== */ /* === CHOLMOD objects ====================================================== */ /* ========================================================================== */ /* Each CHOLMOD object has its own type code. */ #define CHOLMOD_COMMON 0 #define CHOLMOD_SPARSE 1 #define CHOLMOD_FACTOR 2 #define CHOLMOD_DENSE 3 #define CHOLMOD_TRIPLET 4 /* ========================================================================== */ /* === CHOLMOD Common ======================================================= */ /* ========================================================================== */ /* itype defines the types of integer used: */ #define CHOLMOD_INT 0 /* all integer arrays are int */ #define CHOLMOD_INTLONG 1 /* most are int, some are SuiteSparse_long */ #define CHOLMOD_LONG 2 /* all integer arrays are SuiteSparse_long */ /* The itype of all parameters for all CHOLMOD routines must match. * FUTURE WORK: CHOLMOD_INTLONG is not yet supported. */ /* dtype defines what the numerical type is (double or float): */ #define CHOLMOD_DOUBLE 0 /* all numerical values are double */ #define CHOLMOD_SINGLE 1 /* all numerical values are float */ /* The dtype of all parameters for all CHOLMOD routines must match. * * Scalar floating-point values are always passed as double arrays of size 2 * (for the real and imaginary parts). They are typecast to float as needed. * FUTURE WORK: the float case is not supported yet. */ /* xtype defines the kind of numerical values used: */ #define CHOLMOD_PATTERN 0 /* pattern only, no numerical values */ #define CHOLMOD_REAL 1 /* a real matrix */ #define CHOLMOD_COMPLEX 2 /* a complex matrix (ANSI C99 compatible) */ #define CHOLMOD_ZOMPLEX 3 /* a complex matrix (MATLAB compatible) */ /* The xtype of all parameters for all CHOLMOD routines must match. * * CHOLMOD_PATTERN: x and z are ignored. * CHOLMOD_DOUBLE: x is non-null of size nzmax, z is ignored. * CHOLMOD_COMPLEX: x is non-null of size 2*nzmax doubles, z is ignored. * CHOLMOD_ZOMPLEX: x and z are non-null of size nzmax * * In the real case, z is ignored. The kth entry in the matrix is x [k]. * There are two methods for the complex case. In the ANSI C99-compatible * CHOLMOD_COMPLEX case, the real and imaginary parts of the kth entry * are in x [2*k] and x [2*k+1], respectively. z is ignored. In the * MATLAB-compatible CHOLMOD_ZOMPLEX case, the real and imaginary * parts of the kth entry are in x [k] and z [k]. * * Scalar floating-point values are always passed as double arrays of size 2 * (real and imaginary parts). The imaginary part of a scalar is ignored if * the routine operates on a real matrix. * * These Modules support complex and zomplex matrices, with a few exceptions: * * Check all routines * Cholesky all routines * Core all except cholmod_aat, add, band, copy * Demo all routines * Partition all routines * Supernodal all routines support any real, complex, or zomplex input. * There will never be a supernodal zomplex L; a complex * supernodal L is created if A is zomplex. * Tcov all routines * Valgrind all routines * * These Modules provide partial support for complex and zomplex matrices: * * MATLAB all routines support real and zomplex only, not complex, * with the exception of ldlupdate, which supports * real matrices only. This is a minor constraint since * MATLAB's matrices are all real or zomplex. * MatrixOps only norm_dense, norm_sparse, and sdmult support complex * and zomplex * * These Modules do not support complex and zomplex matrices at all: * * Modify all routines support real matrices only */ /* Definitions for cholmod_common: */ #define CHOLMOD_MAXMETHODS 9 /* maximum number of different methods that */ /* cholmod_analyze can try. Must be >= 9. */ /* Common->status values. zero means success, negative means a fatal error, * positive is a warning. */ #define CHOLMOD_OK 0 /* success */ #define CHOLMOD_NOT_INSTALLED (-1) /* failure: method not installed */ #define CHOLMOD_OUT_OF_MEMORY (-2) /* failure: out of memory */ #define CHOLMOD_TOO_LARGE (-3) /* failure: integer overflow occured */ #define CHOLMOD_INVALID (-4) /* failure: invalid input */ #define CHOLMOD_GPU_PROBLEM (-5) /* failure: GPU fatal error */ #define CHOLMOD_NOT_POSDEF (1) /* warning: matrix not pos. def. */ #define CHOLMOD_DSMALL (2) /* warning: D for LDL' or diag(L) or */ /* LL' has tiny absolute value */ /* ordering method (also used for L->ordering) */ #define CHOLMOD_NATURAL 0 /* use natural ordering */ #define CHOLMOD_GIVEN 1 /* use given permutation */ #define CHOLMOD_AMD 2 /* use minimum degree (AMD) */ #define CHOLMOD_METIS 3 /* use METIS' nested dissection */ #define CHOLMOD_NESDIS 4 /* use CHOLMOD's version of nested dissection:*/ /* node bisector applied recursively, followed * by constrained minimum degree (CSYMAMD or * CCOLAMD) */ #define CHOLMOD_COLAMD 5 /* use AMD for A, COLAMD for A*A' */ /* POSTORDERED is not a method, but a result of natural ordering followed by a * weighted postorder. It is used for L->ordering, not method [ ].ordering. */ #define CHOLMOD_POSTORDERED 6 /* natural ordering, postordered. */ /* supernodal strategy (for Common->supernodal) */ #define CHOLMOD_SIMPLICIAL 0 /* always do simplicial */ #define CHOLMOD_AUTO 1 /* select simpl/super depending on matrix */ #define CHOLMOD_SUPERNODAL 2 /* always do supernodal */ typedef struct cholmod_common_struct { /* ---------------------------------------------------------------------- */ /* parameters for symbolic/numeric factorization and update/downdate */ /* ---------------------------------------------------------------------- */ double dbound ; /* Smallest absolute value of diagonal entries of D * for LDL' factorization and update/downdate/rowadd/ * rowdel, or the diagonal of L for an LL' factorization. * Entries in the range 0 to dbound are replaced with dbound. * Entries in the range -dbound to 0 are replaced with -dbound. No * changes are made to the diagonal if dbound <= 0. Default: zero */ double grow0 ; /* For a simplicial factorization, L->i and L->x can * grow if necessary. grow0 is the factor by which * it grows. For the initial space, L is of size MAX (1,grow0) times * the required space. If L runs out of space, the new size of L is * MAX(1.2,grow0) times the new required space. If you do not plan on * modifying the LDL' factorization in the Modify module, set grow0 to * zero (or set grow2 to 0, see below). Default: 1.2 */ double grow1 ; size_t grow2 ; /* For a simplicial factorization, each column j of L * is initialized with space equal to * grow1*L->ColCount[j] + grow2. If grow0 < 1, grow1 < 1, or grow2 == 0, * then the space allocated is exactly equal to L->ColCount[j]. If the * column j runs out of space, it increases to grow1*need + grow2 in * size, where need is the total # of nonzeros in that column. If you do * not plan on modifying the factorization in the Modify module, set * grow2 to zero. Default: grow1 = 1.2, grow2 = 5. */ size_t maxrank ; /* rank of maximum update/downdate. Valid values: * 2, 4, or 8. A value < 2 is set to 2, and a * value > 8 is set to 8. It is then rounded up to the next highest * power of 2, if not already a power of 2. Workspace (Xwork, below) of * size nrow-by-maxrank double's is allocated for the update/downdate. * If an update/downdate of rank-k is requested, with k > maxrank, * it is done in steps of maxrank. Default: 8, which is fastest. * Memory usage can be reduced by setting maxrank to 2 or 4. */ double supernodal_switch ; /* supernodal vs simplicial factorization */ int supernodal ; /* If Common->supernodal <= CHOLMOD_SIMPLICIAL * (0) then cholmod_analyze performs a * simplicial analysis. If >= CHOLMOD_SUPERNODAL (2), then a supernodal * analysis is performed. If == CHOLMOD_AUTO (1) and * flop/nnz(L) < Common->supernodal_switch, then a simplicial analysis * is done. A supernodal analysis done otherwise. * Default: CHOLMOD_AUTO. Default supernodal_switch = 40 */ int final_asis ; /* If TRUE, then ignore the other final_* parameters * (except for final_pack). * The factor is left as-is when done. Default: TRUE.*/ int final_super ; /* If TRUE, leave a factor in supernodal form when * supernodal factorization is finished. If FALSE, * then convert to a simplicial factor when done. * Default: TRUE */ int final_ll ; /* If TRUE, leave factor in LL' form when done. * Otherwise, leave in LDL' form. Default: FALSE */ int final_pack ; /* If TRUE, pack the columns when done. If TRUE, and * cholmod_factorize is called with a symbolic L, L is * allocated with exactly the space required, using L->ColCount. If you * plan on modifying the factorization, set Common->final_pack to FALSE, * and each column will be given a little extra slack space for future * growth in fill-in due to updates. Default: TRUE */ int final_monotonic ; /* If TRUE, ensure columns are monotonic when done. * Default: TRUE */ int final_resymbol ;/* if cholmod_factorize performed a supernodal * factorization, final_resymbol is true, and * final_super is FALSE (convert a simplicial numeric factorization), * then numerically zero entries that resulted from relaxed supernodal * amalgamation are removed. This does not remove entries that are zero * due to exact numeric cancellation, since doing so would break the * update/downdate rowadd/rowdel routines. Default: FALSE. */ /* supernodal relaxed amalgamation parameters: */ double zrelax [3] ; size_t nrelax [3] ; /* Let ns be the total number of columns in two adjacent supernodes. * Let z be the fraction of zero entries in the two supernodes if they * are merged (z includes zero entries from prior amalgamations). The * two supernodes are merged if: * (ns <= nrelax [0]) || (no new zero entries added) || * (ns <= nrelax [1] && z < zrelax [0]) || * (ns <= nrelax [2] && z < zrelax [1]) || (z < zrelax [2]) * * Default parameters result in the following rule: * (ns <= 4) || (no new zero entries added) || * (ns <= 16 && z < 0.8) || (ns <= 48 && z < 0.1) || (z < 0.05) */ int prefer_zomplex ; /* X = cholmod_solve (sys, L, B, Common) computes * x=A\b or solves a related system. If L and B are * both real, then X is real. Otherwise, X is returned as * CHOLMOD_COMPLEX if Common->prefer_zomplex is FALSE, or * CHOLMOD_ZOMPLEX if Common->prefer_zomplex is TRUE. This parameter * is needed because there is no supernodal zomplex L. Suppose the * caller wants all complex matrices to be stored in zomplex form * (MATLAB, for example). A supernodal L is returned in complex form * if A is zomplex. B can be real, and thus X = cholmod_solve (L,B) * should return X as zomplex. This cannot be inferred from the input * arguments L and B. Default: FALSE, since all data types are * supported in CHOLMOD_COMPLEX form and since this is the native type * of LAPACK and the BLAS. Note that the MATLAB/cholmod.c mexFunction * sets this parameter to TRUE, since MATLAB matrices are in * CHOLMOD_ZOMPLEX form. */ int prefer_upper ; /* cholmod_analyze and cholmod_factorize work * fastest when a symmetric matrix is stored in * upper triangular form when a fill-reducing ordering is used. In * MATLAB, this corresponds to how x=A\b works. When the matrix is * ordered as-is, they work fastest when a symmetric matrix is in lower * triangular form. In MATLAB, R=chol(A) does the opposite. This * parameter affects only how cholmod_read returns a symmetric matrix. * If TRUE (the default case), a symmetric matrix is always returned in * upper-triangular form (A->stype = 1). */ int quick_return_if_not_posdef ; /* if TRUE, the supernodal numeric * factorization will return quickly if * the matrix is not positive definite. Default: FALSE. */ int prefer_binary ; /* cholmod_read_triplet converts a symmetric * pattern-only matrix into a real matrix. If * prefer_binary is FALSE, the diagonal entries are set to 1 + the degree * of the row/column, and off-diagonal entries are set to -1 (resulting * in a positive definite matrix if the diagonal is zero-free). Most * symmetric patterns are the pattern a positive definite matrix. If * this parameter is TRUE, then the matrix is returned with a 1 in each * entry, instead. Default: FALSE. Added in v1.3. */ /* ---------------------------------------------------------------------- */ /* printing and error handling options */ /* ---------------------------------------------------------------------- */ int print ; /* print level. Default: 3 */ int precise ; /* if TRUE, print 16 digits. Otherwise print 5 */ /* CHOLMOD print_function replaced with SuiteSparse_config.print_func */ int try_catch ; /* if TRUE, then ignore errors; CHOLMOD is in the middle * of a try/catch block. No error message is printed * and the Common->error_handler function is not called. */ void (*error_handler) (int status, const char *file, int line, const char *message) ; /* Common->error_handler is the user's error handling routine. If not * NULL, this routine is called if an error occurs in CHOLMOD. status * can be CHOLMOD_OK (0), negative for a fatal error, and positive for * a warning. file is a string containing the name of the source code * file where the error occured, and line is the line number in that * file. message is a string describing the error in more detail. */ /* ---------------------------------------------------------------------- */ /* ordering options */ /* ---------------------------------------------------------------------- */ /* The cholmod_analyze routine can try many different orderings and select * the best one. It can also try one ordering method multiple times, with * different parameter settings. The default is to use three orderings, * the user's permutation (if provided), AMD which is the fastest ordering * and generally gives good fill-in, and METIS. CHOLMOD's nested dissection * (METIS with a constrained AMD) usually gives a better ordering than METIS * alone (by about 5% to 10%) but it takes more time. * * If you know the method that is best for your matrix, set Common->nmethods * to 1 and set Common->method [0] to the set of parameters for that method. * If you set it to 1 and do not provide a permutation, then only AMD will * be called. * * If METIS is not available, the default # of methods tried is 2 (the user * permutation, if any, and AMD). * * To try other methods, set Common->nmethods to the number of methods you * want to try. The suite of default methods and their parameters is * described in the cholmod_defaults routine, and summarized here: * * Common->method [i]: * i = 0: user-provided ordering (cholmod_analyze_p only) * i = 1: AMD (for both A and A*A') * i = 2: METIS * i = 3: CHOLMOD's nested dissection (NESDIS), default parameters * i = 4: natural * i = 5: NESDIS with nd_small = 20000 * i = 6: NESDIS with nd_small = 4, no constrained minimum degree * i = 7: NESDIS with no dense node removal * i = 8: AMD for A, COLAMD for A*A' * * You can modify the suite of methods you wish to try by modifying * Common.method [...] after calling cholmod_start or cholmod_defaults. * * For example, to use AMD, followed by a weighted postordering: * * Common->nmethods = 1 ; * Common->method [0].ordering = CHOLMOD_AMD ; * Common->postorder = TRUE ; * * To use the natural ordering (with no postordering): * * Common->nmethods = 1 ; * Common->method [0].ordering = CHOLMOD_NATURAL ; * Common->postorder = FALSE ; * * If you are going to factorize hundreds or more matrices with the same * nonzero pattern, you may wish to spend a great deal of time finding a * good permutation. In this case, try setting Common->nmethods to 9. * The time spent in cholmod_analysis will be very high, but you need to * call it only once. * * cholmod_analyze sets Common->current to a value between 0 and nmethods-1. * Each ordering method uses the set of options defined by this parameter. */ int nmethods ; /* The number of ordering methods to try. Default: 0. * nmethods = 0 is a special case. cholmod_analyze * will try the user-provided ordering (if given) and AMD. Let fl and * lnz be the flop count and nonzeros in L from AMD's ordering. Let * anz be the number of nonzeros in the upper or lower triangular part * of the symmetric matrix A. If fl/lnz < 500 or lnz/anz < 5, then this * is a good ordering, and METIS is not attempted. Otherwise, METIS is * tried. The best ordering found is used. If nmethods > 0, the * methods used are given in the method[ ] array, below. The first * three methods in the default suite of orderings is (1) use the given * permutation (if provided), (2) use AMD, and (3) use METIS. Maximum * allowed value is CHOLMOD_MAXMETHODS. */ int current ; /* The current method being tried. Default: 0. Valid * range is 0 to nmethods-1. */ int selected ; /* The best method found. */ /* The suite of ordering methods and parameters: */ struct cholmod_method_struct { /* statistics for this method */ double lnz ; /* nnz(L) excl. zeros from supernodal amalgamation, * for a "pure" L */ double fl ; /* flop count for a "pure", real simplicial LL' * factorization, with no extra work due to * amalgamation. Subtract n to get the LDL' flop count. Multiply * by about 4 if the matrix is complex or zomplex. */ /* ordering method parameters */ double prune_dense ;/* dense row/col control for AMD, SYMAMD, CSYMAMD, * and NESDIS (cholmod_nested_dissection). For a * symmetric n-by-n matrix, rows/columns with more than * MAX (16, prune_dense * sqrt (n)) entries are removed prior to * ordering. They appear at the end of the re-ordered matrix. * * If prune_dense < 0, only completely dense rows/cols are removed. * * This paramater is also the dense column control for COLAMD and * CCOLAMD. For an m-by-n matrix, columns with more than * MAX (16, prune_dense * sqrt (MIN (m,n))) entries are removed prior * to ordering. They appear at the end of the re-ordered matrix. * CHOLMOD factorizes A*A', so it calls COLAMD and CCOLAMD with A', * not A. Thus, this parameter affects the dense *row* control for * CHOLMOD's matrix, and the dense *column* control for COLAMD and * CCOLAMD. * * Removing dense rows and columns improves the run-time of the * ordering methods. It has some impact on ordering quality * (usually minimal, sometimes good, sometimes bad). * * Default: 10. */ double prune_dense2 ;/* dense row control for COLAMD and CCOLAMD. * Rows with more than MAX (16, dense2 * sqrt (n)) * for an m-by-n matrix are removed prior to ordering. CHOLMOD's * matrix is transposed before ordering it with COLAMD or CCOLAMD, * so this controls the dense *columns* of CHOLMOD's matrix, and * the dense *rows* of COLAMD's or CCOLAMD's matrix. * * If prune_dense2 < 0, only completely dense rows/cols are removed. * * Default: -1. Note that this is not the default for COLAMD and * CCOLAMD. -1 is best for Cholesky. 10 is best for LU. */ double nd_oksep ; /* in NESDIS, when a node separator is computed, it * discarded if nsep >= nd_oksep*n, where nsep is * the number of nodes in the separator, and n is the size of the * graph being cut. Valid range is 0 to 1. If 1 or greater, the * separator is discarded if it consists of the entire graph. * Default: 1 */ double other_1 [4] ; /* future expansion */ size_t nd_small ; /* do not partition graphs with fewer nodes than * nd_small, in NESDIS. Default: 200 (same as * METIS) */ size_t other_2 [4] ; /* future expansion */ int aggressive ; /* Aggresive absorption in AMD, COLAMD, SYMAMD, * CCOLAMD, and CSYMAMD. Default: TRUE */ int order_for_lu ; /* CCOLAMD can be optimized to produce an ordering * for LU or Cholesky factorization. CHOLMOD only * performs a Cholesky factorization. However, you may wish to use * CHOLMOD as an interface for CCOLAMD but use it for your own LU * factorization. In this case, order_for_lu should be set to FALSE. * When factorizing in CHOLMOD itself, you should *** NEVER *** set * this parameter FALSE. Default: TRUE. */ int nd_compress ; /* If TRUE, compress the graph and subgraphs before * partitioning them in NESDIS. Default: TRUE */ int nd_camd ; /* If 1, follow the nested dissection ordering * with a constrained minimum degree ordering that * respects the partitioning just found (using CAMD). If 2, use * CSYMAMD instead. If you set nd_small very small, you may not need * this ordering, and can save time by setting it to zero (no * constrained minimum degree ordering). Default: 1. */ int nd_components ; /* The nested dissection ordering finds a node * separator that splits the graph into two parts, * which may be unconnected. If nd_components is TRUE, each of * these connected components is split independently. If FALSE, * each part is split as a whole, even if it consists of more than * one connected component. Default: FALSE */ /* fill-reducing ordering to use */ int ordering ; size_t other_3 [4] ; /* future expansion */ } method [CHOLMOD_MAXMETHODS + 1] ; int postorder ; /* If TRUE, cholmod_analyze follows the ordering with a * weighted postorder of the elimination tree. Improves * supernode amalgamation. Does not affect fundamental nnz(L) and * flop count. Default: TRUE. */ int default_nesdis ; /* Default: FALSE. If FALSE, then the default * ordering strategy (when Common->nmethods == 0) * is to try the given ordering (if present), AMD, and then METIS if AMD * reports high fill-in. If Common->default_nesdis is TRUE then NESDIS * is used instead in the default strategy. */ /* ---------------------------------------------------------------------- */ /* memory management, complex divide, and hypot function pointers moved */ /* ---------------------------------------------------------------------- */ /* Function pointers moved from here (in CHOLMOD 2.2.0) to SuiteSparse_config.[ch]. See CHOLMOD/Include/cholmod_back.h for a set of macros that can be #include'd or copied into your application to define these function pointers on any version of CHOLMOD. */ /* ---------------------------------------------------------------------- */ /* METIS workarounds */ /* ---------------------------------------------------------------------- */ /* These workarounds were put into place for METIS 4.0.1. They are safe to use with METIS 5.1.0, but they might not longer be necessary. */ double metis_memory ; /* This is a parameter for CHOLMOD's interface to * METIS, not a parameter to METIS itself. METIS * uses an amount of memory that is difficult to estimate precisely * beforehand. If it runs out of memory, it terminates your program. * All routines in CHOLMOD except for CHOLMOD's interface to METIS * return an error status and safely return to your program if they run * out of memory. To mitigate this problem, the CHOLMOD interface * can allocate a single block of memory equal in size to an empirical * upper bound of METIS's memory usage times the Common->metis_memory * parameter, and then immediately free it. It then calls METIS. If * this pre-allocation fails, it is possible that METIS will fail as * well, and so CHOLMOD returns with an out-of-memory condition without * calling METIS. * * METIS_NodeND (used in the CHOLMOD_METIS ordering option) with its * default parameter settings typically uses about (4*nz+40n+4096) * times sizeof(int) memory, where nz is equal to the number of entries * in A for the symmetric case or AA' if an unsymmetric matrix is * being ordered (where nz includes both the upper and lower parts * of A or AA'). The observed "upper bound" (with 2 exceptions), * measured in an instrumented copy of METIS 4.0.1 on thousands of * matrices, is (10*nz+50*n+4096) * sizeof(int). Two large matrices * exceeded this bound, one by almost a factor of 2 (Gupta/gupta2). * * If your program is terminated by METIS, try setting metis_memory to * 2.0, or even higher if needed. By default, CHOLMOD assumes that METIS * does not have this problem (so that CHOLMOD will work correctly when * this issue is fixed in METIS). Thus, the default value is zero. * This work-around is not guaranteed anyway. * * If a matrix exceeds this predicted memory usage, AMD is attempted * instead. It, too, may run out of memory, but if it does so it will * not terminate your program. */ double metis_dswitch ; /* METIS_NodeND in METIS 4.0.1 gives a seg */ size_t metis_nswitch ; /* fault with one matrix of order n = 3005 and * nz = 6,036,025. This is a very dense graph. * The workaround is to use AMD instead of METIS for matrices of dimension * greater than Common->metis_nswitch (default 3000) or more and with * density of Common->metis_dswitch (default 0.66) or more. * cholmod_nested_dissection has no problems with the same matrix, even * though it uses METIS_ComputeVertexSeparator on this matrix. If this * seg fault does not affect you, set metis_nswitch to zero or less, * and CHOLMOD will not switch to AMD based just on the density of the * matrix (it will still switch to AMD if the metis_memory parameter * causes the switch). */ /* ---------------------------------------------------------------------- */ /* workspace */ /* ---------------------------------------------------------------------- */ /* CHOLMOD has several routines that take less time than the size of * workspace they require. Allocating and initializing the workspace would * dominate the run time, unless workspace is allocated and initialized * just once. CHOLMOD allocates this space when needed, and holds it here * between calls to CHOLMOD. cholmod_start sets these pointers to NULL * (which is why it must be the first routine called in CHOLMOD). * cholmod_finish frees the workspace (which is why it must be the last * call to CHOLMOD). */ size_t nrow ; /* size of Flag and Head */ SuiteSparse_long mark ; /* mark value for Flag array */ size_t iworksize ; /* size of Iwork. Upper bound: 6*nrow+ncol */ size_t xworksize ; /* size of Xwork, in bytes. * maxrank*nrow*sizeof(double) for update/downdate. * 2*nrow*sizeof(double) otherwise */ /* initialized workspace: contents needed between calls to CHOLMOD */ void *Flag ; /* size nrow, an integer array. Kept cleared between * calls to cholmod rouines (Flag [i] < mark) */ void *Head ; /* size nrow+1, an integer array. Kept cleared between * calls to cholmod routines (Head [i] = EMPTY) */ void *Xwork ; /* a double array. Its size varies. It is nrow for * most routines (cholmod_rowfac, cholmod_add, * cholmod_aat, cholmod_norm, cholmod_ssmult) for the real case, twice * that when the input matrices are complex or zomplex. It is of size * 2*nrow for cholmod_rowadd and cholmod_rowdel. For cholmod_updown, * its size is maxrank*nrow where maxrank is 2, 4, or 8. Kept cleared * between calls to cholmod (set to zero). */ /* uninitialized workspace, contents not needed between calls to CHOLMOD */ void *Iwork ; /* size iworksize, 2*nrow+ncol for most routines, * up to 6*nrow+ncol for cholmod_analyze. */ int itype ; /* If CHOLMOD_LONG, Flag, Head, and Iwork are * SuiteSparse_long. Otherwise all three are int. */ int dtype ; /* double or float */ /* Common->itype and Common->dtype are used to define the types of all * sparse matrices, triplet matrices, dense matrices, and factors * created using this Common struct. The itypes and dtypes of all * parameters to all CHOLMOD routines must match. */ int no_workspace_reallocate ; /* this is an internal flag, used as a * precaution by cholmod_analyze. It is normally false. If true, * cholmod_allocate_work is not allowed to reallocate any workspace; * they must use the existing workspace in Common (Iwork, Flag, Head, * and Xwork). Added for CHOLMOD v1.1 */ /* ---------------------------------------------------------------------- */ /* statistics */ /* ---------------------------------------------------------------------- */ /* fl and lnz are set only in cholmod_analyze and cholmod_rowcolcounts, * in the Cholesky modudle. modfl is set only in the Modify module. */ int status ; /* error code */ double fl ; /* LL' flop count from most recent analysis */ double lnz ; /* fundamental nz in L */ double anz ; /* nonzeros in tril(A) if A is symmetric/lower, * triu(A) if symmetric/upper, or tril(A*A') if * unsymmetric, in last call to cholmod_analyze. */ double modfl ; /* flop count from most recent update/downdate/ * rowadd/rowdel (excluding flops to modify the * solution to Lx=b, if computed) */ size_t malloc_count ; /* # of objects malloc'ed minus the # free'd*/ size_t memory_usage ; /* peak memory usage in bytes */ size_t memory_inuse ; /* current memory usage in bytes */ double nrealloc_col ; /* # of column reallocations */ double nrealloc_factor ;/* # of factor reallocations due to col. reallocs */ double ndbounds_hit ; /* # of times diagonal modified by dbound */ double rowfacfl ; /* # of flops in last call to cholmod_rowfac */ double aatfl ; /* # of flops to compute A(:,f)*A(:,f)' */ int called_nd ; /* TRUE if the last call to * cholmod_analyze called NESDIS or METIS. */ int blas_ok ; /* FALSE if BLAS int overflow; TRUE otherwise */ /* ---------------------------------------------------------------------- */ /* SuiteSparseQR control parameters: */ /* ---------------------------------------------------------------------- */ double SPQR_grain ; /* task size is >= max (total flops / grain) */ double SPQR_small ; /* task size is >= small */ int SPQR_shrink ; /* controls stack realloc method */ int SPQR_nthreads ; /* number of TBB threads, 0 = auto */ /* ---------------------------------------------------------------------- */ /* SuiteSparseQR statistics */ /* ---------------------------------------------------------------------- */ /* was other1 [0:3] */ double SPQR_flopcount ; /* flop count for SPQR */ double SPQR_analyze_time ; /* analysis time in seconds for SPQR */ double SPQR_factorize_time ; /* factorize time in seconds for SPQR */ double SPQR_solve_time ; /* backsolve time in seconds */ /* was SPQR_xstat [0:3] */ double SPQR_flopcount_bound ; /* upper bound on flop count */ double SPQR_tol_used ; /* tolerance used */ double SPQR_norm_E_fro ; /* Frobenius norm of dropped entries */ /* was SPQR_istat [0:9] */ SuiteSparse_long SPQR_istat [10] ; /* ---------------------------------------------------------------------- */ /* GPU configuration and statistics */ /* ---------------------------------------------------------------------- */ /* useGPU: 1 if gpu-acceleration is requested */ /* 0 if gpu-acceleration is prohibited */ /* -1 if gpu-acceleration is undefined in which case the */ /* environment CHOLMOD_USE_GPU will be queried and used. */ /* useGPU=-1 is only used by CHOLMOD and treated as 0 by SPQR */ int useGPU; /* for CHOLMOD: */ size_t maxGpuMemBytes; double maxGpuMemFraction; /* for SPQR: */ size_t gpuMemorySize; /* Amount of memory in bytes on the GPU */ double gpuKernelTime; /* Time taken by GPU kernels */ SuiteSparse_long gpuFlops; /* Number of flops performed by the GPU */ int gpuNumKernelLaunches; /* Number of GPU kernel launches */ /* If not using the GPU, these items are not used, but they should be present so that the CHOLMOD Common has the same size whether the GPU is used or not. This way, all packages will agree on the size of the CHOLMOD Common, regardless of whether or not they are compiled with the GPU libraries or not */ #ifdef GPU_BLAS /* in CUDA, these three types are pointers */ #define CHOLMOD_CUBLAS_HANDLE cublasHandle_t #define CHOLMOD_CUDASTREAM cudaStream_t #define CHOLMOD_CUDAEVENT cudaEvent_t #else /* ... so make them void * pointers if the GPU is not being used */ #define CHOLMOD_CUBLAS_HANDLE void * #define CHOLMOD_CUDASTREAM void * #define CHOLMOD_CUDAEVENT void * #endif CHOLMOD_CUBLAS_HANDLE cublasHandle ; /* a set of streams for general use */ CHOLMOD_CUDASTREAM gpuStream[CHOLMOD_HOST_SUPERNODE_BUFFERS]; CHOLMOD_CUDAEVENT cublasEventPotrf [3] ; CHOLMOD_CUDAEVENT updateCKernelsComplete; CHOLMOD_CUDAEVENT updateCBuffersFree[CHOLMOD_HOST_SUPERNODE_BUFFERS]; void *dev_mempool; /* pointer to single allocation of device memory */ size_t dev_mempool_size; void *host_pinned_mempool; /* pointer to single allocation of pinned mem */ size_t host_pinned_mempool_size; size_t devBuffSize; int ibuffer; double syrkStart ; /* time syrk started */ /* run times of the different parts of CHOLMOD (GPU and CPU) */ double cholmod_cpu_gemm_time ; double cholmod_cpu_syrk_time ; double cholmod_cpu_trsm_time ; double cholmod_cpu_potrf_time ; double cholmod_gpu_gemm_time ; double cholmod_gpu_syrk_time ; double cholmod_gpu_trsm_time ; double cholmod_gpu_potrf_time ; double cholmod_assemble_time ; double cholmod_assemble_time2 ; /* number of times the BLAS are called on the CPU and the GPU */ size_t cholmod_cpu_gemm_calls ; size_t cholmod_cpu_syrk_calls ; size_t cholmod_cpu_trsm_calls ; size_t cholmod_cpu_potrf_calls ; size_t cholmod_gpu_gemm_calls ; size_t cholmod_gpu_syrk_calls ; size_t cholmod_gpu_trsm_calls ; size_t cholmod_gpu_potrf_calls ; } cholmod_common ; /* size_t BLAS statistcs in Common: */ #define CHOLMOD_CPU_GEMM_CALLS cholmod_cpu_gemm_calls #define CHOLMOD_CPU_SYRK_CALLS cholmod_cpu_syrk_calls #define CHOLMOD_CPU_TRSM_CALLS cholmod_cpu_trsm_calls #define CHOLMOD_CPU_POTRF_CALLS cholmod_cpu_potrf_calls #define CHOLMOD_GPU_GEMM_CALLS cholmod_gpu_gemm_calls #define CHOLMOD_GPU_SYRK_CALLS cholmod_gpu_syrk_calls #define CHOLMOD_GPU_TRSM_CALLS cholmod_gpu_trsm_calls #define CHOLMOD_GPU_POTRF_CALLS cholmod_gpu_potrf_calls /* double BLAS statistics in Common: */ #define CHOLMOD_CPU_GEMM_TIME cholmod_cpu_gemm_time #define CHOLMOD_CPU_SYRK_TIME cholmod_cpu_syrk_time #define CHOLMOD_CPU_TRSM_TIME cholmod_cpu_trsm_time #define CHOLMOD_CPU_POTRF_TIME cholmod_cpu_potrf_time #define CHOLMOD_GPU_GEMM_TIME cholmod_gpu_gemm_time #define CHOLMOD_GPU_SYRK_TIME cholmod_gpu_syrk_time #define CHOLMOD_GPU_TRSM_TIME cholmod_gpu_trsm_time #define CHOLMOD_GPU_POTRF_TIME cholmod_gpu_potrf_time #define CHOLMOD_ASSEMBLE_TIME cholmod_assemble_time #define CHOLMOD_ASSEMBLE_TIME2 cholmod_assemble_time2 /* for supernodal analysis */ #define CHOLMOD_ANALYZE_FOR_SPQR 0 #define CHOLMOD_ANALYZE_FOR_CHOLESKY 1 #define CHOLMOD_ANALYZE_FOR_SPQRGPU 2 /* -------------------------------------------------------------------------- */ /* cholmod_start: first call to CHOLMOD */ /* -------------------------------------------------------------------------- */ int cholmod_start ( cholmod_common *Common ) ; int cholmod_l_start (cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_finish: last call to CHOLMOD */ /* -------------------------------------------------------------------------- */ int cholmod_finish ( cholmod_common *Common ) ; int cholmod_l_finish (cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_defaults: restore default parameters */ /* -------------------------------------------------------------------------- */ int cholmod_defaults ( cholmod_common *Common ) ; int cholmod_l_defaults (cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_maxrank: return valid maximum rank for update/downdate */ /* -------------------------------------------------------------------------- */ size_t cholmod_maxrank /* returns validated value of Common->maxrank */ ( /* ---- input ---- */ size_t n, /* A and L will have n rows */ /* --------------- */ cholmod_common *Common ) ; size_t cholmod_l_maxrank (size_t, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_allocate_work: allocate workspace in Common */ /* -------------------------------------------------------------------------- */ int cholmod_allocate_work ( /* ---- input ---- */ size_t nrow, /* size: Common->Flag (nrow), Common->Head (nrow+1) */ size_t iworksize, /* size of Common->Iwork */ size_t xworksize, /* size of Common->Xwork */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_allocate_work (size_t, size_t, size_t, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_free_work: free workspace in Common */ /* -------------------------------------------------------------------------- */ int cholmod_free_work ( cholmod_common *Common ) ; int cholmod_l_free_work (cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_clear_flag: clear Flag workspace in Common */ /* -------------------------------------------------------------------------- */ /* use a macro for speed */ #define CHOLMOD_CLEAR_FLAG(Common) \ { \ Common->mark++ ; \ if (Common->mark <= 0) \ { \ Common->mark = EMPTY ; \ CHOLMOD (clear_flag) (Common) ; \ } \ } SuiteSparse_long cholmod_clear_flag ( cholmod_common *Common ) ; SuiteSparse_long cholmod_l_clear_flag (cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_error: called when CHOLMOD encounters an error */ /* -------------------------------------------------------------------------- */ int cholmod_error ( /* ---- input ---- */ int status, /* error status */ const char *file, /* name of source code file where error occured */ int line, /* line number in source code file where error occured*/ const char *message,/* error message */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_error (int, const char *, int, const char *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_dbound: for internal use in CHOLMOD only */ /* -------------------------------------------------------------------------- */ double cholmod_dbound /* returns modified diagonal entry of D or L */ ( /* ---- input ---- */ double dj, /* diagonal entry of D for LDL' or L for LL' */ /* --------------- */ cholmod_common *Common ) ; double cholmod_l_dbound (double, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_hypot: compute sqrt (x*x + y*y) accurately */ /* -------------------------------------------------------------------------- */ double cholmod_hypot ( /* ---- input ---- */ double x, double y ) ; double cholmod_l_hypot (double, double) ; /* -------------------------------------------------------------------------- */ /* cholmod_divcomplex: complex division, c = a/b */ /* -------------------------------------------------------------------------- */ int cholmod_divcomplex /* return 1 if divide-by-zero, 0 otherise */ ( /* ---- input ---- */ double ar, double ai, /* real and imaginary parts of a */ double br, double bi, /* real and imaginary parts of b */ /* ---- output --- */ double *cr, double *ci /* real and imaginary parts of c */ ) ; int cholmod_l_divcomplex (double, double, double, double, double *, double *) ; /* ========================================================================== */ /* === Core/cholmod_sparse ================================================== */ /* ========================================================================== */ /* A sparse matrix stored in compressed-column form. */ typedef struct cholmod_sparse_struct { size_t nrow ; /* the matrix is nrow-by-ncol */ size_t ncol ; size_t nzmax ; /* maximum number of entries in the matrix */ /* pointers to int or SuiteSparse_long: */ void *p ; /* p [0..ncol], the column pointers */ void *i ; /* i [0..nzmax-1], the row indices */ /* for unpacked matrices only: */ void *nz ; /* nz [0..ncol-1], the # of nonzeros in each col. In * packed form, the nonzero pattern of column j is in * A->i [A->p [j] ... A->p [j+1]-1]. In unpacked form, column j is in * A->i [A->p [j] ... A->p [j]+A->nz[j]-1] instead. In both cases, the * numerical values (if present) are in the corresponding locations in * the array x (or z if A->xtype is CHOLMOD_ZOMPLEX). */ /* pointers to double or float: */ void *x ; /* size nzmax or 2*nzmax, if present */ void *z ; /* size nzmax, if present */ int stype ; /* Describes what parts of the matrix are considered: * * 0: matrix is "unsymmetric": use both upper and lower triangular parts * (the matrix may actually be symmetric in pattern and value, but * both parts are explicitly stored and used). May be square or * rectangular. * >0: matrix is square and symmetric, use upper triangular part. * Entries in the lower triangular part are ignored. * <0: matrix is square and symmetric, use lower triangular part. * Entries in the upper triangular part are ignored. * * Note that stype>0 and stype<0 are different for cholmod_sparse and * cholmod_triplet. See the cholmod_triplet data structure for more * details. */ int itype ; /* CHOLMOD_INT: p, i, and nz are int. * CHOLMOD_INTLONG: p is SuiteSparse_long, * i and nz are int. * CHOLMOD_LONG: p, i, and nz are SuiteSparse_long */ int xtype ; /* pattern, real, complex, or zomplex */ int dtype ; /* x and z are double or float */ int sorted ; /* TRUE if columns are sorted, FALSE otherwise */ int packed ; /* TRUE if packed (nz ignored), FALSE if unpacked * (nz is required) */ } cholmod_sparse ; typedef struct cholmod_descendant_score_t { double score; SuiteSparse_long d; } descendantScore; /* For sorting descendant supernodes with qsort */ int cholmod_score_comp (struct cholmod_descendant_score_t *i, struct cholmod_descendant_score_t *j); int cholmod_l_score_comp (struct cholmod_descendant_score_t *i, struct cholmod_descendant_score_t *j); /* -------------------------------------------------------------------------- */ /* cholmod_allocate_sparse: allocate a sparse matrix */ /* -------------------------------------------------------------------------- */ cholmod_sparse *cholmod_allocate_sparse ( /* ---- input ---- */ size_t nrow, /* # of rows of A */ size_t ncol, /* # of columns of A */ size_t nzmax, /* max # of nonzeros of A */ int sorted, /* TRUE if columns of A sorted, FALSE otherwise */ int packed, /* TRUE if A will be packed, FALSE otherwise */ int stype, /* stype of A */ int xtype, /* CHOLMOD_PATTERN, _REAL, _COMPLEX, or _ZOMPLEX */ /* --------------- */ cholmod_common *Common ) ; cholmod_sparse *cholmod_l_allocate_sparse (size_t, size_t, size_t, int, int, int, int, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_free_sparse: free a sparse matrix */ /* -------------------------------------------------------------------------- */ int cholmod_free_sparse ( /* ---- in/out --- */ cholmod_sparse **A, /* matrix to deallocate, NULL on output */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_free_sparse (cholmod_sparse **, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_reallocate_sparse: change the size (# entries) of sparse matrix */ /* -------------------------------------------------------------------------- */ int cholmod_reallocate_sparse ( /* ---- input ---- */ size_t nznew, /* new # of entries in A */ /* ---- in/out --- */ cholmod_sparse *A, /* matrix to reallocate */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_reallocate_sparse ( size_t, cholmod_sparse *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_nnz: return number of nonzeros in a sparse matrix */ /* -------------------------------------------------------------------------- */ SuiteSparse_long cholmod_nnz ( /* ---- input ---- */ cholmod_sparse *A, /* --------------- */ cholmod_common *Common ) ; SuiteSparse_long cholmod_l_nnz (cholmod_sparse *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_speye: sparse identity matrix */ /* -------------------------------------------------------------------------- */ cholmod_sparse *cholmod_speye ( /* ---- input ---- */ size_t nrow, /* # of rows of A */ size_t ncol, /* # of columns of A */ int xtype, /* CHOLMOD_PATTERN, _REAL, _COMPLEX, or _ZOMPLEX */ /* --------------- */ cholmod_common *Common ) ; cholmod_sparse *cholmod_l_speye (size_t, size_t, int, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_spzeros: sparse zero matrix */ /* -------------------------------------------------------------------------- */ cholmod_sparse *cholmod_spzeros ( /* ---- input ---- */ size_t nrow, /* # of rows of A */ size_t ncol, /* # of columns of A */ size_t nzmax, /* max # of nonzeros of A */ int xtype, /* CHOLMOD_PATTERN, _REAL, _COMPLEX, or _ZOMPLEX */ /* --------------- */ cholmod_common *Common ) ; cholmod_sparse *cholmod_l_spzeros (size_t, size_t, size_t, int, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_transpose: transpose a sparse matrix */ /* -------------------------------------------------------------------------- */ /* Return A' or A.' The "values" parameter is 0, 1, or 2 to denote the pattern * transpose, the array transpose (A.'), and the complex conjugate transpose * (A'). */ cholmod_sparse *cholmod_transpose ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to transpose */ int values, /* 0: pattern, 1: array transpose, 2: conj. transpose */ /* --------------- */ cholmod_common *Common ) ; cholmod_sparse *cholmod_l_transpose (cholmod_sparse *, int, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_transpose_unsym: transpose an unsymmetric sparse matrix */ /* -------------------------------------------------------------------------- */ /* Compute F = A', A (:,f)', or A (p,f)', where A is unsymmetric and F is * already allocated. See cholmod_transpose for a simpler routine. */ int cholmod_transpose_unsym ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to transpose */ int values, /* 0: pattern, 1: array transpose, 2: conj. transpose */ int *Perm, /* size nrow, if present (can be NULL) */ int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ /* ---- output --- */ cholmod_sparse *F, /* F = A', A(:,f)', or A(p,f)' */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_transpose_unsym (cholmod_sparse *, int, SuiteSparse_long *, SuiteSparse_long *, size_t, cholmod_sparse *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_transpose_sym: transpose a symmetric sparse matrix */ /* -------------------------------------------------------------------------- */ /* Compute F = A' or A (p,p)', where A is symmetric and F is already allocated. * See cholmod_transpose for a simpler routine. */ int cholmod_transpose_sym ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to transpose */ int values, /* 0: pattern, 1: array transpose, 2: conj. transpose */ int *Perm, /* size nrow, if present (can be NULL) */ /* ---- output --- */ cholmod_sparse *F, /* F = A' or A(p,p)' */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_transpose_sym (cholmod_sparse *, int, SuiteSparse_long *, cholmod_sparse *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_ptranspose: transpose a sparse matrix */ /* -------------------------------------------------------------------------- */ /* Return A' or A(p,p)' if A is symmetric. Return A', A(:,f)', or A(p,f)' if * A is unsymmetric. */ cholmod_sparse *cholmod_ptranspose ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to transpose */ int values, /* 0: pattern, 1: array transpose, 2: conj. transpose */ int *Perm, /* if non-NULL, F = A(p,f) or A(p,p) */ int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ /* --------------- */ cholmod_common *Common ) ; cholmod_sparse *cholmod_l_ptranspose (cholmod_sparse *, int, SuiteSparse_long *, SuiteSparse_long *, size_t, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_sort: sort row indices in each column of sparse matrix */ /* -------------------------------------------------------------------------- */ int cholmod_sort ( /* ---- in/out --- */ cholmod_sparse *A, /* matrix to sort */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_sort (cholmod_sparse *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_band: C = tril (triu (A,k1), k2) */ /* -------------------------------------------------------------------------- */ cholmod_sparse *cholmod_band ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to extract band matrix from */ SuiteSparse_long k1, /* ignore entries below the k1-st diagonal */ SuiteSparse_long k2, /* ignore entries above the k2-nd diagonal */ int mode, /* >0: numerical, 0: pattern, <0: pattern (no diag) */ /* --------------- */ cholmod_common *Common ) ; cholmod_sparse *cholmod_l_band (cholmod_sparse *, SuiteSparse_long, SuiteSparse_long, int, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_band_inplace: A = tril (triu (A,k1), k2) */ /* -------------------------------------------------------------------------- */ int cholmod_band_inplace ( /* ---- input ---- */ SuiteSparse_long k1, /* ignore entries below the k1-st diagonal */ SuiteSparse_long k2, /* ignore entries above the k2-nd diagonal */ int mode, /* >0: numerical, 0: pattern, <0: pattern (no diag) */ /* ---- in/out --- */ cholmod_sparse *A, /* matrix from which entries not in band are removed */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_band_inplace (SuiteSparse_long, SuiteSparse_long, int, cholmod_sparse *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_aat: C = A*A' or A(:,f)*A(:,f)' */ /* -------------------------------------------------------------------------- */ cholmod_sparse *cholmod_aat ( /* ---- input ---- */ cholmod_sparse *A, /* input matrix; C=A*A' is constructed */ int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ int mode, /* >0: numerical, 0: pattern, <0: pattern (no diag), * -2: pattern only, no diagonal, add 50%+n extra * space to C */ /* --------------- */ cholmod_common *Common ) ; cholmod_sparse *cholmod_l_aat (cholmod_sparse *, SuiteSparse_long *, size_t, int, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_copy_sparse: C = A, create an exact copy of a sparse matrix */ /* -------------------------------------------------------------------------- */ cholmod_sparse *cholmod_copy_sparse ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to copy */ /* --------------- */ cholmod_common *Common ) ; cholmod_sparse *cholmod_l_copy_sparse (cholmod_sparse *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_copy: C = A, with possible change of stype */ /* -------------------------------------------------------------------------- */ cholmod_sparse *cholmod_copy ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to copy */ int stype, /* requested stype of C */ int mode, /* >0: numerical, 0: pattern, <0: pattern (no diag) */ /* --------------- */ cholmod_common *Common ) ; cholmod_sparse *cholmod_l_copy (cholmod_sparse *, int, int, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_add: C = alpha*A + beta*B */ /* -------------------------------------------------------------------------- */ cholmod_sparse *cholmod_add ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to add */ cholmod_sparse *B, /* matrix to add */ double alpha [2], /* scale factor for A */ double beta [2], /* scale factor for B */ int values, /* if TRUE compute the numerical values of C */ int sorted, /* if TRUE, sort columns of C */ /* --------------- */ cholmod_common *Common ) ; cholmod_sparse *cholmod_l_add (cholmod_sparse *, cholmod_sparse *, double *, double *, int, int, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_sparse_xtype: change the xtype of a sparse matrix */ /* -------------------------------------------------------------------------- */ int cholmod_sparse_xtype ( /* ---- input ---- */ int to_xtype, /* requested xtype (pattern, real, complex, zomplex) */ /* ---- in/out --- */ cholmod_sparse *A, /* sparse matrix to change */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_sparse_xtype (int, cholmod_sparse *, cholmod_common *) ; /* ========================================================================== */ /* === Core/cholmod_factor ================================================== */ /* ========================================================================== */ /* A symbolic and numeric factorization, either simplicial or supernodal. * In all cases, the row indices in the columns of L are kept sorted. */ typedef struct cholmod_factor_struct { /* ---------------------------------------------------------------------- */ /* for both simplicial and supernodal factorizations */ /* ---------------------------------------------------------------------- */ size_t n ; /* L is n-by-n */ size_t minor ; /* If the factorization failed, L->minor is the column * at which it failed (in the range 0 to n-1). A value * of n means the factorization was successful or * the matrix has not yet been factorized. */ /* ---------------------------------------------------------------------- */ /* symbolic ordering and analysis */ /* ---------------------------------------------------------------------- */ void *Perm ; /* size n, permutation used */ void *ColCount ; /* size n, column counts for simplicial L */ void *IPerm ; /* size n, inverse permutation. Only created by * cholmod_solve2 if Bset is used. */ /* ---------------------------------------------------------------------- */ /* simplicial factorization */ /* ---------------------------------------------------------------------- */ size_t nzmax ; /* size of i and x */ void *p ; /* p [0..ncol], the column pointers */ void *i ; /* i [0..nzmax-1], the row indices */ void *x ; /* x [0..nzmax-1], the numerical values */ void *z ; void *nz ; /* nz [0..ncol-1], the # of nonzeros in each column. * i [p [j] ... p [j]+nz[j]-1] contains the row indices, * and the numerical values are in the same locatins * in x. The value of i [p [k]] is always k. */ void *next ; /* size ncol+2. next [j] is the next column in i/x */ void *prev ; /* size ncol+2. prev [j] is the prior column in i/x. * head of the list is ncol+1, and the tail is ncol. */ /* ---------------------------------------------------------------------- */ /* supernodal factorization */ /* ---------------------------------------------------------------------- */ /* Note that L->x is shared with the simplicial data structure. L->x has * size L->nzmax for a simplicial factor, and size L->xsize for a supernodal * factor. */ size_t nsuper ; /* number of supernodes */ size_t ssize ; /* size of s, integer part of supernodes */ size_t xsize ; /* size of x, real part of supernodes */ size_t maxcsize ; /* size of largest update matrix */ size_t maxesize ; /* max # of rows in supernodes, excl. triangular part */ void *super ; /* size nsuper+1, first col in each supernode */ void *pi ; /* size nsuper+1, pointers to integer patterns */ void *px ; /* size nsuper+1, pointers to real parts */ void *s ; /* size ssize, integer part of supernodes */ /* ---------------------------------------------------------------------- */ /* factorization type */ /* ---------------------------------------------------------------------- */ int ordering ; /* ordering method used */ int is_ll ; /* TRUE if LL', FALSE if LDL' */ int is_super ; /* TRUE if supernodal, FALSE if simplicial */ int is_monotonic ; /* TRUE if columns of L appear in order 0..n-1. * Only applicable to simplicial numeric types. */ /* There are 8 types of factor objects that cholmod_factor can represent * (only 6 are used): * * Numeric types (xtype is not CHOLMOD_PATTERN) * -------------------------------------------- * * simplicial LDL': (is_ll FALSE, is_super FALSE). Stored in compressed * column form, using the simplicial components above (nzmax, p, i, * x, z, nz, next, and prev). The unit diagonal of L is not stored, * and D is stored in its place. There are no supernodes. * * simplicial LL': (is_ll TRUE, is_super FALSE). Uses the same storage * scheme as the simplicial LDL', except that D does not appear. * The first entry of each column of L is the diagonal entry of * that column of L. * * supernodal LDL': (is_ll FALSE, is_super TRUE). Not used. * FUTURE WORK: add support for supernodal LDL' * * supernodal LL': (is_ll TRUE, is_super TRUE). A supernodal factor, * using the supernodal components described above (nsuper, ssize, * xsize, maxcsize, maxesize, super, pi, px, s, x, and z). * * * Symbolic types (xtype is CHOLMOD_PATTERN) * ----------------------------------------- * * simplicial LDL': (is_ll FALSE, is_super FALSE). Nothing is present * except Perm and ColCount. * * simplicial LL': (is_ll TRUE, is_super FALSE). Identical to the * simplicial LDL', except for the is_ll flag. * * supernodal LDL': (is_ll FALSE, is_super TRUE). Not used. * FUTURE WORK: add support for supernodal LDL' * * supernodal LL': (is_ll TRUE, is_super TRUE). A supernodal symbolic * factorization. The simplicial symbolic information is present * (Perm and ColCount), as is all of the supernodal factorization * except for the numerical values (x and z). */ int itype ; /* The integer arrays are Perm, ColCount, p, i, nz, * next, prev, super, pi, px, and s. If itype is * CHOLMOD_INT, all of these are int arrays. * CHOLMOD_INTLONG: p, pi, px are SuiteSparse_long, others int. * CHOLMOD_LONG: all integer arrays are SuiteSparse_long. */ int xtype ; /* pattern, real, complex, or zomplex */ int dtype ; /* x and z double or float */ int useGPU; /* Indicates the symbolic factorization supports * GPU acceleration */ } cholmod_factor ; /* -------------------------------------------------------------------------- */ /* cholmod_allocate_factor: allocate a factor (symbolic LL' or LDL') */ /* -------------------------------------------------------------------------- */ cholmod_factor *cholmod_allocate_factor ( /* ---- input ---- */ size_t n, /* L is n-by-n */ /* --------------- */ cholmod_common *Common ) ; cholmod_factor *cholmod_l_allocate_factor (size_t, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_free_factor: free a factor */ /* -------------------------------------------------------------------------- */ int cholmod_free_factor ( /* ---- in/out --- */ cholmod_factor **L, /* factor to free, NULL on output */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_free_factor (cholmod_factor **, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_reallocate_factor: change the # entries in a factor */ /* -------------------------------------------------------------------------- */ int cholmod_reallocate_factor ( /* ---- input ---- */ size_t nznew, /* new # of entries in L */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_reallocate_factor (size_t, cholmod_factor *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_change_factor: change the type of factor (e.g., LDL' to LL') */ /* -------------------------------------------------------------------------- */ int cholmod_change_factor ( /* ---- input ---- */ int to_xtype, /* to CHOLMOD_PATTERN, _REAL, _COMPLEX, _ZOMPLEX */ int to_ll, /* TRUE: convert to LL', FALSE: LDL' */ int to_super, /* TRUE: convert to supernodal, FALSE: simplicial */ int to_packed, /* TRUE: pack simplicial columns, FALSE: do not pack */ int to_monotonic, /* TRUE: put simplicial columns in order, FALSE: not */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_change_factor ( int, int, int, int, int, cholmod_factor *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_pack_factor: pack the columns of a factor */ /* -------------------------------------------------------------------------- */ /* Pack the columns of a simplicial factor. Unlike cholmod_change_factor, * it can pack the columns of a factor even if they are not stored in their * natural order (non-monotonic). */ int cholmod_pack_factor ( /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_pack_factor (cholmod_factor *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_reallocate_column: resize a single column of a factor */ /* -------------------------------------------------------------------------- */ int cholmod_reallocate_column ( /* ---- input ---- */ size_t j, /* the column to reallocate */ size_t need, /* required size of column j */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_reallocate_column (size_t, size_t, cholmod_factor *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_factor_to_sparse: create a sparse matrix copy of a factor */ /* -------------------------------------------------------------------------- */ /* Only operates on numeric factors, not symbolic ones */ cholmod_sparse *cholmod_factor_to_sparse ( /* ---- in/out --- */ cholmod_factor *L, /* factor to copy, converted to symbolic on output */ /* --------------- */ cholmod_common *Common ) ; cholmod_sparse *cholmod_l_factor_to_sparse (cholmod_factor *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_copy_factor: create a copy of a factor */ /* -------------------------------------------------------------------------- */ cholmod_factor *cholmod_copy_factor ( /* ---- input ---- */ cholmod_factor *L, /* factor to copy */ /* --------------- */ cholmod_common *Common ) ; cholmod_factor *cholmod_l_copy_factor (cholmod_factor *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_factor_xtype: change the xtype of a factor */ /* -------------------------------------------------------------------------- */ int cholmod_factor_xtype ( /* ---- input ---- */ int to_xtype, /* requested xtype (real, complex, or zomplex) */ /* ---- in/out --- */ cholmod_factor *L, /* factor to change */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_factor_xtype (int, cholmod_factor *, cholmod_common *) ; /* ========================================================================== */ /* === Core/cholmod_dense =================================================== */ /* ========================================================================== */ /* A dense matrix in column-oriented form. It has no itype since it contains * no integers. Entry in row i and column j is located in x [i+j*d]. */ typedef struct cholmod_dense_struct { size_t nrow ; /* the matrix is nrow-by-ncol */ size_t ncol ; size_t nzmax ; /* maximum number of entries in the matrix */ size_t d ; /* leading dimension (d >= nrow must hold) */ void *x ; /* size nzmax or 2*nzmax, if present */ void *z ; /* size nzmax, if present */ int xtype ; /* pattern, real, complex, or zomplex */ int dtype ; /* x and z double or float */ } cholmod_dense ; /* -------------------------------------------------------------------------- */ /* cholmod_allocate_dense: allocate a dense matrix (contents uninitialized) */ /* -------------------------------------------------------------------------- */ cholmod_dense *cholmod_allocate_dense ( /* ---- input ---- */ size_t nrow, /* # of rows of matrix */ size_t ncol, /* # of columns of matrix */ size_t d, /* leading dimension */ int xtype, /* CHOLMOD_REAL, _COMPLEX, or _ZOMPLEX */ /* --------------- */ cholmod_common *Common ) ; cholmod_dense *cholmod_l_allocate_dense (size_t, size_t, size_t, int, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_zeros: allocate a dense matrix and set it to zero */ /* -------------------------------------------------------------------------- */ cholmod_dense *cholmod_zeros ( /* ---- input ---- */ size_t nrow, /* # of rows of matrix */ size_t ncol, /* # of columns of matrix */ int xtype, /* CHOLMOD_REAL, _COMPLEX, or _ZOMPLEX */ /* --------------- */ cholmod_common *Common ) ; cholmod_dense *cholmod_l_zeros (size_t, size_t, int, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_ones: allocate a dense matrix and set it to all ones */ /* -------------------------------------------------------------------------- */ cholmod_dense *cholmod_ones ( /* ---- input ---- */ size_t nrow, /* # of rows of matrix */ size_t ncol, /* # of columns of matrix */ int xtype, /* CHOLMOD_REAL, _COMPLEX, or _ZOMPLEX */ /* --------------- */ cholmod_common *Common ) ; cholmod_dense *cholmod_l_ones (size_t, size_t, int, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_eye: allocate a dense matrix and set it to the identity matrix */ /* -------------------------------------------------------------------------- */ cholmod_dense *cholmod_eye ( /* ---- input ---- */ size_t nrow, /* # of rows of matrix */ size_t ncol, /* # of columns of matrix */ int xtype, /* CHOLMOD_REAL, _COMPLEX, or _ZOMPLEX */ /* --------------- */ cholmod_common *Common ) ; cholmod_dense *cholmod_l_eye (size_t, size_t, int, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_free_dense: free a dense matrix */ /* -------------------------------------------------------------------------- */ int cholmod_free_dense ( /* ---- in/out --- */ cholmod_dense **X, /* dense matrix to deallocate, NULL on output */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_free_dense (cholmod_dense **, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_ensure_dense: ensure a dense matrix has a given size and type */ /* -------------------------------------------------------------------------- */ cholmod_dense *cholmod_ensure_dense ( /* ---- input/output ---- */ cholmod_dense **XHandle, /* matrix handle to check */ /* ---- input ---- */ size_t nrow, /* # of rows of matrix */ size_t ncol, /* # of columns of matrix */ size_t d, /* leading dimension */ int xtype, /* CHOLMOD_REAL, _COMPLEX, or _ZOMPLEX */ /* --------------- */ cholmod_common *Common ) ; cholmod_dense *cholmod_l_ensure_dense (cholmod_dense **, size_t, size_t, size_t, int, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_sparse_to_dense: create a dense matrix copy of a sparse matrix */ /* -------------------------------------------------------------------------- */ cholmod_dense *cholmod_sparse_to_dense ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to copy */ /* --------------- */ cholmod_common *Common ) ; cholmod_dense *cholmod_l_sparse_to_dense (cholmod_sparse *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_dense_to_sparse: create a sparse matrix copy of a dense matrix */ /* -------------------------------------------------------------------------- */ cholmod_sparse *cholmod_dense_to_sparse ( /* ---- input ---- */ cholmod_dense *X, /* matrix to copy */ int values, /* TRUE if values to be copied, FALSE otherwise */ /* --------------- */ cholmod_common *Common ) ; cholmod_sparse *cholmod_l_dense_to_sparse (cholmod_dense *, int, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_copy_dense: create a copy of a dense matrix */ /* -------------------------------------------------------------------------- */ cholmod_dense *cholmod_copy_dense ( /* ---- input ---- */ cholmod_dense *X, /* matrix to copy */ /* --------------- */ cholmod_common *Common ) ; cholmod_dense *cholmod_l_copy_dense (cholmod_dense *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_copy_dense2: copy a dense matrix (pre-allocated) */ /* -------------------------------------------------------------------------- */ int cholmod_copy_dense2 ( /* ---- input ---- */ cholmod_dense *X, /* matrix to copy */ /* ---- output --- */ cholmod_dense *Y, /* copy of matrix X */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_copy_dense2 (cholmod_dense *, cholmod_dense *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_dense_xtype: change the xtype of a dense matrix */ /* -------------------------------------------------------------------------- */ int cholmod_dense_xtype ( /* ---- input ---- */ int to_xtype, /* requested xtype (real, complex,or zomplex) */ /* ---- in/out --- */ cholmod_dense *X, /* dense matrix to change */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_dense_xtype (int, cholmod_dense *, cholmod_common *) ; /* ========================================================================== */ /* === Core/cholmod_triplet ================================================= */ /* ========================================================================== */ /* A sparse matrix stored in triplet form. */ typedef struct cholmod_triplet_struct { size_t nrow ; /* the matrix is nrow-by-ncol */ size_t ncol ; size_t nzmax ; /* maximum number of entries in the matrix */ size_t nnz ; /* number of nonzeros in the matrix */ void *i ; /* i [0..nzmax-1], the row indices */ void *j ; /* j [0..nzmax-1], the column indices */ void *x ; /* size nzmax or 2*nzmax, if present */ void *z ; /* size nzmax, if present */ int stype ; /* Describes what parts of the matrix are considered: * * 0: matrix is "unsymmetric": use both upper and lower triangular parts * (the matrix may actually be symmetric in pattern and value, but * both parts are explicitly stored and used). May be square or * rectangular. * >0: matrix is square and symmetric. Entries in the lower triangular * part are transposed and added to the upper triangular part when * the matrix is converted to cholmod_sparse form. * <0: matrix is square and symmetric. Entries in the upper triangular * part are transposed and added to the lower triangular part when * the matrix is converted to cholmod_sparse form. * * Note that stype>0 and stype<0 are different for cholmod_sparse and * cholmod_triplet. The reason is simple. You can permute a symmetric * triplet matrix by simply replacing a row and column index with their * new row and column indices, via an inverse permutation. Suppose * P = L->Perm is your permutation, and Pinv is an array of size n. * Suppose a symmetric matrix A is represent by a triplet matrix T, with * entries only in the upper triangular part. Then the following code: * * Ti = T->i ; * Tj = T->j ; * for (k = 0 ; k < n ; k++) Pinv [P [k]] = k ; * for (k = 0 ; k < nz ; k++) Ti [k] = Pinv [Ti [k]] ; * for (k = 0 ; k < nz ; k++) Tj [k] = Pinv [Tj [k]] ; * * creates the triplet form of C=P*A*P'. However, if T initially * contains just the upper triangular entries (T->stype = 1), after * permutation it has entries in both the upper and lower triangular * parts. These entries should be transposed when constructing the * cholmod_sparse form of A, which is what cholmod_triplet_to_sparse * does. Thus: * * C = cholmod_triplet_to_sparse (T, 0, &Common) ; * * will return the matrix C = P*A*P'. * * Since the triplet matrix T is so simple to generate, it's quite easy * to remove entries that you do not want, prior to converting T to the * cholmod_sparse form. So if you include these entries in T, CHOLMOD * assumes that there must be a reason (such as the one above). Thus, * no entry in a triplet matrix is ever ignored. */ int itype ; /* CHOLMOD_LONG: i and j are SuiteSparse_long. Otherwise int */ int xtype ; /* pattern, real, complex, or zomplex */ int dtype ; /* x and z are double or float */ } cholmod_triplet ; /* -------------------------------------------------------------------------- */ /* cholmod_allocate_triplet: allocate a triplet matrix */ /* -------------------------------------------------------------------------- */ cholmod_triplet *cholmod_allocate_triplet ( /* ---- input ---- */ size_t nrow, /* # of rows of T */ size_t ncol, /* # of columns of T */ size_t nzmax, /* max # of nonzeros of T */ int stype, /* stype of T */ int xtype, /* CHOLMOD_PATTERN, _REAL, _COMPLEX, or _ZOMPLEX */ /* --------------- */ cholmod_common *Common ) ; cholmod_triplet *cholmod_l_allocate_triplet (size_t, size_t, size_t, int, int, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_free_triplet: free a triplet matrix */ /* -------------------------------------------------------------------------- */ int cholmod_free_triplet ( /* ---- in/out --- */ cholmod_triplet **T, /* triplet matrix to deallocate, NULL on output */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_free_triplet (cholmod_triplet **, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_reallocate_triplet: change the # of entries in a triplet matrix */ /* -------------------------------------------------------------------------- */ int cholmod_reallocate_triplet ( /* ---- input ---- */ size_t nznew, /* new # of entries in T */ /* ---- in/out --- */ cholmod_triplet *T, /* triplet matrix to modify */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_reallocate_triplet (size_t, cholmod_triplet *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_sparse_to_triplet: create a triplet matrix copy of a sparse matrix*/ /* -------------------------------------------------------------------------- */ cholmod_triplet *cholmod_sparse_to_triplet ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to copy */ /* --------------- */ cholmod_common *Common ) ; cholmod_triplet *cholmod_l_sparse_to_triplet (cholmod_sparse *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_triplet_to_sparse: create a sparse matrix copy of a triplet matrix*/ /* -------------------------------------------------------------------------- */ cholmod_sparse *cholmod_triplet_to_sparse ( /* ---- input ---- */ cholmod_triplet *T, /* matrix to copy */ size_t nzmax, /* allocate at least this much space in output matrix */ /* --------------- */ cholmod_common *Common ) ; cholmod_sparse *cholmod_l_triplet_to_sparse (cholmod_triplet *, size_t, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_copy_triplet: create a copy of a triplet matrix */ /* -------------------------------------------------------------------------- */ cholmod_triplet *cholmod_copy_triplet ( /* ---- input ---- */ cholmod_triplet *T, /* matrix to copy */ /* --------------- */ cholmod_common *Common ) ; cholmod_triplet *cholmod_l_copy_triplet (cholmod_triplet *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_triplet_xtype: change the xtype of a triplet matrix */ /* -------------------------------------------------------------------------- */ int cholmod_triplet_xtype ( /* ---- input ---- */ int to_xtype, /* requested xtype (pattern, real, complex,or zomplex)*/ /* ---- in/out --- */ cholmod_triplet *T, /* triplet matrix to change */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_triplet_xtype (int, cholmod_triplet *, cholmod_common *) ; /* ========================================================================== */ /* === Core/cholmod_memory ================================================== */ /* ========================================================================== */ /* The user may make use of these, just like malloc and free. You can even * malloc an object and safely free it with cholmod_free, and visa versa * (except that the memory usage statistics will be corrupted). These routines * do differ from malloc and free. If cholmod_free is given a NULL pointer, * for example, it does nothing (unlike the ANSI free). cholmod_realloc does * not return NULL if given a non-NULL pointer and a nonzero size, even if it * fails (it returns the original pointer and sets an error code in * Common->status instead). * * CHOLMOD keeps track of the amount of memory it has allocated, and so the * cholmod_free routine also takes the size of the object being freed. This * is only used for statistics. If you, the user of CHOLMOD, pass the wrong * size, the only consequence is that the memory usage statistics will be * corrupted. */ void *cholmod_malloc /* returns pointer to the newly malloc'd block */ ( /* ---- input ---- */ size_t n, /* number of items */ size_t size, /* size of each item */ /* --------------- */ cholmod_common *Common ) ; void *cholmod_l_malloc (size_t, size_t, cholmod_common *) ; void *cholmod_calloc /* returns pointer to the newly calloc'd block */ ( /* ---- input ---- */ size_t n, /* number of items */ size_t size, /* size of each item */ /* --------------- */ cholmod_common *Common ) ; void *cholmod_l_calloc (size_t, size_t, cholmod_common *) ; void *cholmod_free /* always returns NULL */ ( /* ---- input ---- */ size_t n, /* number of items */ size_t size, /* size of each item */ /* ---- in/out --- */ void *p, /* block of memory to free */ /* --------------- */ cholmod_common *Common ) ; void *cholmod_l_free (size_t, size_t, void *, cholmod_common *) ; void *cholmod_realloc /* returns pointer to reallocated block */ ( /* ---- input ---- */ size_t nnew, /* requested # of items in reallocated block */ size_t size, /* size of each item */ /* ---- in/out --- */ void *p, /* block of memory to realloc */ size_t *n, /* current size on input, nnew on output if successful*/ /* --------------- */ cholmod_common *Common ) ; void *cholmod_l_realloc (size_t, size_t, void *, size_t *, cholmod_common *) ; int cholmod_realloc_multiple ( /* ---- input ---- */ size_t nnew, /* requested # of items in reallocated blocks */ int nint, /* number of int/SuiteSparse_long blocks */ int xtype, /* CHOLMOD_PATTERN, _REAL, _COMPLEX, or _ZOMPLEX */ /* ---- in/out --- */ void **Iblock, /* int or SuiteSparse_long block */ void **Jblock, /* int or SuiteSparse_long block */ void **Xblock, /* complex, double, or float block */ void **Zblock, /* zomplex case only: double or float block */ size_t *n, /* current size of the I,J,X,Z blocks on input, * nnew on output if successful */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_realloc_multiple (size_t, int, int, void **, void **, void **, void **, size_t *, cholmod_common *) ; /* ========================================================================== */ /* === version control ====================================================== */ /* ========================================================================== */ int cholmod_version /* returns CHOLMOD_VERSION */ ( /* output, contents not defined on input. Not used if NULL. version [0] = CHOLMOD_MAIN_VERSION version [1] = CHOLMOD_SUB_VERSION version [2] = CHOLMOD_SUBSUB_VERSION */ int version [3] ) ; int cholmod_l_version (int version [3]) ; /* Versions prior to 2.1.1 do not have the above function. The following code fragment will work with any version of CHOLMOD: #ifdef CHOLMOD_HAS_VERSION_FUNCTION v = cholmod_version (NULL) ; #else v = CHOLMOD_VERSION ; #endif */ /* ========================================================================== */ /* === symmetry types ======================================================= */ /* ========================================================================== */ #define CHOLMOD_MM_RECTANGULAR 1 #define CHOLMOD_MM_UNSYMMETRIC 2 #define CHOLMOD_MM_SYMMETRIC 3 #define CHOLMOD_MM_HERMITIAN 4 #define CHOLMOD_MM_SKEW_SYMMETRIC 5 #define CHOLMOD_MM_SYMMETRIC_POSDIAG 6 #define CHOLMOD_MM_HERMITIAN_POSDIAG 7 /* ========================================================================== */ /* === Numerical relop macros =============================================== */ /* ========================================================================== */ /* These macros correctly handle the NaN case. * * CHOLMOD_IS_NAN(x): * True if x is NaN. False otherwise. The commonly-existing isnan(x) * function could be used, but it's not in Kernighan & Ritchie 2nd edition * (ANSI C89). It may appear in , but I'm not certain about * portability. The expression x != x is true if and only if x is NaN, * according to the IEEE 754 floating-point standard. * * CHOLMOD_IS_ZERO(x): * True if x is zero. False if x is nonzero, NaN, or +/- Inf. * This is (x == 0) if the compiler is IEEE 754 compliant. * * CHOLMOD_IS_NONZERO(x): * True if x is nonzero, NaN, or +/- Inf. False if x zero. * This is (x != 0) if the compiler is IEEE 754 compliant. * * CHOLMOD_IS_LT_ZERO(x): * True if x is < zero or -Inf. False if x is >= 0, NaN, or +Inf. * This is (x < 0) if the compiler is IEEE 754 compliant. * * CHOLMOD_IS_GT_ZERO(x): * True if x is > zero or +Inf. False if x is <= 0, NaN, or -Inf. * This is (x > 0) if the compiler is IEEE 754 compliant. * * CHOLMOD_IS_LE_ZERO(x): * True if x is <= zero or -Inf. False if x is > 0, NaN, or +Inf. * This is (x <= 0) if the compiler is IEEE 754 compliant. */ #ifdef CHOLMOD_WINDOWS /* Yes, this is exceedingly ugly. Blame Microsoft, which hopelessly */ /* violates the IEEE 754 floating-point standard in a bizarre way. */ /* If you're using an IEEE 754-compliant compiler, then x != x is true */ /* iff x is NaN. For Microsoft, (x < x) is true iff x is NaN. */ /* So either way, this macro safely detects a NaN. */ #define CHOLMOD_IS_NAN(x) (((x) != (x)) || (((x) < (x)))) #define CHOLMOD_IS_ZERO(x) (((x) == 0.) && !CHOLMOD_IS_NAN(x)) #define CHOLMOD_IS_NONZERO(x) (((x) != 0.) || CHOLMOD_IS_NAN(x)) #define CHOLMOD_IS_LT_ZERO(x) (((x) < 0.) && !CHOLMOD_IS_NAN(x)) #define CHOLMOD_IS_GT_ZERO(x) (((x) > 0.) && !CHOLMOD_IS_NAN(x)) #define CHOLMOD_IS_LE_ZERO(x) (((x) <= 0.) && !CHOLMOD_IS_NAN(x)) #else /* These all work properly, according to the IEEE 754 standard ... except on */ /* a PC with windows. Works fine in Linux on the same PC... */ #define CHOLMOD_IS_NAN(x) ((x) != (x)) #define CHOLMOD_IS_ZERO(x) ((x) == 0.) #define CHOLMOD_IS_NONZERO(x) ((x) != 0.) #define CHOLMOD_IS_LT_ZERO(x) ((x) < 0.) #define CHOLMOD_IS_GT_ZERO(x) ((x) > 0.) #define CHOLMOD_IS_LE_ZERO(x) ((x) <= 0.) #endif #endif Matrix/src/CHOLMOD/Include/cholmod_internal.h0000644000176200001440000003306513652535054020466 0ustar liggesusers/* ========================================================================== */ /* === Include/cholmod_internal.h =========================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Include/cholmod_internal.h. * Copyright (C) 2005-2013, Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* CHOLMOD internal include file. * * This file contains internal definitions for CHOLMOD, not meant to be included * in user code. They define macros that are not prefixed with CHOLMOD_. This * file can safely #include'd in user code if you want to make use of the * macros defined here, and don't mind the possible name conflicts with your * code, however. * * Required by all CHOLMOD routines. Not required by any user routine that * uses CHOLMOMD. Unless debugging is enabled, this file does not require any * CHOLMOD module (not even the Core module). * * If debugging is enabled, all CHOLMOD modules require the Check module. * Enabling debugging requires that this file be editted. Debugging cannot be * enabled with a compiler flag. This is because CHOLMOD is exceedingly slow * when debugging is enabled. Debugging is meant for development of CHOLMOD * itself, not by users of CHOLMOD. */ #ifndef CHOLMOD_INTERNAL_H #define CHOLMOD_INTERNAL_H /* ========================================================================== */ /* === large file I/O ======================================================= */ /* ========================================================================== */ /* Definitions for large file I/O must come before any other #includes. If * this causes problems (may not be portable to all platforms), then compile * CHOLMOD with -DNLARGEFILE. You must do this for MATLAB 6.5 and earlier, * for example. */ #include "cholmod_io64.h" /* ========================================================================== */ /* === debugging and basic includes ========================================= */ /* ========================================================================== */ /* turn off debugging */ #ifndef NDEBUG #define NDEBUG #endif /* Uncomment this line to enable debugging. CHOLMOD will be very slow. #undef NDEBUG */ #ifdef MATLAB_MEX_FILE #include "mex.h" #endif #if !defined(NPRINT) || !defined(NDEBUG) #include #endif #include #include #include #include #include /* ========================================================================== */ /* === basic definitions ==================================================== */ /* ========================================================================== */ /* Some non-conforming compilers insist on defining TRUE and FALSE. */ #undef TRUE #undef FALSE #define TRUE 1 #define FALSE 0 #define BOOLEAN(x) ((x) ? TRUE : FALSE) /* NULL should already be defined, but ensure it is here. */ #ifndef NULL #define NULL ((void *) 0) #endif /* FLIP is a "negation about -1", and is used to mark an integer i that is * normally non-negative. FLIP (EMPTY) is EMPTY. FLIP of a number > EMPTY * is negative, and FLIP of a number < EMTPY is positive. FLIP (FLIP (i)) = i * for all integers i. UNFLIP (i) is >= EMPTY. */ #define EMPTY (-1) #define FLIP(i) (-(i)-2) #define UNFLIP(i) (((i) < EMPTY) ? FLIP (i) : (i)) /* MAX and MIN are not safe to use for NaN's */ #define MAX(a,b) (((a) > (b)) ? (a) : (b)) #define MAX3(a,b,c) (((a) > (b)) ? (MAX (a,c)) : (MAX (b,c))) #define MAX4(a,b,c,d) (((a) > (b)) ? (MAX3 (a,c,d)) : (MAX3 (b,c,d))) #define MIN(a,b) (((a) < (b)) ? (a) : (b)) #define IMPLIES(p,q) (!(p) || (q)) /* find the sign: -1 if x < 0, 1 if x > 0, zero otherwise. * Not safe for NaN's */ #define SIGN(x) (((x) < 0) ? (-1) : (((x) > 0) ? 1 : 0)) /* round up an integer x to a multiple of s */ #define ROUNDUP(x,s) ((s) * (((x) + ((s) - 1)) / (s))) #define ERROR(status,msg) \ CHOLMOD(error) (status, __FILE__, __LINE__, msg, Common) /* Check a pointer and return if null. Set status to invalid, unless the * status is already "out of memory" */ #define RETURN_IF_NULL(A,result) \ { \ if ((A) == NULL) \ { \ if (Common->status != CHOLMOD_OUT_OF_MEMORY) \ { \ ERROR (CHOLMOD_INVALID, "argument missing") ; \ } \ return (result) ; \ } \ } /* Return if Common is NULL or invalid */ #define RETURN_IF_NULL_COMMON(result) \ { \ if (Common == NULL) \ { \ return (result) ; \ } \ if (Common->itype != ITYPE || Common->dtype != DTYPE) \ { \ Common->status = CHOLMOD_INVALID ; \ return (result) ; \ } \ } #define IS_NAN(x) CHOLMOD_IS_NAN(x) #define IS_ZERO(x) CHOLMOD_IS_ZERO(x) #define IS_NONZERO(x) CHOLMOD_IS_NONZERO(x) #define IS_LT_ZERO(x) CHOLMOD_IS_LT_ZERO(x) #define IS_GT_ZERO(x) CHOLMOD_IS_GT_ZERO(x) #define IS_LE_ZERO(x) CHOLMOD_IS_LE_ZERO(x) /* 1e308 is a huge number that doesn't take many characters to print in a * file, in CHOLMOD/Check/cholmod_read and _write. Numbers larger than this * are interpretted as Inf, since sscanf doesn't read in Inf's properly. * This assumes IEEE double precision arithmetic. DBL_MAX would be a little * better, except that it takes too many digits to print in a file. */ #define HUGE_DOUBLE 1e308 /* ========================================================================== */ /* === int/long and double/float definitions ================================ */ /* ========================================================================== */ /* CHOLMOD is designed for 3 types of integer variables: * * (1) all integers are int * (2) most integers are int, some are SuiteSparse_long * (3) all integers are SuiteSparse_long * * and two kinds of floating-point values: * * (1) double * (2) float * * the complex types (ANSI-compatible complex, and MATLAB-compatable zomplex) * are based on the double or float type, and are not selected here. They * are typically selected via template routines. * * This gives 6 different modes in which CHOLMOD can be compiled (only the * first two are currently supported): * * DINT double, int prefix: cholmod_ * DLONG double, SuiteSparse_long prefix: cholmod_l_ * DMIX double, mixed int/SuiteSparse_long prefix: cholmod_m_ * SINT float, int prefix: cholmod_si_ * SLONG float, SuiteSparse_long prefix: cholmod_sl_ * SMIX float, mixed int/log prefix: cholmod_sm_ * * These are selected with compile time flags (-DDLONG, for example). If no * flag is selected, the default is DINT. * * All six versions use the same include files. The user-visible include files * are completely independent of which int/long/double/float version is being * used. The integer / real types in all data structures (sparse, triplet, * dense, common, and triplet) are defined at run-time, not compile-time, so * there is only one "cholmod_sparse" data type. Void pointers are used inside * that data structure to point to arrays of the proper type. Each data * structure has an itype and dtype field which determines the kind of basic * types used. These are defined in Include/cholmod_core.h. * * FUTURE WORK: support all six types (float, and mixed int/long) * * SuiteSparse_long is normally defined as long. However, for WIN64 it is * __int64. It can also be redefined for other platforms, by modifying * SuiteSparse_config.h. */ #include "SuiteSparse_config.h" /* -------------------------------------------------------------------------- */ /* Size_max: the largest value of size_t */ /* -------------------------------------------------------------------------- */ #define Size_max ((size_t) (-1)) /* routines for doing arithmetic on size_t, and checking for overflow */ size_t cholmod_add_size_t (size_t a, size_t b, int *ok) ; size_t cholmod_mult_size_t (size_t a, size_t k, int *ok) ; size_t cholmod_l_add_size_t (size_t a, size_t b, int *ok) ; size_t cholmod_l_mult_size_t (size_t a, size_t k, int *ok) ; /* -------------------------------------------------------------------------- */ /* double (also complex double), SuiteSparse_long */ /* -------------------------------------------------------------------------- */ #ifdef DLONG #define Real double #define Int SuiteSparse_long #define Int_max SuiteSparse_long_max #define CHOLMOD(name) cholmod_l_ ## name #define LONG #define DOUBLE #define ITYPE CHOLMOD_LONG #define DTYPE CHOLMOD_DOUBLE #define ID SuiteSparse_long_id /* -------------------------------------------------------------------------- */ /* double (also complex double), int: this is the default */ /* -------------------------------------------------------------------------- */ #else #ifndef DINT #define DINT #endif #define INT #define DOUBLE #define Real double #define Int int #define Int_max INT_MAX #define CHOLMOD(name) cholmod_ ## name #define ITYPE CHOLMOD_INT #define DTYPE CHOLMOD_DOUBLE #define ID "%d" /* GPU acceleration is not available for the int version of CHOLMOD */ #undef GPU_BLAS #endif /* ========================================================================== */ /* === real/complex arithmetic ============================================== */ /* ========================================================================== */ #include "cholmod_complexity.h" /* ========================================================================== */ /* === Architecture and BLAS ================================================ */ /* ========================================================================== */ #define BLAS_OK Common->blas_ok #include "cholmod_blas.h" /* ========================================================================== */ /* === debugging definitions ================================================ */ /* ========================================================================== */ #ifndef NDEBUG #include #include "cholmod.h" /* The cholmod_dump routines are in the Check module. No CHOLMOD routine * calls the cholmod_check_* or cholmod_print_* routines in the Check module, * since they use Common workspace that may already be in use. Instead, they * use the cholmod_dump_* routines defined there, which allocate their own * workspace if they need it. */ #ifndef EXTERN #define EXTERN extern #endif /* double, int */ EXTERN int cholmod_dump ; EXTERN int cholmod_dump_malloc ; SuiteSparse_long cholmod_dump_sparse (cholmod_sparse *, const char *, cholmod_common *) ; int cholmod_dump_factor (cholmod_factor *, const char *, cholmod_common *) ; int cholmod_dump_triplet (cholmod_triplet *, const char *, cholmod_common *) ; int cholmod_dump_dense (cholmod_dense *, const char *, cholmod_common *) ; int cholmod_dump_subset (int *, size_t, size_t, const char *, cholmod_common *) ; int cholmod_dump_perm (int *, size_t, size_t, const char *, cholmod_common *) ; int cholmod_dump_parent (int *, size_t, const char *, cholmod_common *) ; void cholmod_dump_init (const char *, cholmod_common *) ; int cholmod_dump_mem (const char *, SuiteSparse_long, cholmod_common *) ; void cholmod_dump_real (const char *, Real *, SuiteSparse_long, SuiteSparse_long, int, int, cholmod_common *) ; void cholmod_dump_super (SuiteSparse_long, int *, int *, int *, int *, double *, int, cholmod_common *) ; int cholmod_dump_partition (SuiteSparse_long, int *, int *, int *, int *, SuiteSparse_long, cholmod_common *) ; int cholmod_dump_work(int, int, SuiteSparse_long, cholmod_common *) ; /* double, SuiteSparse_long */ EXTERN int cholmod_l_dump ; EXTERN int cholmod_l_dump_malloc ; SuiteSparse_long cholmod_l_dump_sparse (cholmod_sparse *, const char *, cholmod_common *) ; int cholmod_l_dump_factor (cholmod_factor *, const char *, cholmod_common *) ; int cholmod_l_dump_triplet (cholmod_triplet *, const char *, cholmod_common *); int cholmod_l_dump_dense (cholmod_dense *, const char *, cholmod_common *) ; int cholmod_l_dump_subset (SuiteSparse_long *, size_t, size_t, const char *, cholmod_common *) ; int cholmod_l_dump_perm (SuiteSparse_long *, size_t, size_t, const char *, cholmod_common *) ; int cholmod_l_dump_parent (SuiteSparse_long *, size_t, const char *, cholmod_common *) ; void cholmod_l_dump_init (const char *, cholmod_common *) ; int cholmod_l_dump_mem (const char *, SuiteSparse_long, cholmod_common *) ; void cholmod_l_dump_real (const char *, Real *, SuiteSparse_long, SuiteSparse_long, int, int, cholmod_common *) ; void cholmod_l_dump_super (SuiteSparse_long, SuiteSparse_long *, SuiteSparse_long *, SuiteSparse_long *, SuiteSparse_long *, double *, int, cholmod_common *) ; int cholmod_l_dump_partition (SuiteSparse_long, SuiteSparse_long *, SuiteSparse_long *, SuiteSparse_long *, SuiteSparse_long *, SuiteSparse_long, cholmod_common *) ; int cholmod_l_dump_work(int, int, SuiteSparse_long, cholmod_common *) ; #define DEBUG_INIT(s,Common) { CHOLMOD(dump_init)(s, Common) ; } #define ASSERT(expression) (assert (expression)) #define PRK(k,params) \ { \ if (CHOLMOD(dump) >= (k) && SuiteSparse_config.printf_func != NULL) \ { \ (SuiteSparse_config.printf_func) params ; \ } \ } #define PRINT0(params) PRK (0, params) #define PRINT1(params) PRK (1, params) #define PRINT2(params) PRK (2, params) #define PRINT3(params) PRK (3, params) #define PRINTM(params) \ { \ if (CHOLMOD(dump_malloc) > 0) \ { \ printf params ; \ } \ } #define DEBUG(statement) statement #else /* Debugging disabled (the normal case) */ #define PRK(k,params) #define DEBUG_INIT(s,Common) #define PRINT0(params) #define PRINT1(params) #define PRINT2(params) #define PRINT3(params) #define PRINTM(params) #define ASSERT(expression) #define DEBUG(statement) #endif #endif Matrix/src/CHOLMOD/Include/cholmod_camd.h0000644000176200001440000000662213652535054017555 0ustar liggesusers/* ========================================================================== */ /* === Include/cholmod_camd.h =============================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Include/cholmod_camd.h. * Copyright (C) 2005-2013, Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* CHOLMOD Partition module, interface to CAMD, CCOLAMD, and CSYMAMD * * An interface to CCOLAMD and CSYMAMD, constrained minimum degree ordering * methods which order a matrix following constraints determined via nested * dissection. * * These functions do not require METIS. They are installed unless NCAMD * is defined: * cholmod_ccolamd interface to CCOLAMD ordering * cholmod_csymamd interface to CSYMAMD ordering * cholmod_camd interface to CAMD ordering * * Requires the Core and Cholesky modules, and two packages: CAMD, * and CCOLAMD. Used by functions in the Partition Module. */ #ifndef CHOLMOD_CAMD_H #define CHOLMOD_CAMD_H #include "cholmod_core.h" /* -------------------------------------------------------------------------- */ /* cholmod_ccolamd */ /* -------------------------------------------------------------------------- */ /* Order AA' or A(:,f)*A(:,f)' using CCOLAMD. */ int cholmod_ccolamd ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order */ int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ int *Cmember, /* size A->nrow. Cmember [i] = c if row i is in the * constraint set c. c must be >= 0. The # of * constraint sets is max (Cmember) + 1. If Cmember is * NULL, then it is interpretted as Cmember [i] = 0 for * all i */ /* ---- output --- */ int *Perm, /* size A->nrow, output permutation */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_ccolamd (cholmod_sparse *, SuiteSparse_long *, size_t, SuiteSparse_long *, SuiteSparse_long *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_csymamd */ /* -------------------------------------------------------------------------- */ /* Order A using CSYMAMD. */ int cholmod_csymamd ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order */ /* ---- output --- */ int *Cmember, /* size nrow. see cholmod_ccolamd above */ int *Perm, /* size A->nrow, output permutation */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_csymamd (cholmod_sparse *, SuiteSparse_long *, SuiteSparse_long *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_camd */ /* -------------------------------------------------------------------------- */ /* Order A using CAMD. */ int cholmod_camd ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order */ int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ /* ---- output --- */ int *Cmember, /* size nrow. see cholmod_ccolamd above */ int *Perm, /* size A->nrow, output permutation */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_camd (cholmod_sparse *, SuiteSparse_long *, size_t, SuiteSparse_long *, SuiteSparse_long *, cholmod_common *) ; #endif Matrix/src/CHOLMOD/Include/README.txt0000644000176200001440000000240511770402705016457 0ustar liggesusersCHOLMOD: a sparse Cholesky factorization package. http://www.suitesparse.com The Include/*.h files in this directory provide a basic documentation of all user-callable routines and user-visible data structures in the CHOLMOD package. Start with cholmod.h, which describes the general structure of the parameter lists of CHOLMOD routines. cholmod_core.h describes the data structures and basic operations on them (creating and deleting them). cholmod.h single include file for all user programs cholmod_config.h CHOLMOD compile-time configuration cholmod_core.h Core module: data structures and basic support routines cholmod_check.h Check module: check/print CHOLMOD data structures cholmod_cholesky.h Cholesky module: LL' and LDL' factorization cholmod_matrixops.h MatrixOps module: sparse matrix operators (add, mult,..) cholmod_modify.h Modify module: update/downdate/... cholmod_partition.h Partition module: nested dissection ordering cholmod_supernodal.h Supernodal module: supernodal Cholesky These include files are not used in user programs, but in CHOLMOD only: cholmod_blas.h BLAS definitions cholmod_complexity.h complex arithmetic cholmod_template.h complex arithmetic for template routines cholmod_internal.h internal definitions, not visible to user program Matrix/src/CHOLMOD/Include/cholmod.h0000644000176200001440000000720213652535054016564 0ustar liggesusers/* ========================================================================== */ /* === Include/cholmod.h ==================================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Include/cholmod.h. * Copyright (C) 2005-2013, Univ. of Florida. Author: Timothy A. Davis * http://www.suitesparse.com * * Portions of CHOLMOD (the Core and Partition Modules) are copyrighted by the * University of Florida. The Modify Module is co-authored by William W. * Hager, Univ. of Florida. * * Acknowledgements: this work was supported in part by the National Science * Foundation (NFS CCR-0203270 and DMS-9803599), and a grant from Sandia * National Laboratories (Dept. of Energy) which supported the development of * CHOLMOD's Partition Module. * -------------------------------------------------------------------------- */ /* CHOLMOD include file, for inclusion user programs. * * The include files listed below include a short description of each user- * callable routine. Each routine in CHOLMOD has a consistent interface. * More details about the CHOLMOD data types is in the cholmod_core.h file. * * Naming convention: * ------------------ * * All routine names, data types, and CHOLMOD library files use the * cholmod_ prefix. All macros and other #define's use the CHOLMOD * prefix. * * Return value: * ------------- * * Most CHOLMOD routines return an int (TRUE (1) if successful, or FALSE * (0) otherwise. A SuiteSparse_long or double return value is >= 0 if * successful, or -1 otherwise. A size_t return value is > 0 if * successful, or 0 otherwise. * * If a routine returns a pointer, it is a pointer to a newly allocated * object or NULL if a failure occured, with one exception. cholmod_free * always returns NULL. * * "Common" parameter: * ------------------ * * The last parameter in all CHOLMOD routines is a pointer to the CHOLMOD * "Common" object. This contains control parameters, statistics, and * workspace used between calls to CHOLMOD. It is always an input/output * parameter. * * Input, Output, and Input/Output parameters: * ------------------------------------------- * * Input parameters are listed first. They are not modified by CHOLMOD. * * Input/output are listed next. They must be defined on input, and * are modified on output. * * Output parameters are listed next. If they are pointers, they must * point to allocated space on input, but their contents are not defined * on input. * * Workspace parameters appear next. They are used in only two routines * in the Supernodal module. * * The cholmod_common *Common parameter always appears as the last * parameter. It is always an input/output parameter. */ #ifndef CHOLMOD_H #define CHOLMOD_H /* make it easy for C++ programs to include CHOLMOD */ #ifdef __cplusplus extern "C" { #endif /* assume large file support. If problems occur, compile with -DNLARGEFILE */ #include "cholmod_io64.h" #include "SuiteSparse_config.h" #include "cholmod_config.h" /* CHOLMOD always includes the Core module. */ #include "cholmod_core.h" #ifndef NCHECK #include "cholmod_check.h" #endif #ifndef NCHOLESKY #include "cholmod_cholesky.h" #endif #ifndef NMATRIXOPS #include "cholmod_matrixops.h" #endif #ifndef NMODIFY #include "cholmod_modify.h" #endif #ifndef NCAMD #include "cholmod_camd.h" #endif #ifndef NPARTITION #include "cholmod_partition.h" #endif #ifndef NSUPERNODAL #include "cholmod_supernodal.h" #endif #ifdef GPU_BLAS #include "cholmod_gpu.h" #endif #ifdef __cplusplus } #endif #endif Matrix/src/CHOLMOD/Include/cholmod_io64.h0000644000176200001440000000263213652535054017427 0ustar liggesusers/* ========================================================================== */ /* === Include/cholmod_io64 ================================================= */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Include/cholmod_io64.h. * Copyright (C) 2005-2006, Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* Definitions required for large file I/O, which must come before any other * #includes. These are not used if -DNLARGEFILE is defined at compile time. * Large file support may not be portable across all platforms and compilers; * if you encounter an error here, compile your code with -DNLARGEFILE. In * particular, you must use -DNLARGEFILE for MATLAB 6.5 or earlier (which does * not have the io64.h include file). */ #ifndef CHOLMOD_IO_H #define CHOLMOD_IO_H /* skip all of this if NLARGEFILE is defined at the compiler command line */ #ifndef NLARGEFILE #if defined(MATLAB_MEX_FILE) || defined(MATHWORKS) /* CHOLMOD is being compiled as a MATLAB mexFunction, or for use in MATLAB */ #include "io64.h" #else /* CHOLMOD is being compiled in a stand-alone library */ #undef _LARGEFILE64_SOURCE #define _LARGEFILE64_SOURCE #undef _FILE_OFFSET_BITS #define _FILE_OFFSET_BITS 64 #endif #endif #endif Matrix/src/CHOLMOD/Include/cholmod_template.h0000644000176200001440000002245613652535054020467 0ustar liggesusers/* ========================================================================== */ /* === Include/cholmod_template.h =========================================== */ /* ========================================================================== */ /* -------------------------------------------------------------------------- */ /* undefine current xtype macros, and then define macros for current type */ /* -------------------------------------------------------------------------- */ #undef TEMPLATE #undef TEMPLATE2 #undef XTYPE #undef XTYPE2 #undef XTYPE_OK #undef ENTRY_IS_NONZERO #undef ENTRY_IS_ZERO #undef ENTRY_IS_ONE #undef IMAG_IS_NONZERO #undef ASSEMBLE #undef ASSIGN #undef ASSIGN_CONJ #undef ASSIGN2 #undef ASSIGN2_CONJ #undef ASSIGN_REAL #undef MULT #undef MULTADD #undef ADD #undef ADD_REAL #undef MULTSUB #undef MULTADDCONJ #undef MULTSUBCONJ #undef LLDOT #undef CLEAR #undef DIV #undef DIV_REAL #undef MULT_REAL #undef CLEAR_IMAG #undef LDLDOT #undef PREFIX #undef ENTRY_SIZE #undef XPRINT0 #undef XPRINT1 #undef XPRINT2 #undef XPRINT3 /* -------------------------------------------------------------------------- */ /* pattern */ /* -------------------------------------------------------------------------- */ #ifdef PATTERN #define PREFIX p_ #define TEMPLATE(name) P_TEMPLATE(name) #define TEMPLATE2(name) P_TEMPLATE(name) #define XTYPE CHOLMOD_PATTERN #define XTYPE2 CHOLMOD_REAL #define XTYPE_OK(type) (TRUE) #define ENTRY_IS_NONZERO(ax,az,q) (TRUE) #define ENTRY_IS_ZERO(ax,az,q) (FALSE) #define ENTRY_IS_ONE(ax,az,q) (TRUE) #define IMAG_IS_NONZERO(ax,az,q) (FALSE) #define ENTRY_SIZE 0 #define ASSEMBLE(x,z,p,ax,az,q) #define ASSIGN(x,z,p,ax,az,q) #define ASSIGN_CONJ(x,z,p,ax,az,q) #define ASSIGN2(x,z,p,ax,az,q) P_ASSIGN2(x,z,p,ax,az,q) #define ASSIGN2_CONJ(x,z,p,ax,az,q) P_ASSIGN2(x,z,p,ax,az,q) #define ASSIGN_REAL(x,p,ax,q) #define MULT(x,z,p,ax,az,q,bx,bz,pb) #define MULTADD(x,z,p,ax,az,q,bx,bz,pb) #define ADD(x,z,p,ax,az,q,bx,bz,pb) #define ADD_REAL(x,p, ax,q, bx,r) #define MULTSUB(x,z,p,ax,az,q,bx,bz,pb) #define MULTADDCONJ(x,z,p,ax,az,q,bx,bz,pb) #define MULTSUBCONJ(x,z,p,ax,az,q,bx,bz,pb) #define LLDOT(x,p,ax,az,q) #define CLEAR(x,z,p) #define CLEAR_IMAG(x,z,p) #define DIV(x,z,p,ax,az,q) #define DIV_REAL(x,z,p, ax,az,q, bx,r) #define MULT_REAL(x,z,p, ax,az,q, bx,r) #define LDLDOT(x,p, ax,az,q, bx,r) #define XPRINT0(x,z,p) P_PRINT(0,x,z,p) #define XPRINT1(x,z,p) P_PRINT(1,x,z,p) #define XPRINT2(x,z,p) P_PRINT(2,x,z,p) #define XPRINT3(x,z,p) P_PRINT(3,x,z,p) /* -------------------------------------------------------------------------- */ /* real */ /* -------------------------------------------------------------------------- */ #elif defined (REAL) #define PREFIX r_ #define TEMPLATE(name) R_TEMPLATE(name) #define TEMPLATE2(name) R_TEMPLATE(name) #define XTYPE CHOLMOD_REAL #define XTYPE2 CHOLMOD_REAL #define XTYPE_OK(type) R_XTYPE_OK(type) #define ENTRY_IS_NONZERO(ax,az,q) R_IS_NONZERO(ax,az,q) #define ENTRY_IS_ZERO(ax,az,q) R_IS_ZERO(ax,az,q) #define ENTRY_IS_ONE(ax,az,q) R_IS_ONE(ax,az,q) #define IMAG_IS_NONZERO(ax,az,q) (FALSE) #define ENTRY_SIZE 1 #define ASSEMBLE(x,z,p,ax,az,q) R_ASSEMBLE(x,z,p,ax,az,q) #define ASSIGN(x,z,p,ax,az,q) R_ASSIGN(x,z,p,ax,az,q) #define ASSIGN_CONJ(x,z,p,ax,az,q) R_ASSIGN(x,z,p,ax,az,q) #define ASSIGN2(x,z,p,ax,az,q) R_ASSIGN(x,z,p,ax,az,q) #define ASSIGN2_CONJ(x,z,p,ax,az,q) R_ASSIGN(x,z,p,ax,az,q) #define ASSIGN_REAL(x,p,ax,q) R_ASSIGN_REAL(x,p,ax,q) #define MULT(x,z,p,ax,az,q,bx,bz,pb) R_MULT(x,z,p,ax,az,q,bx,bz,pb) #define MULTADD(x,z,p,ax,az,q,bx,bz,pb) R_MULTADD(x,z,p,ax,az,q,bx,bz,pb) #define ADD(x,z,p,ax,az,q,bx,bz,pb) R_ADD(x,z,p,ax,az,q,bx,bz,pb) #define ADD_REAL(x,p, ax,q, bx,r) R_ADD_REAL(x,p, ax,q, bx,r) #define MULTSUB(x,z,p,ax,az,q,bx,bz,pb) R_MULTSUB(x,z,p,ax,az,q,bx,bz,pb) #define MULTADDCONJ(x,z,p,ax,az,q,bx,bz,pb) \ R_MULTADDCONJ(x,z,p,ax,az,q,bx,bz,pb) #define MULTSUBCONJ(x,z,p,ax,az,q,bx,bz,pb) \ R_MULTSUBCONJ(x,z,p,ax,az,q,bx,bz,pb) #define LLDOT(x,p,ax,az,q) R_LLDOT(x,p,ax,az,q) #define CLEAR(x,z,p) R_CLEAR(x,z,p) #define CLEAR_IMAG(x,z,p) R_CLEAR_IMAG(x,z,p) #define DIV(x,z,p,ax,az,q) R_DIV(x,z,p,ax,az,q) #define DIV_REAL(x,z,p, ax,az,q, bx,r) R_DIV_REAL(x,z,p, ax,az,q, bx,r) #define MULT_REAL(x,z,p, ax,az,q, bx,r) R_MULT_REAL(x,z,p, ax,az,q, bx,r) #define LDLDOT(x,p, ax,az,q, bx,r) R_LDLDOT(x,p, ax,az,q, bx,r) #define XPRINT0(x,z,p) R_PRINT(0,x,z,p) #define XPRINT1(x,z,p) R_PRINT(1,x,z,p) #define XPRINT2(x,z,p) R_PRINT(2,x,z,p) #define XPRINT3(x,z,p) R_PRINT(3,x,z,p) /* -------------------------------------------------------------------------- */ /* complex */ /* -------------------------------------------------------------------------- */ #elif defined (COMPLEX) #define PREFIX c_ #ifdef NCONJUGATE #define TEMPLATE(name) CT_TEMPLATE(name) #define TEMPLATE2(name) CT_TEMPLATE(name) #else #define TEMPLATE(name) C_TEMPLATE(name) #define TEMPLATE2(name) C_TEMPLATE(name) #endif #define ASSEMBLE(x,z,p,ax,az,q) C_ASSEMBLE(x,z,p,ax,az,q) #define ASSIGN(x,z,p,ax,az,q) C_ASSIGN(x,z,p,ax,az,q) #define ASSIGN_CONJ(x,z,p,ax,az,q) C_ASSIGN_CONJ(x,z,p,ax,az,q) #define ASSIGN2(x,z,p,ax,az,q) C_ASSIGN(x,z,p,ax,az,q) #define ASSIGN2_CONJ(x,z,p,ax,az,q) C_ASSIGN_CONJ(x,z,p,ax,az,q) #define ASSIGN_REAL(x,p,ax,q) C_ASSIGN_REAL(x,p,ax,q) #define XTYPE CHOLMOD_COMPLEX #define XTYPE2 CHOLMOD_COMPLEX #define XTYPE_OK(type) C_XTYPE_OK(type) #define ENTRY_IS_NONZERO(ax,az,q) C_IS_NONZERO(ax,az,q) #define ENTRY_IS_ZERO(ax,az,q) C_IS_ZERO(ax,az,q) #define ENTRY_IS_ONE(ax,az,q) C_IS_ONE(ax,az,q) #define IMAG_IS_NONZERO(ax,az,q) C_IMAG_IS_NONZERO(ax,az,q) #define ENTRY_SIZE 2 #define MULTADD(x,z,p,ax,az,q,bx,bz,pb) C_MULTADD(x,z,p,ax,az,q,bx,bz,pb) #define MULT(x,z,p,ax,az,q,bx,bz,pb) C_MULT(x,z,p,ax,az,q,bx,bz,pb) #define ADD(x,z,p,ax,az,q,bx,bz,pb) C_ADD(x,z,p,ax,az,q,bx,bz,pb) #define ADD_REAL(x,p, ax,q, bx,r) C_ADD_REAL(x,p, ax,q, bx,r) #define MULTSUB(x,z,p,ax,az,q,bx,bz,pb) C_MULTSUB(x,z,p,ax,az,q,bx,bz,pb) #define MULTADDCONJ(x,z,p,ax,az,q,bx,bz,pb) \ C_MULTADDCONJ(x,z,p,ax,az,q,bx,bz,pb) #define MULTSUBCONJ(x,z,p,ax,az,q,bx,bz,pb) \ C_MULTSUBCONJ(x,z,p,ax,az,q,bx,bz,pb) #define LLDOT(x,p,ax,az,q) C_LLDOT(x,p,ax,az,q) #define CLEAR(x,z,p) C_CLEAR(x,z,p) #define CLEAR_IMAG(x,z,p) C_CLEAR_IMAG(x,z,p) #define DIV(x,z,p,ax,az,q) C_DIV(x,z,p,ax,az,q) #define DIV_REAL(x,z,p, ax,az,q, bx,r) C_DIV_REAL(x,z,p, ax,az,q, bx,r) #define MULT_REAL(x,z,p, ax,az,q, bx,r) C_MULT_REAL(x,z,p, ax,az,q, bx,r) #define LDLDOT(x,p, ax,az,q, bx,r) C_LDLDOT(x,p, ax,az,q, bx,r) #define XPRINT0(x,z,p) C_PRINT(0,x,z,p) #define XPRINT1(x,z,p) C_PRINT(1,x,z,p) #define XPRINT2(x,z,p) C_PRINT(2,x,z,p) #define XPRINT3(x,z,p) C_PRINT(3,x,z,p) /* -------------------------------------------------------------------------- */ /* zomplex */ /* -------------------------------------------------------------------------- */ #elif defined (ZOMPLEX) #define PREFIX z_ #ifdef NCONJUGATE #define TEMPLATE(name) ZT_TEMPLATE(name) #define TEMPLATE2(name) CT_TEMPLATE(name) #else #define TEMPLATE(name) Z_TEMPLATE(name) #define TEMPLATE2(name) C_TEMPLATE(name) #endif #define ASSEMBLE(x,z,p,ax,az,q) Z_ASSEMBLE(x,z,p,ax,az,q) #define ASSIGN(x,z,p,ax,az,q) Z_ASSIGN(x,z,p,ax,az,q) #define ASSIGN_CONJ(x,z,p,ax,az,q) Z_ASSIGN_CONJ(x,z,p,ax,az,q) #define ASSIGN2(x,z,p,ax,az,q) Z_ASSIGN(x,z,p,ax,az,q) #define ASSIGN2_CONJ(x,z,p,ax,az,q) Z_ASSIGN_CONJ(x,z,p,ax,az,q) #define ASSIGN_REAL(x,p,ax,q) Z_ASSIGN_REAL(x,p,ax,q) #define XTYPE CHOLMOD_ZOMPLEX #define XTYPE2 CHOLMOD_ZOMPLEX #define XTYPE_OK(type) Z_XTYPE_OK(type) #define ENTRY_IS_NONZERO(ax,az,q) Z_IS_NONZERO(ax,az,q) #define ENTRY_IS_ZERO(ax,az,q) Z_IS_ZERO(ax,az,q) #define ENTRY_IS_ONE(ax,az,q) Z_IS_ONE(ax,az,q) #define IMAG_IS_NONZERO(ax,az,q) Z_IMAG_IS_NONZERO(ax,az,q) #define ENTRY_SIZE 1 #define MULTADD(x,z,p,ax,az,q,bx,bz,pb) Z_MULTADD(x,z,p,ax,az,q,bx,bz,pb) #define MULT(x,z,p,ax,az,q,bx,bz,pb) Z_MULT(x,z,p,ax,az,q,bx,bz,pb) #define ADD(x,z,p,ax,az,q,bx,bz,pb) Z_ADD(x,z,p,ax,az,q,bx,bz,pb) #define ADD_REAL(x,p, ax,q, bx,r) Z_ADD_REAL(x,p, ax,q, bx,r) #define MULTSUB(x,z,p,ax,az,q,bx,bz,pb) Z_MULTSUB(x,z,p,ax,az,q,bx,bz,pb) #define MULTADDCONJ(x,z,p,ax,az,q,bx,bz,pb) \ Z_MULTADDCONJ(x,z,p,ax,az,q,bx,bz,pb) #define MULTSUBCONJ(x,z,p,ax,az,q,bx,bz,pb) \ Z_MULTSUBCONJ(x,z,p,ax,az,q,bx,bz,pb) #define LLDOT(x,p,ax,az,q) Z_LLDOT(x,p,ax,az,q) #define CLEAR(x,z,p) Z_CLEAR(x,z,p) #define CLEAR_IMAG(x,z,p) Z_CLEAR_IMAG(x,z,p) #define DIV(x,z,p,ax,az,q) Z_DIV(x,z,p,ax,az,q) #define DIV_REAL(x,z,p, ax,az,q, bx,r) Z_DIV_REAL(x,z,p, ax,az,q, bx,r) #define MULT_REAL(x,z,p, ax,az,q, bx,r) Z_MULT_REAL(x,z,p, ax,az,q, bx,r) #define LDLDOT(x,p, ax,az,q, bx,r) Z_LDLDOT(x,p, ax,az,q, bx,r) #define XPRINT0(x,z,p) Z_PRINT(0,x,z,p) #define XPRINT1(x,z,p) Z_PRINT(1,x,z,p) #define XPRINT2(x,z,p) Z_PRINT(2,x,z,p) #define XPRINT3(x,z,p) Z_PRINT(3,x,z,p) #endif Matrix/src/CHOLMOD/Include/cholmod_supernodal.h0000644000176200001440000001411613652535054021022 0ustar liggesusers/* ========================================================================== */ /* === Include/cholmod_supernodal.h ========================================= */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Include/cholmod_supernodal.h. * Copyright (C) 2005-2006, Timothy A. Davis * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* CHOLMOD Supernodal module. * * Supernodal analysis, factorization, and solve. The simplest way to use * these routines is via the Cholesky module. It does not provide any * fill-reducing orderings, but does accept the orderings computed by the * Cholesky module. It does not require the Cholesky module itself, however. * * Primary routines: * ----------------- * cholmod_super_symbolic supernodal symbolic analysis * cholmod_super_numeric supernodal numeric factorization * cholmod_super_lsolve supernodal Lx=b solve * cholmod_super_ltsolve supernodal L'x=b solve * * Prototypes for the BLAS and LAPACK routines that CHOLMOD uses are listed * below, including how they are used in CHOLMOD. * * BLAS routines: * -------------- * dtrsv solve Lx=b or L'x=b, L non-unit diagonal, x and b stride-1 * dtrsm solve LX=B or L'X=b, L non-unit diagonal * dgemv y=y-A*x or y=y-A'*x (x and y stride-1) * dgemm C=A*B', C=C-A*B, or C=C-A'*B * dsyrk C=tril(A*A') * * LAPACK routines: * ---------------- * dpotrf LAPACK: A=chol(tril(A)) * * Requires the Core module, and two external packages: LAPACK and the BLAS. * Optionally used by the Cholesky module. */ #ifndef CHOLMOD_SUPERNODAL_H #define CHOLMOD_SUPERNODAL_H #include "cholmod_core.h" /* -------------------------------------------------------------------------- */ /* cholmod_super_symbolic */ /* -------------------------------------------------------------------------- */ /* Analyzes A, AA', or A(:,f)*A(:,f)' in preparation for a supernodal numeric * factorization. The user need not call this directly; cholmod_analyze is * a "simple" wrapper for this routine. */ int cholmod_super_symbolic ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to analyze */ cholmod_sparse *F, /* F = A' or A(:,f)' */ int *Parent, /* elimination tree */ /* ---- in/out --- */ cholmod_factor *L, /* simplicial symbolic on input, * supernodal symbolic on output */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_super_symbolic (cholmod_sparse *, cholmod_sparse *, SuiteSparse_long *, cholmod_factor *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_super_symbolic2 */ /* -------------------------------------------------------------------------- */ /* Analyze for supernodal Cholesky or multifrontal QR */ int cholmod_super_symbolic2 ( /* ---- input ---- */ int for_whom, /* FOR_SPQR (0): for SPQR but not GPU-accelerated FOR_CHOLESKY (1): for Cholesky (GPU or not) FOR_SPQRGPU (2): for SPQR with GPU acceleration */ cholmod_sparse *A, /* matrix to analyze */ cholmod_sparse *F, /* F = A' or A(:,f)' */ int *Parent, /* elimination tree */ /* ---- in/out --- */ cholmod_factor *L, /* simplicial symbolic on input, * supernodal symbolic on output */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_super_symbolic2 (int, cholmod_sparse *, cholmod_sparse *, SuiteSparse_long *, cholmod_factor *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_super_numeric */ /* -------------------------------------------------------------------------- */ /* Computes the numeric LL' factorization of A, AA', or A(:,f)*A(:,f)' using * a BLAS-based supernodal method. The user need not call this directly; * cholmod_factorize is a "simple" wrapper for this routine. */ int cholmod_super_numeric ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to factorize */ cholmod_sparse *F, /* F = A' or A(:,f)' */ double beta [2], /* beta*I is added to diagonal of matrix to factorize */ /* ---- in/out --- */ cholmod_factor *L, /* factorization */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_super_numeric (cholmod_sparse *, cholmod_sparse *, double *, cholmod_factor *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_super_lsolve */ /* -------------------------------------------------------------------------- */ /* Solve Lx=b where L is from a supernodal numeric factorization. The user * need not call this routine directly. cholmod_solve is a "simple" wrapper * for this routine. */ int cholmod_super_lsolve ( /* ---- input ---- */ cholmod_factor *L, /* factor to use for the forward solve */ /* ---- output ---- */ cholmod_dense *X, /* b on input, solution to Lx=b on output */ /* ---- workspace */ cholmod_dense *E, /* workspace of size nrhs*(L->maxesize) */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_super_lsolve (cholmod_factor *, cholmod_dense *, cholmod_dense *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_super_ltsolve */ /* -------------------------------------------------------------------------- */ /* Solve L'x=b where L is from a supernodal numeric factorization. The user * need not call this routine directly. cholmod_solve is a "simple" wrapper * for this routine. */ int cholmod_super_ltsolve ( /* ---- input ---- */ cholmod_factor *L, /* factor to use for the backsolve */ /* ---- output ---- */ cholmod_dense *X, /* b on input, solution to L'x=b on output */ /* ---- workspace */ cholmod_dense *E, /* workspace of size nrhs*(L->maxesize) */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_super_ltsolve (cholmod_factor *, cholmod_dense *, cholmod_dense *, cholmod_common *) ; #endif Matrix/src/CHOLMOD/Include/cholmod_cholesky.h0000644000176200001440000005467113652535054020501 0ustar liggesusers/* ========================================================================== */ /* === Include/cholmod_cholesky.h =========================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Include/cholmod_cholesky.h. Copyright (C) 2005-2013, Timothy A. Davis * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* CHOLMOD Cholesky module. * * Sparse Cholesky routines: analysis, factorization, and solve. * * The primary routines are all that a user requires to order, analyze, and * factorize a sparse symmetric positive definite matrix A (or A*A'), and * to solve Ax=b (or A*A'x=b). The primary routines rely on the secondary * routines, the CHOLMOD Core module, and the AMD and COLAMD packages. They * make optional use of the CHOLMOD Supernodal and Partition modules, the * METIS package, and the CCOLAMD package. * * Primary routines: * ----------------- * * cholmod_analyze order and analyze (simplicial or supernodal) * cholmod_factorize simplicial or supernodal Cholesky factorization * cholmod_solve solve a linear system (simplicial or supernodal) * cholmod_solve2 like cholmod_solve, but reuse workspace * cholmod_spsolve solve a linear system (sparse x and b) * * Secondary routines: * ------------------ * * cholmod_analyze_p analyze, with user-provided permutation or f set * cholmod_factorize_p factorize, with user-provided permutation or f * cholmod_analyze_ordering analyze a fill-reducing ordering * cholmod_etree find the elimination tree * cholmod_rowcolcounts compute the row/column counts of L * cholmod_amd order using AMD * cholmod_colamd order using COLAMD * cholmod_rowfac incremental simplicial factorization * cholmod_rowfac_mask rowfac, specific to LPDASA * cholmod_rowfac_mask2 rowfac, specific to LPDASA * cholmod_row_subtree find the nonzero pattern of a row of L * cholmod_resymbol recompute the symbolic pattern of L * cholmod_resymbol_noperm recompute the symbolic pattern of L, no L->Perm * cholmod_postorder postorder a tree * * Requires the Core module, and two packages: AMD and COLAMD. * Optionally uses the Supernodal and Partition modules. * Required by the Partition module. */ #ifndef CHOLMOD_CHOLESKY_H #define CHOLMOD_CHOLESKY_H #include "cholmod_config.h" #include "cholmod_core.h" #ifndef NPARTITION #include "cholmod_partition.h" #endif #ifndef NSUPERNODAL #include "cholmod_supernodal.h" #endif /* -------------------------------------------------------------------------- */ /* cholmod_analyze: order and analyze (simplicial or supernodal) */ /* -------------------------------------------------------------------------- */ /* Orders and analyzes A, AA', PAP', or PAA'P' and returns a symbolic factor * that can later be passed to cholmod_factorize. */ cholmod_factor *cholmod_analyze ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order and analyze */ /* --------------- */ cholmod_common *Common ) ; cholmod_factor *cholmod_l_analyze (cholmod_sparse *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_analyze_p: analyze, with user-provided permutation or f set */ /* -------------------------------------------------------------------------- */ /* Orders and analyzes A, AA', PAP', PAA'P', FF', or PFF'P and returns a * symbolic factor that can later be passed to cholmod_factorize, where * F = A(:,fset) if fset is not NULL and A->stype is zero. * UserPerm is tried if non-NULL. */ cholmod_factor *cholmod_analyze_p ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order and analyze */ int *UserPerm, /* user-provided permutation, size A->nrow */ int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ /* --------------- */ cholmod_common *Common ) ; cholmod_factor *cholmod_l_analyze_p (cholmod_sparse *, SuiteSparse_long *, SuiteSparse_long *, size_t, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_analyze_p2: analyze for sparse Cholesky or sparse QR */ /* -------------------------------------------------------------------------- */ cholmod_factor *cholmod_analyze_p2 ( /* ---- input ---- */ int for_whom, /* FOR_SPQR (0): for SPQR but not GPU-accelerated FOR_CHOLESKY (1): for Cholesky (GPU or not) FOR_SPQRGPU (2): for SPQR with GPU acceleration */ cholmod_sparse *A, /* matrix to order and analyze */ int *UserPerm, /* user-provided permutation, size A->nrow */ int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ /* --------------- */ cholmod_common *Common ) ; cholmod_factor *cholmod_l_analyze_p2 (int, cholmod_sparse *, SuiteSparse_long *, SuiteSparse_long *, size_t, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_factorize: simplicial or supernodal Cholesky factorization */ /* -------------------------------------------------------------------------- */ /* Factorizes PAP' (or PAA'P' if A->stype is 0), using a factor obtained * from cholmod_analyze. The analysis can be re-used simply by calling this * routine a second time with another matrix. A must have the same nonzero * pattern as that passed to cholmod_analyze. */ int cholmod_factorize ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to factorize */ /* ---- in/out --- */ cholmod_factor *L, /* resulting factorization */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_factorize (cholmod_sparse *, cholmod_factor *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_factorize_p: factorize, with user-provided permutation or fset */ /* -------------------------------------------------------------------------- */ /* Same as cholmod_factorize, but with more options. */ int cholmod_factorize_p ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to factorize */ double beta [2], /* factorize beta*I+A or beta*I+A'*A */ int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ /* ---- in/out --- */ cholmod_factor *L, /* resulting factorization */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_factorize_p (cholmod_sparse *, double *, SuiteSparse_long *, size_t, cholmod_factor *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_solve: solve a linear system (simplicial or supernodal) */ /* -------------------------------------------------------------------------- */ /* Solves one of many linear systems with a dense right-hand-side, using the * factorization from cholmod_factorize (or as modified by any other CHOLMOD * routine). D is identity for LL' factorizations. */ #define CHOLMOD_A 0 /* solve Ax=b */ #define CHOLMOD_LDLt 1 /* solve LDL'x=b */ #define CHOLMOD_LD 2 /* solve LDx=b */ #define CHOLMOD_DLt 3 /* solve DL'x=b */ #define CHOLMOD_L 4 /* solve Lx=b */ #define CHOLMOD_Lt 5 /* solve L'x=b */ #define CHOLMOD_D 6 /* solve Dx=b */ #define CHOLMOD_P 7 /* permute x=Px */ #define CHOLMOD_Pt 8 /* permute x=P'x */ cholmod_dense *cholmod_solve /* returns the solution X */ ( /* ---- input ---- */ int sys, /* system to solve */ cholmod_factor *L, /* factorization to use */ cholmod_dense *B, /* right-hand-side */ /* --------------- */ cholmod_common *Common ) ; cholmod_dense *cholmod_l_solve (int, cholmod_factor *, cholmod_dense *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_solve2: like cholmod_solve, but with reusable workspace */ /* -------------------------------------------------------------------------- */ int cholmod_solve2 /* returns TRUE on success, FALSE on failure */ ( /* ---- input ---- */ int sys, /* system to solve */ cholmod_factor *L, /* factorization to use */ cholmod_dense *B, /* right-hand-side */ cholmod_sparse *Bset, /* ---- output --- */ cholmod_dense **X_Handle, /* solution, allocated if need be */ cholmod_sparse **Xset_Handle, /* ---- workspace */ cholmod_dense **Y_Handle, /* workspace, or NULL */ cholmod_dense **E_Handle, /* workspace, or NULL */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_solve2 (int, cholmod_factor *, cholmod_dense *, cholmod_sparse *, cholmod_dense **, cholmod_sparse **, cholmod_dense **, cholmod_dense **, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_spsolve: solve a linear system with a sparse right-hand-side */ /* -------------------------------------------------------------------------- */ cholmod_sparse *cholmod_spsolve ( /* ---- input ---- */ int sys, /* system to solve */ cholmod_factor *L, /* factorization to use */ cholmod_sparse *B, /* right-hand-side */ /* --------------- */ cholmod_common *Common ) ; cholmod_sparse *cholmod_l_spsolve (int, cholmod_factor *, cholmod_sparse *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_etree: find the elimination tree of A or A'*A */ /* -------------------------------------------------------------------------- */ int cholmod_etree ( /* ---- input ---- */ cholmod_sparse *A, /* ---- output --- */ int *Parent, /* size ncol. Parent [j] = p if p is the parent of j */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_etree (cholmod_sparse *, SuiteSparse_long *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_rowcolcounts: compute the row/column counts of L */ /* -------------------------------------------------------------------------- */ int cholmod_rowcolcounts ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to analyze */ int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ int *Parent, /* size nrow. Parent [i] = p if p is the parent of i */ int *Post, /* size nrow. Post [k] = i if i is the kth node in * the postordered etree. */ /* ---- output --- */ int *RowCount, /* size nrow. RowCount [i] = # entries in the ith row of * L, including the diagonal. */ int *ColCount, /* size nrow. ColCount [i] = # entries in the ith * column of L, including the diagonal. */ int *First, /* size nrow. First [i] = k is the least postordering * of any descendant of i. */ int *Level, /* size nrow. Level [i] is the length of the path from * i to the root, with Level [root] = 0. */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_rowcolcounts (cholmod_sparse *, SuiteSparse_long *, size_t, SuiteSparse_long *, SuiteSparse_long *, SuiteSparse_long *, SuiteSparse_long *, SuiteSparse_long *, SuiteSparse_long *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_analyze_ordering: analyze a fill-reducing ordering */ /* -------------------------------------------------------------------------- */ int cholmod_analyze_ordering ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to analyze */ int ordering, /* ordering method used */ int *Perm, /* size n, fill-reducing permutation to analyze */ int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ /* ---- output --- */ int *Parent, /* size n, elimination tree */ int *Post, /* size n, postordering of elimination tree */ int *ColCount, /* size n, nnz in each column of L */ /* ---- workspace */ int *First, /* size nworkspace for cholmod_postorder */ int *Level, /* size n workspace for cholmod_postorder */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_analyze_ordering (cholmod_sparse *, int, SuiteSparse_long *, SuiteSparse_long *, size_t, SuiteSparse_long *, SuiteSparse_long *, SuiteSparse_long *, SuiteSparse_long *, SuiteSparse_long *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_amd: order using AMD */ /* -------------------------------------------------------------------------- */ /* Finds a permutation P to reduce fill-in in the factorization of P*A*P' * or P*A*A'P' */ int cholmod_amd ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order */ int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ /* ---- output --- */ int *Perm, /* size A->nrow, output permutation */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_amd (cholmod_sparse *, SuiteSparse_long *, size_t, SuiteSparse_long *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_colamd: order using COLAMD */ /* -------------------------------------------------------------------------- */ /* Finds a permutation P to reduce fill-in in the factorization of P*A*A'*P'. * Orders F*F' where F = A (:,fset) if fset is not NULL */ int cholmod_colamd ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order */ int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ int postorder, /* if TRUE, follow with a coletree postorder */ /* ---- output --- */ int *Perm, /* size A->nrow, output permutation */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_colamd (cholmod_sparse *, SuiteSparse_long *, size_t, int, SuiteSparse_long *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_rowfac: incremental simplicial factorization */ /* -------------------------------------------------------------------------- */ /* Partial or complete simplicial factorization. Rows and columns kstart:kend-1 * of L and D must be initially equal to rows/columns kstart:kend-1 of the * identity matrix. Row k can only be factorized if all descendants of node * k in the elimination tree have been factorized. */ int cholmod_rowfac ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to factorize */ cholmod_sparse *F, /* used for A*A' case only. F=A' or A(:,fset)' */ double beta [2], /* factorize beta*I+A or beta*I+A'*A */ size_t kstart, /* first row to factorize */ size_t kend, /* last row to factorize is kend-1 */ /* ---- in/out --- */ cholmod_factor *L, /* --------------- */ cholmod_common *Common ) ; int cholmod_l_rowfac (cholmod_sparse *, cholmod_sparse *, double *, size_t, size_t, cholmod_factor *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_rowfac_mask: incremental simplicial factorization */ /* -------------------------------------------------------------------------- */ /* cholmod_rowfac_mask is a version of cholmod_rowfac that is specific to * LPDASA. It is unlikely to be needed by any other application. */ int cholmod_rowfac_mask ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to factorize */ cholmod_sparse *F, /* used for A*A' case only. F=A' or A(:,fset)' */ double beta [2], /* factorize beta*I+A or beta*I+A'*A */ size_t kstart, /* first row to factorize */ size_t kend, /* last row to factorize is kend-1 */ int *mask, /* if mask[i] >= 0, then set row i to zero */ int *RLinkUp, /* link list of rows to compute */ /* ---- in/out --- */ cholmod_factor *L, /* --------------- */ cholmod_common *Common ) ; int cholmod_l_rowfac_mask (cholmod_sparse *, cholmod_sparse *, double *, size_t, size_t, SuiteSparse_long *, SuiteSparse_long *, cholmod_factor *, cholmod_common *) ; int cholmod_rowfac_mask2 ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to factorize */ cholmod_sparse *F, /* used for A*A' case only. F=A' or A(:,fset)' */ double beta [2], /* factorize beta*I+A or beta*I+A'*A */ size_t kstart, /* first row to factorize */ size_t kend, /* last row to factorize is kend-1 */ int *mask, /* if mask[i] >= maskmark, then set row i to zero */ int maskmark, int *RLinkUp, /* link list of rows to compute */ /* ---- in/out --- */ cholmod_factor *L, /* --------------- */ cholmod_common *Common ) ; int cholmod_l_rowfac_mask2 (cholmod_sparse *, cholmod_sparse *, double *, size_t, size_t, SuiteSparse_long *, SuiteSparse_long, SuiteSparse_long *, cholmod_factor *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_row_subtree: find the nonzero pattern of a row of L */ /* -------------------------------------------------------------------------- */ /* Find the nonzero pattern of x for the system Lx=b where L = (0:k-1,0:k-1) * and b = kth column of A or A*A' (rows 0 to k-1 only) */ int cholmod_row_subtree ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to analyze */ cholmod_sparse *F, /* used for A*A' case only. F=A' or A(:,fset)' */ size_t k, /* row k of L */ int *Parent, /* elimination tree */ /* ---- output --- */ cholmod_sparse *R, /* pattern of L(k,:), n-by-1 with R->nzmax >= n */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_row_subtree (cholmod_sparse *, cholmod_sparse *, size_t, SuiteSparse_long *, cholmod_sparse *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_lsolve_pattern: find the nonzero pattern of x=L\b */ /* -------------------------------------------------------------------------- */ int cholmod_lsolve_pattern ( /* ---- input ---- */ cholmod_sparse *B, /* sparse right-hand-side (a single sparse column) */ cholmod_factor *L, /* the factor L from which parent(i) is derived */ /* ---- output --- */ cholmod_sparse *X, /* pattern of X=L\B, n-by-1 with X->nzmax >= n */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_lsolve_pattern (cholmod_sparse *, cholmod_factor *, cholmod_sparse *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_row_lsubtree: find the nonzero pattern of a row of L */ /* -------------------------------------------------------------------------- */ /* Identical to cholmod_row_subtree, except that it finds the elimination tree * from L itself. */ int cholmod_row_lsubtree ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to analyze */ int *Fi, size_t fnz, /* nonzero pattern of kth row of A', not required * for the symmetric case. Need not be sorted. */ size_t k, /* row k of L */ cholmod_factor *L, /* the factor L from which parent(i) is derived */ /* ---- output --- */ cholmod_sparse *R, /* pattern of L(k,:), n-by-1 with R->nzmax >= n */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_row_lsubtree (cholmod_sparse *, SuiteSparse_long *, size_t, size_t, cholmod_factor *, cholmod_sparse *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_resymbol: recompute the symbolic pattern of L */ /* -------------------------------------------------------------------------- */ /* Remove entries from L that are not in the factorization of P*A*P', P*A*A'*P', * or P*F*F'*P' (depending on A->stype and whether fset is NULL or not). * * cholmod_resymbol is the same as cholmod_resymbol_noperm, except that it * first permutes A according to L->Perm. A can be upper/lower/unsymmetric, * in contrast to cholmod_resymbol_noperm (which can be lower or unsym). */ int cholmod_resymbol ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to analyze */ int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ int pack, /* if TRUE, pack the columns of L */ /* ---- in/out --- */ cholmod_factor *L, /* factorization, entries pruned on output */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_resymbol (cholmod_sparse *, SuiteSparse_long *, size_t, int, cholmod_factor *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_resymbol_noperm: recompute the symbolic pattern of L, no L->Perm */ /* -------------------------------------------------------------------------- */ /* Remove entries from L that are not in the factorization of A, A*A', * or F*F' (depending on A->stype and whether fset is NULL or not). */ int cholmod_resymbol_noperm ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to analyze */ int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ int pack, /* if TRUE, pack the columns of L */ /* ---- in/out --- */ cholmod_factor *L, /* factorization, entries pruned on output */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_resymbol_noperm (cholmod_sparse *, SuiteSparse_long *, size_t, int, cholmod_factor *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_rcond: compute rough estimate of reciprocal of condition number */ /* -------------------------------------------------------------------------- */ double cholmod_rcond /* return min(diag(L)) / max(diag(L)) */ ( /* ---- input ---- */ cholmod_factor *L, /* --------------- */ cholmod_common *Common ) ; double cholmod_l_rcond (cholmod_factor *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_postorder: Compute the postorder of a tree */ /* -------------------------------------------------------------------------- */ SuiteSparse_long cholmod_postorder /* return # of nodes postordered */ ( /* ---- input ---- */ int *Parent, /* size n. Parent [j] = p if p is the parent of j */ size_t n, int *Weight_p, /* size n, optional. Weight [j] is weight of node j */ /* ---- output --- */ int *Post, /* size n. Post [k] = j is kth in postordered tree */ /* --------------- */ cholmod_common *Common ) ; SuiteSparse_long cholmod_l_postorder (SuiteSparse_long *, size_t, SuiteSparse_long *, SuiteSparse_long *, cholmod_common *) ; #endif Matrix/src/CHOLMOD/Include/cholmod_modify.h0000644000176200001440000003237313652535054020142 0ustar liggesusers/* ========================================================================== */ /* === Include/cholmod_modify.h ============================================= */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Include/cholmod_modify.h. * Copyright (C) 2005-2006, Timothy A. Davis and William W. Hager * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* CHOLMOD Modify module. * * Sparse Cholesky modification routines: update / downdate / rowadd / rowdel. * Can also modify a corresponding solution to Lx=b when L is modified. This * module is most useful when applied on a Cholesky factorization computed by * the Cholesky module, but it does not actually require the Cholesky module. * The Core module can create an identity Cholesky factorization (LDL' where * L=D=I) that can then by modified by these routines. * * Primary routines: * ----------------- * * cholmod_updown multiple rank update/downdate * cholmod_rowadd add a row to an LDL' factorization * cholmod_rowdel delete a row from an LDL' factorization * * Secondary routines: * ------------------- * * cholmod_updown_solve update/downdate, and modify solution to Lx=b * cholmod_updown_mark update/downdate, and modify solution to partial Lx=b * cholmod_updown_mask update/downdate for LPDASA * cholmod_updown_mask2 update/downdate for LPDASA * cholmod_rowadd_solve add a row, and update solution to Lx=b * cholmod_rowadd_mark add a row, and update solution to partial Lx=b * cholmod_rowdel_solve delete a row, and downdate Lx=b * cholmod_rowdel_mark delete a row, and downdate solution to partial Lx=b * * Requires the Core module. Not required by any other CHOLMOD module. */ #ifndef CHOLMOD_MODIFY_H #define CHOLMOD_MODIFY_H #include "cholmod_core.h" /* -------------------------------------------------------------------------- */ /* cholmod_updown: multiple rank update/downdate */ /* -------------------------------------------------------------------------- */ /* Compute the new LDL' factorization of LDL'+CC' (an update) or LDL'-CC' * (a downdate). The factor object L need not be an LDL' factorization; it * is converted to one if it isn't. */ int cholmod_updown ( /* ---- input ---- */ int update, /* TRUE for update, FALSE for downdate */ cholmod_sparse *C, /* the incoming sparse update */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_updown (int, cholmod_sparse *, cholmod_factor *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_updown_solve: update/downdate, and modify solution to Lx=b */ /* -------------------------------------------------------------------------- */ /* Does the same as cholmod_updown, except that it also updates/downdates the * solution to Lx=b+DeltaB. x and b must be n-by-1 dense matrices. b is not * need as input to this routine, but a sparse change to b is (DeltaB). Only * entries in DeltaB corresponding to columns modified in L are accessed; the * rest must be zero. */ int cholmod_updown_solve ( /* ---- input ---- */ int update, /* TRUE for update, FALSE for downdate */ cholmod_sparse *C, /* the incoming sparse update */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ cholmod_dense *X, /* solution to Lx=b (size n-by-1) */ cholmod_dense *DeltaB, /* change in b, zero on output */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_updown_solve (int, cholmod_sparse *, cholmod_factor *, cholmod_dense *, cholmod_dense *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_updown_mark: update/downdate, and modify solution to partial Lx=b */ /* -------------------------------------------------------------------------- */ /* Does the same as cholmod_updown_solve, except only part of L is used in * the update/downdate of the solution to Lx=b. This routine is an "expert" * routine. It is meant for use in LPDASA only. See cholmod_updown.c for * a description of colmark. */ int cholmod_updown_mark ( /* ---- input ---- */ int update, /* TRUE for update, FALSE for downdate */ cholmod_sparse *C, /* the incoming sparse update */ int *colmark, /* int array of size n. See cholmod_updown.c */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ cholmod_dense *X, /* solution to Lx=b (size n-by-1) */ cholmod_dense *DeltaB, /* change in b, zero on output */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_updown_mark (int, cholmod_sparse *, SuiteSparse_long *, cholmod_factor *, cholmod_dense *, cholmod_dense *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_updown_mask: update/downdate, for LPDASA */ /* -------------------------------------------------------------------------- */ /* Does the same as cholmod_updown_mark, except has an additional "mask" * argument. This routine is an "expert" routine. It is meant for use in * LPDASA only. See cholmod_updown.c for a description of mask. */ int cholmod_updown_mask ( /* ---- input ---- */ int update, /* TRUE for update, FALSE for downdate */ cholmod_sparse *C, /* the incoming sparse update */ int *colmark, /* int array of size n. See cholmod_updown.c */ int *mask, /* size n */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ cholmod_dense *X, /* solution to Lx=b (size n-by-1) */ cholmod_dense *DeltaB, /* change in b, zero on output */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_updown_mask (int, cholmod_sparse *, SuiteSparse_long *, SuiteSparse_long *, cholmod_factor *, cholmod_dense *, cholmod_dense *, cholmod_common *) ; int cholmod_updown_mask2 ( /* ---- input ---- */ int update, /* TRUE for update, FALSE for downdate */ cholmod_sparse *C, /* the incoming sparse update */ int *colmark, /* int array of size n. See cholmod_updown.c */ int *mask, /* size n */ int maskmark, /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ cholmod_dense *X, /* solution to Lx=b (size n-by-1) */ cholmod_dense *DeltaB, /* change in b, zero on output */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_updown_mask2 (int, cholmod_sparse *, SuiteSparse_long *, SuiteSparse_long *, SuiteSparse_long, cholmod_factor *, cholmod_dense *, cholmod_dense *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_rowadd: add a row to an LDL' factorization (a rank-2 update) */ /* -------------------------------------------------------------------------- */ /* cholmod_rowadd adds a row to the LDL' factorization. It computes the kth * row and kth column of L, and then updates the submatrix L (k+1:n,k+1:n) * accordingly. The kth row and column of L must originally be equal to the * kth row and column of the identity matrix. The kth row/column of L is * computed as the factorization of the kth row/column of the matrix to * factorize, which is provided as a single n-by-1 sparse matrix R. */ int cholmod_rowadd ( /* ---- input ---- */ size_t k, /* row/column index to add */ cholmod_sparse *R, /* row/column of matrix to factorize (n-by-1) */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_rowadd (size_t, cholmod_sparse *, cholmod_factor *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_rowadd_solve: add a row, and update solution to Lx=b */ /* -------------------------------------------------------------------------- */ /* Does the same as cholmod_rowadd, and also updates the solution to Lx=b * See cholmod_updown for a description of how Lx=b is updated. There is on * additional parameter: bk specifies the new kth entry of b. */ int cholmod_rowadd_solve ( /* ---- input ---- */ size_t k, /* row/column index to add */ cholmod_sparse *R, /* row/column of matrix to factorize (n-by-1) */ double bk [2], /* kth entry of the right-hand-side b */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ cholmod_dense *X, /* solution to Lx=b (size n-by-1) */ cholmod_dense *DeltaB, /* change in b, zero on output */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_rowadd_solve (size_t, cholmod_sparse *, double *, cholmod_factor *, cholmod_dense *, cholmod_dense *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_rowadd_mark: add a row, and update solution to partial Lx=b */ /* -------------------------------------------------------------------------- */ /* Does the same as cholmod_rowadd_solve, except only part of L is used in * the update/downdate of the solution to Lx=b. This routine is an "expert" * routine. It is meant for use in LPDASA only. */ int cholmod_rowadd_mark ( /* ---- input ---- */ size_t k, /* row/column index to add */ cholmod_sparse *R, /* row/column of matrix to factorize (n-by-1) */ double bk [2], /* kth entry of the right hand side, b */ int *colmark, /* int array of size n. See cholmod_updown.c */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ cholmod_dense *X, /* solution to Lx=b (size n-by-1) */ cholmod_dense *DeltaB, /* change in b, zero on output */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_rowadd_mark (size_t, cholmod_sparse *, double *, SuiteSparse_long *, cholmod_factor *, cholmod_dense *, cholmod_dense *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_rowdel: delete a row from an LDL' factorization (a rank-2 update) */ /* -------------------------------------------------------------------------- */ /* Sets the kth row and column of L to be the kth row and column of the identity * matrix, and updates L(k+1:n,k+1:n) accordingly. To reduce the running time, * the caller can optionally provide the nonzero pattern (or an upper bound) of * kth row of L, as the sparse n-by-1 vector R. Provide R as NULL if you want * CHOLMOD to determine this itself, which is easier for the caller, but takes * a little more time. */ int cholmod_rowdel ( /* ---- input ---- */ size_t k, /* row/column index to delete */ cholmod_sparse *R, /* NULL, or the nonzero pattern of kth row of L */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_rowdel (size_t, cholmod_sparse *, cholmod_factor *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_rowdel_solve: delete a row, and downdate Lx=b */ /* -------------------------------------------------------------------------- */ /* Does the same as cholmod_rowdel, but also downdates the solution to Lx=b. * When row/column k of A is "deleted" from the system A*y=b, this can induce * a change to x, in addition to changes arising when L and b are modified. * If this is the case, the kth entry of y is required as input (yk) */ int cholmod_rowdel_solve ( /* ---- input ---- */ size_t k, /* row/column index to delete */ cholmod_sparse *R, /* NULL, or the nonzero pattern of kth row of L */ double yk [2], /* kth entry in the solution to A*y=b */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ cholmod_dense *X, /* solution to Lx=b (size n-by-1) */ cholmod_dense *DeltaB, /* change in b, zero on output */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_rowdel_solve (size_t, cholmod_sparse *, double *, cholmod_factor *, cholmod_dense *, cholmod_dense *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_rowdel_mark: delete a row, and downdate solution to partial Lx=b */ /* -------------------------------------------------------------------------- */ /* Does the same as cholmod_rowdel_solve, except only part of L is used in * the update/downdate of the solution to Lx=b. This routine is an "expert" * routine. It is meant for use in LPDASA only. */ int cholmod_rowdel_mark ( /* ---- input ---- */ size_t k, /* row/column index to delete */ cholmod_sparse *R, /* NULL, or the nonzero pattern of kth row of L */ double yk [2], /* kth entry in the solution to A*y=b */ int *colmark, /* int array of size n. See cholmod_updown.c */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ cholmod_dense *X, /* solution to Lx=b (size n-by-1) */ cholmod_dense *DeltaB, /* change in b, zero on output */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_rowdel_mark (size_t, cholmod_sparse *, double *, SuiteSparse_long *, cholmod_factor *, cholmod_dense *, cholmod_dense *, cholmod_common *) ; #endif Matrix/src/CHOLMOD/Include/License.txt0000644000176200001440000000041211770402705017100 0ustar liggesusersCHOLMOD/Include/* files. Copyright (C) 2005-2006, either Univ. of Florida or T. Davis, depending on the file. Refer to each include file in this directory; each file is licensed separately, according to the Module for which it contains definitions and prototypes. Matrix/src/CHOLMOD/Include/cholmod_blas.h0000644000176200001440000003445513711014777017577 0ustar liggesusers/* ========================================================================== */ /* === Include/cholmod_blas.h =============================================== */ /* ========================================================================== */ /* For R's Matrix package (by Martin Maechler), need FCLEN FCONE : * _NOT_ the full #include * --- but just */ #define USE_FC_LEN_T #include // included by R.h, so define USE_FC_LEN_T early #ifdef FC_LEN_T //# pragma message ( "FC_LEN_T is defined -- FCLEN and FCONE are defined using it" ) // _instead of_ # include // for size_t if needed // use a "hack" : but this fails # define size_t long int // --> try to use size_t as it has been defined earlier # define FCLEN ,FC_LEN_T # define FCONE ,(FC_LEN_T)1 #else # define FCLEN # define FCONE #endif /* ----------------------------------------------------------------------------- * CHOLMOD/Include/cholmod_blas.h. * Copyright (C) 2005-2006, Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* This does not need to be included in the user's program. */ #ifndef CHOLMOD_BLAS_H #define CHOLMOD_BLAS_H /* ========================================================================== */ /* === Architecture ========================================================= */ /* ========================================================================== */ #if defined (__sun) || defined (MSOL2) || defined (ARCH_SOL2) #define CHOLMOD_SOL2 #define CHOLMOD_ARCHITECTURE "Sun Solaris" #elif defined (__sgi) || defined (MSGI) || defined (ARCH_SGI) #define CHOLMOD_SGI #define CHOLMOD_ARCHITECTURE "SGI Irix" #elif defined (__linux) || defined (MGLNX86) || defined (ARCH_GLNX86) #define CHOLMOD_LINUX #define CHOLMOD_ARCHITECTURE "Linux" #elif defined (__APPLE__) #define CHOLMOD_MAC #define CHOLMOD_ARCHITECTURE "Mac" #elif defined (_AIX) || defined (MIBM_RS) || defined (ARCH_IBM_RS) #define CHOLMOD_AIX #define CHOLMOD_ARCHITECTURE "IBM AIX" /* recent reports from IBM AIX seem to indicate that this is not needed: */ /* #define BLAS_NO_UNDERSCORE */ #elif defined (__alpha) || defined (MALPHA) || defined (ARCH_ALPHA) #define CHOLMOD_ALPHA #define CHOLMOD_ARCHITECTURE "Compaq Alpha" #elif defined (_WIN32) || defined (WIN32) || defined (_WIN64) || defined (WIN64) #if defined (__MINGW32__) || defined (__MINGW32__) #define CHOLMOD_MINGW #elif defined (__CYGWIN32__) || defined (__CYGWIN32__) #define CHOLMOD_CYGWIN #else #define CHOLMOD_WINDOWS #define BLAS_NO_UNDERSCORE #endif #define CHOLMOD_ARCHITECTURE "Microsoft Windows" #elif defined (__hppa) || defined (__hpux) || defined (MHPUX) || defined (ARCH_HPUX) #define CHOLMOD_HP #define CHOLMOD_ARCHITECTURE "HP Unix" #define BLAS_NO_UNDERSCORE #elif defined (__hp700) || defined (MHP700) || defined (ARCH_HP700) #define CHOLMOD_HP #define CHOLMOD_ARCHITECTURE "HP 700 Unix" #define BLAS_NO_UNDERSCORE #else /* If the architecture is unknown, and you call the BLAS, you may need to */ /* define BLAS_BY_VALUE, BLAS_NO_UNDERSCORE, and/or BLAS_CHAR_ARG yourself. */ #define CHOLMOD_ARCHITECTURE "unknown" #endif /* ========================================================================== */ /* === BLAS and LAPACK names ================================================ */ /* ========================================================================== */ /* Prototypes for the various versions of the BLAS. */ /* Determine if the 64-bit Sun Performance BLAS is to be used */ #if defined(CHOLMOD_SOL2) && !defined(NSUNPERF) && defined(BLAS64) #define SUN64 #endif #ifdef SUN64 #define BLAS_DTRSV dtrsv_64_ #define BLAS_DGEMV dgemv_64_ #define BLAS_DTRSM dtrsm_64_ #define BLAS_DGEMM dgemm_64_ #define BLAS_DSYRK dsyrk_64_ #define BLAS_DGER dger_64_ #define BLAS_DSCAL dscal_64_ #define LAPACK_DPOTRF dpotrf_64_ #define BLAS_ZTRSV ztrsv_64_ #define BLAS_ZGEMV zgemv_64_ #define BLAS_ZTRSM ztrsm_64_ #define BLAS_ZGEMM zgemm_64_ #define BLAS_ZHERK zherk_64_ #define BLAS_ZGER zgeru_64_ #define BLAS_ZSCAL zscal_64_ #define LAPACK_ZPOTRF zpotrf_64_ #elif defined (BLAS_NO_UNDERSCORE) #define BLAS_DTRSV dtrsv #define BLAS_DGEMV dgemv #define BLAS_DTRSM dtrsm #define BLAS_DGEMM dgemm #define BLAS_DSYRK dsyrk #define BLAS_DGER dger #define BLAS_DSCAL dscal #define LAPACK_DPOTRF dpotrf #define BLAS_ZTRSV ztrsv #define BLAS_ZGEMV zgemv #define BLAS_ZTRSM ztrsm #define BLAS_ZGEMM zgemm #define BLAS_ZHERK zherk #define BLAS_ZGER zgeru #define BLAS_ZSCAL zscal #define LAPACK_ZPOTRF zpotrf #else #define BLAS_DTRSV dtrsv_ #define BLAS_DGEMV dgemv_ #define BLAS_DTRSM dtrsm_ #define BLAS_DGEMM dgemm_ #define BLAS_DSYRK dsyrk_ #define BLAS_DGER dger_ #define BLAS_DSCAL dscal_ #define LAPACK_DPOTRF dpotrf_ #define BLAS_ZTRSV ztrsv_ #define BLAS_ZGEMV zgemv_ #define BLAS_ZTRSM ztrsm_ #define BLAS_ZGEMM zgemm_ #define BLAS_ZHERK zherk_ #define BLAS_ZGER zgeru_ #define BLAS_ZSCAL zscal_ #define LAPACK_ZPOTRF zpotrf_ #endif /* ========================================================================== */ /* === BLAS and LAPACK integer arguments ==================================== */ /* ========================================================================== */ /* Compile CHOLMOD, UMFPACK, and SPQR with -DBLAS64 if you have a BLAS that * uses 64-bit integers */ #if defined (LONGBLAS) || defined (BLAS64) #define BLAS_INT SuiteSparse_long #else #define BLAS_INT int #endif /* If the BLAS integer is smaller than the basic CHOLMOD integer, then we need * to check for integer overflow when converting from Int to BLAS_INT. If * any integer overflows, the externally-defined BLAS_OK variable is * set to FALSE. BLAS_OK should be set to TRUE before calling any * BLAS_* macro. */ #define CHECK_BLAS_INT (sizeof (BLAS_INT) < sizeof (Int)) #define EQ(K,k) (((BLAS_INT) K) == ((Int) k)) /* ========================================================================== */ /* === BLAS and LAPACK prototypes and macros ================================ */ /* ========================================================================== */ void BLAS_DGEMV (char *trans, BLAS_INT *m, BLAS_INT *n, double *alpha, double *A, BLAS_INT *lda, double *X, BLAS_INT *incx, double *beta, double *Y, BLAS_INT *incy FCLEN) ; #define BLAS_dgemv(trans,m,n,alpha,A,lda,X,incx,beta,Y,incy) \ { \ BLAS_INT M = m, N = n, LDA = lda, INCX = incx, INCY = incy ; \ if (CHECK_BLAS_INT && !(EQ (M,m) && EQ (N,n) && EQ (LDA,lda) && \ EQ (INCX,incx) && EQ (INCY,incy))) \ { \ BLAS_OK = FALSE ; \ } \ if (!CHECK_BLAS_INT || BLAS_OK) \ { \ BLAS_DGEMV (trans, &M, &N, alpha, A, &LDA, X, &INCX, beta, Y, &INCY FCONE) ; \ } \ } void BLAS_ZGEMV (char *trans, BLAS_INT *m, BLAS_INT *n, double *alpha, double *A, BLAS_INT *lda, double *X, BLAS_INT *incx, double *beta, double *Y, BLAS_INT *incy FCLEN) ; #define BLAS_zgemv(trans,m,n,alpha,A,lda,X,incx,beta,Y,incy) \ { \ BLAS_INT M = m, N = n, LDA = lda, INCX = incx, INCY = incy ; \ if (CHECK_BLAS_INT && !(EQ (M,m) && EQ (N,n) && EQ (LDA,lda) && \ EQ (INCX,incx) && EQ (INCY,incy))) \ { \ BLAS_OK = FALSE ; \ } \ if (!CHECK_BLAS_INT || BLAS_OK) \ { \ BLAS_ZGEMV (trans, &M, &N, alpha, A, &LDA, X, &INCX, beta, Y, &INCY FCONE) ; \ } \ } void BLAS_DTRSV (char *uplo, char *trans, char *diag, BLAS_INT *n, double *A, BLAS_INT *lda, double *X, BLAS_INT *incx FCLEN FCLEN FCLEN) ; #define BLAS_dtrsv(uplo,trans,diag,n,A,lda,X,incx) \ { \ BLAS_INT N = n, LDA = lda, INCX = incx ; \ if (CHECK_BLAS_INT && !(EQ (N,n) && EQ (LDA,lda) && EQ (INCX,incx))) \ { \ BLAS_OK = FALSE ; \ } \ if (!CHECK_BLAS_INT || BLAS_OK) \ { \ BLAS_DTRSV (uplo, trans, diag, &N, A, &LDA, X, &INCX FCONE FCONE FCONE) ; \ } \ } void BLAS_ZTRSV (char *uplo, char *trans, char *diag, BLAS_INT *n, double *A, BLAS_INT *lda, double *X, BLAS_INT *incx FCLEN FCLEN FCLEN) ; #define BLAS_ztrsv(uplo,trans,diag,n,A,lda,X,incx) \ { \ BLAS_INT N = n, LDA = lda, INCX = incx ; \ if (CHECK_BLAS_INT && !(EQ (N,n) && EQ (LDA,lda) && EQ (INCX,incx))) \ { \ BLAS_OK = FALSE ; \ } \ if (!CHECK_BLAS_INT || BLAS_OK) \ { \ BLAS_ZTRSV (uplo, trans, diag, &N, A, &LDA, X, &INCX FCONE FCONE FCONE) ; \ } \ } void BLAS_DTRSM (char *side, char *uplo, char *transa, char *diag, BLAS_INT *m, BLAS_INT *n, double *alpha, double *A, BLAS_INT *lda, double *B, BLAS_INT *ldb FCLEN FCLEN FCLEN FCLEN) ; #define BLAS_dtrsm(side,uplo,transa,diag,m,n,alpha,A,lda,B,ldb) \ { \ BLAS_INT M = m, N = n, LDA = lda, LDB = ldb ; \ if (CHECK_BLAS_INT && !(EQ (M,m) && EQ (N,n) && EQ (LDA,lda) && \ EQ (LDB,ldb))) \ { \ BLAS_OK = FALSE ; \ } \ if (!CHECK_BLAS_INT || BLAS_OK) \ { \ BLAS_DTRSM (side, uplo, transa, diag, &M, &N, alpha, A, &LDA, B, &LDB FCONE FCONE FCONE FCONE);\ } \ } void BLAS_ZTRSM (char *side, char *uplo, char *transa, char *diag, BLAS_INT *m, BLAS_INT *n, double *alpha, double *A, BLAS_INT *lda, double *B, BLAS_INT *ldb FCLEN FCLEN FCLEN FCLEN) ; #define BLAS_ztrsm(side,uplo,transa,diag,m,n,alpha,A,lda,B,ldb) \ { \ BLAS_INT M = m, N = n, LDA = lda, LDB = ldb ; \ if (CHECK_BLAS_INT && !(EQ (M,m) && EQ (N,n) && EQ (LDA,lda) && \ EQ (LDB,ldb))) \ { \ BLAS_OK = FALSE ; \ } \ if (!CHECK_BLAS_INT || BLAS_OK) \ { \ BLAS_ZTRSM (side, uplo, transa, diag, &M, &N, alpha, A, &LDA, B, &LDB FCONE FCONE FCONE FCONE);\ } \ } void BLAS_DGEMM (char *transa, char *transb, BLAS_INT *m, BLAS_INT *n, BLAS_INT *k, double *alpha, double *A, BLAS_INT *lda, double *B, BLAS_INT *ldb, double *beta, double *C, BLAS_INT *ldc FCLEN FCLEN) ; #define BLAS_dgemm(transa,transb,m,n,k,alpha,A,lda,B,ldb,beta,C,ldc) \ { \ BLAS_INT M = m, N = n, K = k, LDA = lda, LDB = ldb, LDC = ldc ; \ if (CHECK_BLAS_INT && !(EQ (M,m) && EQ (N,n) && EQ (K,k) && \ EQ (LDA,lda) && EQ (LDB,ldb) && EQ (LDC,ldc))) \ { \ BLAS_OK = FALSE ; \ } \ if (!CHECK_BLAS_INT || BLAS_OK) \ { \ BLAS_DGEMM (transa, transb, &M, &N, &K, alpha, A, &LDA, B, &LDB, beta, \ C, &LDC FCONE FCONE) ; \ } \ } void BLAS_ZGEMM (char *transa, char *transb, BLAS_INT *m, BLAS_INT *n, BLAS_INT *k, double *alpha, double *A, BLAS_INT *lda, double *B, BLAS_INT *ldb, double *beta, double *C, BLAS_INT *ldc FCLEN FCLEN) ; #define BLAS_zgemm(transa,transb,m,n,k,alpha,A,lda,B,ldb,beta,C,ldc) \ { \ BLAS_INT M = m, N = n, K = k, LDA = lda, LDB = ldb, LDC = ldc ; \ if (CHECK_BLAS_INT && !(EQ (M,m) && EQ (N,n) && EQ (K,k) && \ EQ (LDA,lda) && EQ (LDB,ldb) && EQ (LDC,ldc))) \ { \ BLAS_OK = FALSE ; \ } \ if (!CHECK_BLAS_INT || BLAS_OK) \ { \ BLAS_ZGEMM (transa, transb, &M, &N, &K, alpha, A, &LDA, B, &LDB, beta, \ C, &LDC FCONE FCONE) ; \ } \ } void BLAS_DSYRK (char *uplo, char *trans, BLAS_INT *n, BLAS_INT *k, double *alpha, double *A, BLAS_INT *lda, double *beta, double *C, BLAS_INT *ldc FCLEN FCLEN) ; #define BLAS_dsyrk(uplo,trans,n,k,alpha,A,lda,beta,C,ldc) \ { \ BLAS_INT N = n, K = k, LDA = lda, LDC = ldc ; \ if (CHECK_BLAS_INT && !(EQ (N,n) && EQ (K,k) && EQ (LDA,lda) && \ EQ (LDC,ldc))) \ { \ BLAS_OK = FALSE ; \ } \ if (!CHECK_BLAS_INT || BLAS_OK) \ { \ BLAS_DSYRK (uplo, trans, &N, &K, alpha, A, &LDA, beta, C, &LDC FCONE FCONE) ; \ } \ } \ void BLAS_ZHERK (char *uplo, char *trans, BLAS_INT *n, BLAS_INT *k, double *alpha, double *A, BLAS_INT *lda, double *beta, double *C, BLAS_INT *ldc FCLEN FCLEN) ; #define BLAS_zherk(uplo,trans,n,k,alpha,A,lda,beta,C,ldc) \ { \ BLAS_INT N = n, K = k, LDA = lda, LDC = ldc ; \ if (CHECK_BLAS_INT && !(EQ (N,n) && EQ (K,k) && EQ (LDA,lda) && \ EQ (LDC,ldc))) \ { \ BLAS_OK = FALSE ; \ } \ if (!CHECK_BLAS_INT || BLAS_OK) \ { \ BLAS_ZHERK (uplo, trans, &N, &K, alpha, A, &LDA, beta, C, &LDC FCONE FCONE) ; \ } \ } \ void LAPACK_DPOTRF (char *uplo, BLAS_INT *n, double *A, BLAS_INT *lda, BLAS_INT *info FCLEN) ; #define LAPACK_dpotrf(uplo,n,A,lda,info) \ { \ BLAS_INT N = n, LDA = lda, INFO = 1 ; \ if (CHECK_BLAS_INT && !(EQ (N,n) && EQ (LDA,lda))) \ { \ BLAS_OK = FALSE ; \ } \ if (!CHECK_BLAS_INT || BLAS_OK) \ { \ LAPACK_DPOTRF (uplo, &N, A, &LDA, &INFO FCONE) ; \ } \ info = INFO ; \ } void LAPACK_ZPOTRF (char *uplo, BLAS_INT *n, double *A, BLAS_INT *lda, BLAS_INT *info FCLEN) ; #define LAPACK_zpotrf(uplo,n,A,lda,info) \ { \ BLAS_INT N = n, LDA = lda, INFO = 1 ; \ if (CHECK_BLAS_INT && !(EQ (N,n) && EQ (LDA,lda))) \ { \ BLAS_OK = FALSE ; \ } \ if (!CHECK_BLAS_INT || BLAS_OK) \ { \ LAPACK_ZPOTRF (uplo, &N, A, &LDA, &INFO FCONE) ; \ } \ info = INFO ; \ } /* ========================================================================== */ void BLAS_DSCAL (BLAS_INT *n, double *alpha, double *Y, BLAS_INT *incy) ; #define BLAS_dscal(n,alpha,Y,incy) \ { \ BLAS_INT N = n, INCY = incy ; \ if (CHECK_BLAS_INT && !(EQ (N,n) && EQ (INCY,incy))) \ { \ BLAS_OK = FALSE ; \ } \ if (!CHECK_BLAS_INT || BLAS_OK) \ { \ BLAS_DSCAL (&N, alpha, Y, &INCY) ; \ } \ } void BLAS_ZSCAL (BLAS_INT *n, double *alpha, double *Y, BLAS_INT *incy) ; #define BLAS_zscal(n,alpha,Y,incy) \ { \ BLAS_INT N = n, INCY = incy ; \ if (CHECK_BLAS_INT && !(EQ (N,n) && EQ (INCY,incy))) \ { \ BLAS_OK = FALSE ; \ } \ if (!CHECK_BLAS_INT || BLAS_OK) \ { \ BLAS_ZSCAL (&N, alpha, Y, &INCY) ; \ } \ } void BLAS_DGER (BLAS_INT *m, BLAS_INT *n, double *alpha, double *X, BLAS_INT *incx, double *Y, BLAS_INT *incy, double *A, BLAS_INT *lda) ; #define BLAS_dger(m,n,alpha,X,incx,Y,incy,A,lda) \ { \ BLAS_INT M = m, N = n, LDA = lda, INCX = incx, INCY = incy ; \ if (CHECK_BLAS_INT && !(EQ (M,m) && EQ (N,n) && EQ (LDA,lda) && \ EQ (INCX,incx) && EQ (INCY,incy))) \ { \ BLAS_OK = FALSE ; \ } \ if (!CHECK_BLAS_INT || BLAS_OK) \ { \ BLAS_DGER (&M, &N, alpha, X, &INCX, Y, &INCY, A, &LDA) ; \ } \ } void BLAS_ZGER (BLAS_INT *m, BLAS_INT *n, double *alpha, double *X, BLAS_INT *incx, double *Y, BLAS_INT *incy, double *A, BLAS_INT *lda) ; #define BLAS_zgeru(m,n,alpha,X,incx,Y,incy,A,lda) \ { \ BLAS_INT M = m, N = n, LDA = lda, INCX = incx, INCY = incy ; \ if (CHECK_BLAS_INT && !(EQ (M,m) && EQ (N,n) && EQ (LDA,lda) && \ EQ (INCX,incx) && EQ (INCY,incy))) \ { \ BLAS_OK = FALSE ; \ } \ if (!CHECK_BLAS_INT || BLAS_OK) \ { \ BLAS_ZGER (&M, &N, alpha, X, &INCX, Y, &INCY, A, &LDA) ; \ } \ } #endif Matrix/src/CHOLMOD/Include/cholmod_partition.h0000644000176200001440000001535413652535054020664 0ustar liggesusers/* ========================================================================== */ /* === Include/cholmod_partition.h ========================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Include/cholmod_partition.h. * Copyright (C) 2005-2013, Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* CHOLMOD Partition module. * * Graph partitioning and graph-partition-based orderings. Includes an * interface to CCOLAMD and CSYMAMD, constrained minimum degree ordering * methods which order a matrix following constraints determined via nested * dissection. * * These functions require METIS: * cholmod_nested_dissection CHOLMOD nested dissection ordering * cholmod_metis METIS nested dissection ordering (METIS_NodeND) * cholmod_bisect graph partitioner (currently based on METIS) * cholmod_metis_bisector direct interface to METIS_ComputeVertexSeparator * * Requires the Core and Cholesky modules, and three packages: METIS, CAMD, * and CCOLAMD. Optionally used by the Cholesky module. * * Note that METIS does not have a version that uses SuiteSparse_long integers. * If you try to use cholmod_nested_dissection, cholmod_metis, cholmod_bisect, * or cholmod_metis_bisector on a matrix that is too large, an error code will * be returned. METIS does have an "idxtype", which could be redefined as * SuiteSparse_long, if you wish to edit METIS or use compile-time flags to * redefine idxtype. */ #ifndef CHOLMOD_PARTITION_H #define CHOLMOD_PARTITION_H #include "cholmod_core.h" #include "cholmod_camd.h" /* -------------------------------------------------------------------------- */ /* cholmod_nested_dissection */ /* -------------------------------------------------------------------------- */ /* Order A, AA', or A(:,f)*A(:,f)' using CHOLMOD's nested dissection method * (METIS's node bisector applied recursively to compute the separator tree * and constraint sets, followed by CCOLAMD using the constraints). Usually * finds better orderings than METIS_NodeND, but takes longer. */ SuiteSparse_long cholmod_nested_dissection /* returns # of components */ ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order */ int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ /* ---- output --- */ int *Perm, /* size A->nrow, output permutation */ int *CParent, /* size A->nrow. On output, CParent [c] is the parent * of component c, or EMPTY if c is a root, and where * c is in the range 0 to # of components minus 1 */ int *Cmember, /* size A->nrow. Cmember [j] = c if node j of A is * in component c */ /* --------------- */ cholmod_common *Common ) ; SuiteSparse_long cholmod_l_nested_dissection (cholmod_sparse *, SuiteSparse_long *, size_t, SuiteSparse_long *, SuiteSparse_long *, SuiteSparse_long *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_metis */ /* -------------------------------------------------------------------------- */ /* Order A, AA', or A(:,f)*A(:,f)' using METIS_NodeND. */ int cholmod_metis ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order */ int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ int postorder, /* if TRUE, follow with etree or coletree postorder */ /* ---- output --- */ int *Perm, /* size A->nrow, output permutation */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_metis (cholmod_sparse *, SuiteSparse_long *, size_t, int, SuiteSparse_long *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_bisect */ /* -------------------------------------------------------------------------- */ /* Finds a node bisector of A, A*A', A(:,f)*A(:,f)'. */ SuiteSparse_long cholmod_bisect /* returns # of nodes in separator */ ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to bisect */ int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ int compress, /* if TRUE, compress the graph first */ /* ---- output --- */ int *Partition, /* size A->nrow. Node i is in the left graph if * Partition [i] = 0, the right graph if 1, and in the * separator if 2. */ /* --------------- */ cholmod_common *Common ) ; SuiteSparse_long cholmod_l_bisect (cholmod_sparse *, SuiteSparse_long *, size_t, int, SuiteSparse_long *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_metis_bisector */ /* -------------------------------------------------------------------------- */ /* Find a set of nodes that bisects the graph of A or AA' (direct interface * to METIS_ComputeVertexSeperator). */ SuiteSparse_long cholmod_metis_bisector /* returns separator size */ ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to bisect */ int *Anw, /* size A->nrow, node weights, can be NULL, */ /* which means the graph is unweighted. */ int *Aew, /* size nz, edge weights (silently ignored). */ /* This option was available with METIS 4, but not */ /* in METIS 5. This argument is now unused, but */ /* it remains for backward compatibilty, so as not */ /* to change the API for cholmod_metis_bisector. */ /* ---- output --- */ int *Partition, /* size A->nrow */ /* --------------- */ cholmod_common *Common ) ; SuiteSparse_long cholmod_l_metis_bisector (cholmod_sparse *, SuiteSparse_long *, SuiteSparse_long *, SuiteSparse_long *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_collapse_septree */ /* -------------------------------------------------------------------------- */ /* Collapse nodes in a separator tree. */ SuiteSparse_long cholmod_collapse_septree ( /* ---- input ---- */ size_t n, /* # of nodes in the graph */ size_t ncomponents, /* # of nodes in the separator tree (must be <= n) */ double nd_oksep, /* collapse if #sep >= nd_oksep * #nodes in subtree */ size_t nd_small, /* collapse if #nodes in subtree < nd_small */ /* ---- in/out --- */ int *CParent, /* size ncomponents; from cholmod_nested_dissection */ int *Cmember, /* size n; from cholmod_nested_dissection */ /* --------------- */ cholmod_common *Common ) ; SuiteSparse_long cholmod_l_collapse_septree (size_t, size_t, double, size_t, SuiteSparse_long *, SuiteSparse_long *, cholmod_common *) ; #endif Matrix/src/CHOLMOD/Include/cholmod_matrixops.h0000644000176200001440000002042013652535054020667 0ustar liggesusers/* ========================================================================== */ /* === Include/cholmod_matrixops.h ========================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Include/cholmod_matrixops.h. * Copyright (C) 2005-2006, Timothy A. Davis * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* CHOLMOD MatrixOps module. * * Basic operations on sparse and dense matrices. * * cholmod_drop A = entries in A with abs. value >= tol * cholmod_norm_dense s = norm (X), 1-norm, inf-norm, or 2-norm * cholmod_norm_sparse s = norm (A), 1-norm or inf-norm * cholmod_horzcat C = [A,B] * cholmod_scale A = diag(s)*A, A*diag(s), s*A or diag(s)*A*diag(s) * cholmod_sdmult Y = alpha*(A*X) + beta*Y or alpha*(A'*X) + beta*Y * cholmod_ssmult C = A*B * cholmod_submatrix C = A (i,j), where i and j are arbitrary vectors * cholmod_vertcat C = [A ; B] * * A, B, C: sparse matrices (cholmod_sparse) * X, Y: dense matrices (cholmod_dense) * s: scalar or vector * * Requires the Core module. Not required by any other CHOLMOD module. */ #ifndef CHOLMOD_MATRIXOPS_H #define CHOLMOD_MATRIXOPS_H #include "cholmod_core.h" /* -------------------------------------------------------------------------- */ /* cholmod_drop: drop entries with small absolute value */ /* -------------------------------------------------------------------------- */ int cholmod_drop ( /* ---- input ---- */ double tol, /* keep entries with absolute value > tol */ /* ---- in/out --- */ cholmod_sparse *A, /* matrix to drop entries from */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_drop (double, cholmod_sparse *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_norm_dense: s = norm (X), 1-norm, inf-norm, or 2-norm */ /* -------------------------------------------------------------------------- */ double cholmod_norm_dense ( /* ---- input ---- */ cholmod_dense *X, /* matrix to compute the norm of */ int norm, /* type of norm: 0: inf. norm, 1: 1-norm, 2: 2-norm */ /* --------------- */ cholmod_common *Common ) ; double cholmod_l_norm_dense (cholmod_dense *, int, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_norm_sparse: s = norm (A), 1-norm or inf-norm */ /* -------------------------------------------------------------------------- */ double cholmod_norm_sparse ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to compute the norm of */ int norm, /* type of norm: 0: inf. norm, 1: 1-norm */ /* --------------- */ cholmod_common *Common ) ; double cholmod_l_norm_sparse (cholmod_sparse *, int, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_horzcat: C = [A,B] */ /* -------------------------------------------------------------------------- */ cholmod_sparse *cholmod_horzcat ( /* ---- input ---- */ cholmod_sparse *A, /* left matrix to concatenate */ cholmod_sparse *B, /* right matrix to concatenate */ int values, /* if TRUE compute the numerical values of C */ /* --------------- */ cholmod_common *Common ) ; cholmod_sparse *cholmod_l_horzcat (cholmod_sparse *, cholmod_sparse *, int, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_scale: A = diag(s)*A, A*diag(s), s*A or diag(s)*A*diag(s) */ /* -------------------------------------------------------------------------- */ /* scaling modes, selected by the scale input parameter: */ #define CHOLMOD_SCALAR 0 /* A = s*A */ #define CHOLMOD_ROW 1 /* A = diag(s)*A */ #define CHOLMOD_COL 2 /* A = A*diag(s) */ #define CHOLMOD_SYM 3 /* A = diag(s)*A*diag(s) */ int cholmod_scale ( /* ---- input ---- */ cholmod_dense *S, /* scale factors (scalar or vector) */ int scale, /* type of scaling to compute */ /* ---- in/out --- */ cholmod_sparse *A, /* matrix to scale */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_scale (cholmod_dense *, int, cholmod_sparse *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_sdmult: Y = alpha*(A*X) + beta*Y or alpha*(A'*X) + beta*Y */ /* -------------------------------------------------------------------------- */ /* Sparse matrix times dense matrix */ int cholmod_sdmult ( /* ---- input ---- */ cholmod_sparse *A, /* sparse matrix to multiply */ int transpose, /* use A if 0, or A' otherwise */ double alpha [2], /* scale factor for A */ double beta [2], /* scale factor for Y */ cholmod_dense *X, /* dense matrix to multiply */ /* ---- in/out --- */ cholmod_dense *Y, /* resulting dense matrix */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_sdmult (cholmod_sparse *, int, double *, double *, cholmod_dense *, cholmod_dense *Y, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_ssmult: C = A*B */ /* -------------------------------------------------------------------------- */ /* Sparse matrix times sparse matrix */ cholmod_sparse *cholmod_ssmult ( /* ---- input ---- */ cholmod_sparse *A, /* left matrix to multiply */ cholmod_sparse *B, /* right matrix to multiply */ int stype, /* requested stype of C */ int values, /* TRUE: do numerical values, FALSE: pattern only */ int sorted, /* if TRUE then return C with sorted columns */ /* --------------- */ cholmod_common *Common ) ; cholmod_sparse *cholmod_l_ssmult (cholmod_sparse *, cholmod_sparse *, int, int, int, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_submatrix: C = A (r,c), where i and j are arbitrary vectors */ /* -------------------------------------------------------------------------- */ /* rsize < 0 denotes ":" in MATLAB notation, or more precisely 0:(A->nrow)-1. * In this case, r can be NULL. An rsize of zero, or r = NULL and rsize >= 0, * denotes "[ ]" in MATLAB notation (the empty set). * Similar rules hold for csize. */ cholmod_sparse *cholmod_submatrix ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to subreference */ int *rset, /* set of row indices, duplicates OK */ SuiteSparse_long rsize, /* size of r; rsize < 0 denotes ":" */ int *cset, /* set of column indices, duplicates OK */ SuiteSparse_long csize, /* size of c; csize < 0 denotes ":" */ int values, /* if TRUE compute the numerical values of C */ int sorted, /* if TRUE then return C with sorted columns */ /* --------------- */ cholmod_common *Common ) ; cholmod_sparse *cholmod_l_submatrix (cholmod_sparse *, SuiteSparse_long *, SuiteSparse_long, SuiteSparse_long *, SuiteSparse_long, int, int, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_vertcat: C = [A ; B] */ /* -------------------------------------------------------------------------- */ cholmod_sparse *cholmod_vertcat ( /* ---- input ---- */ cholmod_sparse *A, /* left matrix to concatenate */ cholmod_sparse *B, /* right matrix to concatenate */ int values, /* if TRUE compute the numerical values of C */ /* --------------- */ cholmod_common *Common ) ; cholmod_sparse *cholmod_l_vertcat (cholmod_sparse *, cholmod_sparse *, int, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_symmetry: determine if a sparse matrix is symmetric */ /* -------------------------------------------------------------------------- */ int cholmod_symmetry ( /* ---- input ---- */ cholmod_sparse *A, int option, /* ---- output ---- */ int *xmatched, int *pmatched, int *nzoffdiag, int *nzdiag, /* --------------- */ cholmod_common *Common ) ; int cholmod_l_symmetry (cholmod_sparse *, int, SuiteSparse_long *, SuiteSparse_long *, SuiteSparse_long *, SuiteSparse_long *, cholmod_common *) ; #endif Matrix/src/CHOLMOD/Include/cholmod_check.h0000644000176200001440000003500313652535054017721 0ustar liggesusers/* ========================================================================== */ /* === Include/cholmod_check.h ============================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Include/cholmod_check.h. Copyright (C) 2005-2006, Timothy A. Davis * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* CHOLMOD Check module. * * Routines that check and print the 5 basic data types in CHOLMOD, and 3 kinds * of integer vectors (subset, perm, and parent), and read in matrices from a * file: * * cholmod_check_common check/print the Common object * cholmod_print_common * * cholmod_check_sparse check/print a sparse matrix in column-oriented form * cholmod_print_sparse * * cholmod_check_dense check/print a dense matrix * cholmod_print_dense * * cholmod_check_factor check/print a Cholesky factorization * cholmod_print_factor * * cholmod_check_triplet check/print a sparse matrix in triplet form * cholmod_print_triplet * * cholmod_check_subset check/print a subset (integer vector in given range) * cholmod_print_subset * * cholmod_check_perm check/print a permutation (an integer vector) * cholmod_print_perm * * cholmod_check_parent check/print an elimination tree (an integer vector) * cholmod_print_parent * * cholmod_read_triplet read a matrix in triplet form (any Matrix Market * "coordinate" format, or a generic triplet format). * * cholmod_read_sparse read a matrix in sparse form (same file format as * cholmod_read_triplet). * * cholmod_read_dense read a dense matrix (any Matrix Market "array" * format, or a generic dense format). * * cholmod_write_sparse write a sparse matrix to a Matrix Market file. * * cholmod_write_dense write a dense matrix to a Matrix Market file. * * cholmod_print_common and cholmod_check_common are the only two routines that * you may call after calling cholmod_finish. * * Requires the Core module. Not required by any CHOLMOD module, except when * debugging is enabled (in which case all modules require the Check module). * * See cholmod_read.c for a description of the file formats supported by the * cholmod_read_* routines. */ #ifndef CHOLMOD_CHECK_H #define CHOLMOD_CHECK_H #include "cholmod_core.h" #include /* -------------------------------------------------------------------------- */ /* cholmod_check_common: check the Common object */ /* -------------------------------------------------------------------------- */ int cholmod_check_common ( cholmod_common *Common ) ; int cholmod_l_check_common (cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_print_common: print the Common object */ /* -------------------------------------------------------------------------- */ int cholmod_print_common ( /* ---- input ---- */ const char *name, /* printed name of Common object */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_print_common (const char *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_gpu_stats: print the GPU / CPU statistics */ /* -------------------------------------------------------------------------- */ int cholmod_gpu_stats (cholmod_common *) ; int cholmod_l_gpu_stats (cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_check_sparse: check a sparse matrix */ /* -------------------------------------------------------------------------- */ int cholmod_check_sparse ( /* ---- input ---- */ cholmod_sparse *A, /* sparse matrix to check */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_check_sparse (cholmod_sparse *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_print_sparse */ /* -------------------------------------------------------------------------- */ int cholmod_print_sparse ( /* ---- input ---- */ cholmod_sparse *A, /* sparse matrix to print */ const char *name, /* printed name of sparse matrix */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_print_sparse (cholmod_sparse *, const char *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_check_dense: check a dense matrix */ /* -------------------------------------------------------------------------- */ int cholmod_check_dense ( /* ---- input ---- */ cholmod_dense *X, /* dense matrix to check */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_check_dense (cholmod_dense *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_print_dense: print a dense matrix */ /* -------------------------------------------------------------------------- */ int cholmod_print_dense ( /* ---- input ---- */ cholmod_dense *X, /* dense matrix to print */ const char *name, /* printed name of dense matrix */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_print_dense (cholmod_dense *, const char *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_check_factor: check a factor */ /* -------------------------------------------------------------------------- */ int cholmod_check_factor ( /* ---- input ---- */ cholmod_factor *L, /* factor to check */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_check_factor (cholmod_factor *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_print_factor: print a factor */ /* -------------------------------------------------------------------------- */ int cholmod_print_factor ( /* ---- input ---- */ cholmod_factor *L, /* factor to print */ const char *name, /* printed name of factor */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_print_factor (cholmod_factor *, const char *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_check_triplet: check a sparse matrix in triplet form */ /* -------------------------------------------------------------------------- */ int cholmod_check_triplet ( /* ---- input ---- */ cholmod_triplet *T, /* triplet matrix to check */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_check_triplet (cholmod_triplet *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_print_triplet: print a triplet matrix */ /* -------------------------------------------------------------------------- */ int cholmod_print_triplet ( /* ---- input ---- */ cholmod_triplet *T, /* triplet matrix to print */ const char *name, /* printed name of triplet matrix */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_print_triplet (cholmod_triplet *, const char *, cholmod_common *); /* -------------------------------------------------------------------------- */ /* cholmod_check_subset: check a subset */ /* -------------------------------------------------------------------------- */ int cholmod_check_subset ( /* ---- input ---- */ int *Set, /* Set [0:len-1] is a subset of 0:n-1. Duplicates OK */ SuiteSparse_long len, /* size of Set (an integer array) */ size_t n, /* 0:n-1 is valid range */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_check_subset (SuiteSparse_long *, SuiteSparse_long, size_t, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_print_subset: print a subset */ /* -------------------------------------------------------------------------- */ int cholmod_print_subset ( /* ---- input ---- */ int *Set, /* Set [0:len-1] is a subset of 0:n-1. Duplicates OK */ SuiteSparse_long len, /* size of Set (an integer array) */ size_t n, /* 0:n-1 is valid range */ const char *name, /* printed name of Set */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_print_subset (SuiteSparse_long *, SuiteSparse_long, size_t, const char *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_check_perm: check a permutation */ /* -------------------------------------------------------------------------- */ int cholmod_check_perm ( /* ---- input ---- */ int *Perm, /* Perm [0:len-1] is a permutation of subset of 0:n-1 */ size_t len, /* size of Perm (an integer array) */ size_t n, /* 0:n-1 is valid range */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_check_perm (SuiteSparse_long *, size_t, size_t, cholmod_common *); /* -------------------------------------------------------------------------- */ /* cholmod_print_perm: print a permutation vector */ /* -------------------------------------------------------------------------- */ int cholmod_print_perm ( /* ---- input ---- */ int *Perm, /* Perm [0:len-1] is a permutation of subset of 0:n-1 */ size_t len, /* size of Perm (an integer array) */ size_t n, /* 0:n-1 is valid range */ const char *name, /* printed name of Perm */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_print_perm (SuiteSparse_long *, size_t, size_t, const char *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_check_parent: check an elimination tree */ /* -------------------------------------------------------------------------- */ int cholmod_check_parent ( /* ---- input ---- */ int *Parent, /* Parent [0:n-1] is an elimination tree */ size_t n, /* size of Parent */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_check_parent (SuiteSparse_long *, size_t, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_print_parent */ /* -------------------------------------------------------------------------- */ int cholmod_print_parent ( /* ---- input ---- */ int *Parent, /* Parent [0:n-1] is an elimination tree */ size_t n, /* size of Parent */ const char *name, /* printed name of Parent */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_print_parent (SuiteSparse_long *, size_t, const char *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_read_sparse: read a sparse matrix from a file */ /* -------------------------------------------------------------------------- */ cholmod_sparse *cholmod_read_sparse ( /* ---- input ---- */ FILE *f, /* file to read from, must already be open */ /* --------------- */ cholmod_common *Common ) ; cholmod_sparse *cholmod_l_read_sparse (FILE *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_read_triplet: read a triplet matrix from a file */ /* -------------------------------------------------------------------------- */ cholmod_triplet *cholmod_read_triplet ( /* ---- input ---- */ FILE *f, /* file to read from, must already be open */ /* --------------- */ cholmod_common *Common ) ; cholmod_triplet *cholmod_l_read_triplet (FILE *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_read_dense: read a dense matrix from a file */ /* -------------------------------------------------------------------------- */ cholmod_dense *cholmod_read_dense ( /* ---- input ---- */ FILE *f, /* file to read from, must already be open */ /* --------------- */ cholmod_common *Common ) ; cholmod_dense *cholmod_l_read_dense (FILE *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_read_matrix: read a sparse or dense matrix from a file */ /* -------------------------------------------------------------------------- */ void *cholmod_read_matrix ( /* ---- input ---- */ FILE *f, /* file to read from, must already be open */ int prefer, /* If 0, a sparse matrix is always return as a * cholmod_triplet form. It can have any stype * (symmetric-lower, unsymmetric, or * symmetric-upper). * If 1, a sparse matrix is returned as an unsymmetric * cholmod_sparse form (A->stype == 0), with both * upper and lower triangular parts present. * This is what the MATLAB mread mexFunction does, * since MATLAB does not have an stype. * If 2, a sparse matrix is returned with an stype of 0 * or 1 (unsymmetric, or symmetric with upper part * stored). * This argument has no effect for dense matrices. */ /* ---- output---- */ int *mtype, /* CHOLMOD_TRIPLET, CHOLMOD_SPARSE or CHOLMOD_DENSE */ /* --------------- */ cholmod_common *Common ) ; void *cholmod_l_read_matrix (FILE *, int, int *, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_write_sparse: write a sparse matrix to a file */ /* -------------------------------------------------------------------------- */ int cholmod_write_sparse ( /* ---- input ---- */ FILE *f, /* file to write to, must already be open */ cholmod_sparse *A, /* matrix to print */ cholmod_sparse *Z, /* optional matrix with pattern of explicit zeros */ const char *comments, /* optional filename of comments to include */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_write_sparse (FILE *, cholmod_sparse *, cholmod_sparse *, const char *c, cholmod_common *) ; /* -------------------------------------------------------------------------- */ /* cholmod_write_dense: write a dense matrix to a file */ /* -------------------------------------------------------------------------- */ int cholmod_write_dense ( /* ---- input ---- */ FILE *f, /* file to write to, must already be open */ cholmod_dense *X, /* matrix to print */ const char *comments, /* optional filename of comments to include */ /* --------------- */ cholmod_common *Common ) ; int cholmod_l_write_dense (FILE *, cholmod_dense *, const char *, cholmod_common *) ; #endif Matrix/src/CHOLMOD/Include/cholmod_complexity.h0000644000176200001440000002231013652535054021036 0ustar liggesusers/* ========================================================================== */ /* === Include/cholmod_complexity.h ========================================= */ /* ========================================================================== */ /* Define operations on pattern, real, complex, and zomplex objects. * * The xtype of an object defines it numerical type. A qttern object has no * numerical values (A->x and A->z are NULL). A real object has no imaginary * qrt (A->x is used, A->z is NULL). A complex object has an imaginary qrt * that is stored interleaved with its real qrt (A->x is of size 2*nz, A->z * is NULL). A zomplex object has both real and imaginary qrts, which are * stored seqrately, as in MATLAB (A->x and A->z are both used). * * XTYPE is CHOLMOD_PATTERN, _REAL, _COMPLEX or _ZOMPLEX, and is the xtype of * the template routine under construction. XTYPE2 is equal to XTYPE, except * if XTYPE is CHOLMOD_PATTERN, in which case XTYPE is CHOLMOD_REAL. * XTYPE and XTYPE2 are defined in cholmod_template.h. */ /* -------------------------------------------------------------------------- */ /* pattern */ /* -------------------------------------------------------------------------- */ #define P_TEMPLATE(name) p_ ## name #define P_ASSIGN2(x,z,p,ax,az,q) x [p] = 1 #define P_PRINT(k,x,z,p) PRK(k, ("1")) /* -------------------------------------------------------------------------- */ /* real */ /* -------------------------------------------------------------------------- */ #define R_TEMPLATE(name) r_ ## name #define R_ASSEMBLE(x,z,p,ax,az,q) x [p] += ax [q] #define R_ASSIGN(x,z,p,ax,az,q) x [p] = ax [q] #define R_ASSIGN_CONJ(x,z,p,ax,az,q) x [p] = ax [q] #define R_ASSIGN_REAL(x,p,ax,q) x [p] = ax [q] #define R_XTYPE_OK(type) ((type) == CHOLMOD_REAL) #define R_IS_NONZERO(ax,az,q) IS_NONZERO (ax [q]) #define R_IS_ZERO(ax,az,q) IS_ZERO (ax [q]) #define R_IS_ONE(ax,az,q) (ax [q] == 1) #define R_MULT(x,z,p, ax,az,q, bx,bz,r) x [p] = ax [q] * bx [r] #define R_MULTADD(x,z,p, ax,az,q, bx,bz,r) x [p] += ax [q] * bx [r] #define R_MULTSUB(x,z,p, ax,az,q, bx,bz,r) x [p] -= ax [q] * bx [r] #define R_MULTADDCONJ(x,z,p, ax,az,q, bx,bz,r) x [p] += ax [q] * bx [r] #define R_MULTSUBCONJ(x,z,p, ax,az,q, bx,bz,r) x [p] -= ax [q] * bx [r] #define R_ADD(x,z,p, ax,az,q, bx,bz,r) x [p] = ax [q] + bx [r] #define R_ADD_REAL(x,p, ax,q, bx,r) x [p] = ax [q] + bx [r] #define R_CLEAR(x,z,p) x [p] = 0 #define R_CLEAR_IMAG(x,z,p) #define R_DIV(x,z,p,ax,az,q) x [p] /= ax [q] #define R_LLDOT(x,p, ax,az,q) x [p] -= ax [q] * ax [q] #define R_PRINT(k,x,z,p) PRK(k, ("%24.16e", x [p])) #define R_DIV_REAL(x,z,p, ax,az,q, bx,r) x [p] = ax [q] / bx [r] #define R_MULT_REAL(x,z,p, ax,az,q, bx,r) x [p] = ax [q] * bx [r] #define R_LDLDOT(x,p, ax,az,q, bx,r) x [p] -=(ax[q] * ax[q])/ bx[r] /* -------------------------------------------------------------------------- */ /* complex */ /* -------------------------------------------------------------------------- */ #define C_TEMPLATE(name) c_ ## name #define CT_TEMPLATE(name) ct_ ## name #define C_ASSEMBLE(x,z,p,ax,az,q) \ x [2*(p) ] += ax [2*(q) ] ; \ x [2*(p)+1] += ax [2*(q)+1] #define C_ASSIGN(x,z,p,ax,az,q) \ x [2*(p) ] = ax [2*(q) ] ; \ x [2*(p)+1] = ax [2*(q)+1] #define C_ASSIGN_REAL(x,p,ax,q) x [2*(p)] = ax [2*(q)] #define C_ASSIGN_CONJ(x,z,p,ax,az,q) \ x [2*(p) ] = ax [2*(q) ] ; \ x [2*(p)+1] = -ax [2*(q)+1] #define C_XTYPE_OK(type) ((type) == CHOLMOD_COMPLEX) #define C_IS_NONZERO(ax,az,q) \ (IS_NONZERO (ax [2*(q)]) || IS_NONZERO (ax [2*(q)+1])) #define C_IS_ZERO(ax,az,q) \ (IS_ZERO (ax [2*(q)]) && IS_ZERO (ax [2*(q)+1])) #define C_IS_ONE(ax,az,q) \ ((ax [2*(q)] == 1) && IS_ZERO (ax [2*(q)+1])) #define C_IMAG_IS_NONZERO(ax,az,q) (IS_NONZERO (ax [2*(q)+1])) #define C_MULT(x,z,p, ax,az,q, bx,bz,r) \ x [2*(p) ] = ax [2*(q) ] * bx [2*(r)] - ax [2*(q)+1] * bx [2*(r)+1] ; \ x [2*(p)+1] = ax [2*(q)+1] * bx [2*(r)] + ax [2*(q) ] * bx [2*(r)+1] #define C_MULTADD(x,z,p, ax,az,q, bx,bz,r) \ x [2*(p) ] += ax [2*(q) ] * bx [2*(r)] - ax [2*(q)+1] * bx [2*(r)+1] ; \ x [2*(p)+1] += ax [2*(q)+1] * bx [2*(r)] + ax [2*(q) ] * bx [2*(r)+1] #define C_MULTSUB(x,z,p, ax,az,q, bx,bz,r) \ x [2*(p) ] -= ax [2*(q) ] * bx [2*(r)] - ax [2*(q)+1] * bx [2*(r)+1] ; \ x [2*(p)+1] -= ax [2*(q)+1] * bx [2*(r)] + ax [2*(q) ] * bx [2*(r)+1] /* s += conj(a)*b */ #define C_MULTADDCONJ(x,z,p, ax,az,q, bx,bz,r) \ x [2*(p) ] += ax [2*(q) ] * bx [2*(r)] + ax [2*(q)+1] * bx [2*(r)+1] ; \ x [2*(p)+1] += (-ax [2*(q)+1]) * bx [2*(r)] + ax [2*(q) ] * bx [2*(r)+1] /* s -= conj(a)*b */ #define C_MULTSUBCONJ(x,z,p, ax,az,q, bx,bz,r) \ x [2*(p) ] -= ax [2*(q) ] * bx [2*(r)] + ax [2*(q)+1] * bx [2*(r)+1] ; \ x [2*(p)+1] -= (-ax [2*(q)+1]) * bx [2*(r)] + ax [2*(q) ] * bx [2*(r)+1] #define C_ADD(x,z,p, ax,az,q, bx,bz,r) \ x [2*(p) ] = ax [2*(q) ] + bx [2*(r) ] ; \ x [2*(p)+1] = ax [2*(q)+1] + bx [2*(r)+1] #define C_ADD_REAL(x,p, ax,q, bx,r) \ x [2*(p)] = ax [2*(q)] + bx [2*(r)] #define C_CLEAR(x,z,p) \ x [2*(p) ] = 0 ; \ x [2*(p)+1] = 0 #define C_CLEAR_IMAG(x,z,p) \ x [2*(p)+1] = 0 /* s = s / a */ #define C_DIV(x,z,p,ax,az,q) \ SuiteSparse_config.divcomplex_func ( \ x [2*(p)], x [2*(p)+1], \ ax [2*(q)], ax [2*(q)+1], \ &x [2*(p)], &x [2*(p)+1]) /* s -= conj(a)*a ; note that the result of conj(a)*a is real */ #define C_LLDOT(x,p, ax,az,q) \ x [2*(p)] -= ax [2*(q)] * ax [2*(q)] + ax [2*(q)+1] * ax [2*(q)+1] #define C_PRINT(k,x,z,p) PRK(k, ("(%24.16e,%24.16e)", x [2*(p)], x [2*(p)+1])) #define C_DIV_REAL(x,z,p, ax,az,q, bx,r) \ x [2*(p) ] = ax [2*(q) ] / bx [2*(r)] ; \ x [2*(p)+1] = ax [2*(q)+1] / bx [2*(r)] #define C_MULT_REAL(x,z,p, ax,az,q, bx,r) \ x [2*(p) ] = ax [2*(q) ] * bx [2*(r)] ; \ x [2*(p)+1] = ax [2*(q)+1] * bx [2*(r)] /* s -= conj(a)*a/t */ #define C_LDLDOT(x,p, ax,az,q, bx,r) \ x [2*(p)] -= (ax [2*(q)] * ax [2*(q)] + ax [2*(q)+1] * ax [2*(q)+1]) / bx[r] /* -------------------------------------------------------------------------- */ /* zomplex */ /* -------------------------------------------------------------------------- */ #define Z_TEMPLATE(name) z_ ## name #define ZT_TEMPLATE(name) zt_ ## name #define Z_ASSEMBLE(x,z,p,ax,az,q) \ x [p] += ax [q] ; \ z [p] += az [q] #define Z_ASSIGN(x,z,p,ax,az,q) \ x [p] = ax [q] ; \ z [p] = az [q] #define Z_ASSIGN_REAL(x,p,ax,q) x [p] = ax [q] #define Z_ASSIGN_CONJ(x,z,p,ax,az,q) \ x [p] = ax [q] ; \ z [p] = -az [q] #define Z_XTYPE_OK(type) ((type) == CHOLMOD_ZOMPLEX) #define Z_IS_NONZERO(ax,az,q) \ (IS_NONZERO (ax [q]) || IS_NONZERO (az [q])) #define Z_IS_ZERO(ax,az,q) \ (IS_ZERO (ax [q]) && IS_ZERO (az [q])) #define Z_IS_ONE(ax,az,q) \ ((ax [q] == 1) && IS_ZERO (az [q])) #define Z_IMAG_IS_NONZERO(ax,az,q) (IS_NONZERO (az [q])) #define Z_MULT(x,z,p, ax,az,q, bx,bz,r) \ x [p] = ax [q] * bx [r] - az [q] * bz [r] ; \ z [p] = az [q] * bx [r] + ax [q] * bz [r] #define Z_MULTADD(x,z,p, ax,az,q, bx,bz,r) \ x [p] += ax [q] * bx [r] - az [q] * bz [r] ; \ z [p] += az [q] * bx [r] + ax [q] * bz [r] #define Z_MULTSUB(x,z,p, ax,az,q, bx,bz,r) \ x [p] -= ax [q] * bx [r] - az [q] * bz [r] ; \ z [p] -= az [q] * bx [r] + ax [q] * bz [r] #define Z_MULTADDCONJ(x,z,p, ax,az,q, bx,bz,r) \ x [p] += ax [q] * bx [r] + az [q] * bz [r] ; \ z [p] += (-az [q]) * bx [r] + ax [q] * bz [r] #define Z_MULTSUBCONJ(x,z,p, ax,az,q, bx,bz,r) \ x [p] -= ax [q] * bx [r] + az [q] * bz [r] ; \ z [p] -= (-az [q]) * bx [r] + ax [q] * bz [r] #define Z_ADD(x,z,p, ax,az,q, bx,bz,r) \ x [p] = ax [q] + bx [r] ; \ z [p] = az [q] + bz [r] #define Z_ADD_REAL(x,p, ax,q, bx,r) \ x [p] = ax [q] + bx [r] #define Z_CLEAR(x,z,p) \ x [p] = 0 ; \ z [p] = 0 #define Z_CLEAR_IMAG(x,z,p) \ z [p] = 0 /* s = s / a */ #define Z_DIV(x,z,p,ax,az,q) \ SuiteSparse_config.divcomplex_func \ (x [p], z [p], ax [q], az [q], &x [p], &z [p]) /* s -= conj(a)*a ; note that the result of conj(a)*a is real */ #define Z_LLDOT(x,p, ax,az,q) \ x [p] -= ax [q] * ax [q] + az [q] * az [q] #define Z_PRINT(k,x,z,p) PRK(k, ("(%24.16e,%24.16e)", x [p], z [p])) #define Z_DIV_REAL(x,z,p, ax,az,q, bx,r) \ x [p] = ax [q] / bx [r] ; \ z [p] = az [q] / bx [r] #define Z_MULT_REAL(x,z,p, ax,az,q, bx,r) \ x [p] = ax [q] * bx [r] ; \ z [p] = az [q] * bx [r] /* s -= conj(a)*a/t */ #define Z_LDLDOT(x,p, ax,az,q, bx,r) \ x [p] -= (ax [q] * ax [q] + az [q] * az [q]) / bx[r] /* -------------------------------------------------------------------------- */ /* all classes */ /* -------------------------------------------------------------------------- */ /* Check if A->xtype and the two arrays A->x and A->z are valid. Set status to * invalid, unless status is already "out of memory". A can be a sparse matrix, * dense matrix, factor, or triplet. */ #define RETURN_IF_XTYPE_INVALID(A,xtype1,xtype2,result) \ { \ if ((A)->xtype < (xtype1) || (A)->xtype > (xtype2) || \ ((A)->xtype != CHOLMOD_PATTERN && ((A)->x) == NULL) || \ ((A)->xtype == CHOLMOD_ZOMPLEX && ((A)->z) == NULL)) \ { \ if (Common->status != CHOLMOD_OUT_OF_MEMORY) \ { \ ERROR (CHOLMOD_INVALID, "invalid xtype") ; \ } \ return (result) ; \ } \ } Matrix/src/CHOLMOD/Include/cholmod_config.h0000644000176200001440000000507113652535054020113 0ustar liggesusers/* ========================================================================== */ /* === Include/cholmod_config.h ============================================= */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Include/cholmod_config.h. * Copyright (C) 2005-2013, Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* CHOLMOD configuration file, for inclusion in user programs. * * You do not have to edit any CHOLMOD files to compile and install CHOLMOD. * However, if you do not use all of CHOLMOD's modules, you need to compile * with the appropriate flag, or edit this file to add the appropriate #define. * * Compiler flags for CHOLMOD: * * -DNCHECK do not include the Check module. * -DNCHOLESKY do not include the Cholesky module. * -DNPARTITION do not include the Partition module. * -DNCAMD do not include the interfaces to CAMD, * CCOLAMD, CSYMAND in Partition module. * -DNMATRIXOPS do not include the MatrixOps module. * -DNMODIFY do not include the Modify module. * -DNSUPERNODAL do not include the Supernodal module. * * -DNPRINT do not print anything * * -D'LONGBLAS=long' or -DLONGBLAS='long long' defines the integers used by * LAPACK and the BLAS. Use LONGBLAS=long on Solaris to use * the 64-bit Sun Performance BLAS in cholmod_l_* routines. * You may need to use -D'LONGBLAS=long long' on the SGI * (this is not tested). * * -DNSUNPERF for Solaris only. If defined, do not use the Sun * Performance Library. The default is to use SunPerf. * You must compile CHOLMOD with -xlic_lib=sunperf. * * The Core Module is always included in the CHOLMOD library. */ #ifndef CHOLMOD_CONFIG_H #define CHOLMOD_CONFIG_H /* Use the compiler flag, or uncomment the definition(s), if you want to use * one or more non-default installation options: */ /* #define NCHECK #define NCHOLESKY #define NCAMD #define NPARTITION #define NMATRIXOPS #define NMODIFY #define NSUPERNODAL #define NPRINT #define LONGBLAS long #define LONGBLAS long long #define NSUNPERF */ /* The option disables the MatrixOps, Modify, and Supernodal modules. The existence of this #define here, and its use in these 3 modules, does not affect the license itself; see CHOLMOD/Doc/License.txt for your actual license. */ #ifdef NGPL #define NMATRIXOPS #define NMODIFY #define NSUPERNODAL #endif #endif Matrix/src/CHOLMOD/Cholesky/0000755000176200001440000000000014154165363015163 5ustar liggesusersMatrix/src/CHOLMOD/Cholesky/cholmod_solve.c0000644000176200001440000014115713652535054020175 0ustar liggesusers/* ========================================================================== */ /* === Cholesky/cholmod_solve =============================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Cholesky Module. Copyright (C) 2005-2013, Timothy A. Davis * -------------------------------------------------------------------------- */ /* Solve one of the following systems. D is identity for an LL' factorization, * in which the D operation is skipped: * * Ax=b 0: CHOLMOD_A x = P' * (L' \ (D \ (L \ (P * b)))) * LDL'x=b 1: CHOLMOD_LDLt x = (L' \ (D \ (L \ ( b)))) * LDx=b 2: CHOLMOD_LD x = ( (D \ (L \ ( b)))) * DL'x=b 3: CHOLMOD_DLt x = (L' \ (D \ ( ( b)))) * Lx=b 4: CHOLMOD_L x = ( ( (L \ ( b)))) * L'x=b 5: CHOLMOD_Lt x = (L' \ ( ( ( b)))) * Dx=b 6: CHOLMOD_D x = ( (D \ ( ( b)))) * x=Pb 7: CHOLMOD_P x = ( ( ( (P * b)))) * x=P'b 8: CHOLMOD_Pt x = P' * ( ( ( ( b)))) * * The factorization can be simplicial LDL', simplicial LL', or supernodal LL'. * For an LL' factorization, D is the identity matrix. Thus CHOLMOD_LD and * CHOLMOD_L solve the same system if an LL' factorization was performed, * for example. * * The supernodal solver uses BLAS routines dtrsv, dgemv, dtrsm, and dgemm, * or their complex counterparts ztrsv, zgemv, ztrsm, and zgemm. * * If both L and B are real, then X is returned real. If either is complex * or zomplex, X is returned as either complex or zomplex, depending on the * Common->prefer_zomplex parameter. * * Supports any numeric xtype (pattern-only matrices not supported). * * This routine does not check to see if the diagonal of L or D is zero, * because sometimes a partial solve can be done with indefinite or singular * matrix. If you wish to check in your own code, test L->minor. If * L->minor == L->n, then the matrix has no zero diagonal entries. * If k = L->minor < L->n, then L(k,k) is zero for an LL' factorization, or * D(k,k) is zero for an LDL' factorization. * * This routine returns X as NULL only if it runs out of memory. If L is * indefinite or singular, then X may contain Inf's or NaN's, but it will * exist on output. */ #ifndef NCHOLESKY #include "cholmod_internal.h" #include "cholmod_cholesky.h" #ifndef NSUPERNODAL #include "cholmod_supernodal.h" #endif /* ========================================================================== */ /* === TEMPLATE ============================================================= */ /* ========================================================================== */ #define REAL #include "t_cholmod_solve.c" #define COMPLEX #include "t_cholmod_solve.c" #define ZOMPLEX #include "t_cholmod_solve.c" /* ========================================================================== */ /* === Permutation macro ==================================================== */ /* ========================================================================== */ /* If Perm is NULL, it is interpretted as the identity permutation */ #define P(k) ((Perm == NULL) ? (k) : Perm [k]) /* ========================================================================== */ /* === perm ================================================================= */ /* ========================================================================== */ /* Y = B (P (1:nrow), k1 : min (k1+ncols,ncol)-1) where B is nrow-by-ncol. * * Creates a permuted copy of a contiguous set of columns of B. * Y is already allocated on input. Y must be of sufficient size. Let nk be * the number of columns accessed in B. Y->xtype determines the complexity of * the result. * * If B is real and Y is complex (or zomplex), only the real part of B is * copied into Y. The imaginary part of Y is set to zero. * * If B is complex (or zomplex) and Y is real, both the real and imaginary and * parts of B are returned in Y. Y is returned as nrow-by-2*nk. The even * columns of Y contain the real part of B and the odd columns contain the * imaginary part of B. Y->nzmax must be >= 2*nrow*nk. Otherise, Y is * returned as nrow-by-nk with leading dimension nrow. Y->nzmax must be >= * nrow*nk. * * The case where the input (B) is real and the output (Y) is zomplex is * not used. */ static void perm ( /* ---- input ---- */ cholmod_dense *B, /* input matrix B */ Int *Perm, /* optional input permutation (can be NULL) */ Int k1, /* first column of B to copy */ Int ncols, /* last column to copy is min(k1+ncols,B->ncol)-1 */ /* ---- in/out --- */ cholmod_dense *Y /* output matrix Y, already allocated */ ) { double *Yx, *Yz, *Bx, *Bz ; Int k2, nk, p, k, j, nrow, ncol, d, dual, dj, j2 ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ ncol = B->ncol ; nrow = B->nrow ; k2 = MIN (k1+ncols, ncol) ; nk = MAX (k2 - k1, 0) ; dual = (Y->xtype == CHOLMOD_REAL && B->xtype != CHOLMOD_REAL) ? 2 : 1 ; d = B->d ; Bx = B->x ; Bz = B->z ; Yx = Y->x ; Yz = Y->z ; Y->nrow = nrow ; Y->ncol = dual*nk ; Y->d = nrow ; ASSERT (((Int) Y->nzmax) >= nrow*nk*dual) ; /* ---------------------------------------------------------------------- */ /* Y = B (P (1:nrow), k1:k2-1) */ /* ---------------------------------------------------------------------- */ switch (Y->xtype) { case CHOLMOD_REAL: switch (B->xtype) { case CHOLMOD_REAL: /* Y real, B real */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = nrow * (j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Yx [k + j2] = Bx [p] ; /* real */ } } break ; case CHOLMOD_COMPLEX: /* Y real, B complex. Y is nrow-by-2*nk */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = nrow * 2 * (j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Yx [k + j2 ] = Bx [2*p ] ; /* real */ Yx [k + j2 + nrow] = Bx [2*p+1] ; /* imag */ } } break ; case CHOLMOD_ZOMPLEX: /* Y real, B zomplex. Y is nrow-by-2*nk */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = nrow * 2 * (j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Yx [k + j2 ] = Bx [p] ; /* real */ Yx [k + j2 + nrow] = Bz [p] ; /* imag */ } } break ; } break ; case CHOLMOD_COMPLEX: switch (B->xtype) { case CHOLMOD_REAL: /* Y complex, B real */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = nrow * 2 * (j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Yx [2*k + j2] = Bx [p] ; /* real */ Yx [2*k+1 + j2] = 0 ; /* imag */ } } break ; case CHOLMOD_COMPLEX: /* Y complex, B complex */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = nrow * 2 * (j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Yx [2*k + j2] = Bx [2*p ] ; /* real */ Yx [2*k+1 + j2] = Bx [2*p+1] ; /* imag */ } } break ; case CHOLMOD_ZOMPLEX: /* Y complex, B zomplex */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = nrow * 2 * (j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Yx [2*k + j2] = Bx [p] ; /* real */ Yx [2*k+1 + j2] = Bz [p] ; /* imag */ } } break ; } break ; case CHOLMOD_ZOMPLEX: switch (B->xtype) { #if 0 case CHOLMOD_REAL: /* this case is not used */ break ; #endif case CHOLMOD_COMPLEX: /* Y zomplex, B complex */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = nrow * (j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Yx [k + j2] = Bx [2*p ] ; /* real */ Yz [k + j2] = Bx [2*p+1] ; /* imag */ } } break ; case CHOLMOD_ZOMPLEX: /* Y zomplex, B zomplex */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = nrow * (j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Yx [k + j2] = Bx [p] ; /* real */ Yz [k + j2] = Bz [p] ; /* imag */ } } break ; } break ; } } /* ========================================================================== */ /* === iperm ================================================================ */ /* ========================================================================== */ /* X (P (1:nrow), k1 : min (k1+ncols,ncol)-1) = Y where X is nrow-by-ncol. * * Copies and permutes Y into a contiguous set of columns of X. X is already * allocated on input. Y must be of sufficient size. Let nk be the number * of columns accessed in X. X->xtype determines the complexity of the result. * * If X is real and Y is complex (or zomplex), only the real part of B is * copied into X. The imaginary part of Y is ignored. * * If X is complex (or zomplex) and Y is real, both the real and imaginary and * parts of Y are returned in X. Y is nrow-by-2*nk. The even * columns of Y contain the real part of B and the odd columns contain the * imaginary part of B. Y->nzmax must be >= 2*nrow*nk. Otherise, Y is * nrow-by-nk with leading dimension nrow. Y->nzmax must be >= nrow*nk. * * The case where the input (Y) is complex and the output (X) is real, * and the case where the input (Y) is zomplex and the output (X) is real, * are not used. */ static void iperm ( /* ---- input ---- */ cholmod_dense *Y, /* input matrix Y */ Int *Perm, /* optional input permutation (can be NULL) */ Int k1, /* first column of B to copy */ Int ncols, /* last column to copy is min(k1+ncols,B->ncol)-1 */ /* ---- in/out --- */ cholmod_dense *X /* output matrix X, already allocated */ ) { double *Yx, *Yz, *Xx, *Xz ; Int k2, nk, p, k, j, nrow, ncol, d, dj, j2 ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ ncol = X->ncol ; nrow = X->nrow ; k2 = MIN (k1+ncols, ncol) ; nk = MAX (k2 - k1, 0) ; d = X->d ; Xx = X->x ; Xz = X->z ; Yx = Y->x ; Yz = Y->z ; ASSERT (((Int) Y->nzmax) >= nrow*nk* ((X->xtype != CHOLMOD_REAL && Y->xtype == CHOLMOD_REAL) ? 2:1)) ; /* ---------------------------------------------------------------------- */ /* X (P (1:nrow), k1:k2-1) = Y */ /* ---------------------------------------------------------------------- */ switch (Y->xtype) { case CHOLMOD_REAL: switch (X->xtype) { case CHOLMOD_REAL: /* Y real, X real */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = nrow * (j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Xx [p] = Yx [k + j2] ; /* real */ } } break ; case CHOLMOD_COMPLEX: /* Y real, X complex. Y is nrow-by-2*nk */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = nrow * 2 * (j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Xx [2*p ] = Yx [k + j2 ] ; /* real */ Xx [2*p+1] = Yx [k + j2 + nrow] ; /* imag */ } } break ; case CHOLMOD_ZOMPLEX: /* Y real, X zomplex. Y is nrow-by-2*nk */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = nrow * 2 * (j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Xx [p] = Yx [k + j2 ] ; /* real */ Xz [p] = Yx [k + j2 + nrow] ; /* imag */ } } break ; } break ; case CHOLMOD_COMPLEX: switch (X->xtype) { #if 0 case CHOLMOD_REAL: /* this case is not used */ break ; #endif case CHOLMOD_COMPLEX: /* Y complex, X complex */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = nrow * 2 * (j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Xx [2*p ] = Yx [2*k + j2] ; /* real */ Xx [2*p+1] = Yx [2*k+1 + j2] ; /* imag */ } } break ; case CHOLMOD_ZOMPLEX: /* Y complex, X zomplex */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = nrow * 2 * (j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Xx [p] = Yx [2*k + j2] ; /* real */ Xz [p] = Yx [2*k+1 + j2] ; /* imag */ } } break ; } break ; case CHOLMOD_ZOMPLEX: switch (X->xtype) { #if 0 case CHOLMOD_REAL: /* this case is not used */ break ; #endif case CHOLMOD_COMPLEX: /* Y zomplex, X complex */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = nrow * (j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Xx [2*p ] = Yx [k + j2] ; /* real */ Xx [2*p+1] = Yz [k + j2] ; /* imag */ } } break ; case CHOLMOD_ZOMPLEX: /* Y zomplex, X zomplex */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = nrow * (j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Xx [p] = Yx [k + j2] ; /* real */ Xz [p] = Yz [k + j2] ; /* imag */ } } break ; } break ; } } /* ========================================================================== */ /* === ptrans =============================================================== */ /* ========================================================================== */ /* Y = B (P (1:nrow), k1 : min (k1+ncols,ncol)-1)' where B is nrow-by-ncol. * * Creates a permuted and transposed copy of a contiguous set of columns of B. * Y is already allocated on input. Y must be of sufficient size. Let nk be * the number of columns accessed in B. Y->xtype determines the complexity of * the result. * * If B is real and Y is complex (or zomplex), only the real part of B is * copied into Y. The imaginary part of Y is set to zero. * * If B is complex (or zomplex) and Y is real, both the real and imaginary and * parts of B are returned in Y. Y is returned as 2*nk-by-nrow. The even * rows of Y contain the real part of B and the odd rows contain the * imaginary part of B. Y->nzmax must be >= 2*nrow*nk. Otherise, Y is * returned as nk-by-nrow with leading dimension nk. Y->nzmax must be >= * nrow*nk. * * The array transpose is performed, not the complex conjugate transpose. */ static void ptrans ( /* ---- input ---- */ cholmod_dense *B, /* input matrix B */ Int *Perm, /* optional input permutation (can be NULL) */ Int k1, /* first column of B to copy */ Int ncols, /* last column to copy is min(k1+ncols,B->ncol)-1 */ /* ---- in/out --- */ cholmod_dense *Y /* output matrix Y, already allocated */ ) { double *Yx, *Yz, *Bx, *Bz ; Int k2, nk, p, k, j, nrow, ncol, d, dual, dj, j2 ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ ncol = B->ncol ; nrow = B->nrow ; k2 = MIN (k1+ncols, ncol) ; nk = MAX (k2 - k1, 0) ; dual = (Y->xtype == CHOLMOD_REAL && B->xtype != CHOLMOD_REAL) ? 2 : 1 ; d = B->d ; Bx = B->x ; Bz = B->z ; Yx = Y->x ; Yz = Y->z ; Y->nrow = dual*nk ; Y->ncol = nrow ; Y->d = dual*nk ; ASSERT (((Int) Y->nzmax) >= nrow*nk*dual) ; /* ---------------------------------------------------------------------- */ /* Y = B (P (1:nrow), k1:k2-1)' */ /* ---------------------------------------------------------------------- */ switch (Y->xtype) { case CHOLMOD_REAL: switch (B->xtype) { case CHOLMOD_REAL: /* Y real, B real */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = j-k1 ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Yx [j2 + k*nk] = Bx [p] ; /* real */ } } break ; case CHOLMOD_COMPLEX: /* Y real, B complex. Y is 2*nk-by-nrow */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = 2*(j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Yx [j2 + k*2*nk] = Bx [2*p ] ; /* real */ Yx [j2+1 + k*2*nk] = Bx [2*p+1] ; /* imag */ } } break ; case CHOLMOD_ZOMPLEX: /* Y real, B zomplex. Y is 2*nk-by-nrow */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = 2*(j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Yx [j2 + k*2*nk] = Bx [p] ; /* real */ Yx [j2+1 + k*2*nk] = Bz [p] ; /* imag */ } } break ; } break ; case CHOLMOD_COMPLEX: switch (B->xtype) { case CHOLMOD_REAL: /* Y complex, B real */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = 2*(j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Yx [j2 + k*2*nk] = Bx [p] ; /* real */ Yx [j2+1 + k*2*nk] = 0 ; /* imag */ } } break ; case CHOLMOD_COMPLEX: /* Y complex, B complex */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = 2*(j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Yx [j2 + k*2*nk] = Bx [2*p ] ; /* real */ Yx [j2+1 + k*2*nk] = Bx [2*p+1] ; /* imag */ } } break ; case CHOLMOD_ZOMPLEX: /* Y complex, B zomplex */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = 2*(j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Yx [j2 + k*2*nk] = Bx [p] ; /* real */ Yx [j2+1 + k*2*nk] = Bz [p] ; /* imag */ } } break ; } break ; case CHOLMOD_ZOMPLEX: switch (B->xtype) { case CHOLMOD_REAL: /* Y zomplex, B real */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = j-k1 ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Yx [j2 + k*nk] = Bx [p] ; /* real */ Yz [j2 + k*nk] = 0 ; /* imag */ } } break ; case CHOLMOD_COMPLEX: /* Y zomplex, B complex */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = j-k1 ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Yx [j2 + k*nk] = Bx [2*p ] ; /* real */ Yz [j2 + k*nk] = Bx [2*p+1] ; /* imag */ } } break ; case CHOLMOD_ZOMPLEX: /* Y zomplex, B zomplex */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = j-k1 ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Yx [j2 + k*nk] = Bx [p] ; /* real */ Yz [j2 + k*nk] = Bz [p] ; /* imag */ } } break ; } break ; } } /* ========================================================================== */ /* === iptrans ============================================================== */ /* ========================================================================== */ /* X (P (1:nrow), k1 : min (k1+ncols,ncol)-1) = Y' where X is nrow-by-ncol. * * Copies into a permuted and transposed contiguous set of columns of X. * X is already allocated on input. Y must be of sufficient size. Let nk be * the number of columns accessed in X. X->xtype determines the complexity of * the result. * * If X is real and Y is complex (or zomplex), only the real part of Y is * copied into X. The imaginary part of Y is ignored. * * If X is complex (or zomplex) and Y is real, both the real and imaginary and * parts of X are returned in Y. Y is 2*nk-by-nrow. The even * rows of Y contain the real part of X and the odd rows contain the * imaginary part of X. Y->nzmax must be >= 2*nrow*nk. Otherise, Y is * nk-by-nrow with leading dimension nk. Y->nzmax must be >= nrow*nk. * * The case where Y is complex or zomplex, and X is real, is not used. * * The array transpose is performed, not the complex conjugate transpose. */ static void iptrans ( /* ---- input ---- */ cholmod_dense *Y, /* input matrix Y */ Int *Perm, /* optional input permutation (can be NULL) */ Int k1, /* first column of X to copy into */ Int ncols, /* last column to copy is min(k1+ncols,X->ncol)-1 */ /* ---- in/out --- */ cholmod_dense *X /* output matrix X, already allocated */ ) { double *Yx, *Yz, *Xx, *Xz ; Int k2, nk, p, k, j, nrow, ncol, d, dj, j2 ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ ncol = X->ncol ; nrow = X->nrow ; k2 = MIN (k1+ncols, ncol) ; nk = MAX (k2 - k1, 0) ; d = X->d ; Xx = X->x ; Xz = X->z ; Yx = Y->x ; Yz = Y->z ; ASSERT (((Int) Y->nzmax) >= nrow*nk* ((X->xtype != CHOLMOD_REAL && Y->xtype == CHOLMOD_REAL) ? 2:1)) ; /* ---------------------------------------------------------------------- */ /* X (P (1:nrow), k1:k2-1) = Y' */ /* ---------------------------------------------------------------------- */ switch (Y->xtype) { case CHOLMOD_REAL: switch (X->xtype) { case CHOLMOD_REAL: /* Y real, X real */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = j-k1 ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Xx [p] = Yx [j2 + k*nk] ; /* real */ } } break ; case CHOLMOD_COMPLEX: /* Y real, X complex. Y is 2*nk-by-nrow */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = 2*(j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Xx [2*p ] = Yx [j2 + k*2*nk] ; /* real */ Xx [2*p+1] = Yx [j2+1 + k*2*nk] ; /* imag */ } } break ; case CHOLMOD_ZOMPLEX: /* Y real, X zomplex. Y is 2*nk-by-nrow */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = 2*(j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Xx [p] = Yx [j2 + k*2*nk] ; /* real */ Xz [p] = Yx [j2+1 + k*2*nk] ; /* imag */ } } break ; } break ; case CHOLMOD_COMPLEX: switch (X->xtype) { #if 0 case CHOLMOD_REAL: /* this case is not used */ break ; #endif case CHOLMOD_COMPLEX: /* Y complex, X complex */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = 2*(j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Xx [2*p ] = Yx [j2 + k*2*nk] ; /* real */ Xx [2*p+1] = Yx [j2+1 + k*2*nk] ; /* imag */ } } break ; case CHOLMOD_ZOMPLEX: /* Y complex, X zomplex */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = 2*(j-k1) ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Xx [p] = Yx [j2 + k*2*nk] ; /* real */ Xz [p] = Yx [j2+1 + k*2*nk] ; /* imag */ } } break ; } break ; case CHOLMOD_ZOMPLEX: switch (X->xtype) { #if 0 case CHOLMOD_REAL: /* this case is not used */ break ; #endif case CHOLMOD_COMPLEX: /* Y zomplex, X complex */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = j-k1 ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Xx [2*p ] = Yx [j2 + k*nk] ; /* real */ Xx [2*p+1] = Yz [j2 + k*nk] ; /* imag */ } } break ; case CHOLMOD_ZOMPLEX: /* Y zomplex, X zomplex */ for (j = k1 ; j < k2 ; j++) { dj = d*j ; j2 = j-k1 ; for (k = 0 ; k < nrow ; k++) { p = P(k) + dj ; Xx [p] = Yx [j2 + k*nk] ; /* real */ Xz [p] = Yz [j2 + k*nk] ; /* imag */ } } break ; } break ; } } /* ========================================================================== */ /* === cholmod_solve ======================================================== */ /* ========================================================================== */ /* Solve a linear system. * * The factorization can be simplicial LDL', simplicial LL', or supernodal LL'. * The Dx=b solve returns silently for the LL' factorizations (it is implicitly * identity). */ cholmod_dense *CHOLMOD(solve) ( /* ---- input ---- */ int sys, /* system to solve */ cholmod_factor *L, /* factorization to use */ cholmod_dense *B, /* right-hand-side */ /* --------------- */ cholmod_common *Common ) { cholmod_dense *Y = NULL, *X = NULL ; cholmod_dense *E = NULL ; int ok ; /* do the solve, allocating workspaces as needed */ ok = CHOLMOD (solve2) (sys, L, B, NULL, &X, NULL, &Y, &E, Common) ; /* free workspaces if allocated, and free result if an error occured */ CHOLMOD(free_dense) (&Y, Common) ; CHOLMOD(free_dense) (&E, Common) ; if (!ok) { CHOLMOD(free_dense) (&X, Common) ; } return (X) ; } /* ========================================================================== */ /* === cholmod_solve2 ======================================================= */ /* ========================================================================== */ /* This function acts just like cholmod_solve, except that the solution X and * the internal workspace (Y and E) can be passed in preallocated. If the * solution X or any required workspaces are not allocated on input, or if they * are the wrong size or type, then this function frees them and reallocates * them as the proper size and type. Thus, if you have a sequence of solves to * do, you can let this function allocate X, Y, and E on the first call. * Subsequent calls to cholmod_solve2 can then reuse this space. You must * then free the workspaces Y and E (and X if desired) when you are finished. * For example, the first call to cholmod_l_solve2, below, will solve the * requested system. The next 2 calls (with different right-hand-sides but * the same value of "sys") will resuse the workspace and solution X from the * first call. Finally, when all solves are done, you must free the workspaces * Y and E (otherwise you will have a memory leak), and you should also free X * when you are done with it. Note that on input, X, Y, and E must be either * valid cholmod_dense matrices, or initialized to NULL. You cannot pass in an * uninitialized X, Y, or E. * * cholmod_dense *X = NULL, *Y = NULL, *E = NULL ; * ... * cholmod_l_solve2 (sys, L, B1, NULL, &X, NULL, &Y, &E, Common) ; * cholmod_l_solve2 (sys, L, B2, NULL, &X, NULL, &Y, &E, Common) ; * cholmod_l_solve2 (sys, L, B3, NULL, &X, NULL, &Y, &E, Common) ; * cholmod_l_free_dense (&X, Common) ; * cholmod_l_free_dense (&Y, Common) ; * cholmod_l_free_dense (&E, Common) ; * * The equivalent when using cholmod_l_solve is: * * cholmod_dense *X = NULL, *Y = NULL, *E = NULL ; * ... * X = cholmod_l_solve (sys, L, B1, Common) ; * cholmod_l_free_dense (&X, Common) ; * X = cholmod_l_solve (sys, L, B2, Common) ; * cholmod_l_free_dense (&X, Common) ; * X = cholmod_l_solve (sys, L, B3, Common) ; * cholmod_l_free_dense (&X, Common) ; * * Both methods work fine, but in the 2nd method with cholmod_solve, the * internal workspaces (Y and E) are allocated and freed on each call. * * Bset is an optional sparse column (pattern only) that specifies a set * of row indices. It is ignored if NULL, or if sys is CHOLMOD_P or * CHOLMOD_Pt. If it is present and not ignored, B must be a dense column * vector, and only entries B(i) where i is in the pattern of Bset are * considered. All others are treated as if they were zero (they are not * accessed). L must be a simplicial factorization, not supernodal. L is * converted from supernodal to simplicial if necessary. The solution X is * defined only for entries in the output sparse pattern of Xset. * The xtype (real/complex/zomplex) of L and B must match. * * NOTE: If Bset is present and L is supernodal, it is converted to simplicial * on output. */ int CHOLMOD(solve2) /* returns TRUE on success, FALSE on failure */ ( /* ---- input ---- */ int sys, /* system to solve */ cholmod_factor *L, /* factorization to use */ cholmod_dense *B, /* right-hand-side */ cholmod_sparse *Bset, /* ---- output --- */ cholmod_dense **X_Handle, /* solution, allocated if need be */ cholmod_sparse **Xset_Handle, /* ---- workspace */ cholmod_dense **Y_Handle, /* workspace, or NULL */ cholmod_dense **E_Handle, /* workspace, or NULL */ /* --------------- */ cholmod_common *Common ) { double *Yx, *Yz, *Bx, *Bz, *Xx, *Xz ; cholmod_dense *Y = NULL, *X = NULL ; cholmod_sparse *C, *Yset, C_header, Yset_header, *Xset ; Int *Perm = NULL, *IPerm = NULL ; Int n, nrhs, ncols, ctype, xtype, k1, nr, ytype, k, blen, p, i, d, nrow ; Int Cp [2], Ysetp [2], *Ci, *Yseti, ysetlen ; Int *Bsetp, *Bseti, *Bsetnz, *Xseti, *Xsetp, *Iwork ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_NULL (B, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (B, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ; if (sys < CHOLMOD_A || sys > CHOLMOD_Pt) { ERROR (CHOLMOD_INVALID, "invalid system") ; return (FALSE) ; } DEBUG (CHOLMOD(dump_factor) (L, "L", Common)) ; DEBUG (CHOLMOD(dump_dense) (B, "B", Common)) ; nrhs = B->ncol ; n = (Int) L->n ; d = (Int) B->d ; nrow = (Int) B->nrow ; if (d < n || nrow != n) { ERROR (CHOLMOD_INVALID, "dimensions of L and B do not match") ; return (FALSE) ; } if (Bset) { if (nrhs != 1) { ERROR (CHOLMOD_INVALID, "Bset requires a single right-hand side") ; return (FALSE) ; } if (L->xtype != B->xtype) { ERROR (CHOLMOD_INVALID, "Bset requires xtype of L and B to match") ; return (FALSE) ; } DEBUG (CHOLMOD(dump_sparse) (Bset, "Bset", Common)) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ if ((sys == CHOLMOD_P || sys == CHOLMOD_Pt || sys == CHOLMOD_A) && L->ordering != CHOLMOD_NATURAL) { /* otherwise, Perm is NULL, and the identity permutation is used */ Perm = L->Perm ; } /* ---------------------------------------------------------------------- */ /* allocate the result X (or resuse the space from a prior call) */ /* ---------------------------------------------------------------------- */ ctype = (Common->prefer_zomplex) ? CHOLMOD_ZOMPLEX : CHOLMOD_COMPLEX ; if (Bset) { xtype = L->xtype ; } else if (sys == CHOLMOD_P || sys == CHOLMOD_Pt) { /* x=Pb and x=P'b return X real if B is real; X is the preferred * complex/zcomplex type if B is complex or zomplex */ xtype = (B->xtype == CHOLMOD_REAL) ? CHOLMOD_REAL : ctype ; } else if (L->xtype == CHOLMOD_REAL && B->xtype == CHOLMOD_REAL) { /* X is real if both L and B are real */ xtype = CHOLMOD_REAL ; } else { /* X is complex, use the preferred complex/zomplex type */ xtype = ctype ; } /* ensure X has the right size and type */ X = CHOLMOD(ensure_dense) (X_Handle, n, nrhs, n, xtype, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } /* ---------------------------------------------------------------------- */ /* solve using L, D, L', P, or some combination */ /* ---------------------------------------------------------------------- */ if (Bset) { /* ------------------------------------------------------------------ */ /* solve for a subset of x, with a sparse b */ /* ------------------------------------------------------------------ */ Int save_realloc_state ; #ifndef NSUPERNODAL /* convert a supernodal L to simplicial when using Bset */ if (L->is_super) { /* Can only use Bset on a simplicial factorization. The supernodal * factor L is converted to simplicial, leaving the xtype unchanged * (real, complex, or zomplex). Since the supernodal factorization * is already LL', it is left in that form. This conversion uses * the ll_super_to_simplicial_numeric function in * cholmod_change_factor. */ CHOLMOD(change_factor) ( CHOLMOD_REAL, /* ignored, since L is already numeric */ TRUE, /* convert to LL' (no change to num. values) */ FALSE, /* convert to simplicial */ FALSE, /* do not pack the columns of L */ FALSE, /* (ignored) */ L, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory, L is returned unchanged */ return (FALSE) ; } } #endif /* L, X, and B are all the same xtype */ /* ensure Y is the the right size */ Y = CHOLMOD(ensure_dense) (Y_Handle, 1, n, 1, L->xtype, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (FALSE) ; } /* ------------------------------------------------------------------ */ /* get the inverse permutation, constructing it if needed */ /* ------------------------------------------------------------------ */ DEBUG (CHOLMOD (dump_perm) (Perm, n,n, "Perm", Common)) ; if ((sys == CHOLMOD_A || sys == CHOLMOD_P) && Perm != NULL) { /* The inverse permutation IPerm is used for the c=Pb step, which is needed only for solving Ax=b or x=Pb. No other steps should use IPerm */ if (L->IPerm == NULL) { /* construct the inverse permutation. This is done only once * and then stored in L permanently. */ L->IPerm = CHOLMOD(malloc) (n, sizeof (Int), Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (FALSE) ; } IPerm = L->IPerm ; for (k = 0 ; k < n ; k++) { IPerm [Perm [k]] = k ; } } /* x=A\b and x=Pb both need IPerm */ IPerm = L->IPerm ; } if (sys == CHOLMOD_P) { /* x=Pb needs to turn off the subsequent x=P'b permutation */ Perm = NULL ; } DEBUG (CHOLMOD (dump_perm) (Perm, n,n, "Perm", Common)) ; DEBUG (CHOLMOD (dump_perm) (IPerm, n,n, "IPerm", Common)) ; /* ------------------------------------------------------------------ */ /* ensure Xset is the right size and type */ /* ------------------------------------------------------------------ */ /* Xset is n-by-1, nzmax >= n, pattern-only, packed, unsorted */ Xset = *Xset_Handle ; if (Xset == NULL || (Int) Xset->nrow != n || (Int) Xset->ncol != 1 || (Int) Xset->nzmax < n || Xset->itype != CHOLMOD_PATTERN) { /* this is done only once, for the 1st call to cholmod_solve */ CHOLMOD(free_sparse) (Xset_Handle, Common) ; Xset = CHOLMOD(allocate_sparse) (n, 1, n, FALSE, TRUE, 0, CHOLMOD_PATTERN, Common) ; *Xset_Handle = Xset ; } Xset->sorted = FALSE ; Xset->stype = 0 ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (FALSE) ; } /* -------------------------------------------------------------- */ /* ensure Flag of size n, and 3*n Int workspace is available */ /* -------------------------------------------------------------- */ /* does no work if prior calls already allocated enough space */ CHOLMOD(allocate_work) (n, 3*n, 0, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (FALSE) ; } /* [ use Iwork (n:3n-1) for Ci and Yseti */ Iwork = Common->Iwork ; /* Iwork (0:n-1) is not used because it is used by check_perm, print_perm, check_sparse, and print_sparse */ Ci = Iwork + n ; Yseti = Ci + n ; /* reallocating workspace would break Ci and Yseti */ save_realloc_state = Common->no_workspace_reallocate ; Common->no_workspace_reallocate = TRUE ; /* -------------------------------------------------------------- */ /* C = permuted Bset, to correspond to the permutation of L */ /* -------------------------------------------------------------- */ /* C = IPerm (Bset) */ DEBUG (CHOLMOD(dump_sparse) (Bset, "Bset", Common)) ; Bsetp = Bset->p ; Bseti = Bset->i ; Bsetnz = Bset->nz ; blen = (Bset->packed) ? Bsetp [1] : Bsetnz [0] ; /* C = spones (P*B) or C = spones (B) if IPerm is NULL */ C = &C_header ; C->nrow = n ; C->ncol = 1 ; C->nzmax = n ; C->packed = TRUE ; C->stype = 0 ; C->itype = ITYPE ; C->xtype = CHOLMOD_PATTERN ; C->dtype = CHOLMOD_DOUBLE ; C->nz = NULL ; C->p = Cp ; C->i = Ci ; C->x = NULL ; C->z = NULL ; C->sorted = FALSE ; Cp [0] = 0 ; Cp [1] = blen ; for (p = 0 ; p < blen ; p++) { Int iold = Bseti [p] ; Ci [p] = IPerm ? IPerm [iold] : iold ; } DEBUG (CHOLMOD (dump_sparse) (C, "C", Common)) ; /* create a sparse column Yset from Iwork (n:2n-1) */ Yset = &Yset_header ; Yset->nrow = n ; Yset->ncol = 1 ; Yset->nzmax = n ; Yset->packed = TRUE ; Yset->stype = 0 ; Yset->itype = ITYPE ; Yset->xtype = CHOLMOD_PATTERN ; Yset->dtype = CHOLMOD_DOUBLE ; Yset->nz = NULL ; Yset->p = Ysetp ; Yset->i = Yseti ; Yset->x = NULL ; Yset->z = NULL ; Yset->sorted = FALSE ; Ysetp [0] = 0 ; Ysetp [1] = 0 ; DEBUG (CHOLMOD (dump_sparse) (Yset, "Yset empty", Common)) ; /* -------------------------------------------------------------- */ /* Yset = nonzero pattern of L\C, or just C itself */ /* -------------------------------------------------------------- */ /* this takes O(ysetlen) time */ if (sys == CHOLMOD_P || sys == CHOLMOD_Pt || sys == CHOLMOD_D) { Ysetp [1] = blen ; for (p = 0 ; p < blen ; p++) { Yseti [p] = Ci [p] ; } } else { if (!CHOLMOD(lsolve_pattern) (C, L, Yset, Common)) { Common->no_workspace_reallocate = save_realloc_state ; return (FALSE) ; } } DEBUG (CHOLMOD (dump_sparse) (Yset, "Yset", Common)) ; /* -------------------------------------------------------------- */ /* clear the parts of Y that we will use in the solve */ /* -------------------------------------------------------------- */ Yx = Y->x ; Yz = Y->z ; ysetlen = Ysetp [1] ; switch (L->xtype) { case CHOLMOD_REAL: for (p = 0 ; p < ysetlen ; p++) { i = Yseti [p] ; Yx [i] = 0 ; } break ; case CHOLMOD_COMPLEX: for (p = 0 ; p < ysetlen ; p++) { i = Yseti [p] ; Yx [2*i ] = 0 ; Yx [2*i+1] = 0 ; } break ; case CHOLMOD_ZOMPLEX: for (p = 0 ; p < ysetlen ; p++) { i = Yseti [p] ; Yx [i] = 0 ; Yz [i] = 0 ; } break ; } DEBUG (CHOLMOD (dump_dense) (Y, "Y (Yset) = 0", Common)) ; /* -------------------------------------------------------------- */ /* scatter and permute B into Y */ /* -------------------------------------------------------------- */ /* Y (C) = B (Bset) */ Bx = B->x ; Bz = B->z ; switch (L->xtype) { case CHOLMOD_REAL: for (p = 0 ; p < blen ; p++) { Int iold = Bseti [p] ; Int inew = Ci [p] ; Yx [inew] = Bx [iold] ; } break ; case CHOLMOD_COMPLEX: for (p = 0 ; p < blen ; p++) { Int iold = Bseti [p] ; Int inew = Ci [p] ; Yx [2*inew ] = Bx [2*iold ] ; Yx [2*inew+1] = Bx [2*iold+1] ; } break ; case CHOLMOD_ZOMPLEX: for (p = 0 ; p < blen ; p++) { Int iold = Bseti [p] ; Int inew = Ci [p] ; Yx [inew] = Bx [iold] ; Yz [inew] = Bz [iold] ; } break ; } DEBUG (CHOLMOD (dump_dense) (Y, "Y (C) = B (Bset)", Common)) ; /* -------------------------------------------------------------- */ /* solve Y = (L' \ (L \ Y'))', or other system, with template */ /* -------------------------------------------------------------- */ /* the solve only iterates over columns in Yseti [0...ysetlen-1] */ if (! (sys == CHOLMOD_P || sys == CHOLMOD_Pt)) { switch (L->xtype) { case CHOLMOD_REAL: r_simplicial_solver (sys, L, Y, Yseti, ysetlen) ; break ; case CHOLMOD_COMPLEX: c_simplicial_solver (sys, L, Y, Yseti, ysetlen) ; break ; case CHOLMOD_ZOMPLEX: z_simplicial_solver (sys, L, Y, Yseti, ysetlen) ; break ; } } DEBUG (CHOLMOD (dump_dense) (Y, "Y after solve", Common)) ; /* -------------------------------------------------------------- */ /* X = P'*Y, but only for rows in Yset, and create Xset */ /* -------------------------------------------------------------- */ /* X (Perm (Yset)) = Y (Yset) */ Xx = X->x ; Xz = X->z ; Xseti = Xset->i ; Xsetp = Xset->p ; switch (L->xtype) { case CHOLMOD_REAL: for (p = 0 ; p < ysetlen ; p++) { Int inew = Yseti [p] ; Int iold = Perm ? Perm [inew] : inew ; Xx [iold] = Yx [inew] ; Xseti [p] = iold ; } break ; case CHOLMOD_COMPLEX: for (p = 0 ; p < ysetlen ; p++) { Int inew = Yseti [p] ; Int iold = Perm ? Perm [inew] : inew ; Xx [2*iold ] = Yx [2*inew] ; Xx [2*iold+1] = Yx [2*inew+1] ; Xseti [p] = iold ; } break ; case CHOLMOD_ZOMPLEX: for (p = 0 ; p < ysetlen ; p++) { Int inew = Yseti [p] ; Int iold = Perm ? Perm [inew] : inew ; Xx [iold] = Yx [inew] ; Xz [iold] = Yz [inew] ; Xseti [p] = iold ; } break ; } Xsetp [0] = 0 ; Xsetp [1] = ysetlen ; DEBUG (CHOLMOD(dump_sparse) (Xset, "Xset", Common)) ; DEBUG (CHOLMOD(dump_dense) (X, "X", Common)) ; Common->no_workspace_reallocate = save_realloc_state ; /* done using Iwork (n:3n-1) for Ci and Yseti ] */ } else if (sys == CHOLMOD_P) { /* ------------------------------------------------------------------ */ /* x = P*b */ /* ------------------------------------------------------------------ */ perm (B, Perm, 0, nrhs, X) ; } else if (sys == CHOLMOD_Pt) { /* ------------------------------------------------------------------ */ /* x = P'*b */ /* ------------------------------------------------------------------ */ iperm (B, Perm, 0, nrhs, X) ; } else if (L->is_super) { /* ------------------------------------------------------------------ */ /* solve using a supernodal LL' factorization */ /* ------------------------------------------------------------------ */ #ifndef NSUPERNODAL /* allocate workspace */ cholmod_dense *E ; Int dual ; Common->blas_ok = TRUE ; dual = (L->xtype == CHOLMOD_REAL && B->xtype != CHOLMOD_REAL) ? 2 : 1 ; Y = CHOLMOD(ensure_dense) (Y_Handle, n, dual*nrhs, n, L->xtype, Common); E = CHOLMOD(ensure_dense) (E_Handle, dual*nrhs, L->maxesize, dual*nrhs, L->xtype, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (FALSE) ; } perm (B, Perm, 0, nrhs, Y) ; /* Y = P*B */ if (sys == CHOLMOD_A || sys == CHOLMOD_LDLt) { CHOLMOD(super_lsolve) (L, Y, E, Common) ; /* Y = L\Y */ CHOLMOD(super_ltsolve) (L, Y, E, Common) ; /* Y = L'\Y*/ } else if (sys == CHOLMOD_L || sys == CHOLMOD_LD) { CHOLMOD(super_lsolve) (L, Y, E, Common) ; /* Y = L\Y */ } else if (sys == CHOLMOD_Lt || sys == CHOLMOD_DLt) { CHOLMOD(super_ltsolve) (L, Y, E, Common) ; /* Y = L'\Y*/ } iperm (Y, Perm, 0, nrhs, X) ; /* X = P'*Y */ if (CHECK_BLAS_INT && !Common->blas_ok) { /* Integer overflow in the BLAS. This is probably impossible, * since the BLAS were used to create the supernodal factorization. * It might be possible for the calls to the BLAS to differ between * factorization and forward/backsolves, however. This statement * is untested; it does not appear in the compiled code if * CHECK_BLAS_INT is true (when the same integer is used in * CHOLMOD and the BLAS. */ return (FALSE) ; } #else /* CHOLMOD Supernodal module not installed */ ERROR (CHOLMOD_NOT_INSTALLED,"Supernodal module not installed") ; #endif } else { /* ------------------------------------------------------------------ */ /* solve using a simplicial LL' or LDL' factorization */ /* ------------------------------------------------------------------ */ if (L->xtype == CHOLMOD_REAL && B->xtype == CHOLMOD_REAL) { /* L, B, and Y are all real */ /* solve with up to 4 columns of B at a time */ ncols = 4 ; nr = MAX (4, nrhs) ; ytype = CHOLMOD_REAL ; } else if (L->xtype == CHOLMOD_REAL) { /* L is real and B is complex or zomplex */ /* solve with one column of B (real/imag), at a time */ ncols = 1 ; nr = 2 ; ytype = CHOLMOD_REAL ; } else { /* L is complex or zomplex, B is real/complex/zomplex, Y has the * same complexity as L. Solve with one column of B at a time. */ ncols = 1 ; nr = 1 ; ytype = L->xtype ; } Y = CHOLMOD(ensure_dense) (Y_Handle, nr, n, nr, ytype, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (FALSE) ; } for (k1 = 0 ; k1 < nrhs ; k1 += ncols) { /* -------------------------------------------------------------- */ /* Y = B (P, k1:k1+ncols-1)' = (P * B (:,...))' */ /* -------------------------------------------------------------- */ ptrans (B, Perm, k1, ncols, Y) ; /* -------------------------------------------------------------- */ /* solve Y = (L' \ (L \ Y'))', or other system, with template */ /* -------------------------------------------------------------- */ switch (L->xtype) { case CHOLMOD_REAL: r_simplicial_solver (sys, L, Y, NULL, 0) ; break ; case CHOLMOD_COMPLEX: c_simplicial_solver (sys, L, Y, NULL, 0) ; break ; case CHOLMOD_ZOMPLEX: z_simplicial_solver (sys, L, Y, NULL, 0) ; break ; } /* -------------------------------------------------------------- */ /* X (P, k1:k2+ncols-1) = Y' */ /* -------------------------------------------------------------- */ iptrans (Y, Perm, k1, ncols, X) ; } } DEBUG (CHOLMOD(dump_dense) (X, "X result", Common)) ; return (TRUE) ; } #endif Matrix/src/CHOLMOD/Cholesky/t_cholmod_ltsolve.c0000644000176200001440000005426613652535054021064 0ustar liggesusers/* ========================================================================== */ /* === Cholesky/t_cholmod_ltsolve =========================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Cholesky Module. Copyright (C) 2005-2013, Timothy A. Davis * -------------------------------------------------------------------------- */ /* Template routine to solve L'x=b with unit or non-unit diagonal, or * solve DL'x=b. * * The numeric xtype of L and Y must match. Y contains b on input and x on * output, stored in row-form. Y is nrow-by-n, where nrow must equal 1 for the * complex or zomplex cases, and nrow <= 4 for the real case. * * This file is not compiled separately. It is included in t_cholmod_solve.c * instead. It contains no user-callable routines. * * workspace: none * * Supports real, complex, and zomplex factors. */ /* undefine all prior definitions */ #undef FORM_NAME #undef LSOLVE #undef DIAG /* -------------------------------------------------------------------------- */ /* define the method */ /* -------------------------------------------------------------------------- */ #ifdef LL /* LL': solve Lx=b with non-unit diagonal */ #define FORM_NAME(prefix,rank) prefix ## ll_ltsolve_ ## rank #define DIAG #elif defined (LD) /* LDL': solve LDx=b */ #define FORM_NAME(prefix,rank) prefix ## ldl_dltsolve_ ## rank #define DIAG #else /* LDL': solve Lx=b with unit diagonal */ #define FORM_NAME(prefix,rank) prefix ## ldl_ltsolve_ ## rank #endif /* LSOLVE(k) defines the name of a routine for an n-by-k right-hand-side. */ #define LSOLVE(prefix,rank) FORM_NAME(prefix,rank) #ifdef REAL /* ========================================================================== */ /* === LSOLVE (1) =========================================================== */ /* ========================================================================== */ /* Solve L'x=b, where b has 1 column */ static void LSOLVE (PREFIX,1) ( cholmod_factor *L, double X [ ] /* n-by-1 in row form */ ) { double *Lx = L->x ; Int *Li = L->i ; Int *Lp = L->p ; Int *Lnz = L->nz ; Int j, n = L->n ; for (j = n-1 ; j >= 0 ; ) { /* get the start, end, and length of column j */ Int p = Lp [j] ; Int lnz = Lnz [j] ; Int pend = p + lnz ; /* find a chain of supernodes (up to j, j-1, and j-2) */ if (j < 4 || lnz != Lnz [j-1] - 1 || Li [Lp [j-1]+1] != j) { /* -------------------------------------------------------------- */ /* solve with a single column of L */ /* -------------------------------------------------------------- */ double y = X [j] ; #ifdef DIAG double d = Lx [p] ; #endif #ifdef LD y /= d ; #endif for (p++ ; p < pend ; p++) { y -= Lx [p] * X [Li [p]] ; } #ifdef LL X [j] = y / d ; #else X [j] = y ; #endif j-- ; /* advance to the next column of L */ } else if (lnz != Lnz [j-2]-2 || Li [Lp [j-2]+2] != j) { /* -------------------------------------------------------------- */ /* solve with a supernode of two columns of L */ /* -------------------------------------------------------------- */ double y [2], t ; Int q = Lp [j-1] ; #ifdef DIAG double d [2] ; d [0] = Lx [p] ; d [1] = Lx [q] ; #endif t = Lx [q+1] ; #ifdef LD y [0] = X [j ] / d [0] ; y [1] = X [j-1] / d [1] ; #else y [0] = X [j ] ; y [1] = X [j-1] ; #endif for (p++, q += 2 ; p < pend ; p++, q++) { Int i = Li [p] ; y [0] -= Lx [p] * X [i] ; y [1] -= Lx [q] * X [i] ; } #ifdef LL y [0] /= d [0] ; y [1] = (y [1] - t * y [0]) / d [1] ; #else y [1] -= t * y [0] ; #endif X [j ] = y [0] ; X [j-1] = y [1] ; j -= 2 ; /* advance to the next column of L */ } else { /* -------------------------------------------------------------- */ /* solve with a supernode of three columns of L */ /* -------------------------------------------------------------- */ double y [3], t [3] ; Int q = Lp [j-1] ; Int r = Lp [j-2] ; #ifdef DIAG double d [3] ; d [0] = Lx [p] ; d [1] = Lx [q] ; d [2] = Lx [r] ; #endif t [0] = Lx [q+1] ; t [1] = Lx [r+1] ; t [2] = Lx [r+2] ; #ifdef LD y [0] = X [j] / d [0] ; y [1] = X [j-1] / d [1] ; y [2] = X [j-2] / d [2] ; #else y [0] = X [j] ; y [1] = X [j-1] ; y [2] = X [j-2] ; #endif for (p++, q += 2, r += 3 ; p < pend ; p++, q++, r++) { Int i = Li [p] ; y [0] -= Lx [p] * X [i] ; y [1] -= Lx [q] * X [i] ; y [2] -= Lx [r] * X [i] ; } #ifdef LL y [0] /= d [0] ; y [1] = (y [1] - t [0] * y [0]) / d [1] ; y [2] = (y [2] - t [2] * y [0] - t [1] * y [1]) / d [2] ; #else y [1] -= t [0] * y [0] ; y [2] -= t [2] * y [0] + t [1] * y [1] ; #endif X [j-2] = y [2] ; X [j-1] = y [1] ; X [j ] = y [0] ; j -= 3 ; /* advance to the next column of L */ } } } /* ========================================================================== */ /* === LSOLVE (2) =========================================================== */ /* ========================================================================== */ /* Solve L'x=b, where b has 2 columns */ static void LSOLVE (PREFIX,2) ( cholmod_factor *L, double X [ ][2] /* n-by-2 in row form */ ) { double *Lx = L->x ; Int *Li = L->i ; Int *Lp = L->p ; Int *Lnz = L->nz ; Int j, n = L->n ; for (j = n-1 ; j >= 0 ; ) { /* get the start, end, and length of column j */ Int p = Lp [j] ; Int lnz = Lnz [j] ; Int pend = p + lnz ; /* find a chain of supernodes (up to j, j-1, and j-2) */ if (j < 4 || lnz != Lnz [j-1] - 1 || Li [Lp [j-1]+1] != j) { /* -------------------------------------------------------------- */ /* solve with a single column of L */ /* -------------------------------------------------------------- */ double y [2] ; #ifdef DIAG double d = Lx [p] ; #endif #ifdef LD y [0] = X [j][0] / d ; y [1] = X [j][1] / d ; #else y [0] = X [j][0] ; y [1] = X [j][1] ; #endif for (p++ ; p < pend ; p++) { Int i = Li [p] ; y [0] -= Lx [p] * X [i][0] ; y [1] -= Lx [p] * X [i][1] ; } #ifdef LL X [j][0] = y [0] / d ; X [j][1] = y [1] / d ; #else X [j][0] = y [0] ; X [j][1] = y [1] ; #endif j-- ; /* advance to the next column of L */ } else if (lnz != Lnz [j-2]-2 || Li [Lp [j-2]+2] != j) { /* -------------------------------------------------------------- */ /* solve with a supernode of two columns of L */ /* -------------------------------------------------------------- */ double y [2][2], t ; Int q = Lp [j-1] ; #ifdef DIAG double d [2] ; d [0] = Lx [p] ; d [1] = Lx [q] ; #endif t = Lx [q+1] ; #ifdef LD y [0][0] = X [j ][0] / d [0] ; y [0][1] = X [j ][1] / d [0] ; y [1][0] = X [j-1][0] / d [1] ; y [1][1] = X [j-1][1] / d [1] ; #else y [0][0] = X [j ][0] ; y [0][1] = X [j ][1] ; y [1][0] = X [j-1][0] ; y [1][1] = X [j-1][1] ; #endif for (p++, q += 2 ; p < pend ; p++, q++) { Int i = Li [p] ; y [0][0] -= Lx [p] * X [i][0] ; y [0][1] -= Lx [p] * X [i][1] ; y [1][0] -= Lx [q] * X [i][0] ; y [1][1] -= Lx [q] * X [i][1] ; } #ifdef LL y [0][0] /= d [0] ; y [0][1] /= d [0] ; y [1][0] = (y [1][0] - t * y [0][0]) / d [1] ; y [1][1] = (y [1][1] - t * y [0][1]) / d [1] ; #else y [1][0] -= t * y [0][0] ; y [1][1] -= t * y [0][1] ; #endif X [j ][0] = y [0][0] ; X [j ][1] = y [0][1] ; X [j-1][0] = y [1][0] ; X [j-1][1] = y [1][1] ; j -= 2 ; /* advance to the next column of L */ } else { /* -------------------------------------------------------------- */ /* solve with a supernode of three columns of L */ /* -------------------------------------------------------------- */ double y [3][2], t [3] ; Int q = Lp [j-1] ; Int r = Lp [j-2] ; #ifdef DIAG double d [3] ; d [0] = Lx [p] ; d [1] = Lx [q] ; d [2] = Lx [r] ; #endif t [0] = Lx [q+1] ; t [1] = Lx [r+1] ; t [2] = Lx [r+2] ; #ifdef LD y [0][0] = X [j ][0] / d [0] ; y [0][1] = X [j ][1] / d [0] ; y [1][0] = X [j-1][0] / d [1] ; y [1][1] = X [j-1][1] / d [1] ; y [2][0] = X [j-2][0] / d [2] ; y [2][1] = X [j-2][1] / d [2] ; #else y [0][0] = X [j ][0] ; y [0][1] = X [j ][1] ; y [1][0] = X [j-1][0] ; y [1][1] = X [j-1][1] ; y [2][0] = X [j-2][0] ; y [2][1] = X [j-2][1] ; #endif for (p++, q += 2, r += 3 ; p < pend ; p++, q++, r++) { Int i = Li [p] ; y [0][0] -= Lx [p] * X [i][0] ; y [0][1] -= Lx [p] * X [i][1] ; y [1][0] -= Lx [q] * X [i][0] ; y [1][1] -= Lx [q] * X [i][1] ; y [2][0] -= Lx [r] * X [i][0] ; y [2][1] -= Lx [r] * X [i][1] ; } #ifdef LL y [0][0] /= d [0] ; y [0][1] /= d [0] ; y [1][0] = (y [1][0] - t [0] * y [0][0]) / d [1] ; y [1][1] = (y [1][1] - t [0] * y [0][1]) / d [1] ; y [2][0] = (y [2][0] - t [2] * y [0][0] - t [1] * y [1][0]) / d [2]; y [2][1] = (y [2][1] - t [2] * y [0][1] - t [1] * y [1][1]) / d [2]; #else y [1][0] -= t [0] * y [0][0] ; y [1][1] -= t [0] * y [0][1] ; y [2][0] -= t [2] * y [0][0] + t [1] * y [1][0] ; y [2][1] -= t [2] * y [0][1] + t [1] * y [1][1] ; #endif X [j ][0] = y [0][0] ; X [j ][1] = y [0][1] ; X [j-1][0] = y [1][0] ; X [j-1][1] = y [1][1] ; X [j-2][0] = y [2][0] ; X [j-2][1] = y [2][1] ; j -= 3 ; /* advance to the next column of L */ } } } /* ========================================================================== */ /* === LSOLVE (3) =========================================================== */ /* ========================================================================== */ /* Solve L'x=b, where b has 3 columns */ static void LSOLVE (PREFIX,3) ( cholmod_factor *L, double X [ ][3] /* n-by-3 in row form */ ) { double *Lx = L->x ; Int *Li = L->i ; Int *Lp = L->p ; Int *Lnz = L->nz ; Int j, n = L->n ; for (j = n-1 ; j >= 0 ; ) { /* get the start, end, and length of column j */ Int p = Lp [j] ; Int lnz = Lnz [j] ; Int pend = p + lnz ; /* find a chain of supernodes (up to j, j-1, and j-2) */ if (j < 4 || lnz != Lnz [j-1] - 1 || Li [Lp [j-1]+1] != j) { /* -------------------------------------------------------------- */ /* solve with a single column of L */ /* -------------------------------------------------------------- */ double y [3] ; #ifdef DIAG double d = Lx [p] ; #endif #ifdef LD y [0] = X [j][0] / d ; y [1] = X [j][1] / d ; y [2] = X [j][2] / d ; #else y [0] = X [j][0] ; y [1] = X [j][1] ; y [2] = X [j][2] ; #endif for (p++ ; p < pend ; p++) { Int i = Li [p] ; y [0] -= Lx [p] * X [i][0] ; y [1] -= Lx [p] * X [i][1] ; y [2] -= Lx [p] * X [i][2] ; } #ifdef LL X [j][0] = y [0] / d ; X [j][1] = y [1] / d ; X [j][2] = y [2] / d ; #else X [j][0] = y [0] ; X [j][1] = y [1] ; X [j][2] = y [2] ; #endif j-- ; /* advance to the next column of L */ } else if (lnz != Lnz [j-2]-2 || Li [Lp [j-2]+2] != j) { /* -------------------------------------------------------------- */ /* solve with a supernode of two columns of L */ /* -------------------------------------------------------------- */ double y [2][3], t ; Int q = Lp [j-1] ; #ifdef DIAG double d [2] ; d [0] = Lx [p] ; d [1] = Lx [q] ; #endif t = Lx [q+1] ; #ifdef LD y [0][0] = X [j ][0] / d [0] ; y [0][1] = X [j ][1] / d [0] ; y [0][2] = X [j ][2] / d [0] ; y [1][0] = X [j-1][0] / d [1] ; y [1][1] = X [j-1][1] / d [1] ; y [1][2] = X [j-1][2] / d [1] ; #else y [0][0] = X [j ][0] ; y [0][1] = X [j ][1] ; y [0][2] = X [j ][2] ; y [1][0] = X [j-1][0] ; y [1][1] = X [j-1][1] ; y [1][2] = X [j-1][2] ; #endif for (p++, q += 2 ; p < pend ; p++, q++) { Int i = Li [p] ; y [0][0] -= Lx [p] * X [i][0] ; y [0][1] -= Lx [p] * X [i][1] ; y [0][2] -= Lx [p] * X [i][2] ; y [1][0] -= Lx [q] * X [i][0] ; y [1][1] -= Lx [q] * X [i][1] ; y [1][2] -= Lx [q] * X [i][2] ; } #ifdef LL y [0][0] /= d [0] ; y [0][1] /= d [0] ; y [0][2] /= d [0] ; y [1][0] = (y [1][0] - t * y [0][0]) / d [1] ; y [1][1] = (y [1][1] - t * y [0][1]) / d [1] ; y [1][2] = (y [1][2] - t * y [0][2]) / d [1] ; #else y [1][0] -= t * y [0][0] ; y [1][1] -= t * y [0][1] ; y [1][2] -= t * y [0][2] ; #endif X [j ][0] = y [0][0] ; X [j ][1] = y [0][1] ; X [j ][2] = y [0][2] ; X [j-1][0] = y [1][0] ; X [j-1][1] = y [1][1] ; X [j-1][2] = y [1][2] ; j -= 2 ; /* advance to the next column of L */ } else { /* -------------------------------------------------------------- */ /* solve with a supernode of three columns of L */ /* -------------------------------------------------------------- */ double y [3][3], t [3] ; Int q = Lp [j-1] ; Int r = Lp [j-2] ; #ifdef DIAG double d [3] ; d [0] = Lx [p] ; d [1] = Lx [q] ; d [2] = Lx [r] ; #endif t [0] = Lx [q+1] ; t [1] = Lx [r+1] ; t [2] = Lx [r+2] ; #ifdef LD y [0][0] = X [j ][0] / d [0] ; y [0][1] = X [j ][1] / d [0] ; y [0][2] = X [j ][2] / d [0] ; y [1][0] = X [j-1][0] / d [1] ; y [1][1] = X [j-1][1] / d [1] ; y [1][2] = X [j-1][2] / d [1] ; y [2][0] = X [j-2][0] / d [2] ; y [2][1] = X [j-2][1] / d [2] ; y [2][2] = X [j-2][2] / d [2] ; #else y [0][0] = X [j ][0] ; y [0][1] = X [j ][1] ; y [0][2] = X [j ][2] ; y [1][0] = X [j-1][0] ; y [1][1] = X [j-1][1] ; y [1][2] = X [j-1][2] ; y [2][0] = X [j-2][0] ; y [2][1] = X [j-2][1] ; y [2][2] = X [j-2][2] ; #endif for (p++, q += 2, r += 3 ; p < pend ; p++, q++, r++) { Int i = Li [p] ; y [0][0] -= Lx [p] * X [i][0] ; y [0][1] -= Lx [p] * X [i][1] ; y [0][2] -= Lx [p] * X [i][2] ; y [1][0] -= Lx [q] * X [i][0] ; y [1][1] -= Lx [q] * X [i][1] ; y [1][2] -= Lx [q] * X [i][2] ; y [2][0] -= Lx [r] * X [i][0] ; y [2][1] -= Lx [r] * X [i][1] ; y [2][2] -= Lx [r] * X [i][2] ; } #ifdef LL y [0][0] /= d [0] ; y [0][1] /= d [0] ; y [0][2] /= d [0] ; y [1][0] = (y [1][0] - t [0] * y [0][0]) / d [1] ; y [1][1] = (y [1][1] - t [0] * y [0][1]) / d [1] ; y [1][2] = (y [1][2] - t [0] * y [0][2]) / d [1] ; y [2][0] = (y [2][0] - t [2] * y [0][0] - t [1] * y [1][0]) / d [2]; y [2][1] = (y [2][1] - t [2] * y [0][1] - t [1] * y [1][1]) / d [2]; y [2][2] = (y [2][2] - t [2] * y [0][2] - t [1] * y [1][2]) / d [2]; #else y [1][0] -= t [0] * y [0][0] ; y [1][1] -= t [0] * y [0][1] ; y [1][2] -= t [0] * y [0][2] ; y [2][0] -= t [2] * y [0][0] + t [1] * y [1][0] ; y [2][1] -= t [2] * y [0][1] + t [1] * y [1][1] ; y [2][2] -= t [2] * y [0][2] + t [1] * y [1][2] ; #endif X [j ][0] = y [0][0] ; X [j ][1] = y [0][1] ; X [j ][2] = y [0][2] ; X [j-1][0] = y [1][0] ; X [j-1][1] = y [1][1] ; X [j-1][2] = y [1][2] ; X [j-2][0] = y [2][0] ; X [j-2][1] = y [2][1] ; X [j-2][2] = y [2][2] ; j -= 3 ; /* advance to the next column of L */ } } } /* ========================================================================== */ /* === LSOLVE (4) =========================================================== */ /* ========================================================================== */ /* Solve L'x=b, where b has 4 columns */ static void LSOLVE (PREFIX,4) ( cholmod_factor *L, double X [ ][4] /* n-by-4 in row form */ ) { double *Lx = L->x ; Int *Li = L->i ; Int *Lp = L->p ; Int *Lnz = L->nz ; Int j, n = L->n ; for (j = n-1 ; j >= 0 ; ) { /* get the start, end, and length of column j */ Int p = Lp [j] ; Int lnz = Lnz [j] ; Int pend = p + lnz ; /* find a chain of supernodes (up to j, j-1, and j-2) */ if (j < 4 || lnz != Lnz [j-1] - 1 || Li [Lp [j-1]+1] != j) { /* -------------------------------------------------------------- */ /* solve with a single column of L */ /* -------------------------------------------------------------- */ double y [4] ; #ifdef DIAG double d = Lx [p] ; #endif #ifdef LD y [0] = X [j][0] / d ; y [1] = X [j][1] / d ; y [2] = X [j][2] / d ; y [3] = X [j][3] / d ; #else y [0] = X [j][0] ; y [1] = X [j][1] ; y [2] = X [j][2] ; y [3] = X [j][3] ; #endif for (p++ ; p < pend ; p++) { Int i = Li [p] ; y [0] -= Lx [p] * X [i][0] ; y [1] -= Lx [p] * X [i][1] ; y [2] -= Lx [p] * X [i][2] ; y [3] -= Lx [p] * X [i][3] ; } #ifdef LL X [j][0] = y [0] / d ; X [j][1] = y [1] / d ; X [j][2] = y [2] / d ; X [j][3] = y [3] / d ; #else X [j][0] = y [0] ; X [j][1] = y [1] ; X [j][2] = y [2] ; X [j][3] = y [3] ; #endif j-- ; /* advance to the next column of L */ } else /* if (j == 1 || lnz != Lnz [j-2]-2 || Li [Lp [j-2]+2] != j) */ { /* -------------------------------------------------------------- */ /* solve with a supernode of two columns of L */ /* -------------------------------------------------------------- */ double y [2][4], t ; Int q = Lp [j-1] ; #ifdef DIAG double d [2] ; d [0] = Lx [p] ; d [1] = Lx [q] ; #endif t = Lx [q+1] ; #ifdef LD y [0][0] = X [j ][0] / d [0] ; y [0][1] = X [j ][1] / d [0] ; y [0][2] = X [j ][2] / d [0] ; y [0][3] = X [j ][3] / d [0] ; y [1][0] = X [j-1][0] / d [1] ; y [1][1] = X [j-1][1] / d [1] ; y [1][2] = X [j-1][2] / d [1] ; y [1][3] = X [j-1][3] / d [1] ; #else y [0][0] = X [j ][0] ; y [0][1] = X [j ][1] ; y [0][2] = X [j ][2] ; y [0][3] = X [j ][3] ; y [1][0] = X [j-1][0] ; y [1][1] = X [j-1][1] ; y [1][2] = X [j-1][2] ; y [1][3] = X [j-1][3] ; #endif for (p++, q += 2 ; p < pend ; p++, q++) { Int i = Li [p] ; y [0][0] -= Lx [p] * X [i][0] ; y [0][1] -= Lx [p] * X [i][1] ; y [0][2] -= Lx [p] * X [i][2] ; y [0][3] -= Lx [p] * X [i][3] ; y [1][0] -= Lx [q] * X [i][0] ; y [1][1] -= Lx [q] * X [i][1] ; y [1][2] -= Lx [q] * X [i][2] ; y [1][3] -= Lx [q] * X [i][3] ; } #ifdef LL y [0][0] /= d [0] ; y [0][1] /= d [0] ; y [0][2] /= d [0] ; y [0][3] /= d [0] ; y [1][0] = (y [1][0] - t * y [0][0]) / d [1] ; y [1][1] = (y [1][1] - t * y [0][1]) / d [1] ; y [1][2] = (y [1][2] - t * y [0][2]) / d [1] ; y [1][3] = (y [1][3] - t * y [0][3]) / d [1] ; #else y [1][0] -= t * y [0][0] ; y [1][1] -= t * y [0][1] ; y [1][2] -= t * y [0][2] ; y [1][3] -= t * y [0][3] ; #endif X [j ][0] = y [0][0] ; X [j ][1] = y [0][1] ; X [j ][2] = y [0][2] ; X [j ][3] = y [0][3] ; X [j-1][0] = y [1][0] ; X [j-1][1] = y [1][1] ; X [j-1][2] = y [1][2] ; X [j-1][3] = y [1][3] ; j -= 2 ; /* advance to the next column of L */ } /* NOTE: with 4 right-hand-sides, it suffices to exploit dynamic * supernodes of just size 1 and 2. 3-column supernodes are not * needed. */ } } #endif /* ========================================================================== */ /* === LSOLVE (k) =========================================================== */ /* ========================================================================== */ static void LSOLVE (PREFIX,k) ( cholmod_factor *L, cholmod_dense *Y, /* nr-by-n where nr is 1 to 4 */ Int *Yseti, Int ysetlen ) { #ifdef DIAG double d [1] ; #endif double yx [2] ; #ifdef ZOMPLEX double yz [1] ; double *Lz = L->z ; double *Xz = Y->z ; #endif double *Lx = L->x ; double *Xx = Y->x ; Int *Li = L->i ; Int *Lp = L->p ; Int *Lnz = L->nz ; Int n = L->n, jj, jjiters ; ASSERT (L->xtype == Y->xtype) ; /* L and Y must have the same xtype */ ASSERT (L->n == Y->ncol) ; /* dimensions must match */ ASSERT (Y->nrow == Y->d) ; /* leading dimension of Y = # rows of Y */ ASSERT (L->xtype != CHOLMOD_PATTERN) ; /* L is not symbolic */ ASSERT (!(L->is_super)) ; /* L is simplicial LL' or LDL' */ #ifdef REAL if (Yseti == NULL) { /* ------------------------------------------------------------------ */ /* real case, no Yseti, with 1 to 4 RHS's and dynamic supernodes */ /* ------------------------------------------------------------------ */ ASSERT (Y->nrow <= 4) ; switch (Y->nrow) { case 1: LSOLVE (PREFIX,1) (L, Y->x) ; break ; case 2: LSOLVE (PREFIX,2) (L, Y->x) ; break ; case 3: LSOLVE (PREFIX,3) (L, Y->x) ; break ; case 4: LSOLVE (PREFIX,4) (L, Y->x) ; break ; } } else #endif { /* ------------------------------------------------------------------ */ /* solve a complex linear system or solve with Yseti */ /* ------------------------------------------------------------------ */ ASSERT (Y->nrow == 1) ; jjiters = Yseti ? ysetlen : n ; for (jj = jjiters-1 ; jj >= 0 ; jj--) { Int j = Yseti ? Yseti [jj] : jj ; /* get the start, end, and length of column j */ Int p = Lp [j] ; Int lnz = Lnz [j] ; Int pend = p + lnz ; /* y = X [j] ; */ ASSIGN (yx,yz,0, Xx,Xz,j) ; #ifdef DIAG /* d = Lx [p] ; */ ASSIGN_REAL (d,0, Lx,p) ; #endif #ifdef LD /* y /= d ; */ DIV_REAL (yx,yz,0, yx,yz,0, d,0) ; #endif for (p++ ; p < pend ; p++) { /* y -= conj (Lx [p]) * X [Li [p]] ; */ Int i = Li [p] ; MULTSUBCONJ (yx,yz,0, Lx,Lz,p, Xx,Xz,i) ; } #ifdef LL /* X [j] = y / d ; */ DIV_REAL (Xx,Xz,j, yx,yz,0, d,0) ; #else /* X [j] = y ; */ ASSIGN (Xx,Xz,j, yx,yz,0) ; #endif } } } /* prepare for the next inclusion of this file in cholmod_solve.c */ #undef LL #undef LD Matrix/src/CHOLMOD/Cholesky/cholmod_etree.c0000644000176200001440000001542313652535054020145 0ustar liggesusers/* ========================================================================== */ /* === Cholesky/cholmod_etree =============================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Cholesky Module. Copyright (C) 2005-2006, Timothy A. Davis * -------------------------------------------------------------------------- */ /* Compute the elimination tree of A or A'*A * * In the symmetric case, the upper triangular part of A is used. Entries not * in this part of the matrix are ignored. Computing the etree of a symmetric * matrix from just its lower triangular entries is not supported. * * In the unsymmetric case, all of A is used, and the etree of A'*A is computed. * * References: * * J. Liu, "A compact row storage scheme for Cholesky factors", ACM Trans. * Math. Software, vol 12, 1986, pp. 127-148. * * J. Liu, "The role of elimination trees in sparse factorization", SIAM J. * Matrix Analysis & Applic., vol 11, 1990, pp. 134-172. * * J. Gilbert, X. Li, E. Ng, B. Peyton, "Computing row and column counts for * sparse QR and LU factorization", BIT, vol 41, 2001, pp. 693-710. * * workspace: symmetric: Iwork (nrow), unsymmetric: Iwork (nrow+ncol) * * Supports any xtype (pattern, real, complex, or zomplex) */ #ifndef NCHOLESKY #include "cholmod_internal.h" #include "cholmod_cholesky.h" /* ========================================================================== */ /* === update_etree ========================================================= */ /* ========================================================================== */ static void update_etree ( /* inputs, not modified */ Int k, /* process the edge (k,i) in the input graph */ Int i, /* inputs, modified on output */ Int Parent [ ], /* Parent [t] = p if p is the parent of t */ Int Ancestor [ ] /* Ancestor [t] is the ancestor of node t in the partially-constructed etree */ ) { Int a ; for ( ; ; ) /* traverse the path from k to the root of the tree */ { a = Ancestor [k] ; if (a == i) { /* final ancestor reached; no change to tree */ return ; } /* perform path compression */ Ancestor [k] = i ; if (a == EMPTY) { /* final ancestor undefined; this is a new edge in the tree */ Parent [k] = i ; return ; } /* traverse up to the ancestor of k */ k = a ; } } /* ========================================================================== */ /* === cholmod_etree ======================================================== */ /* ========================================================================== */ /* Find the elimination tree of A or A'*A */ int CHOLMOD(etree) ( /* ---- input ---- */ cholmod_sparse *A, /* ---- output --- */ Int *Parent, /* size ncol. Parent [j] = p if p is the parent of j */ /* --------------- */ cholmod_common *Common ) { Int *Ap, *Ai, *Anz, *Ancestor, *Prev, *Iwork ; Int i, j, jprev, p, pend, nrow, ncol, packed, stype ; size_t s ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (Parent, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ stype = A->stype ; /* s = A->nrow + (stype ? 0 : A->ncol) */ s = CHOLMOD(add_size_t) (A->nrow, (stype ? 0 : A->ncol), &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (FALSE) ; } CHOLMOD(allocate_work) (0, s, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; /* out of memory */ } ASSERT (CHOLMOD(dump_sparse) (A, "etree", Common) >= 0) ; Iwork = Common->Iwork ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ ncol = A->ncol ; /* the number of columns of A */ nrow = A->nrow ; /* the number of rows of A */ Ap = A->p ; /* size ncol+1, column pointers for A */ Ai = A->i ; /* the row indices of A */ Anz = A->nz ; /* number of nonzeros in each column of A */ packed = A->packed ; Ancestor = Iwork ; /* size ncol (i/i/l) */ for (j = 0 ; j < ncol ; j++) { Parent [j] = EMPTY ; Ancestor [j] = EMPTY ; } /* ---------------------------------------------------------------------- */ /* compute the etree */ /* ---------------------------------------------------------------------- */ if (stype > 0) { /* ------------------------------------------------------------------ */ /* symmetric (upper) case: compute etree (A) */ /* ------------------------------------------------------------------ */ for (j = 0 ; j < ncol ; j++) { /* for each row i in column j of triu(A), excluding the diagonal */ p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i < j) { update_etree (i, j, Parent, Ancestor) ; } } } } else if (stype == 0) { /* ------------------------------------------------------------------ */ /* unsymmetric case: compute etree (A'*A) */ /* ------------------------------------------------------------------ */ Prev = Iwork + ncol ; /* size nrow (i/i/l) */ for (i = 0 ; i < nrow ; i++) { Prev [i] = EMPTY ; } for (j = 0 ; j < ncol ; j++) { /* for each row i in column j of A */ p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { /* a graph is constructed dynamically with one path per row * of A. If the ith row of A contains column indices * (j1,j2,j3,j4) then the new graph has edges (j1,j2), (j2,j3), * and (j3,j4). When at node i of this path-graph, all edges * (jprev,j) are considered, where jprev>>>> finding etree of post-permuted matrix\n") ; */ cholmod_etree (symmetric ? SS:FF, Parent2, Common) ; /* cholmod_print_parent (Parent2, n, "Parent2, w/colcnt", Common) ; for (k = 0 ; k < n ; k++) { printf ("k %d Parent old %d new %d\n", k, Lparent [k], Parent2 [k]) ; } */ for (k = 0 ; k < n ; k++) { ASSERT (Lparent [k] == Parent2 [k]) ; } /* workspace: Iwork (2*nrow) */ cholmod_postorder (Parent2, n, NULL, Post2, Common) ; cholmod_rowcolcounts (symmetric ? FF:SS, fset, nf, Parent2, Post2, NULL, ColCount2, First, Level, Common) ; for (k = 0 ; k < n ; k++) { ASSERT (Lcolcount [k] == ColCount2 [k]) ; } cholmod_free (n, sizeof (int), ColCount2, Common) ; cholmod_free (n, sizeof (int), Parent2, Common) ; cholmod_free (n, sizeof (int), Post2, Common) ; cholmod_free_sparse (&C1, Common) ; cholmod_free_sparse (&C2, Common) ; #endif Matrix/src/CHOLMOD/Cholesky/t_cholmod_solve.c0000644000176200001440000001205613652535054020513 0ustar liggesusers/* ========================================================================== */ /* === Cholesky/t_cholmod_solve ============================================= */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Cholesky Module. Copyright (C) 2005-2013, Timothy A. Davis * -------------------------------------------------------------------------- */ /* Template routine for cholmod_solve. Supports any numeric xtype (real, * complex, or zomplex). The xtypes of all matrices (L and Y) must match. */ #include "cholmod_template.h" /* ========================================================================== */ /* === simplicial template solvers ========================================== */ /* ========================================================================== */ /* LL': solve Lx=b with non-unit diagonal */ #define LL #include "t_cholmod_lsolve.c" /* LDL': solve LDx=b */ #define LD #include "t_cholmod_lsolve.c" /* LDL': solve Lx=b with unit diagonal */ #include "t_cholmod_lsolve.c" /* LL': solve L'x=b with non-unit diagonal */ #define LL #include "t_cholmod_ltsolve.c" /* LDL': solve DL'x=b */ #define LD #include "t_cholmod_ltsolve.c" /* LDL': solve L'x=b with unit diagonal */ #include "t_cholmod_ltsolve.c" /* ========================================================================== */ /* === t_ldl_dsolve ========================================================= */ /* ========================================================================== */ /* Solve Dx=b for an LDL' factorization, where Y holds b' on input and x' on * output. * * The number of right-hand-sides (nrhs) is not restricted, even if Yseti * is present. */ static void TEMPLATE (ldl_dsolve) ( cholmod_factor *L, cholmod_dense *Y, /* nr-by-n with leading dimension nr */ Int *Yseti, Int ysetlen ) { double d [1] ; double *Lx, *Yx, *Yz ; Int *Lp ; Int n, nrhs, k, p, k1, k2, kk, kkiters ; ASSERT (L->xtype == Y->xtype) ; /* L and Y must have the same xtype */ ASSERT (L->n == Y->ncol) ; /* dimensions must match */ ASSERT (Y->nrow == Y->d) ; /* leading dimension of Y = # rows of Y */ ASSERT (L->xtype != CHOLMOD_PATTERN) ; /* L is not symbolic */ ASSERT (!(L->is_super) && !(L->is_ll)) ; /* L is simplicial LDL' */ nrhs = Y->nrow ; n = L->n ; Lp = L->p ; Lx = L->x ; Yx = Y->x ; Yz = Y->z ; kkiters = Yseti ? ysetlen : n ; for (kk = 0 ; kk < kkiters ; kk++) { k = Yseti ? Yseti [kk] : kk ; k1 = k*nrhs ; k2 = (k+1)*nrhs ; ASSIGN_REAL (d,0, Lx,Lp[k]) ; for (p = k1 ; p < k2 ; p++) { DIV_REAL (Yx,Yz,p, Yx,Yz,p, d,0) ; } } } /* ========================================================================== */ /* === t_simplicial_solver ================================================== */ /* ========================================================================== */ /* Solve a linear system, where Y' contains the (array-transposed) right-hand * side on input, and the solution on output. No permutations are applied; * these must have already been applied to Y on input. * * Yseti [0..ysetlen-1] is an optional list of indices from * cholmod_lsolve_pattern. The solve is performed only on the columns of L * corresponding to entries in Yseti. Ignored if NULL. If present, most * functions require that Y' consist of a single dense column. */ static void TEMPLATE (simplicial_solver) ( int sys, /* system to solve */ cholmod_factor *L, /* factor to use, a simplicial LL' or LDL' */ cholmod_dense *Y, /* right-hand-side on input, solution on output */ Int *Yseti, Int ysetlen ) { if (L->is_ll) { /* The factorization is LL' */ if (sys == CHOLMOD_A || sys == CHOLMOD_LDLt) { /* Solve Ax=b or LL'x=b */ TEMPLATE (ll_lsolve_k) (L, Y, Yseti, ysetlen) ; TEMPLATE (ll_ltsolve_k) (L, Y, Yseti, ysetlen) ; } else if (sys == CHOLMOD_L || sys == CHOLMOD_LD) { /* Solve Lx=b */ TEMPLATE (ll_lsolve_k) (L, Y, Yseti, ysetlen) ; } else if (sys == CHOLMOD_Lt || sys == CHOLMOD_DLt) { /* Solve L'x=b */ TEMPLATE (ll_ltsolve_k) (L, Y, Yseti, ysetlen) ; } } else { /* The factorization is LDL' */ if (sys == CHOLMOD_A || sys == CHOLMOD_LDLt) { /* Solve Ax=b or LDL'x=b */ TEMPLATE (ldl_lsolve_k) (L, Y, Yseti, ysetlen) ; TEMPLATE (ldl_dltsolve_k) (L, Y, Yseti, ysetlen) ; } else if (sys == CHOLMOD_LD) { /* Solve LDx=b */ TEMPLATE (ldl_ldsolve_k) (L, Y, Yseti, ysetlen) ; } else if (sys == CHOLMOD_L) { /* Solve Lx=b */ TEMPLATE (ldl_lsolve_k) (L, Y, Yseti, ysetlen) ; } else if (sys == CHOLMOD_Lt) { /* Solve L'x=b */ TEMPLATE (ldl_ltsolve_k) (L, Y, Yseti, ysetlen) ; } else if (sys == CHOLMOD_DLt) { /* Solve DL'x=b */ TEMPLATE (ldl_dltsolve_k) (L, Y, Yseti, ysetlen) ; } else if (sys == CHOLMOD_D) { /* Solve Dx=b */ TEMPLATE (ldl_dsolve) (L, Y, Yseti, ysetlen) ; } } } #undef PATTERN #undef REAL #undef COMPLEX #undef ZOMPLEX Matrix/src/CHOLMOD/Cholesky/t_cholmod_rowfac.c0000644000176200001440000003202313652535054020640 0ustar liggesusers/* ========================================================================== */ /* === Cholesky/t_cholmod_rowfac ============================================ */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Cholesky Module. Copyright (C) 2005-2006, Timothy A. Davis * -------------------------------------------------------------------------- */ /* Template routine for cholmod_rowfac. Supports any numeric xtype * (real, complex, or zomplex). * * workspace: Iwork (n), Flag (n), Xwork (n if real, 2*n if complex) */ #include "cholmod_template.h" #ifdef MASK static int TEMPLATE (cholmod_rowfac_mask) #else static int TEMPLATE (cholmod_rowfac) #endif ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to factorize */ cholmod_sparse *F, /* used for A*A' case only. F=A' or A(:,f)' */ double beta [2], /* factorize beta*I+A or beta*I+AA' (beta [0] only) */ size_t kstart, /* first row to factorize */ size_t kend, /* last row to factorize is kend-1 */ #ifdef MASK /* These inputs are used for cholmod_rowfac_mask only */ Int *mask, /* size A->nrow. if mask[i] >= maskmark then W(i) is set to zero */ Int maskmark, Int *RLinkUp, /* size A->nrow. link list of rows to compute */ #endif /* ---- in/out --- */ cholmod_factor *L, /* --------------- */ cholmod_common *Common ) { double yx [2], lx [2], fx [2], dk [1], di [1], fl = 0 ; #ifdef ZOMPLEX double yz [1], lz [1], fz [1] ; #endif double *Ax, *Az, *Lx, *Lz, *Wx, *Wz, *Fx, *Fz ; Int *Ap, *Anz, *Ai, *Lp, *Lnz, *Li, *Lnext, *Flag, *Stack, *Fp, *Fi, *Fnz, *Iwork ; Int i, p, k, t, pf, pfend, top, s, mark, pend, n, lnz, is_ll, multadds, use_dbound, packed, stype, Fpacked, sorted, nzmax, len, parent ; #ifndef REAL Int dk_imaginary ; #endif /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ PRINT1 (("\nin cholmod_rowfac, kstart %d kend %d stype %d\n", kstart, kend, A->stype)) ; DEBUG (CHOLMOD(dump_factor) (L, "Initial L", Common)) ; n = A->nrow ; stype = A->stype ; if (stype > 0) { /* symmetric upper case: F is not needed. It may be NULL */ Fp = NULL ; Fi = NULL ; Fx = NULL ; Fz = NULL ; Fnz = NULL ; Fpacked = TRUE ; } else { /* unsymmetric case: F is required. */ Fp = F->p ; Fi = F->i ; Fx = F->x ; Fz = F->z ; Fnz = F->nz ; Fpacked = F->packed ; } Ap = A->p ; /* size A->ncol+1, column pointers of A */ Ai = A->i ; /* size nz = Ap [A->ncol], row indices of A */ Ax = A->x ; /* size nz, numeric values of A */ Az = A->z ; Anz = A->nz ; packed = A->packed ; sorted = A->sorted ; use_dbound = IS_GT_ZERO (Common->dbound) ; /* get the current factors L (and D for LDL'); allocate space if needed */ is_ll = L->is_ll ; if (L->xtype == CHOLMOD_PATTERN) { /* ------------------------------------------------------------------ */ /* L is symbolic only; allocate and initialize L (and D for LDL') */ /* ------------------------------------------------------------------ */ /* workspace: none */ CHOLMOD(change_factor) (A->xtype, is_ll, FALSE, FALSE, TRUE, L, Common); if (Common->status < CHOLMOD_OK) { /* out of memory */ return (FALSE) ; } ASSERT (L->minor == (size_t) n) ; } else if (kstart == 0 && kend == (size_t) n) { /* ------------------------------------------------------------------ */ /* refactorization; reset L->nz and L->minor to restart factorization */ /* ------------------------------------------------------------------ */ L->minor = n ; Lnz = L->nz ; for (k = 0 ; k < n ; k++) { Lnz [k] = 1 ; } } ASSERT (is_ll == L->is_ll) ; ASSERT (L->xtype != CHOLMOD_PATTERN) ; DEBUG (CHOLMOD(dump_factor) (L, "L ready", Common)) ; DEBUG (CHOLMOD(dump_sparse) (A, "A ready", Common)) ; DEBUG (if (stype == 0) CHOLMOD(dump_sparse) (F, "F ready", Common)) ; /* inputs, can be modified on output: */ Lp = L->p ; /* size n+1 */ ASSERT (Lp != NULL) ; /* outputs, contents defined on input for incremental case only: */ Lnz = L->nz ; /* size n */ Lnext = L->next ; /* size n+2 */ Li = L->i ; /* size L->nzmax, can change in size */ Lx = L->x ; /* size L->nzmax or 2*L->nzmax, can change in size */ Lz = L->z ; /* size L->nzmax for zomplex case, can change in size */ nzmax = L->nzmax ; ASSERT (Lnz != NULL && Li != NULL && Lx != NULL) ; /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ Iwork = Common->Iwork ; Stack = Iwork ; /* size n (i/i/l) */ Flag = Common->Flag ; /* size n, Flag [i] < mark must hold */ Wx = Common->Xwork ; /* size n if real, 2*n if complex or * zomplex. Xwork [i] == 0 must hold. */ Wz = Wx + n ; /* size n for zomplex case only */ mark = Common->mark ; ASSERT ((Int) Common->xworksize >= (L->xtype == CHOLMOD_REAL ? 1:2)*n) ; /* ---------------------------------------------------------------------- */ /* compute LDL' or LL' factorization by rows */ /* ---------------------------------------------------------------------- */ #ifdef MASK #define NEXT(k) k = RLinkUp [k] #else #define NEXT(k) k++ #endif for (k = kstart ; k < ((Int) kend) ; NEXT(k)) { PRINT1 (("\n===============K "ID" Lnz [k] "ID"\n", k, Lnz [k])) ; /* ------------------------------------------------------------------ */ /* compute pattern of kth row of L and scatter kth input column */ /* ------------------------------------------------------------------ */ /* column k of L is currently empty */ ASSERT (Lnz [k] == 1) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 2*n, Common)) ; top = n ; /* Stack is empty */ Flag [k] = mark ; /* do not include diagonal entry in Stack */ /* use Li [Lp [i]+1] for etree */ #define PARENT(i) (Lnz [i] > 1) ? (Li [Lp [i] + 1]) : EMPTY if (stype > 0) { /* scatter kth col of triu (beta*I+AA'), get pattern L(k,:) */ p = Ap [k] ; pend = (packed) ? (Ap [k+1]) : (p + Anz [k]) ; /* W [i] = Ax [i] ; scatter column of A */ #define SCATTER ASSIGN(Wx,Wz,i, Ax,Az,p) SUBTREE ; #undef SCATTER } else { /* scatter kth col of triu (beta*I+AA'), get pattern L(k,:) */ pf = Fp [k] ; pfend = (Fpacked) ? (Fp [k+1]) : (pf + Fnz [k]) ; for ( ; pf < pfend ; pf++) { /* get nonzero entry F (t,k) */ t = Fi [pf] ; /* fk = Fx [pf] */ ASSIGN (fx, fz, 0, Fx, Fz, pf) ; p = Ap [t] ; pend = (packed) ? (Ap [t+1]) : (p + Anz [t]) ; multadds = 0 ; /* W [i] += Ax [p] * fx ; scatter column of A*A' */ #define SCATTER MULTADD (Wx,Wz,i, Ax,Az,p, fx,fz,0) ; multadds++ ; SUBTREE ; #undef SCATTER #ifdef REAL fl += 2 * ((double) multadds) ; #else fl += 8 * ((double) multadds) ; #endif } } #undef PARENT /* ------------------------------------------------------------------ */ /* if mask is present, set the corresponding entries in W to zero */ /* ------------------------------------------------------------------ */ #ifdef MASK /* remove the dead element of Wx */ if (mask != NULL) { #if 0 /* older version */ for (p = n; p > top;) { i = Stack [--p] ; if ( mask [i] >= 0 ) { CLEAR (Wx,Wz,i) ; /* set W(i) to zero */ } } #endif for (s = top ; s < n ; s++) { i = Stack [s] ; if (mask [i] >= maskmark) { CLEAR (Wx,Wz,i) ; /* set W(i) to zero */ } } } #endif /* nonzero pattern of kth row of L is now in Stack [top..n-1]. * Flag [Stack [top..n-1]] is equal to mark, but no longer needed */ /* mark = CHOLMOD(clear_flag) (Common) ; */ CHOLMOD_CLEAR_FLAG (Common) ; mark = Common->mark ; /* ------------------------------------------------------------------ */ /* compute kth row of L and store in column form */ /* ------------------------------------------------------------------ */ /* Solve L (0:k-1, 0:k-1) * y (0:k-1) = b (0:k-1) where * b (0:k) = A (0:k,k) or A(0:k,:) * F(:,k) is in W and Stack. * * For LDL' factorization: * L (k, 0:k-1) = y (0:k-1) ./ D (0:k-1) * D (k) = b (k) - L (k, 0:k-1) * y (0:k-1) * * For LL' factorization: * L (k, 0:k-1) = y (0:k-1) * L (k,k) = sqrt (b (k) - L (k, 0:k-1) * L (0:k-1, k)) */ /* dk = W [k] + beta */ ADD_REAL (dk,0, Wx,k, beta,0) ; #ifndef REAL /* In the unsymmetric case, the imaginary part of W[k] must be real, * since F is assumed to be the complex conjugate transpose of A. In * the symmetric case, W[k] is the diagonal of A. If the imaginary part * of W[k] is nonzero, then the Cholesky factorization cannot be * computed; A is not positive definite */ dk_imaginary = (stype > 0) ? (IMAG_IS_NONZERO (Wx,Wz,k)) : FALSE ; #endif /* W [k] = 0.0 ; */ CLEAR (Wx,Wz,k) ; for (s = top ; s < n ; s++) { /* get i for each nonzero entry L(k,i) */ i = Stack [s] ; /* y = W [i] ; */ ASSIGN (yx,yz,0, Wx,Wz,i) ; /* W [i] = 0.0 ; */ CLEAR (Wx,Wz,i) ; lnz = Lnz [i] ; p = Lp [i] ; ASSERT (lnz > 0 && Li [p] == i) ; pend = p + lnz ; /* di = Lx [p] ; the diagonal entry L or D(i,i), which is real */ ASSIGN_REAL (di,0, Lx,p) ; if (i >= (Int) L->minor || IS_ZERO (di [0])) { /* For the LL' factorization, L(i,i) is zero. For the LDL', * D(i,i) is zero. Skip column i of L, and set L(k,i) = 0. */ CLEAR (lx,lz,0) ; p = pend ; } else if (is_ll) { #ifdef REAL fl += 2 * ((double) (pend - p - 1)) + 3 ; #else fl += 8 * ((double) (pend - p - 1)) + 6 ; #endif /* forward solve using L (i:(k-1),i) */ /* divide by L(i,i), which must be real and nonzero */ /* y /= di [0] */ DIV_REAL (yx,yz,0, yx,yz,0, di,0) ; for (p++ ; p < pend ; p++) { /* W [Li [p]] -= Lx [p] * y ; */ MULTSUB (Wx,Wz,Li[p], Lx,Lz,p, yx,yz,0) ; } /* do not scale L; compute dot product for L(k,k) */ /* L(k,i) = conj(y) ; */ ASSIGN_CONJ (lx,lz,0, yx,yz,0) ; /* d -= conj(y) * y ; */ LLDOT (dk,0, yx,yz,0) ; } else { #ifdef REAL fl += 2 * ((double) (pend - p - 1)) + 3 ; #else fl += 8 * ((double) (pend - p - 1)) + 6 ; #endif /* forward solve using D (i,i) and L ((i+1):(k-1),i) */ for (p++ ; p < pend ; p++) { /* W [Li [p]] -= Lx [p] * y ; */ MULTSUB (Wx,Wz,Li[p], Lx,Lz,p, yx,yz,0) ; } /* Scale L (k,0:k-1) for LDL' factorization, compute D (k,k)*/ #ifdef REAL /* L(k,i) = y/d */ lx [0] = yx [0] / di [0] ; /* d -= L(k,i) * y */ dk [0] -= lx [0] * yx [0] ; #else /* L(k,i) = conj(y) ; */ ASSIGN_CONJ (lx,lz,0, yx,yz,0) ; /* L(k,i) /= di ; */ DIV_REAL (lx,lz,0, lx,lz,0, di,0) ; /* d -= conj(y) * y / di */ LDLDOT (dk,0, yx,yz,0, di,0) ; #endif } /* determine if column i of L can hold the new L(k,i) entry */ if (p >= Lp [Lnext [i]]) { /* column i needs to grow */ PRINT1 (("Factor Colrealloc "ID", old Lnz "ID"\n", i, Lnz [i])); if (!CHOLMOD(reallocate_column) (i, lnz + 1, L, Common)) { /* out of memory, L is now simplicial symbolic */ for (i = 0 ; i < n ; i++) { /* W [i] = 0 ; */ CLEAR (Wx,Wz,i) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, n, Common)) ; return (FALSE) ; } Li = L->i ; /* L->i, L->x, L->z may have moved */ Lx = L->x ; Lz = L->z ; p = Lp [i] + lnz ; /* contents of L->p changed */ ASSERT (p < Lp [Lnext [i]]) ; } /* store L (k,i) in the column form matrix of L */ Li [p] = k ; /* Lx [p] = L(k,i) ; */ ASSIGN (Lx,Lz,p, lx,lz,0) ; Lnz [i]++ ; } /* ------------------------------------------------------------------ */ /* ensure abs (d) >= dbound if dbound is given, and store it in L */ /* ------------------------------------------------------------------ */ p = Lp [k] ; Li [p] = k ; if (k >= (Int) L->minor) { /* the matrix is already not positive definite */ dk [0] = 0 ; } else if (use_dbound) { /* modify the diagonal to force LL' or LDL' to exist */ dk [0] = CHOLMOD(dbound) (is_ll ? fabs (dk [0]) : dk [0], Common) ; } else if ((is_ll ? (IS_LE_ZERO (dk [0])) : (IS_ZERO (dk [0]))) #ifndef REAL || dk_imaginary #endif ) { /* the matrix has just been found to be not positive definite */ dk [0] = 0 ; L->minor = k ; ERROR (CHOLMOD_NOT_POSDEF, "not positive definite") ; } if (is_ll) { /* this is counted as one flop, below */ dk [0] = sqrt (dk [0]) ; } /* Lx [p] = D(k,k) = d ; real part only */ ASSIGN_REAL (Lx,p, dk,0) ; CLEAR_IMAG (Lx,Lz,p) ; } #undef NEXT if (is_ll) fl += MAX ((Int) kend - (Int) kstart, 0) ; /* count sqrt's */ Common->rowfacfl = fl ; DEBUG (CHOLMOD(dump_factor) (L, "final cholmod_rowfac", Common)) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, n, Common)) ; return (TRUE) ; } #undef PATTERN #undef REAL #undef COMPLEX #undef ZOMPLEX Matrix/src/CHOLMOD/Cholesky/cholmod_rowcolcounts.c0000644000176200001440000004331113652535054021577 0ustar liggesusers/* ========================================================================== */ /* === Cholesky/cholmod_rowcolcounts ======================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Cholesky Module. Copyright (C) 2005-2006, Timothy A. Davis * -------------------------------------------------------------------------- */ /* Compute the row and column counts of the Cholesky factor L of the matrix * A or A*A'. The etree and its postordering must already be computed (see * cholmod_etree and cholmod_postorder) and given as inputs to this routine. * * For the symmetric case (LL'=A), A is accessed by column. Only the lower * triangular part of A is used. Entries not in this part of the matrix are * ignored. This is the same as storing the upper triangular part of A by * rows, with entries in the lower triangular part being ignored. NOTE: this * representation is the TRANSPOSE of the input to cholmod_etree. * * For the unsymmetric case (LL'=AA'), A is accessed by column. Equivalently, * if A is viewed as a matrix in compressed-row form, this routine computes * the row and column counts for L where LL'=A'A. If the input vector f is * present, then F*F' is analyzed instead, where F = A(:,f). * * The set f is held in fset and fsize. * fset = NULL means ":" in MATLAB. fset is ignored. * fset != NULL means f = fset [0..fset-1]. * fset != NULL and fsize = 0 means f is the empty set. * Common->status is set to CHOLMOD_INVALID if fset is invalid. * * In both cases, the columns of A need not be sorted. * A can be packed or unpacked. * * References: * J. Gilbert, E. Ng, B. Peyton, "An efficient algorithm to compute row and * column counts for sparse Cholesky factorization", SIAM J. Matrix Analysis & * Applic., vol 15, 1994, pp. 1075-1091. * * J. Gilbert, X. Li, E. Ng, B. Peyton, "Computing row and column counts for * sparse QR and LU factorization", BIT, vol 41, 2001, pp. 693-710. * * workspace: * if symmetric: Flag (nrow), Iwork (2*nrow) * if unsymmetric: Flag (nrow), Iwork (2*nrow+ncol), Head (nrow+1) * * Supports any xtype (pattern, real, complex, or zomplex). */ #ifndef NCHOLESKY #include "cholmod_internal.h" #include "cholmod_cholesky.h" /* ========================================================================== */ /* === initialize_node ====================================================== */ /* ========================================================================== */ static Int initialize_node /* initial work for kth node in postordered etree */ ( Int k, /* at the kth step of the algorithm (and kth node) */ Int Post [ ], /* Post [k] = i, the kth node in postordered etree */ Int Parent [ ], /* Parent [i] is the parent of i in the etree */ Int ColCount [ ], /* ColCount [c] is the current weight of node c */ Int PrevNbr [ ] /* PrevNbr [u] = k if u was last considered at step k */ ) { Int p, parent ; /* determine p, the kth node in the postordered etree */ p = Post [k] ; /* adjust the weight if p is not a root of the etree */ parent = Parent [p] ; if (parent != EMPTY) { ColCount [parent]-- ; } /* flag node p to exclude self edges (p,p) */ PrevNbr [p] = k ; return (p) ; } /* ========================================================================== */ /* === process_edge ========================================================= */ /* ========================================================================== */ /* edge (p,u) is being processed. p < u is a descendant of its ancestor u in * the etree. node p is the kth node in the postordered etree. */ static void process_edge ( Int p, /* process edge (p,u) of the matrix */ Int u, Int k, /* we are at the kth node in the postordered etree */ Int First [ ], /* First [i] = k if the postordering of first * descendent of node i is k */ Int PrevNbr [ ], /* u was last considered at step k = PrevNbr [u] */ Int ColCount [ ], /* ColCount [c] is the current weight of node c */ Int PrevLeaf [ ], /* s = PrevLeaf [u] means that s was the last leaf * seen in the subtree rooted at u. */ Int RowCount [ ], /* RowCount [i] is # of nonzeros in row i of L, * including the diagonal. Not computed if NULL. */ Int SetParent [ ], /* the FIND/UNION data structure, which forms a set * of trees. A root i has i = SetParent [i]. Following * a path from i to the root q of the subtree containing * i means that q is the SetParent representative of i. * All nodes in the tree could have their SetParent * equal to the root q; the tree representation is used * to save time. When a path is traced from i to its * root q, the path is re-traversed to set the SetParent * of the whole path to be the root q. */ Int Level [ ] /* Level [i] = length of path from node i to root */ ) { Int prevleaf, q, s, sparent ; if (First [p] > PrevNbr [u]) { /* p is a leaf of the subtree of u */ ColCount [p]++ ; prevleaf = PrevLeaf [u] ; if (prevleaf == EMPTY) { /* p is the first leaf of subtree of u; RowCount will be incremented * by the length of the path in the etree from p up to u. */ q = u ; } else { /* q = FIND (prevleaf): find the root q of the * SetParent tree containing prevleaf */ for (q = prevleaf ; q != SetParent [q] ; q = SetParent [q]) { ; } /* the root q has been found; re-traverse the path and * perform path compression */ s = prevleaf ; for (s = prevleaf ; s != q ; s = sparent) { sparent = SetParent [s] ; SetParent [s] = q ; } /* adjust the RowCount and ColCount; RowCount will be incremented by * the length of the path from p to the SetParent root q, and * decrement the ColCount of q by one. */ ColCount [q]-- ; } if (RowCount != NULL) { /* if RowCount is being computed, increment it by the length of * the path from p to q */ RowCount [u] += (Level [p] - Level [q]) ; } /* p is a leaf of the subtree of u, so mark PrevLeaf [u] to be p */ PrevLeaf [u] = p ; } /* flag u has having been processed at step k */ PrevNbr [u] = k ; } /* ========================================================================== */ /* === finalize_node ======================================================== */ /* ========================================================================== */ static void finalize_node /* compute UNION (p, Parent [p]) */ ( Int p, Int Parent [ ], /* Parent [p] is the parent of p in the etree */ Int SetParent [ ] /* see process_edge, above */ ) { /* all nodes in the SetParent tree rooted at p now have as their final * root the node Parent [p]. This computes UNION (p, Parent [p]) */ if (Parent [p] != EMPTY) { SetParent [p] = Parent [p] ; } } /* ========================================================================== */ /* === cholmod_rowcolcounts ================================================= */ /* ========================================================================== */ int CHOLMOD(rowcolcounts) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to analyze */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ Int *Parent, /* size nrow. Parent [i] = p if p is the parent of i */ Int *Post, /* size nrow. Post [k] = i if i is the kth node in * the postordered etree. */ /* ---- output --- */ Int *RowCount, /* size nrow. RowCount [i] = # entries in the ith row of * L, including the diagonal. */ Int *ColCount, /* size nrow. ColCount [i] = # entries in the ith * column of L, including the diagonal. */ Int *First, /* size nrow. First [i] = k is the least postordering * of any descendant of i. */ Int *Level, /* size nrow. Level [i] is the length of the path from * i to the root, with Level [root] = 0. */ /* --------------- */ cholmod_common *Common ) { double fl, ff ; Int *Ap, *Ai, *Anz, *PrevNbr, *SetParent, *Head, *PrevLeaf, *Anext, *Ipost, *Iwork ; Int i, j, r, k, len, s, p, pend, inew, stype, nf, anz, inode, parent, nrow, ncol, packed, use_fset, jj ; size_t w ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (Parent, FALSE) ; RETURN_IF_NULL (Post, FALSE) ; RETURN_IF_NULL (ColCount, FALSE) ; RETURN_IF_NULL (First, FALSE) ; RETURN_IF_NULL (Level, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; stype = A->stype ; if (stype > 0) { /* symmetric with upper triangular part not supported */ ERROR (CHOLMOD_INVALID, "symmetric upper not supported") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ nrow = A->nrow ; /* the number of rows of A */ ncol = A->ncol ; /* the number of columns of A */ /* w = 2*nrow + (stype ? 0 : ncol) */ w = CHOLMOD(mult_size_t) (nrow, 2, &ok) ; w = CHOLMOD(add_size_t) (w, (stype ? 0 : ncol), &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (FALSE) ; } CHOLMOD(allocate_work) (nrow, w, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } ASSERT (CHOLMOD(dump_perm) (Post, nrow, nrow, "Post", Common)) ; ASSERT (CHOLMOD(dump_parent) (Parent, nrow, "Parent", Common)) ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ Ap = A->p ; /* size ncol+1, column pointers for A */ Ai = A->i ; /* the row indices of A, of size nz=Ap[ncol+1] */ Anz = A->nz ; packed = A->packed ; ASSERT (IMPLIES (!packed, Anz != NULL)) ; /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ Iwork = Common->Iwork ; SetParent = Iwork ; /* size nrow (i/i/l) */ PrevNbr = Iwork + nrow ; /* size nrow (i/i/l) */ Anext = Iwork + 2*((size_t) nrow) ; /* size ncol (i/i/l) (unsym only) */ PrevLeaf = Common->Flag ; /* size nrow */ Head = Common->Head ; /* size nrow+1 (unsym only)*/ /* ---------------------------------------------------------------------- */ /* find the first descendant and level of each node in the tree */ /* ---------------------------------------------------------------------- */ /* First [i] = k if the postordering of first descendent of node i is k */ /* Level [i] = length of path from node i to the root (Level [root] = 0) */ for (i = 0 ; i < nrow ; i++) { First [i] = EMPTY ; } /* postorder traversal of the etree */ for (k = 0 ; k < nrow ; k++) { /* node i of the etree is the kth node in the postordered etree */ i = Post [k] ; /* i is a leaf if First [i] is still EMPTY */ /* ColCount [i] starts at 1 if i is a leaf, zero otherwise */ ColCount [i] = (First [i] == EMPTY) ? 1 : 0 ; /* traverse the path from node i to the root, stopping if we find a * node r whose First [r] is already defined. */ len = 0 ; for (r = i ; (r != EMPTY) && (First [r] == EMPTY) ; r = Parent [r]) { First [r] = k ; len++ ; } if (r == EMPTY) { /* we hit a root node, the level of which is zero */ len-- ; } else { /* we stopped at node r, where Level [r] is already defined */ len += Level [r] ; } /* re-traverse the path from node i to r; set the level of each node */ for (s = i ; s != r ; s = Parent [s]) { Level [s] = len-- ; } } /* ---------------------------------------------------------------------- */ /* AA' case: sort columns of A according to first postordered row index */ /* ---------------------------------------------------------------------- */ fl = 0.0 ; if (stype == 0) { /* [ use PrevNbr [0..nrow-1] as workspace for Ipost */ Ipost = PrevNbr ; /* Ipost [i] = k if i is the kth node in the postordered etree. */ for (k = 0 ; k < nrow ; k++) { Ipost [Post [k]] = k ; } use_fset = (fset != NULL) ; if (use_fset) { nf = fsize ; /* clear Anext to check fset */ for (j = 0 ; j < ncol ; j++) { Anext [j] = -2 ; } /* find the first postordered row in each column of A (post,f) * and place the column in the corresponding link list */ for (jj = 0 ; jj < nf ; jj++) { j = fset [jj] ; if (j < 0 || j > ncol || Anext [j] != -2) { /* out-of-range or duplicate entry in fset */ ERROR (CHOLMOD_INVALID, "fset invalid") ; return (FALSE) ; } /* flag column j as having been seen */ Anext [j] = EMPTY ; } /* fset is now valid */ ASSERT (CHOLMOD(dump_perm) (fset, nf, ncol, "fset", Common)) ; } else { nf = ncol ; } for (jj = 0 ; jj < nf ; jj++) { j = (use_fset) ? (fset [jj]) : jj ; /* column j is in the fset; find the smallest row (if any) */ p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; ff = (double) MAX (0, pend - p) ; fl += ff*ff + ff ; if (pend > p) { k = Ipost [Ai [p]] ; for ( ; p < pend ; p++) { inew = Ipost [Ai [p]] ; k = MIN (k, inew) ; } /* place column j in link list k */ ASSERT (k >= 0 && k < nrow) ; Anext [j] = Head [k] ; Head [k] = j ; } } /* Ipost no longer needed for inverse postordering ] * Head [k] contains a link list of all columns whose first * postordered row index is equal to k, for k = 0 to nrow-1. */ } /* ---------------------------------------------------------------------- */ /* compute the row counts and node weights */ /* ---------------------------------------------------------------------- */ if (RowCount != NULL) { for (i = 0 ; i < nrow ; i++) { RowCount [i] = 1 ; } } for (i = 0 ; i < nrow ; i++) { PrevLeaf [i] = EMPTY ; PrevNbr [i] = EMPTY ; SetParent [i] = i ; /* every node is in its own set, by itself */ } if (stype != 0) { /* ------------------------------------------------------------------ */ /* symmetric case: LL' = A */ /* ------------------------------------------------------------------ */ /* also determine the number of entries in triu(A) */ anz = nrow ; for (k = 0 ; k < nrow ; k++) { /* j is the kth node in the postordered etree */ j = initialize_node (k, Post, Parent, ColCount, PrevNbr) ; /* for all nonzeros A(i,j) below the diagonal, in column j of A */ p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i > j) { /* j is a descendant of i in etree(A) */ anz++ ; process_edge (j, i, k, First, PrevNbr, ColCount, PrevLeaf, RowCount, SetParent, Level) ; } } /* update SetParent: UNION (j, Parent [j]) */ finalize_node (j, Parent, SetParent) ; } Common->anz = anz ; } else { /* ------------------------------------------------------------------ */ /* unsymmetric case: LL' = AA' */ /* ------------------------------------------------------------------ */ for (k = 0 ; k < nrow ; k++) { /* inode is the kth node in the postordered etree */ inode = initialize_node (k, Post, Parent, ColCount, PrevNbr) ; /* for all cols j whose first postordered row is k: */ for (j = Head [k] ; j != EMPTY ; j = Anext [j]) { /* k is the first postordered row in column j of A */ /* for all rows i in column j: */ p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; /* has i already been considered at this step k */ if (PrevNbr [i] < k) { /* inode is a descendant of i in etree(AA') */ /* process edge (inode,i) and set PrevNbr[i] to k */ process_edge (inode, i, k, First, PrevNbr, ColCount, PrevLeaf, RowCount, SetParent, Level) ; } } } /* clear link list k */ Head [k] = EMPTY ; /* update SetParent: UNION (inode, Parent [inode]) */ finalize_node (inode, Parent, SetParent) ; } } /* ---------------------------------------------------------------------- */ /* finish computing the column counts */ /* ---------------------------------------------------------------------- */ for (j = 0 ; j < nrow ; j++) { parent = Parent [j] ; if (parent != EMPTY) { /* add the ColCount of j to its parent */ ColCount [parent] += ColCount [j] ; } } /* ---------------------------------------------------------------------- */ /* clear workspace */ /* ---------------------------------------------------------------------- */ Common->mark = EMPTY ; /* CHOLMOD(clear_flag) (Common) ; */ CHOLMOD_CLEAR_FLAG (Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; /* ---------------------------------------------------------------------- */ /* flop count and nnz(L) for subsequent LL' numerical factorization */ /* ---------------------------------------------------------------------- */ /* use double to avoid integer overflow. lnz cannot be NaN. */ Common->aatfl = fl ; Common->lnz = 0. ; fl = 0 ; for (j = 0 ; j < nrow ; j++) { ff = (double) (ColCount [j]) ; Common->lnz += ff ; fl += ff*ff ; } Common->fl = fl ; PRINT1 (("rowcol fl %g lnz %g\n", Common->fl, Common->lnz)) ; return (TRUE) ; } #endif Matrix/src/CHOLMOD/Cholesky/cholmod_resymbol.c0000644000176200001440000004404713652535054020701 0ustar liggesusers/* ========================================================================== */ /* === Cholesky/cholmod_resymbol ============================================ */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Cholesky Module. Copyright (C) 2005-2006, Timothy A. Davis * -------------------------------------------------------------------------- */ /* Recompute the symbolic pattern of L. Entries not in the symbolic pattern * are dropped. L->Perm can be used (or not) to permute the input matrix A. * * These routines are used after a supernodal factorization is converted into * a simplicial one, to remove zero entries that were added due to relaxed * supernode amalgamation. They can also be used after a series of downdates * to remove entries that would no longer be present if the matrix were * factorized from scratch. A downdate (cholmod_updown) does not remove any * entries from L. * * workspace: Flag (nrow), Head (nrow+1), * if symmetric: Iwork (2*nrow) * if unsymmetric: Iwork (2*nrow+ncol). * Allocates up to 2 copies of its input matrix A (pattern only). */ #ifndef NCHOLESKY #include "cholmod_internal.h" #include "cholmod_cholesky.h" /* ========================================================================== */ /* === cholmod_resymbol ===================================================== */ /* ========================================================================== */ /* Remove entries from L that are not in the factorization of P*A*P', P*A*A'*P', * or P*F*F'*P' (depending on A->stype and whether fset is NULL or not). * * cholmod_resymbol is the same as cholmod_resymbol_noperm, except that it * first permutes A according to L->Perm. A can be upper/lower/unsymmetric, * in contrast to cholmod_resymbol_noperm (which can be lower or unsym). */ int CHOLMOD(resymbol) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to analyze */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ int pack, /* if TRUE, pack the columns of L */ /* ---- in/out --- */ cholmod_factor *L, /* factorization, entries pruned on output */ /* --------------- */ cholmod_common *Common ) { cholmod_sparse *H, *F, *G ; Int stype, nrow, ncol ; size_t s ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ; Common->status = CHOLMOD_OK ; if (L->is_super) { /* cannot operate on a supernodal factorization */ ERROR (CHOLMOD_INVALID, "cannot operate on supernodal L") ; return (FALSE) ; } if (L->n != A->nrow) { /* dimensions must agree */ ERROR (CHOLMOD_INVALID, "A and L dimensions do not match") ; return (FALSE) ; } /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ stype = A->stype ; nrow = A->nrow ; ncol = A->ncol ; /* s = 2*nrow + (stype ? 0 : ncol) */ s = CHOLMOD(mult_size_t) (nrow, 2, &ok) ; s = CHOLMOD(add_size_t) (s, (stype ? 0 : ncol), &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (FALSE) ; } CHOLMOD(allocate_work) (nrow, s, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } /* ---------------------------------------------------------------------- */ /* permute the input matrix if necessary */ /* ---------------------------------------------------------------------- */ H = NULL ; G = NULL ; if (stype > 0) { if (L->ordering == CHOLMOD_NATURAL) { /* F = triu(A)' */ /* workspace: Iwork (nrow) */ G = CHOLMOD(ptranspose) (A, 0, NULL, NULL, 0, Common) ; } else { /* F = triu(A(p,p))' */ /* workspace: Iwork (2*nrow) */ G = CHOLMOD(ptranspose) (A, 0, L->Perm, NULL, 0, Common) ; } F = G ; } else if (stype < 0) { if (L->ordering == CHOLMOD_NATURAL) { F = A ; } else { /* G = triu(A(p,p))' */ /* workspace: Iwork (2*nrow) */ G = CHOLMOD(ptranspose) (A, 0, L->Perm, NULL, 0, Common) ; /* H = G' */ /* workspace: Iwork (nrow) */ H = CHOLMOD(ptranspose) (G, 0, NULL, NULL, 0, Common) ; F = H ; } } else { if (L->ordering == CHOLMOD_NATURAL) { F = A ; } else { /* G = A(p,f)' */ /* workspace: Iwork (nrow if no fset; MAX (nrow,ncol) if fset)*/ G = CHOLMOD(ptranspose) (A, 0, L->Perm, fset, fsize, Common) ; /* H = G' */ /* workspace: Iwork (ncol) */ H = CHOLMOD(ptranspose) (G, 0, NULL, NULL, 0, Common) ; F = H ; } } /* No need to check for failure here. cholmod_resymbol_noperm will return * FALSE if F is NULL. */ /* ---------------------------------------------------------------------- */ /* resymbol */ /* ---------------------------------------------------------------------- */ ok = CHOLMOD(resymbol_noperm) (F, fset, fsize, pack, L, Common) ; /* ---------------------------------------------------------------------- */ /* free the temporary matrices, if they exist */ /* ---------------------------------------------------------------------- */ CHOLMOD(free_sparse) (&H, Common) ; CHOLMOD(free_sparse) (&G, Common) ; return (ok) ; } /* ========================================================================== */ /* === cholmod_resymbol_noperm ============================================== */ /* ========================================================================== */ /* Redo symbolic LDL' or LL' factorization of I + F*F' or I+A, where F=A(:,f). * * L already exists, but is a superset of the true dynamic pattern (simple * column downdates and row deletions haven't pruned anything). Just redo the * symbolic factorization and drop entries that are no longer there. The * diagonal is not modified. The number of nonzeros in column j of L * (L->nz[j]) can decrease. The column pointers (L->p[j]) remain unchanged if * pack is FALSE or if L is not monotonic. Otherwise, the columns of L are * packed in place. * * For the symmetric case, the columns of the lower triangular part of A * are accessed by column. NOTE that this the transpose of the general case. * * For the unsymmetric case, F=A(:,f) is accessed by column. * * A need not be sorted, and can be packed or unpacked. If L->Perm is not * identity, then A must already be permuted according to the permutation used * to factorize L. The advantage of using this routine is that it does not * need to create permuted copies of A first. * * This routine can be called if L is only partially factored via cholmod_rowfac * since all it does is prune. If an entry is in F*F' or A, but not in L, it * isn't added to L. * * L must be simplicial LDL' or LL'; it cannot be supernodal or symbolic. * * The set f is held in fset and fsize. * fset = NULL means ":" in MATLAB. fset is ignored. * fset != NULL means f = fset [0..fset-1]. * fset != NULL and fsize = 0 means f is the empty set. * There can be no duplicates in fset. * Common->status is set to CHOLMOD_INVALID if fset is invalid. * * workspace: Flag (nrow), Head (nrow+1), * if symmetric: Iwork (2*nrow) * if unsymmetric: Iwork (2*nrow+ncol). * Unlike cholmod_resymbol, this routine does not allocate any temporary * copies of its input matrix. */ int CHOLMOD(resymbol_noperm) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to analyze */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ int pack, /* if TRUE, pack the columns of L */ /* ---- in/out --- */ cholmod_factor *L, /* factorization, entries pruned on output */ /* --------------- */ cholmod_common *Common ) { double *Lx, *Lz ; Int i, j, k, row, parent, p, pend, pdest, ncol, apacked, sorted, nrow, nf, use_fset, mark, jj, stype, xtype ; Int *Ap, *Ai, *Anz, *Li, *Lp, *Lnz, *Flag, *Head, *Link, *Anext, *Iwork ; size_t s ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ; ncol = A->ncol ; nrow = A->nrow ; stype = A->stype ; ASSERT (IMPLIES (stype != 0, nrow == ncol)) ; if (stype > 0) { /* symmetric, with upper triangular part, not supported */ ERROR (CHOLMOD_INVALID, "symmetric upper not supported ") ; return (FALSE) ; } if (L->is_super) { /* cannot operate on a supernodal or symbolic factorization */ ERROR (CHOLMOD_INVALID, "cannot operate on supernodal L") ; return (FALSE) ; } if (L->n != A->nrow) { /* dimensions must agree */ ERROR (CHOLMOD_INVALID, "A and L dimensions do not match") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* s = 2*nrow + (stype ? 0 : ncol) */ s = CHOLMOD(mult_size_t) (nrow, 2, &ok) ; if (stype != 0) { s = CHOLMOD(add_size_t) (s, ncol, &ok) ; } if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (FALSE) ; } CHOLMOD(allocate_work) (nrow, s, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; /* out of memory */ } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ Ai = A->i ; Ap = A->p ; Anz = A->nz ; apacked = A->packed ; sorted = A->sorted ; Li = L->i ; Lx = L->x ; Lz = L->z ; Lp = L->p ; Lnz = L->nz ; xtype = L->xtype ; /* If L is monotonic on input, then it can be packed or * unpacked on output, depending on the pack input parameter. */ /* cannot pack a non-monotonic matrix */ if (!(L->is_monotonic)) { pack = FALSE ; } ASSERT (L->nzmax >= (size_t) (Lp [L->n])) ; pdest = 0 ; PRINT1 (("\n\n===================== Resymbol pack %d Apacked %d\n", pack, A->packed)) ; ASSERT (CHOLMOD(dump_sparse) (A, "ReSymbol A:", Common) >= 0) ; DEBUG (CHOLMOD(dump_factor) (L, "ReSymbol initial L (i, x):", Common)) ; /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ Flag = Common->Flag ; /* size nrow */ Head = Common->Head ; /* size nrow+1 */ Iwork = Common->Iwork ; Link = Iwork ; /* size nrow (i/i/l) [ */ Lnz = Iwork + nrow ; /* size nrow (i/i/l), if L not packed */ Anext = Iwork + 2*((size_t) nrow) ; /* size ncol (i/i/l), unsym. only */ for (j = 0 ; j < nrow ; j++) { Link [j] = EMPTY ; } /* use Lnz in L itself */ Lnz = L->nz ; ASSERT (Lnz != NULL) ; /* ---------------------------------------------------------------------- */ /* for the unsymmetric case, queue each column of A (:,f) */ /* ---------------------------------------------------------------------- */ /* place each column of the basis set on the link list corresponding to */ /* the smallest row index in that column */ if (stype == 0) { use_fset = (fset != NULL) ; if (use_fset) { nf = fsize ; /* This is the only O(ncol) loop in cholmod_resymbol. * It is required only to check the fset. */ for (j = 0 ; j < ncol ; j++) { Anext [j] = -2 ; } for (jj = 0 ; jj < nf ; jj++) { j = fset [jj] ; if (j < 0 || j > ncol || Anext [j] != -2) { /* out-of-range or duplicate entry in fset */ ERROR (CHOLMOD_INVALID, "fset invalid") ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; return (FALSE) ; } /* flag column j as having been seen */ Anext [j] = EMPTY ; } /* the fset is now valid */ ASSERT (CHOLMOD(dump_perm) (fset, nf, ncol, "fset", Common)) ; } else { nf = ncol ; } for (jj = 0 ; jj < nf ; jj++) { j = (use_fset) ? (fset [jj]) : jj ; /* column j is the fset; find the smallest row (if any) */ p = Ap [j] ; pend = (apacked) ? (Ap [j+1]) : (p + Anz [j]) ; if (pend > p) { k = Ai [p] ; if (!sorted) { for ( ; p < pend ; p++) { k = MIN (k, Ai [p]) ; } } /* place column j on link list k */ ASSERT (k >= 0 && k < nrow) ; Anext [j] = Head [k] ; Head [k] = j ; } } } /* ---------------------------------------------------------------------- */ /* recompute symbolic LDL' factorization */ /* ---------------------------------------------------------------------- */ for (k = 0 ; k < nrow ; k++) { #ifndef NDEBUG PRINT1 (("\n\n================== Initial column k = "ID"\n", k)) ; for (p = Lp [k] ; p < Lp [k] + Lnz [k] ; p++) { PRINT1 ((" row: "ID" value: ", Li [p])) ; PRINT1 (("\n")) ; } PRINT1 (("Recomputing LDL, column k = "ID"\n", k)) ; #endif /* ------------------------------------------------------------------ */ /* compute column k of I+F*F' or I+A */ /* ------------------------------------------------------------------ */ /* flag the diagonal entry */ /* mark = CHOLMOD(clear_flag) (Common) ; */ CHOLMOD_CLEAR_FLAG (Common) ; mark = Common->mark ; Flag [k] = mark ; PRINT1 ((" row: "ID" (diagonal)\n", k)) ; if (stype != 0) { /* merge column k of A into Flag (lower triangular part only) */ p = Ap [k] ; pend = (apacked) ? (Ap [k+1]) : (p + Anz [k]) ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i > k) { Flag [i] = mark ; } } } else { /* for each column j whos first row index is in row k */ for (j = Head [k] ; j != EMPTY ; j = Anext [j]) { /* merge column j of A into Flag */ PRINT1 ((" ---- A column "ID"\n", j)) ; p = Ap [j] ; pend = (apacked) ? (Ap [j+1]) : (p + Anz [j]) ; PRINT1 ((" length "ID" adding\n", pend-p)) ; for ( ; p < pend ; p++) { #ifndef NDEBUG ASSERT (Ai [p] >= k && Ai [p] < nrow) ; if (Flag [Ai [p]] < mark) PRINT1 ((" row "ID"\n", Ai [p])) ; #endif Flag [Ai [p]] = mark ; } } /* clear the kth link list */ Head [k] = EMPTY ; } /* ------------------------------------------------------------------ */ /* compute pruned pattern of kth column of L = union of children */ /* ------------------------------------------------------------------ */ /* for each column j of L whose parent is k */ for (j = Link [k] ; j != EMPTY ; j = Link [j]) { /* merge column j of L into Flag */ PRINT1 ((" ---- L column "ID"\n", k)) ; ASSERT (j < k) ; ASSERT (Lnz [j] > 0) ; p = Lp [j] ; pend = p + Lnz [j] ; ASSERT (Li [p] == j && Li [p+1] == k) ; p++ ; /* skip past the diagonal entry */ for ( ; p < pend ; p++) { /* add to pattern */ ASSERT (Li [p] >= k && Li [p] < nrow) ; Flag [Li [p]] = mark ; } } /* ------------------------------------------------------------------ */ /* prune the kth column of L */ /* ------------------------------------------------------------------ */ PRINT1 (("Final column of L:\n")) ; p = Lp [k] ; pend = p + Lnz [k] ; if (pack) { /* shift column k upwards */ Lp [k] = pdest ; } else { /* leave column k in place, just reduce Lnz [k] */ pdest = p ; } for ( ; p < pend ; p++) { ASSERT (pdest < pend) ; ASSERT (pdest <= p) ; row = Li [p] ; ASSERT (row >= k && row < nrow) ; if (Flag [row] == mark) { /* keep this entry */ Li [pdest] = row ; if (xtype == CHOLMOD_REAL) { Lx [pdest] = Lx [p] ; } else if (xtype == CHOLMOD_COMPLEX) { Lx [2*pdest ] = Lx [2*p ] ; Lx [2*pdest+1] = Lx [2*p+1] ; } else if (xtype == CHOLMOD_ZOMPLEX) { Lx [pdest] = Lx [p] ; Lz [pdest] = Lz [p] ; } pdest++ ; } } /* ------------------------------------------------------------------ */ /* prepare this column for its parent */ /* ------------------------------------------------------------------ */ Lnz [k] = pdest - Lp [k] ; PRINT1 ((" L("ID") length "ID"\n", k, Lnz [k])) ; ASSERT (Lnz [k] > 0) ; /* parent is the first entry in the column after the diagonal */ parent = (Lnz [k] > 1) ? (Li [Lp [k] + 1]) : EMPTY ; PRINT1 (("parent ("ID") = "ID"\n", k, parent)) ; ASSERT ((parent > k && parent < nrow) || (parent == EMPTY)) ; if (parent != EMPTY) { Link [k] = Link [parent] ; Link [parent] = k ; } } /* done using Iwork for Link, Lnz (if needed), and Anext ] */ /* ---------------------------------------------------------------------- */ /* convert L to packed, if requested */ /* ---------------------------------------------------------------------- */ if (pack) { /* finalize Lp */ Lp [nrow] = pdest ; /* Shrink L to be just large enough. It cannot fail. */ /* workspace: none */ ASSERT ((size_t) (Lp [nrow]) <= L->nzmax) ; CHOLMOD(reallocate_factor) (Lp [nrow], L, Common) ; ASSERT (Common->status >= CHOLMOD_OK) ; } /* ---------------------------------------------------------------------- */ /* clear workspace */ /* ---------------------------------------------------------------------- */ /* CHOLMOD(clear_flag) (Common) ; */ CHOLMOD_CLEAR_FLAG (Common) ; DEBUG (CHOLMOD(dump_factor) (L, "ReSymbol final L (i, x):", Common)) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; return (TRUE) ; } #endif Matrix/src/CHOLMOD/Cholesky/cholmod_spsolve.c0000644000176200001440000002327613652535054020541 0ustar liggesusers/* ========================================================================== */ /* === Cholesky/cholmod_spsolve ============================================= */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Cholesky Module. Copyright (C) 2005-2006, Timothy A. Davis * -------------------------------------------------------------------------- */ /* Given an LL' or LDL' factorization of A, solve one of the following systems: * * Ax=b 0: CHOLMOD_A also applies the permutation L->Perm * LDL'x=b 1: CHOLMOD_LDLt does not apply L->Perm * LDx=b 2: CHOLMOD_LD * DL'x=b 3: CHOLMOD_DLt * Lx=b 4: CHOLMOD_L * L'x=b 5: CHOLMOD_Lt * Dx=b 6: CHOLMOD_D * x=Pb 7: CHOLMOD_P apply a permutation (P is L->Perm) * x=P'b 8: CHOLMOD_Pt apply an inverse permutation * * where b and x are sparse. If L and b are real, then x is real. Otherwise, * x is complex or zomplex, depending on the Common->prefer_zomplex parameter. * All xtypes of x and b are supported (real, complex, and zomplex). */ #ifndef NCHOLESKY #include "cholmod_internal.h" #include "cholmod_cholesky.h" /* ========================================================================== */ /* === EXPAND_AS_NEEDED ===================================================== */ /* ========================================================================== */ /* Double the size of the sparse matrix X, if we have run out of space. */ #define EXPAND_AS_NEEDED \ if (xnz >= nzmax) \ { \ nzmax *= 2 ; \ CHOLMOD(reallocate_sparse) (nzmax, X, Common) ; \ if (Common->status < CHOLMOD_OK) \ { \ CHOLMOD(free_sparse) (&X, Common) ; \ CHOLMOD(free_dense) (&X4, Common) ; \ CHOLMOD(free_dense) (&B4, Common) ; \ return (NULL) ; \ } \ Xi = X->i ; \ Xx = X->x ; \ Xz = X->z ; \ } /* ========================================================================== */ /* === cholmod_spolve ======================================================= */ /* ========================================================================== */ cholmod_sparse *CHOLMOD(spsolve) /* returns the sparse solution X */ ( /* ---- input ---- */ int sys, /* system to solve */ cholmod_factor *L, /* factorization to use */ cholmod_sparse *B, /* right-hand-side */ /* --------------- */ cholmod_common *Common ) { double x, z ; cholmod_dense *X4, *B4 ; cholmod_sparse *X ; double *Bx, *Bz, *Xx, *Xz, *B4x, *B4z, *X4x, *X4z ; Int *Bi, *Bp, *Xp, *Xi, *Bnz ; Int n, nrhs, q, p, i, j, jfirst, jlast, packed, block, pend, j_n, xtype ; size_t xnz, nzmax ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (L, NULL) ; RETURN_IF_NULL (B, NULL) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, NULL) ; RETURN_IF_XTYPE_INVALID (B, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, NULL) ; if (L->n != B->nrow) { ERROR (CHOLMOD_INVALID, "dimensions of L and B do not match") ; return (NULL) ; } if (B->stype) { ERROR (CHOLMOD_INVALID, "B cannot be stored in symmetric mode") ; return (NULL) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace B4 and initial result X */ /* ---------------------------------------------------------------------- */ n = L->n ; nrhs = B->ncol ; /* X is real if both L and B are real, complex/zomplex otherwise */ xtype = (L->xtype == CHOLMOD_REAL && B->xtype == CHOLMOD_REAL) ? CHOLMOD_REAL : (Common->prefer_zomplex ? CHOLMOD_ZOMPLEX : CHOLMOD_COMPLEX) ; /* solve up to 4 columns at a time */ block = MIN (nrhs, 4) ; /* initial size of X is at most 4*n */ nzmax = n*block ; X = CHOLMOD(spzeros) (n, nrhs, nzmax, xtype, Common) ; B4 = CHOLMOD(zeros) (n, block, B->xtype, Common) ; if (Common->status < CHOLMOD_OK) { CHOLMOD(free_sparse) (&X, Common) ; CHOLMOD(free_dense) (&B4, Common) ; return (NULL) ; } Bp = B->p ; Bi = B->i ; Bx = B->x ; Bz = B->z ; Bnz = B->nz ; packed = B->packed ; Xp = X->p ; Xi = X->i ; Xx = X->x ; Xz = X->z ; xnz = 0 ; B4x = B4->x ; B4z = B4->z ; /* ---------------------------------------------------------------------- */ /* solve in chunks of 4 columns at a time */ /* ---------------------------------------------------------------------- */ for (jfirst = 0 ; jfirst < nrhs ; jfirst += block) { /* ------------------------------------------------------------------ */ /* adjust the number of columns of B4 */ /* ------------------------------------------------------------------ */ jlast = MIN (nrhs, jfirst + block) ; B4->ncol = jlast - jfirst ; /* ------------------------------------------------------------------ */ /* scatter B(jfirst:jlast-1) into B4 */ /* ------------------------------------------------------------------ */ for (j = jfirst ; j < jlast ; j++) { p = Bp [j] ; pend = (packed) ? (Bp [j+1]) : (p + Bnz [j]) ; j_n = (j-jfirst)*n ; switch (B->xtype) { case CHOLMOD_REAL: for ( ; p < pend ; p++) { B4x [Bi [p] + j_n] = Bx [p] ; } break ; case CHOLMOD_COMPLEX: for ( ; p < pend ; p++) { q = Bi [p] + j_n ; B4x [2*q ] = Bx [2*p ] ; B4x [2*q+1] = Bx [2*p+1] ; } break ; case CHOLMOD_ZOMPLEX: for ( ; p < pend ; p++) { q = Bi [p] + j_n ; B4x [q] = Bx [p] ; B4z [q] = Bz [p] ; } break ; } } /* ------------------------------------------------------------------ */ /* solve the system (X4 = A\B4 or other system) */ /* ------------------------------------------------------------------ */ X4 = CHOLMOD(solve) (sys, L, B4, Common) ; if (Common->status < CHOLMOD_OK) { CHOLMOD(free_sparse) (&X, Common) ; CHOLMOD(free_dense) (&B4, Common) ; CHOLMOD(free_dense) (&X4, Common) ; return (NULL) ; } ASSERT (X4->xtype == xtype) ; X4x = X4->x ; X4z = X4->z ; /* ------------------------------------------------------------------ */ /* append the solution onto X */ /* ------------------------------------------------------------------ */ for (j = jfirst ; j < jlast ; j++) { Xp [j] = xnz ; j_n = (j-jfirst)*n ; if ( xnz + n <= nzmax) { /* ---------------------------------------------------------- */ /* X is guaranteed to be large enough */ /* ---------------------------------------------------------- */ switch (xtype) { case CHOLMOD_REAL: for (i = 0 ; i < n ; i++) { x = X4x [i + j_n] ; if (IS_NONZERO (x)) { Xi [xnz] = i ; Xx [xnz] = x ; xnz++ ; } } break ; case CHOLMOD_COMPLEX: for (i = 0 ; i < n ; i++) { x = X4x [2*(i + j_n) ] ; z = X4x [2*(i + j_n)+1] ; if (IS_NONZERO (x) || IS_NONZERO (z)) { Xi [xnz] = i ; Xx [2*xnz ] = x ; Xx [2*xnz+1] = z ; xnz++ ; } } break ; case CHOLMOD_ZOMPLEX: for (i = 0 ; i < n ; i++) { x = X4x [i + j_n] ; z = X4z [i + j_n] ; if (IS_NONZERO (x) || IS_NONZERO (z)) { Xi [xnz] = i ; Xx [xnz] = x ; Xz [xnz] = z ; xnz++ ; } } break ; } } else { /* ---------------------------------------------------------- */ /* X may need to increase in size */ /* ---------------------------------------------------------- */ switch (xtype) { case CHOLMOD_REAL: for (i = 0 ; i < n ; i++) { x = X4x [i + j_n] ; if (IS_NONZERO (x)) { EXPAND_AS_NEEDED ; Xi [xnz] = i ; Xx [xnz] = x ; xnz++ ; } } break ; case CHOLMOD_COMPLEX: for (i = 0 ; i < n ; i++) { x = X4x [2*(i + j_n) ] ; z = X4x [2*(i + j_n)+1] ; if (IS_NONZERO (x) || IS_NONZERO (z)) { EXPAND_AS_NEEDED ; Xi [xnz] = i ; Xx [2*xnz ] = x ; Xx [2*xnz+1] = z ; xnz++ ; } } break ; case CHOLMOD_ZOMPLEX: for (i = 0 ; i < n ; i++) { x = X4x [i + j_n] ; z = X4z [i + j_n] ; if (IS_NONZERO (x) || IS_NONZERO (z)) { EXPAND_AS_NEEDED ; Xi [xnz] = i ; Xx [xnz] = x ; Xz [xnz] = z ; xnz++ ; } } break ; } } } CHOLMOD(free_dense) (&X4, Common) ; /* ------------------------------------------------------------------ */ /* clear B4 for next iteration */ /* ------------------------------------------------------------------ */ if (jlast < nrhs) { for (j = jfirst ; j < jlast ; j++) { p = Bp [j] ; pend = (packed) ? (Bp [j+1]) : (p + Bnz [j]) ; j_n = (j-jfirst)*n ; switch (B->xtype) { case CHOLMOD_REAL: for ( ; p < pend ; p++) { B4x [Bi [p] + j_n] = 0 ; } break ; case CHOLMOD_COMPLEX: for ( ; p < pend ; p++) { q = Bi [p] + j_n ; B4x [2*q ] = 0 ; B4x [2*q+1] = 0 ; } break ; case CHOLMOD_ZOMPLEX: for ( ; p < pend ; p++) { q = Bi [p] + j_n ; B4x [q] = 0 ; B4z [q] = 0 ; } break ; } } } } Xp [nrhs] = xnz ; /* ---------------------------------------------------------------------- */ /* reduce X in size, free workspace, and return result */ /* ---------------------------------------------------------------------- */ ASSERT (xnz <= X->nzmax) ; CHOLMOD(reallocate_sparse) (xnz, X, Common) ; ASSERT (Common->status == CHOLMOD_OK) ; CHOLMOD(free_dense) (&B4, Common) ; return (X) ; } #endif Matrix/src/CHOLMOD/Cholesky/cholmod_postorder.c0000644000176200001440000002240313652535054021056 0ustar liggesusers/* ========================================================================== */ /* === Cholesky/cholmod_postorder =========================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Cholesky Module. Copyright (C) 2005-2006, Timothy A. Davis * -------------------------------------------------------------------------- */ /* Compute the postorder of a tree. */ #ifndef NCHOLESKY #include "cholmod_internal.h" #include "cholmod_cholesky.h" /* ========================================================================== */ /* === dfs ================================================================== */ /* ========================================================================== */ /* The code below includes both a recursive and non-recursive depth-first-search * of a tree. The recursive code is simpler, but can lead to stack overflow. * It is left here for reference, to understand what the non-recursive code * is computing. To try the recursive version, uncomment the following * #define, or compile the code with -DRECURSIVE. Be aware that stack * overflow may occur. #define RECURSIVE */ #ifdef RECURSIVE /* recursive version: a working code for reference only, not actual use */ static Int dfs /* return the new value of k */ ( Int p, /* start a DFS at node p */ Int k, /* start the node numbering at k */ Int Post [ ], /* Post ordering, modified on output */ Int Head [ ], /* Head [p] = youngest child of p; EMPTY on output */ Int Next [ ], /* Next [j] = sibling of j; unmodified */ Int Pstack [ ] /* unused */ ) { Int j ; /* start a DFS at each child of node p */ for (j = Head [p] ; j != EMPTY ; j = Next [j]) { /* start a DFS at child node j */ k = dfs (j, k, Post, Head, Next, Pstack) ; } Post [k++] = p ; /* order node p as the kth node */ Head [p] = EMPTY ; /* link list p no longer needed */ return (k) ; /* the next node will be numbered k */ } #else /* non-recursive version for actual use */ static Int dfs /* return the new value of k */ ( Int p, /* start the DFS at a root node p */ Int k, /* start the node numbering at k */ Int Post [ ], /* Post ordering, modified on output */ Int Head [ ], /* Head [p] = youngest child of p; EMPTY on output */ Int Next [ ], /* Next [j] = sibling of j; unmodified */ Int Pstack [ ] /* workspace of size n, undefined on input or output */ ) { Int j, phead ; /* put the root node on the stack */ Pstack [0] = p ; phead = 0 ; /* while the stack is not empty, do: */ while (phead >= 0) { /* grab the node p from top of the stack and get its youngest child j */ p = Pstack [phead] ; j = Head [p] ; if (j == EMPTY) { /* all children of p ordered. remove p from stack and order it */ phead-- ; Post [k++] = p ; /* order node p as the kth node */ } else { /* leave p on the stack. Start a DFS at child node j by putting * j on the stack and removing j from the list of children of p. */ Head [p] = Next [j] ; Pstack [++phead] = j ; } } return (k) ; /* the next node will be numbered k */ } #endif /* ========================================================================== */ /* === cholmod_postorder ==================================================== */ /* ========================================================================== */ /* Postorder a tree. The tree is either an elimination tree (the output from * from cholmod_etree) or a component tree (from cholmod_nested_dissection). * * An elimination tree is a complete tree of n nodes with Parent [j] > j or * Parent [j] = EMPTY if j is a root. On output Post [0..n-1] is a complete * permutation vector. * * A component tree is a subset of 0..n-1. Parent [j] = -2 if node j is not * in the component tree. Parent [j] = EMPTY if j is a root of the component * tree, and Parent [j] is in the range 0 to n-1 if j is in the component * tree but not a root. On output, Post [k] is defined only for nodes in * the component tree. Post [k] = j if node j is the kth node in the * postordered component tree, where k is in the range 0 to the number of * components minus 1. * * Node j is ignored and not included in the postorder if Parent [j] < EMPTY. * * As a result, check_parent (Parent, n,...) may fail on input, since * cholmod_check_parent assumes Parent is an elimination tree. Similarly, * cholmod_check_perm (Post, ...) may fail on output, since Post is a partial * permutation if Parent is a component tree. * * An optional node weight can be given. When starting a postorder at node j, * the children of j are ordered in increasing order of their weight. * If no weights are given (Weight is NULL) then children are ordered in * increasing order of their node number. The weight of a node must be in the * range 0 to n-1. Weights outside that range are silently converted to that * range (weights < 0 are treated as zero, and weights >= n are treated as n-1). * * * workspace: Head (n), Iwork (2*n) */ SuiteSparse_long CHOLMOD(postorder) /* return # of nodes postordered */ ( /* ---- input ---- */ Int *Parent, /* size n. Parent [j] = p if p is the parent of j */ size_t n, Int *Weight, /* size n, optional. Weight [j] is weight of node j */ /* ---- output --- */ Int *Post, /* size n. Post [k] = j is kth in postordered tree */ /* --------------- */ cholmod_common *Common ) { Int *Head, *Next, *Pstack, *Iwork ; Int j, p, k, w, nextj ; size_t s ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (EMPTY) ; RETURN_IF_NULL (Parent, EMPTY) ; RETURN_IF_NULL (Post, EMPTY) ; Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* s = 2*n */ s = CHOLMOD(mult_size_t) (n, 2, &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (EMPTY) ; } CHOLMOD(allocate_work) (n, s, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (EMPTY) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ Head = Common->Head ; /* size n+1, initially all EMPTY */ Iwork = Common->Iwork ; Next = Iwork ; /* size n (i/i/l) */ Pstack = Iwork + n ; /* size n (i/i/l) */ /* ---------------------------------------------------------------------- */ /* construct a link list of children for each node */ /* ---------------------------------------------------------------------- */ if (Weight == NULL) { /* in reverse order so children are in ascending order in each list */ for (j = n-1 ; j >= 0 ; j--) { p = Parent [j] ; if (p >= 0 && p < ((Int) n)) { /* add j to the list of children for node p */ Next [j] = Head [p] ; Head [p] = j ; } } /* Head [p] = j if j is the youngest (least-numbered) child of p */ /* Next [j1] = j2 if j2 is the next-oldest sibling of j1 */ } else { /* First, construct a set of link lists according to Weight. * * Whead [w] = j if node j is the first node in bucket w. * Next [j1] = j2 if node j2 follows j1 in a link list. */ Int *Whead = Pstack ; /* use Pstack as workspace for Whead [ */ for (w = 0 ; w < ((Int) n) ; w++) { Whead [w] = EMPTY ; } /* do in forward order, so nodes that ties are ordered by node index */ for (j = 0 ; j < ((Int) n) ; j++) { p = Parent [j] ; if (p >= 0 && p < ((Int) n)) { w = Weight [j] ; w = MAX (0, w) ; w = MIN (w, ((Int) n) - 1) ; /* place node j at the head of link list for weight w */ Next [j] = Whead [w] ; Whead [w] = j ; } } /* traverse weight buckets, placing each node in its parent's list */ for (w = n-1 ; w >= 0 ; w--) { for (j = Whead [w] ; j != EMPTY ; j = nextj) { nextj = Next [j] ; /* put node j in the link list of its parent */ p = Parent [j] ; ASSERT (p >= 0 && p < ((Int) n)) ; Next [j] = Head [p] ; Head [p] = j ; } } /* Whead no longer needed ] */ /* Head [p] = j if j is the lightest child of p */ /* Next [j1] = j2 if j2 is the next-heaviest sibling of j1 */ } /* ---------------------------------------------------------------------- */ /* start a DFS at each root node of the etree */ /* ---------------------------------------------------------------------- */ k = 0 ; for (j = 0 ; j < ((Int) n) ; j++) { if (Parent [j] == EMPTY) { /* j is the root of a tree; start a DFS here */ k = dfs (j, k, Post, Head, Next, Pstack) ; } } /* this would normally be EMPTY already, unless Parent is invalid */ for (j = 0 ; j < ((Int) n) ; j++) { Head [j] = EMPTY ; } PRINT1 (("postordered "ID" nodes\n", k)) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; return (k) ; } #endif Matrix/src/CHOLMOD/Cholesky/t_cholmod_lsolve.c0000644000176200001440000006334513652535054020676 0ustar liggesusers/* ========================================================================== */ /* === Cholesky/t_cholmod_lsolve ============================================ */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Cholesky Module. Copyright (C) 2005-2013, Timothy A. Davis * -------------------------------------------------------------------------- */ /* Template routine to solve Lx=b with unit or non-unit diagonal, or * solve LDx=b. * * The numeric xtype of L and Y must match. Y contains b on input and x on * output, stored in row-form. Y is nrow-by-n, where nrow must equal 1 for the * complex or zomplex cases, and nrow <= 4 for the real case. * * This file is not compiled separately. It is included in t_cholmod_solve.c * instead. It contains no user-callable routines. * * workspace: none * * Supports real, complex, and zomplex factors. */ /* undefine all prior definitions */ #undef FORM_NAME #undef LSOLVE /* -------------------------------------------------------------------------- */ /* define the method */ /* -------------------------------------------------------------------------- */ #ifdef LL /* LL': solve Lx=b with non-unit diagonal */ #define FORM_NAME(prefix,rank) prefix ## ll_lsolve_ ## rank #elif defined (LD) /* LDL': solve LDx=b */ #define FORM_NAME(prefix,rank) prefix ## ldl_ldsolve_ ## rank #else /* LDL': solve Lx=b with unit diagonal */ #define FORM_NAME(prefix,rank) prefix ## ldl_lsolve_ ## rank #endif /* LSOLVE(k) defines the name of a routine for an n-by-k right-hand-side. */ #define LSOLVE(prefix,rank) FORM_NAME(prefix,rank) #ifdef REAL /* ========================================================================== */ /* === LSOLVE (1) =========================================================== */ /* ========================================================================== */ /* Solve Lx=b, where b has 1 column */ static void LSOLVE (PREFIX,1) ( cholmod_factor *L, double X [ ] /* n-by-1 in row form */ ) { double *Lx = L->x ; Int *Li = L->i ; Int *Lp = L->p ; Int *Lnz = L->nz ; Int j, n = L->n ; for (j = 0 ; j < n ; ) { /* get the start, end, and length of column j */ Int p = Lp [j] ; Int lnz = Lnz [j] ; Int pend = p + lnz ; /* find a chain of supernodes (up to j, j+1, and j+2) */ if (lnz < 4 || lnz != Lnz [j+1] + 1 || Li [p+1] != j+1) { /* -------------------------------------------------------------- */ /* solve with a single column of L */ /* -------------------------------------------------------------- */ double y = X [j] ; #ifdef LL y /= Lx [p] ; X [j] = y ; #elif defined (LD) X [j] = y / Lx [p] ; #endif for (p++ ; p < pend ; p++) { X [Li [p]] -= Lx [p] * y ; } j++ ; /* advance to next column of L */ } else if (lnz != Lnz [j+2] + 2 || Li [p+2] != j+2) { /* -------------------------------------------------------------- */ /* solve with a supernode of two columns of L */ /* -------------------------------------------------------------- */ double y [2] ; Int q = Lp [j+1] ; #ifdef LL y [0] = X [j] / Lx [p] ; y [1] = (X [j+1] - Lx [p+1] * y [0]) / Lx [q] ; X [j ] = y [0] ; X [j+1] = y [1] ; #elif defined (LD) y [0] = X [j] ; y [1] = X [j+1] - Lx [p+1] * y [0] ; X [j ] = y [0] / Lx [p] ; X [j+1] = y [1] / Lx [q] ; #else y [0] = X [j] ; y [1] = X [j+1] - Lx [p+1] * y [0] ; X [j+1] = y [1] ; #endif for (p += 2, q++ ; p < pend ; p++, q++) { X [Li [p]] -= Lx [p] * y [0] + Lx [q] * y [1] ; } j += 2 ; /* advance to next column of L */ } else { /* -------------------------------------------------------------- */ /* solve with a supernode of three columns of L */ /* -------------------------------------------------------------- */ double y [3] ; Int q = Lp [j+1] ; Int r = Lp [j+2] ; #ifdef LL y [0] = X [j] / Lx [p] ; y [1] = (X [j+1] - Lx [p+1] * y [0]) / Lx [q] ; y [2] = (X [j+2] - Lx [p+2] * y [0] - Lx [q+1] * y [1]) / Lx [r] ; X [j ] = y [0] ; X [j+1] = y [1] ; X [j+2] = y [2] ; #elif defined (LD) y [0] = X [j] ; y [1] = X [j+1] - Lx [p+1] * y [0] ; y [2] = X [j+2] - Lx [p+2] * y [0] - Lx [q+1] * y [1] ; X [j ] = y [0] / Lx [p] ; X [j+1] = y [1] / Lx [q] ; X [j+2] = y [2] / Lx [r] ; #else y [0] = X [j] ; y [1] = X [j+1] - Lx [p+1] * y [0] ; y [2] = X [j+2] - Lx [p+2] * y [0] - Lx [q+1] * y [1] ; X [j+1] = y [1] ; X [j+2] = y [2] ; #endif for (p += 3, q += 2, r++ ; p < pend ; p++, q++, r++) { X [Li [p]] -= Lx [p] * y [0] + Lx [q] * y [1] + Lx [r] * y [2] ; } j += 3 ; /* advance to next column of L */ } } } /* ========================================================================== */ /* === LSOLVE (2) =========================================================== */ /* ========================================================================== */ /* Solve Lx=b, where b has 2 columns */ static void LSOLVE (PREFIX,2) ( cholmod_factor *L, double X [ ][2] /* n-by-2 in row form */ ) { double *Lx = L->x ; Int *Li = L->i ; Int *Lp = L->p ; Int *Lnz = L->nz ; Int j, n = L->n ; for (j = 0 ; j < n ; ) { /* get the start, end, and length of column j */ Int p = Lp [j] ; Int lnz = Lnz [j] ; Int pend = p + lnz ; /* find a chain of supernodes (up to j, j+1, and j+2) */ if (lnz < 4 || lnz != Lnz [j+1] + 1 || Li [p+1] != j+1) { /* -------------------------------------------------------------- */ /* solve with a single column of L */ /* -------------------------------------------------------------- */ double y [2] ; y [0] = X [j][0] ; y [1] = X [j][1] ; #ifdef LL y [0] /= Lx [p] ; y [1] /= Lx [p] ; X [j][0] = y [0] ; X [j][1] = y [1] ; #elif defined (LD) X [j][0] = y [0] / Lx [p] ; X [j][1] = y [1] / Lx [p] ; #endif for (p++ ; p < pend ; p++) { Int i = Li [p] ; X [i][0] -= Lx [p] * y [0] ; X [i][1] -= Lx [p] * y [1] ; } j++ ; /* advance to next column of L */ } else if (lnz != Lnz [j+2] + 2 || Li [p+2] != j+2) { /* -------------------------------------------------------------- */ /* solve with a supernode of two columns of L */ /* -------------------------------------------------------------- */ double y [2][2] ; Int q = Lp [j+1] ; y [0][0] = X [j][0] ; y [0][1] = X [j][1] ; #ifdef LL y [0][0] /= Lx [p] ; y [0][1] /= Lx [p] ; y [1][0] = (X [j+1][0] - Lx [p+1] * y [0][0]) / Lx [q] ; y [1][1] = (X [j+1][1] - Lx [p+1] * y [0][1]) / Lx [q] ; X [j ][0] = y [0][0] ; X [j ][1] = y [0][1] ; X [j+1][0] = y [1][0] ; X [j+1][1] = y [1][1] ; #elif defined (LD) y [1][0] = X [j+1][0] - Lx [p+1] * y [0][0] ; y [1][1] = X [j+1][1] - Lx [p+1] * y [0][1] ; X [j ][0] = y [0][0] / Lx [p] ; X [j ][1] = y [0][1] / Lx [p] ; X [j+1][0] = y [1][0] / Lx [q] ; X [j+1][1] = y [1][1] / Lx [q] ; #else y [1][0] = X [j+1][0] - Lx [p+1] * y [0][0] ; y [1][1] = X [j+1][1] - Lx [p+1] * y [0][1] ; X [j+1][0] = y [1][0] ; X [j+1][1] = y [1][1] ; #endif for (p += 2, q++ ; p < pend ; p++, q++) { Int i = Li [p] ; X [i][0] -= Lx [p] * y [0][0] + Lx [q] * y [1][0] ; X [i][1] -= Lx [p] * y [0][1] + Lx [q] * y [1][1] ; } j += 2 ; /* advance to next column of L */ } else { /* -------------------------------------------------------------- */ /* solve with a supernode of three columns of L */ /* -------------------------------------------------------------- */ double y [3][2] ; Int q = Lp [j+1] ; Int r = Lp [j+2] ; y [0][0] = X [j][0] ; y [0][1] = X [j][1] ; #ifdef LL y [0][0] /= Lx [p] ; y [0][1] /= Lx [p] ; y [1][0] = (X [j+1][0] - Lx[p+1] * y[0][0]) / Lx [q] ; y [1][1] = (X [j+1][1] - Lx[p+1] * y[0][1]) / Lx [q] ; y [2][0] = (X [j+2][0] - Lx[p+2] * y[0][0] - Lx[q+1]*y[1][0])/Lx[r]; y [2][1] = (X [j+2][1] - Lx[p+2] * y[0][1] - Lx[q+1]*y[1][1])/Lx[r]; X [j ][0] = y [0][0] ; X [j ][1] = y [0][1] ; X [j+1][0] = y [1][0] ; X [j+1][1] = y [1][1] ; X [j+2][0] = y [2][0] ; X [j+2][1] = y [2][1] ; #elif defined (LD) y [1][0] = X [j+1][0] - Lx [p+1] * y [0][0] ; y [1][1] = X [j+1][1] - Lx [p+1] * y [0][1] ; y [2][0] = X [j+2][0] - Lx [p+2] * y [0][0] - Lx [q+1] * y [1][0] ; y [2][1] = X [j+2][1] - Lx [p+2] * y [0][1] - Lx [q+1] * y [1][1] ; X [j ][0] = y [0][0] / Lx [p] ; X [j ][1] = y [0][1] / Lx [p] ; X [j+1][0] = y [1][0] / Lx [q] ; X [j+1][1] = y [1][1] / Lx [q] ; X [j+2][0] = y [2][0] / Lx [r] ; X [j+2][1] = y [2][1] / Lx [r] ; #else y [1][0] = X [j+1][0] - Lx [p+1] * y [0][0] ; y [1][1] = X [j+1][1] - Lx [p+1] * y [0][1] ; y [2][0] = X [j+2][0] - Lx [p+2] * y [0][0] - Lx [q+1] * y [1][0] ; y [2][1] = X [j+2][1] - Lx [p+2] * y [0][1] - Lx [q+1] * y [1][1] ; X [j+1][0] = y [1][0] ; X [j+1][1] = y [1][1] ; X [j+2][0] = y [2][0] ; X [j+2][1] = y [2][1] ; #endif for (p += 3, q += 2, r++ ; p < pend ; p++, q++, r++) { Int i = Li [p] ; X[i][0] -= Lx[p] * y[0][0] + Lx[q] * y[1][0] + Lx[r] * y[2][0] ; X[i][1] -= Lx[p] * y[0][1] + Lx[q] * y[1][1] + Lx[r] * y[2][1] ; } j += 3 ; /* advance to next column of L */ } } } /* ========================================================================== */ /* === LSOLVE (3) =========================================================== */ /* ========================================================================== */ /* Solve Lx=b, where b has 3 columns */ static void LSOLVE (PREFIX,3) ( cholmod_factor *L, double X [ ][3] /* n-by-3 in row form */ ) { double *Lx = L->x ; Int *Li = L->i ; Int *Lp = L->p ; Int *Lnz = L->nz ; Int j, n = L->n ; for (j = 0 ; j < n ; ) { /* get the start, end, and length of column j */ Int p = Lp [j] ; Int lnz = Lnz [j] ; Int pend = p + lnz ; /* find a chain of supernodes (up to j, j+1, and j+2) */ if (lnz < 4 || lnz != Lnz [j+1] + 1 || Li [p+1] != j+1) { /* -------------------------------------------------------------- */ /* solve with a single column of L */ /* -------------------------------------------------------------- */ double y [3] ; y [0] = X [j][0] ; y [1] = X [j][1] ; y [2] = X [j][2] ; #ifdef LL y [0] /= Lx [p] ; y [1] /= Lx [p] ; y [2] /= Lx [p] ; X [j][0] = y [0] ; X [j][1] = y [1] ; X [j][2] = y [2] ; #elif defined (LD) X [j][0] = y [0] / Lx [p] ; X [j][1] = y [1] / Lx [p] ; X [j][2] = y [2] / Lx [p] ; #endif for (p++ ; p < pend ; p++) { Int i = Li [p] ; double lx = Lx [p] ; X [i][0] -= lx * y [0] ; X [i][1] -= lx * y [1] ; X [i][2] -= lx * y [2] ; } j++ ; /* advance to next column of L */ } else if (lnz != Lnz [j+2] + 2 || Li [p+2] != j+2) { /* -------------------------------------------------------------- */ /* solve with a supernode of two columns of L */ /* -------------------------------------------------------------- */ double y [2][3] ; Int q = Lp [j+1] ; y [0][0] = X [j][0] ; y [0][1] = X [j][1] ; y [0][2] = X [j][2] ; #ifdef LL y [0][0] /= Lx [p] ; y [0][1] /= Lx [p] ; y [0][2] /= Lx [p] ; y [1][0] = (X [j+1][0] - Lx [p+1] * y [0][0]) / Lx [q] ; y [1][1] = (X [j+1][1] - Lx [p+1] * y [0][1]) / Lx [q] ; y [1][2] = (X [j+1][2] - Lx [p+1] * y [0][2]) / Lx [q] ; X [j ][0] = y [0][0] ; X [j ][1] = y [0][1] ; X [j ][2] = y [0][2] ; X [j+1][0] = y [1][0] ; X [j+1][1] = y [1][1] ; X [j+1][2] = y [1][2] ; #elif defined (LD) y [1][0] = X [j+1][0] - Lx [p+1] * y [0][0] ; y [1][1] = X [j+1][1] - Lx [p+1] * y [0][1] ; y [1][2] = X [j+1][2] - Lx [p+1] * y [0][2] ; X [j ][0] = y [0][0] / Lx [p] ; X [j ][1] = y [0][1] / Lx [p] ; X [j ][2] = y [0][2] / Lx [p] ; X [j+1][0] = y [1][0] / Lx [q] ; X [j+1][1] = y [1][1] / Lx [q] ; X [j+1][2] = y [1][2] / Lx [q] ; #else y [1][0] = X [j+1][0] - Lx [p+1] * y [0][0] ; y [1][1] = X [j+1][1] - Lx [p+1] * y [0][1] ; y [1][2] = X [j+1][2] - Lx [p+1] * y [0][2] ; X [j+1][0] = y [1][0] ; X [j+1][1] = y [1][1] ; X [j+1][2] = y [1][2] ; #endif for (p += 2, q++ ; p < pend ; p++, q++) { Int i = Li [p] ; double lx [2] ; lx [0] = Lx [p] ; lx [1] = Lx [q] ; X [i][0] -= lx [0] * y [0][0] + lx [1] * y [1][0] ; X [i][1] -= lx [0] * y [0][1] + lx [1] * y [1][1] ; X [i][2] -= lx [0] * y [0][2] + lx [1] * y [1][2] ; } j += 2 ; /* advance to next column of L */ } else { /* -------------------------------------------------------------- */ /* solve with a supernode of three columns of L */ /* -------------------------------------------------------------- */ double y [3][3] ; Int q = Lp [j+1] ; Int r = Lp [j+2] ; y [0][0] = X [j][0] ; y [0][1] = X [j][1] ; y [0][2] = X [j][2] ; #ifdef LL y [0][0] /= Lx [p] ; y [0][1] /= Lx [p] ; y [0][2] /= Lx [p] ; y [1][0] = (X [j+1][0] - Lx[p+1] * y[0][0]) / Lx [q] ; y [1][1] = (X [j+1][1] - Lx[p+1] * y[0][1]) / Lx [q] ; y [1][2] = (X [j+1][2] - Lx[p+1] * y[0][2]) / Lx [q] ; y [2][0] = (X [j+2][0] - Lx[p+2] * y[0][0] - Lx[q+1]*y[1][0])/Lx[r]; y [2][1] = (X [j+2][1] - Lx[p+2] * y[0][1] - Lx[q+1]*y[1][1])/Lx[r]; y [2][2] = (X [j+2][2] - Lx[p+2] * y[0][2] - Lx[q+1]*y[1][2])/Lx[r]; X [j ][0] = y [0][0] ; X [j ][1] = y [0][1] ; X [j ][2] = y [0][2] ; X [j+1][0] = y [1][0] ; X [j+1][1] = y [1][1] ; X [j+1][2] = y [1][2] ; X [j+2][0] = y [2][0] ; X [j+2][1] = y [2][1] ; X [j+2][2] = y [2][2] ; #elif defined (LD) y [1][0] = X [j+1][0] - Lx [p+1] * y [0][0] ; y [1][1] = X [j+1][1] - Lx [p+1] * y [0][1] ; y [1][2] = X [j+1][2] - Lx [p+1] * y [0][2] ; y [2][0] = X [j+2][0] - Lx [p+2] * y [0][0] - Lx [q+1] * y [1][0] ; y [2][1] = X [j+2][1] - Lx [p+2] * y [0][1] - Lx [q+1] * y [1][1] ; y [2][2] = X [j+2][2] - Lx [p+2] * y [0][2] - Lx [q+1] * y [1][2] ; X [j ][0] = y [0][0] / Lx [p] ; X [j ][1] = y [0][1] / Lx [p] ; X [j ][2] = y [0][2] / Lx [p] ; X [j+1][0] = y [1][0] / Lx [q] ; X [j+1][1] = y [1][1] / Lx [q] ; X [j+1][2] = y [1][2] / Lx [q] ; X [j+2][0] = y [2][0] / Lx [r] ; X [j+2][1] = y [2][1] / Lx [r] ; X [j+2][2] = y [2][2] / Lx [r] ; #else y [1][0] = X [j+1][0] - Lx [p+1] * y [0][0] ; y [1][1] = X [j+1][1] - Lx [p+1] * y [0][1] ; y [1][2] = X [j+1][2] - Lx [p+1] * y [0][2] ; y [2][0] = X [j+2][0] - Lx [p+2] * y [0][0] - Lx [q+1] * y [1][0] ; y [2][1] = X [j+2][1] - Lx [p+2] * y [0][1] - Lx [q+1] * y [1][1] ; y [2][2] = X [j+2][2] - Lx [p+2] * y [0][2] - Lx [q+1] * y [1][2] ; X [j+1][0] = y [1][0] ; X [j+1][1] = y [1][1] ; X [j+1][2] = y [1][2] ; X [j+2][0] = y [2][0] ; X [j+2][1] = y [2][1] ; X [j+2][2] = y [2][2] ; #endif for (p += 3, q += 2, r++ ; p < pend ; p++, q++, r++) { Int i = Li [p] ; double lx [3] ; lx [0] = Lx [p] ; lx [1] = Lx [q] ; lx [2] = Lx [r] ; X [i][0] -= lx[0] * y[0][0] + lx[1] * y[1][0] + lx[2] * y[2][0]; X [i][1] -= lx[0] * y[0][1] + lx[1] * y[1][1] + lx[2] * y[2][1]; X [i][2] -= lx[0] * y[0][2] + lx[1] * y[1][2] + lx[2] * y[2][2]; } j += 3 ; /* advance to next column of L */ } } } /* ========================================================================== */ /* === LSOLVE (4) =========================================================== */ /* ========================================================================== */ /* Solve Lx=b, where b has 4 columns */ static void LSOLVE (PREFIX,4) ( cholmod_factor *L, double X [ ][4] /* n-by-4 in row form */ ) { double *Lx = L->x ; Int *Li = L->i ; Int *Lp = L->p ; Int *Lnz = L->nz ; Int j, n = L->n ; for (j = 0 ; j < n ; ) { /* get the start, end, and length of column j */ Int p = Lp [j] ; Int lnz = Lnz [j] ; Int pend = p + lnz ; /* find a chain of supernodes (up to j, j+1, and j+2) */ if (lnz < 4 || lnz != Lnz [j+1] + 1 || Li [p+1] != j+1) { /* -------------------------------------------------------------- */ /* solve with a single column of L */ /* -------------------------------------------------------------- */ double y [4] ; y [0] = X [j][0] ; y [1] = X [j][1] ; y [2] = X [j][2] ; y [3] = X [j][3] ; #ifdef LL y [0] /= Lx [p] ; y [1] /= Lx [p] ; y [2] /= Lx [p] ; y [3] /= Lx [p] ; X [j][0] = y [0] ; X [j][1] = y [1] ; X [j][2] = y [2] ; X [j][3] = y [3] ; #elif defined (LD) X [j][0] = y [0] / Lx [p] ; X [j][1] = y [1] / Lx [p] ; X [j][2] = y [2] / Lx [p] ; X [j][3] = y [3] / Lx [p] ; #endif for (p++ ; p < pend ; p++) { Int i = Li [p] ; double lx = Lx [p] ; X [i][0] -= lx * y [0] ; X [i][1] -= lx * y [1] ; X [i][2] -= lx * y [2] ; X [i][3] -= lx * y [3] ; } j++ ; /* advance to next column of L */ } else if (lnz != Lnz [j+2] + 2 || Li [p+2] != j+2) { /* -------------------------------------------------------------- */ /* solve with a supernode of two columns of L */ /* -------------------------------------------------------------- */ double y [2][4] ; Int q = Lp [j+1] ; y [0][0] = X [j][0] ; y [0][1] = X [j][1] ; y [0][2] = X [j][2] ; y [0][3] = X [j][3] ; #ifdef LL y [0][0] /= Lx [p] ; y [0][1] /= Lx [p] ; y [0][2] /= Lx [p] ; y [0][3] /= Lx [p] ; y [1][0] = (X [j+1][0] - Lx [p+1] * y [0][0]) / Lx [q] ; y [1][1] = (X [j+1][1] - Lx [p+1] * y [0][1]) / Lx [q] ; y [1][2] = (X [j+1][2] - Lx [p+1] * y [0][2]) / Lx [q] ; y [1][3] = (X [j+1][3] - Lx [p+1] * y [0][3]) / Lx [q] ; X [j ][0] = y [0][0] ; X [j ][1] = y [0][1] ; X [j ][2] = y [0][2] ; X [j ][3] = y [0][3] ; X [j+1][0] = y [1][0] ; X [j+1][1] = y [1][1] ; X [j+1][2] = y [1][2] ; X [j+1][3] = y [1][3] ; #elif defined (LD) y [1][0] = X [j+1][0] - Lx [p+1] * y [0][0] ; y [1][1] = X [j+1][1] - Lx [p+1] * y [0][1] ; y [1][2] = X [j+1][2] - Lx [p+1] * y [0][2] ; y [1][3] = X [j+1][3] - Lx [p+1] * y [0][3] ; X [j ][0] = y [0][0] / Lx [p] ; X [j ][1] = y [0][1] / Lx [p] ; X [j ][2] = y [0][2] / Lx [p] ; X [j ][3] = y [0][3] / Lx [p] ; X [j+1][0] = y [1][0] / Lx [q] ; X [j+1][1] = y [1][1] / Lx [q] ; X [j+1][2] = y [1][2] / Lx [q] ; X [j+1][3] = y [1][3] / Lx [q] ; #else y [1][0] = X [j+1][0] - Lx [p+1] * y [0][0] ; y [1][1] = X [j+1][1] - Lx [p+1] * y [0][1] ; y [1][2] = X [j+1][2] - Lx [p+1] * y [0][2] ; y [1][3] = X [j+1][3] - Lx [p+1] * y [0][3] ; X [j+1][0] = y [1][0] ; X [j+1][1] = y [1][1] ; X [j+1][2] = y [1][2] ; X [j+1][3] = y [1][3] ; #endif for (p += 2, q++ ; p < pend ; p++, q++) { Int i = Li [p] ; double lx [2] ; lx [0] = Lx [p] ; lx [1] = Lx [q] ; X [i][0] -= lx [0] * y [0][0] + lx [1] * y [1][0] ; X [i][1] -= lx [0] * y [0][1] + lx [1] * y [1][1] ; X [i][2] -= lx [0] * y [0][2] + lx [1] * y [1][2] ; X [i][3] -= lx [0] * y [0][3] + lx [1] * y [1][3] ; } j += 2 ; /* advance to next column of L */ } else { /* -------------------------------------------------------------- */ /* solve with a supernode of three columns of L */ /* -------------------------------------------------------------- */ double y [3][4] ; Int q = Lp [j+1] ; Int r = Lp [j+2] ; y [0][0] = X [j][0] ; y [0][1] = X [j][1] ; y [0][2] = X [j][2] ; y [0][3] = X [j][3] ; #ifdef LL y [0][0] /= Lx [p] ; y [0][1] /= Lx [p] ; y [0][2] /= Lx [p] ; y [0][3] /= Lx [p] ; y [1][0] = (X [j+1][0] - Lx[p+1] * y[0][0]) / Lx [q] ; y [1][1] = (X [j+1][1] - Lx[p+1] * y[0][1]) / Lx [q] ; y [1][2] = (X [j+1][2] - Lx[p+1] * y[0][2]) / Lx [q] ; y [1][3] = (X [j+1][3] - Lx[p+1] * y[0][3]) / Lx [q] ; y [2][0] = (X [j+2][0] - Lx[p+2] * y[0][0] - Lx[q+1]*y[1][0])/Lx[r]; y [2][1] = (X [j+2][1] - Lx[p+2] * y[0][1] - Lx[q+1]*y[1][1])/Lx[r]; y [2][2] = (X [j+2][2] - Lx[p+2] * y[0][2] - Lx[q+1]*y[1][2])/Lx[r]; y [2][3] = (X [j+2][3] - Lx[p+2] * y[0][3] - Lx[q+1]*y[1][3])/Lx[r]; X [j ][0] = y [0][0] ; X [j ][1] = y [0][1] ; X [j ][2] = y [0][2] ; X [j ][3] = y [0][3] ; X [j+1][0] = y [1][0] ; X [j+1][1] = y [1][1] ; X [j+1][2] = y [1][2] ; X [j+1][3] = y [1][3] ; X [j+2][0] = y [2][0] ; X [j+2][1] = y [2][1] ; X [j+2][2] = y [2][2] ; X [j+2][3] = y [2][3] ; #elif defined (LD) y [1][0] = X [j+1][0] - Lx [p+1] * y [0][0] ; y [1][1] = X [j+1][1] - Lx [p+1] * y [0][1] ; y [1][2] = X [j+1][2] - Lx [p+1] * y [0][2] ; y [1][3] = X [j+1][3] - Lx [p+1] * y [0][3] ; y [2][0] = X [j+2][0] - Lx [p+2] * y [0][0] - Lx [q+1] * y [1][0] ; y [2][1] = X [j+2][1] - Lx [p+2] * y [0][1] - Lx [q+1] * y [1][1] ; y [2][2] = X [j+2][2] - Lx [p+2] * y [0][2] - Lx [q+1] * y [1][2] ; y [2][3] = X [j+2][3] - Lx [p+2] * y [0][3] - Lx [q+1] * y [1][3] ; X [j ][0] = y [0][0] / Lx [p] ; X [j ][1] = y [0][1] / Lx [p] ; X [j ][2] = y [0][2] / Lx [p] ; X [j ][3] = y [0][3] / Lx [p] ; X [j+1][0] = y [1][0] / Lx [q] ; X [j+1][1] = y [1][1] / Lx [q] ; X [j+1][2] = y [1][2] / Lx [q] ; X [j+1][3] = y [1][3] / Lx [q] ; X [j+2][0] = y [2][0] / Lx [r] ; X [j+2][1] = y [2][1] / Lx [r] ; X [j+2][2] = y [2][2] / Lx [r] ; X [j+2][3] = y [2][3] / Lx [r] ; #else y [1][0] = X [j+1][0] - Lx [p+1] * y [0][0] ; y [1][1] = X [j+1][1] - Lx [p+1] * y [0][1] ; y [1][2] = X [j+1][2] - Lx [p+1] * y [0][2] ; y [1][3] = X [j+1][3] - Lx [p+1] * y [0][3] ; y [2][0] = X [j+2][0] - Lx [p+2] * y [0][0] - Lx [q+1] * y [1][0] ; y [2][1] = X [j+2][1] - Lx [p+2] * y [0][1] - Lx [q+1] * y [1][1] ; y [2][2] = X [j+2][2] - Lx [p+2] * y [0][2] - Lx [q+1] * y [1][2] ; y [2][3] = X [j+2][3] - Lx [p+2] * y [0][3] - Lx [q+1] * y [1][3] ; X [j+1][0] = y [1][0] ; X [j+1][1] = y [1][1] ; X [j+1][2] = y [1][2] ; X [j+1][3] = y [1][3] ; X [j+2][0] = y [2][0] ; X [j+2][1] = y [2][1] ; X [j+2][2] = y [2][2] ; X [j+2][3] = y [2][3] ; #endif for (p += 3, q += 2, r++ ; p < pend ; p++, q++, r++) { Int i = Li [p] ; double lx [3] ; lx [0] = Lx [p] ; lx [1] = Lx [q] ; lx [2] = Lx [r] ; X [i][0] -= lx[0] * y[0][0] + lx[1] * y[1][0] + lx[2] * y[2][0]; X [i][1] -= lx[0] * y[0][1] + lx[1] * y[1][1] + lx[2] * y[2][1]; X [i][2] -= lx[0] * y[0][2] + lx[1] * y[1][2] + lx[2] * y[2][2]; X [i][3] -= lx[0] * y[0][3] + lx[1] * y[1][3] + lx[2] * y[2][3]; } j += 3 ; /* advance to next column of L */ } } } #endif /* ========================================================================== */ /* === LSOLVE (k) =========================================================== */ /* ========================================================================== */ static void LSOLVE (PREFIX,k) ( cholmod_factor *L, cholmod_dense *Y, /* nr-by-n where nr is 1 to 4 */ Int *Yseti, Int ysetlen ) { double yx [2] ; #ifdef ZOMPLEX double yz [1] ; double *Lz = L->z ; double *Xz = Y->z ; #endif double *Lx = L->x ; double *Xx = Y->x ; Int *Li = L->i ; Int *Lp = L->p ; Int *Lnz = L->nz ; Int n = L->n, jj, jjiters ; ASSERT (L->xtype == Y->xtype) ; /* L and Y must have the same xtype */ ASSERT (L->n == Y->ncol) ; /* dimensions must match */ ASSERT (Y->nrow == Y->d) ; /* leading dimension of Y = # rows of Y */ ASSERT (L->xtype != CHOLMOD_PATTERN) ; /* L is not symbolic */ ASSERT (!(L->is_super)) ; /* L is simplicial LL' or LDL' */ #ifdef REAL if (Yseti == NULL) { /* ------------------------------------------------------------------ */ /* real case, no Yseti, with 1 to 4 RHS's and dynamic supernodes */ /* ------------------------------------------------------------------ */ ASSERT (Y->nrow <= 4) ; switch (Y->nrow) { case 1: LSOLVE (PREFIX,1) (L, Y->x) ; break ; case 2: LSOLVE (PREFIX,2) (L, Y->x) ; break ; case 3: LSOLVE (PREFIX,3) (L, Y->x) ; break ; case 4: LSOLVE (PREFIX,4) (L, Y->x) ; break ; } } else #endif { /* ------------------------------------------------------------------ */ /* solve a complex linear system or solve with Yseti */ /* ------------------------------------------------------------------ */ ASSERT (Y->nrow == 1) ; jjiters = Yseti ? ysetlen : n ; for (jj = 0 ; jj < jjiters ; jj++) { Int j = Yseti ? Yseti [jj] : jj ; /* get the start, end, and length of column j */ Int p = Lp [j] ; Int lnz = Lnz [j] ; Int pend = p + lnz ; /* y = X [j] ; */ ASSIGN (yx,yz,0, Xx,Xz,j) ; #ifdef LL /* y /= Lx [p] ; */ /* X [j] = y ; */ DIV_REAL (yx,yz,0, yx,yz,0, Lx,p) ; ASSIGN (Xx,Xz,j, yx,yz,0) ; #elif defined (LD) /* X [j] = y / Lx [p] ; */ DIV_REAL (Xx,Xz,j, yx,yz,0, Lx,p) ; #endif for (p++ ; p < pend ; p++) { /* X [Li [p]] -= Lx [p] * y ; */ Int i = Li [p] ; MULTSUB (Xx,Xz,i, Lx,Lz,p, yx,yz,0) ; } } } } /* prepare for the next inclusion of this file in cholmod_solve.c */ #undef LL #undef LD Matrix/src/CHOLMOD/Cholesky/License.txt0000644000176200001440000000204711770402705017304 0ustar liggesusersCHOLMOD/Cholesky module, Copyright (C) 2005-2006, Timothy A. Davis CHOLMOD is also available under other licenses; contact authors for details. http://www.suitesparse.com Note that this license is for the CHOLMOD/Cholesky module only. All CHOLMOD modules are licensed separately. -------------------------------------------------------------------------------- This Module is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This Module 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this Module; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Matrix/src/CHOLMOD/Cholesky/cholmod_analyze.c0000644000176200001440000007772713652535054020523 0ustar liggesusers/* ========================================================================== */ /* === Cholesky/cholmod_analyze ============================================= */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Cholesky Module. Copyright (C) 2005-2013, Timothy A. Davis * -------------------------------------------------------------------------- */ /* Order and analyze a matrix (either simplicial or supernodal), in prepartion * for numerical factorization via cholmod_factorize or via the "expert" * routines cholmod_rowfac and cholmod_super_numeric. * * symmetric case: A or A(p,p) * unsymmetric case: AA', A(p,:)*A(p,:)', A(:,f)*A(:,f)', or A(p,f)*A(p,f)' * * For the symmetric case, only the upper or lower triangular part of A is * accessed (depending on the type of A). LL'=A (or permuted A) is analzed. * For the unsymmetric case (LL'=AA' or permuted A). * * There can be no duplicate entries in p or f. p is of length m if A is * m-by-n. f can be length 0 to n. * * In both cases, the columns of A need not be sorted. A can be in packed * or unpacked form. * * Ordering options include: * * natural: A is not permuted to reduce fill-in * given: a permutation can be provided to this routine (UserPerm) * AMD: approximate minumum degree (AMD for the symmetric case, * COLAMD for the AA' case). * METIS: nested dissection with METIS_NodeND * NESDIS: nested dissection using METIS_ComputeVertexSeparator, * typically followed by a constrained minimum degree * (CAMD for the symmetric case, CCOLAMD for the AA' case). * * Multiple ordering options can be tried (up to 9 of them), and the best one * is selected (the one that gives the smallest number of nonzeros in the * simplicial factor L). If one method fails, cholmod_analyze keeps going, and * picks the best among the methods that succeeded. This routine fails (and * returns NULL) if either initial memory allocation fails, all ordering methods * fail, or the supernodal analysis (if requested) fails. By default, the 9 * methods available are: * * 1) given permutation (skipped if UserPerm is NULL) * 2) AMD (symmetric case) or COLAMD (unsymmetric case) * 3) METIS with default parameters * 4) NESDIS with default parameters (stopping the partitioning when * the graph is of size nd_small = 200 or less, remove nodes with * more than max (16, prune_dense * sqrt (n)) nodes where * prune_dense = 10, and follow partitioning with CCOLAMD, a * constrained minimum degree ordering). * 5) natural * 6) NESDIS, nd_small = 20000, prune_dense = 10 * 7) NESDIS, nd_small = 4, prune_dense = 10, no min degree * 8) NESDIS, nd_small = 200, prune_dense = 0 * 9) COLAMD for A*A' or AMD for A * * By default, the first two are tried, and METIS is tried if AMD reports a high * flop count and fill-in. Let fl denote the flop count for the AMD, ordering, * nnz(L) the # of nonzeros in L, and nnz(tril(A)) (or A*A'). If * fl/nnz(L) >= 500 and nnz(L)/nnz(tril(A)) >= 5, then METIS is attempted. The * best ordering is used (UserPerm if given, AMD, and METIS if attempted). If * you do not have METIS, only the first two will be tried (user permutation, * if provided, and AMD/COLAMD). This default behavior is obtained when * Common->nmethods is zero. In this case, methods 0, 1, and 2 in * Common->method [..] are reset to User-provided, AMD, and METIS (or NESDIS * if Common->default_nesdis is set to the non-default value of TRUE), * respectively. * * You can modify these 9 methods and the number of methods tried by changing * parameters in the Common argument. If you know the best ordering for your * matrix, set Common->nmethods to 1 and set Common->method[0].ordering to the * requested ordering method. Parameters for each method can also be modified * (refer to cholmod.h for details). * * Note that it is possible for METIS to terminate your program if it runs out * of memory. This is not the case for any CHOLMOD or minimum degree ordering * routine (AMD, COLAMD, CAMD, CCOLAMD, or CSYMAMD). Since NESDIS relies on * METIS, it too can terminate your program. * * The factor L is returned as simplicial symbolic (L->is_super FALSE) if * Common->supernodal <= CHOLMOD_SIMPLICIAL (0) or as supernodal symbolic if * Common->supernodal >= CHOLMOD_SUPERNODAL (2). If Common->supernodal is * equal to CHOLMOD_AUTO (1), then L is simplicial if the flop count per * nonzero in L is less than Common->supernodal_switch (default: 40), and * is returned as a supernodal factor otherwise. * * In both cases, L->xtype is CHOLMOD_PATTERN. * A subsequent call to cholmod_factorize will perform a * simplicial or supernodal factorization, depending on the type of L. * * For the simplicial case, L contains the fill-reducing permutation (L->Perm) * and the counts of nonzeros in each column of L (L->ColCount). For the * supernodal case, L also contains the nonzero pattern of each supernode. * * workspace: Flag (nrow), Head (nrow+1) * if symmetric: Iwork (6*nrow) * if unsymmetric: Iwork (6*nrow+ncol). * calls various ordering routines, which typically allocate O(nnz(A)) * temporary workspace ((2 to 3)*nnz(A) * sizeof (Int) is typical, but it * can be much higher if A*A' must be explicitly formed for METIS). Also * allocates up to 2 temporary (permuted/transpose) copies of the nonzero * pattern of A, and up to 3*n*sizeof(Int) additional workspace. * * Supports any xtype (pattern, real, complex, or zomplex) */ #ifndef NCHOLESKY #include "cholmod_internal.h" #include "cholmod_cholesky.h" #ifndef NSUPERNODAL #include "cholmod_supernodal.h" #endif #ifndef NPARTITION #include "cholmod_partition.h" #endif /* ========================================================================== */ /* === cholmod_analyze ====================================================== */ /* ========================================================================== */ /* Orders and analyzes A, AA', PAP', or PAA'P' and returns a symbolic factor * that can later be passed to cholmod_factorize. */ cholmod_factor *CHOLMOD(analyze) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order and analyze */ /* --------------- */ cholmod_common *Common ) { return (CHOLMOD(analyze_p2) (TRUE, A, NULL, NULL, 0, Common)) ; } /* ========================================================================== */ /* === cholmod_analyze_p ==================================================== */ /* ========================================================================== */ /* Orders and analyzes A, AA', PAP', PAA'P', FF', or PFF'P and returns a * symbolic factor that can later be passed to cholmod_factorize, where * F = A(:,fset) if fset is not NULL and A->stype is zero. * UserPerm is tried if non-NULL. */ cholmod_factor *CHOLMOD(analyze_p) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order and analyze */ Int *UserPerm, /* user-provided permutation, size A->nrow */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ /* --------------- */ cholmod_common *Common ) { return (CHOLMOD(analyze_p2) (TRUE, A, UserPerm, fset, fsize, Common)) ; } /* ========================================================================== */ /* === permute_matrices ===================================================== */ /* ========================================================================== */ /* Permute and transpose a matrix. Allocates the A1 and A2 matrices, if needed, * or returns them as NULL if not needed. */ static int permute_matrices ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to permute */ Int ordering, /* ordering method used */ Int *Perm, /* fill-reducing permutation */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ Int do_rowcolcounts,/* if TRUE, compute both S and F. If FALSE, only * S is needed for the symmetric case, and only F for * the unsymmetric case */ /* ---- output --- */ cholmod_sparse **A1_handle, /* see comments below for A1, A2, S, F */ cholmod_sparse **A2_handle, cholmod_sparse **S_handle, cholmod_sparse **F_handle, /* --------------- */ cholmod_common *Common ) { cholmod_sparse *A1, *A2, *S, *F ; *A1_handle = NULL ; *A2_handle = NULL ; *S_handle = NULL ; *F_handle = NULL ; A1 = NULL ; A2 = NULL ; if (ordering == CHOLMOD_NATURAL) { /* ------------------------------------------------------------------ */ /* natural ordering of A */ /* ------------------------------------------------------------------ */ if (A->stype < 0) { /* symmetric lower case: A already in lower form, so S=A' */ /* workspace: Iwork (nrow) */ A2 = CHOLMOD(ptranspose) (A, 0, NULL, NULL, 0, Common) ; F = A ; S = A2 ; } else if (A->stype > 0) { /* symmetric upper case: F = pattern of triu (A)', S = A */ /* workspace: Iwork (nrow) */ if (do_rowcolcounts) { /* F not needed for symmetric case if do_rowcolcounts FALSE */ A1 = CHOLMOD(ptranspose) (A, 0, NULL, fset, fsize, Common) ; } F = A1 ; S = A ; } else { /* unsymmetric case: F = pattern of A (:,f)', S = A */ /* workspace: Iwork (nrow if no fset, MAX(nrow,ncol) if fset) */ A1 = CHOLMOD(ptranspose) (A, 0, NULL, fset, fsize, Common) ; F = A1 ; S = A ; } } else { /* ------------------------------------------------------------------ */ /* A is permuted */ /* ------------------------------------------------------------------ */ if (A->stype < 0) { /* symmetric lower case: S = tril (A (p,p))' and F = S' */ /* workspace: Iwork (2*nrow) */ A2 = CHOLMOD(ptranspose) (A, 0, Perm, NULL, 0, Common) ; S = A2 ; /* workspace: Iwork (nrow) */ if (do_rowcolcounts) { /* F not needed for symmetric case if do_rowcolcounts FALSE */ A1 = CHOLMOD(ptranspose) (A2, 0, NULL, NULL, 0, Common) ; } F = A1 ; } else if (A->stype > 0) { /* symmetric upper case: F = triu (A (p,p))' and S = F' */ /* workspace: Iwork (2*nrow) */ A1 = CHOLMOD(ptranspose) (A, 0, Perm, NULL, 0, Common) ; F = A1 ; /* workspace: Iwork (nrow) */ A2 = CHOLMOD(ptranspose) (A1, 0, NULL, NULL, 0, Common) ; S = A2 ; } else { /* unsymmetric case: F = A (p,f)' and S = F' */ /* workspace: Iwork (nrow if no fset, MAX(nrow,ncol) if fset) */ A1 = CHOLMOD(ptranspose) (A, 0, Perm, fset, fsize, Common) ; F = A1 ; if (do_rowcolcounts) { /* S not needed for unsymmetric case if do_rowcolcounts FALSE */ /* workspace: Iwork (nrow) */ A2 = CHOLMOD(ptranspose) (A1, 0, NULL, NULL, 0, Common) ; } S = A2 ; } } /* If any cholmod_*transpose fails, one or more matrices will be NULL */ *A1_handle = A1 ; *A2_handle = A2 ; *S_handle = S ; *F_handle = F ; return (Common->status == CHOLMOD_OK) ; } /* ========================================================================== */ /* === cholmod_analyze_ordering ============================================= */ /* ========================================================================== */ /* Given a matrix A and its fill-reducing permutation, compute the elimination * tree, its (non-weighted) postordering, and the number of nonzeros in each * column of L. Also computes the flop count, the total nonzeros in L, and * the nonzeros in A (Common->fl, Common->lnz, and Common->anz). * * The column counts of L, flop count, and other statistics from * cholmod_rowcolcounts are not computed if ColCount is NULL. * * workspace: Iwork (2*nrow if symmetric, 2*nrow+ncol if unsymmetric), * Flag (nrow), Head (nrow+1) */ int CHOLMOD(analyze_ordering) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to analyze */ int ordering, /* ordering method used */ Int *Perm, /* size n, fill-reducing permutation to analyze */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ /* ---- output --- */ Int *Parent, /* size n, elimination tree */ Int *Post, /* size n, postordering of elimination tree */ Int *ColCount, /* size n, nnz in each column of L */ /* ---- workspace */ Int *First, /* size n workspace for cholmod_postorder */ Int *Level, /* size n workspace for cholmod_postorder */ /* --------------- */ cholmod_common *Common ) { cholmod_sparse *A1, *A2, *S, *F ; Int n, ok, do_rowcolcounts ; /* check inputs */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; n = A->nrow ; do_rowcolcounts = (ColCount != NULL) ; /* permute A according to Perm and fset */ ok = permute_matrices (A, ordering, Perm, fset, fsize, do_rowcolcounts, &A1, &A2, &S, &F, Common) ; /* find etree of S (symmetric upper/lower case) or F (unsym case) */ /* workspace: symmmetric: Iwork (nrow), unsym: Iwork (nrow+ncol) */ ok = ok && CHOLMOD(etree) (A->stype ? S:F, Parent, Common) ; /* postorder the etree (required by cholmod_rowcolcounts) */ /* workspace: Iwork (2*nrow) */ ok = ok && (CHOLMOD(postorder) (Parent, n, NULL, Post, Common) == n) ; /* cholmod_postorder doesn't set Common->status if it returns < n */ Common->status = (!ok && Common->status == CHOLMOD_OK) ? CHOLMOD_INVALID : Common->status ; /* analyze LL'=S or SS' or S(:,f)*S(:,f)' */ /* workspace: * if symmetric: Flag (nrow), Iwork (2*nrow) * if unsymmetric: Flag (nrow), Iwork (2*nrow+ncol), Head (nrow+1) */ if (do_rowcolcounts) { ok = ok && CHOLMOD(rowcolcounts) (A->stype ? F:S, fset, fsize, Parent, Post, NULL, ColCount, First, Level, Common) ; } /* free temporary matrices and return result */ CHOLMOD(free_sparse) (&A1, Common) ; CHOLMOD(free_sparse) (&A2, Common) ; return (ok) ; } /* ========================================================================== */ /* === Free workspace and return L ========================================== */ /* ========================================================================== */ #define FREE_WORKSPACE_AND_RETURN \ { \ Common->no_workspace_reallocate = FALSE ; \ CHOLMOD(free) (n, sizeof (Int), Lparent, Common) ; \ CHOLMOD(free) (n, sizeof (Int), Perm, Common) ; \ CHOLMOD(free) (n, sizeof (Int), ColCount, Common) ; \ if (Common->status < CHOLMOD_OK) \ { \ CHOLMOD(free_factor) (&L, Common) ; \ } \ ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; \ return (L) ; \ } /* ========================================================================== */ /* === cholmod_analyze_p2 =================================================== */ /* ========================================================================== */ /* Ordering and analysis for sparse Cholesky or sparse QR. */ cholmod_factor *CHOLMOD(analyze_p2) ( /* ---- input ---- */ int for_whom, /* FOR_SPQR (0): for SPQR but not GPU-accelerated FOR_CHOLESKY (1): for Cholesky (GPU or not) FOR_SPQRGPU (2): for SPQR with GPU acceleration */ cholmod_sparse *A, /* matrix to order and analyze */ Int *UserPerm, /* user-provided permutation, size A->nrow */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ /* --------------- */ cholmod_common *Common ) { double lnz_best ; Int *First, *Level, *Work4n, *Cmember, *CParent, *ColCount, *Lperm, *Parent, *Post, *Perm, *Lparent, *Lcolcount ; cholmod_factor *L ; Int k, n, ordering, method, nmethods, status, default_strategy, ncol, uncol, skip_analysis, skip_best ; Int amd_backup ; size_t s ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (A, NULL) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, NULL) ; Common->status = CHOLMOD_OK ; status = CHOLMOD_OK ; Common->selected = EMPTY ; Common->called_nd = FALSE ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ n = A->nrow ; ncol = A->ncol ; uncol = (A->stype == 0) ? (A->ncol) : 0 ; /* ---------------------------------------------------------------------- */ /* set the default strategy */ /* ---------------------------------------------------------------------- */ lnz_best = (double) EMPTY ; skip_best = FALSE ; nmethods = MIN (Common->nmethods, CHOLMOD_MAXMETHODS) ; nmethods = MAX (0, nmethods) ; #ifndef NDEBUG PRINT1 (("cholmod_analyze_p2 :: nmethods "ID"\n", nmethods)) ; for (method = 0 ; method < nmethods ; method++) { PRINT1 ((" "ID": ordering "ID"\n", method, Common->method [method].ordering)) ; } #endif default_strategy = (nmethods == 0) ; if (default_strategy) { /* default strategy: try UserPerm, if given. Try AMD for A, or AMD * to order A*A'. Try METIS for the symmetric case only if AMD reports * a high degree of fill-in and flop count. METIS is not tried if the * Partition Module isn't installed. If Common->default_nesdis is * TRUE, then NESDIS is used as the 3rd ordering instead. */ Common->method [0].ordering = CHOLMOD_GIVEN ;/* skip if UserPerm NULL */ Common->method [1].ordering = CHOLMOD_AMD ; Common->method [2].ordering = (Common->default_nesdis ? CHOLMOD_NESDIS : CHOLMOD_METIS) ; amd_backup = FALSE ; #ifndef NPARTITION nmethods = 3 ; #else nmethods = 2 ; #endif } else { /* If only METIS and NESDIS are selected, or if 2 or more methods are * being tried, then enable AMD backup */ amd_backup = (nmethods > 1) || (nmethods == 1 && (Common->method [0].ordering == CHOLMOD_METIS || Common->method [0].ordering == CHOLMOD_NESDIS)) ; } #ifdef NSUPERNODAL /* CHOLMOD Supernodal module not installed, just do simplicial analysis */ Common->supernodal = CHOLMOD_SIMPLICIAL ; #endif /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* Note: enough space needs to be allocated here so that routines called by * cholmod_analyze do not reallocate the space. */ /* s = 6*n + uncol */ s = CHOLMOD(mult_size_t) (n, 6, &ok) ; s = CHOLMOD(add_size_t) (s, uncol, &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (NULL) ; } CHOLMOD(allocate_work) (n, s, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; /* ensure that subsequent routines, called by cholmod_analyze, do not * reallocate any workspace. This is set back to FALSE in the * FREE_WORKSPACE_AND_RETURN macro, which is the only way this function * returns to its caller. */ Common->no_workspace_reallocate = TRUE ; /* Use the last 4*n Int's in Iwork for Parent, First, Level, and Post, since * other CHOLMOD routines will use the first 2n+uncol space. The ordering * routines (cholmod_amd, cholmod_colamd, cholmod_ccolamd, cholmod_metis) * are an exception. They can use all 6n + ncol space, since the contents * of Parent, First, Level, and Post are not needed across calls to those * routines. */ Work4n = Common->Iwork ; Work4n += 2*((size_t) n) + uncol ; Parent = Work4n ; First = Work4n + n ; Level = Work4n + 2*((size_t) n) ; Post = Work4n + 3*((size_t) n) ; /* note that this assignment means that cholmod_nested_dissection, * cholmod_ccolamd, and cholmod_camd can use only the first 4n+uncol * space in Common->Iwork */ Cmember = Post ; CParent = Level ; /* ---------------------------------------------------------------------- */ /* allocate more workspace, and an empty simplicial symbolic factor */ /* ---------------------------------------------------------------------- */ L = CHOLMOD(allocate_factor) (n, Common) ; Lparent = CHOLMOD(malloc) (n, sizeof (Int), Common) ; Perm = CHOLMOD(malloc) (n, sizeof (Int), Common) ; ColCount = CHOLMOD(malloc) (n, sizeof (Int), Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ FREE_WORKSPACE_AND_RETURN ; } Lperm = L->Perm ; Lcolcount = L->ColCount ; Common->anz = EMPTY ; /* ---------------------------------------------------------------------- */ /* try all the requested ordering options and backup to AMD if needed */ /* ---------------------------------------------------------------------- */ /* turn off error handling [ */ Common->try_catch = TRUE ; for (method = 0 ; method <= nmethods ; method++) { /* ------------------------------------------------------------------ */ /* determine the method to try */ /* ------------------------------------------------------------------ */ Common->fl = EMPTY ; Common->lnz = EMPTY ; skip_analysis = FALSE ; if (method == nmethods) { /* All methods failed: backup to AMD */ if (Common->selected == EMPTY && amd_backup) { PRINT1 (("All methods requested failed: backup to AMD\n")) ; ordering = CHOLMOD_AMD ; } else { break ; } } else { ordering = Common->method [method].ordering ; } Common->current = method ; PRINT1 (("method "ID": Try method: "ID"\n", method, ordering)) ; /* ------------------------------------------------------------------ */ /* find the fill-reducing permutation */ /* ------------------------------------------------------------------ */ if (ordering == CHOLMOD_NATURAL) { /* -------------------------------------------------------------- */ /* natural ordering */ /* -------------------------------------------------------------- */ for (k = 0 ; k < n ; k++) { Perm [k] = k ; } } else if (ordering == CHOLMOD_GIVEN) { /* -------------------------------------------------------------- */ /* use given ordering of A, if provided */ /* -------------------------------------------------------------- */ if (UserPerm == NULL) { /* this is not an error condition */ PRINT1 (("skip, no user perm given\n")) ; continue ; } for (k = 0 ; k < n ; k++) { /* UserPerm is checked in cholmod_ptranspose */ Perm [k] = UserPerm [k] ; } } else if (ordering == CHOLMOD_AMD) { /* -------------------------------------------------------------- */ /* AMD ordering of A, A*A', or A(:,f)*A(:,f)' */ /* -------------------------------------------------------------- */ amd_backup = FALSE ; /* no need to try AMD twice ... */ CHOLMOD(amd) (A, fset, fsize, Perm, Common) ; skip_analysis = TRUE ; } else if (ordering == CHOLMOD_COLAMD) { /* -------------------------------------------------------------- */ /* AMD for symmetric case, COLAMD for A*A' or A(:,f)*A(:,f)' */ /* -------------------------------------------------------------- */ if (A->stype) { CHOLMOD(amd) (A, fset, fsize, Perm, Common) ; skip_analysis = TRUE ; } else { /* Alternative: CHOLMOD(ccolamd) (A, fset, fsize, NULL, Perm, Common) ; */ /* do not postorder, it is done later, below */ /* workspace: Iwork (4*nrow+uncol), Flag (nrow), Head (nrow+1)*/ CHOLMOD(colamd) (A, fset, fsize, FALSE, Perm, Common) ; } } else if (ordering == CHOLMOD_METIS) { /* -------------------------------------------------------------- */ /* use METIS_NodeND directly (via a CHOLMOD wrapper) */ /* -------------------------------------------------------------- */ #ifndef NPARTITION /* postorder parameter is false, because it will be later, below */ /* workspace: Iwork (4*nrow+uncol), Flag (nrow), Head (nrow+1) */ Common->called_nd = TRUE ; CHOLMOD(metis) (A, fset, fsize, FALSE, Perm, Common) ; #else Common->status = CHOLMOD_NOT_INSTALLED ; #endif } else if (ordering == CHOLMOD_NESDIS) { /* -------------------------------------------------------------- */ /* use CHOLMOD's nested dissection */ /* -------------------------------------------------------------- */ /* this method is based on METIS' node bissection routine * (METIS_ComputeVertexSeparator). In contrast to METIS_NodeND, * it calls CAMD or CCOLAMD on the whole graph, instead of MMD * on just the leaves. */ #ifndef NPARTITION /* workspace: Flag (nrow), Head (nrow+1), Iwork (2*nrow) */ Common->called_nd = TRUE ; CHOLMOD(nested_dissection) (A, fset, fsize, Perm, CParent, Cmember, Common) ; #else Common->status = CHOLMOD_NOT_INSTALLED ; #endif } else { /* -------------------------------------------------------------- */ /* invalid ordering method */ /* -------------------------------------------------------------- */ Common->status = CHOLMOD_INVALID ; PRINT1 (("No such ordering: "ID"\n", ordering)) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; if (Common->status < CHOLMOD_OK) { /* out of memory, or method failed */ status = MIN (status, Common->status) ; Common->status = CHOLMOD_OK ; continue ; } /* ------------------------------------------------------------------ */ /* analyze the ordering */ /* ------------------------------------------------------------------ */ if (!skip_analysis) { if (!CHOLMOD(analyze_ordering) (A, ordering, Perm, fset, fsize, Parent, Post, ColCount, First, Level, Common)) { /* ordering method failed; clear status and try next method */ status = MIN (status, Common->status) ; Common->status = CHOLMOD_OK ; continue ; } } ASSERT (Common->fl >= 0 && Common->lnz >= 0) ; Common->method [method].fl = Common->fl ; Common->method [method].lnz = Common->lnz ; PRINT1 (("lnz %g fl %g\n", Common->lnz, Common->fl)) ; /* ------------------------------------------------------------------ */ /* pick the best method */ /* ------------------------------------------------------------------ */ /* fl.pt. compare, but lnz can never be NaN */ if (Common->selected == EMPTY || Common->lnz < lnz_best) { Common->selected = method ; PRINT1 (("this is best so far, method "ID"\n", method)) ; L->ordering = ordering ; lnz_best = Common->lnz ; for (k = 0 ; k < n ; k++) { Lperm [k] = Perm [k] ; } /* save the results of cholmod_analyze_ordering, if it was called */ skip_best = skip_analysis ; if (!skip_analysis) { /* save the column count; becomes permanent part of L */ for (k = 0 ; k < n ; k++) { Lcolcount [k] = ColCount [k] ; } /* Parent is needed for weighted postordering and for supernodal * analysis. Does not become a permanent part of L */ for (k = 0 ; k < n ; k++) { Lparent [k] = Parent [k] ; } } } /* ------------------------------------------------------------------ */ /* determine if METIS is to be skipped */ /* ------------------------------------------------------------------ */ if (default_strategy && ordering == CHOLMOD_AMD) { if ((Common->fl < 500 * Common->lnz) || (Common->lnz < 5 * Common->anz)) { /* AMD found an ordering with less than 500 flops per nonzero in * L, or one with a fill-in ratio (nnz(L)/nnz(A)) of less than * 5. This is pretty good, and it's unlikely that METIS will do * better (this heuristic is based on tests on all symmetric * positive definite matrices in the UF sparse matrix * collection, and it works well across a wide range of * problems). METIS can take much more time than AMD. */ break ; } } } /* turn error printing back on ] */ Common->try_catch = FALSE ; /* ---------------------------------------------------------------------- */ /* return if no ordering method succeeded */ /* ---------------------------------------------------------------------- */ if (Common->selected == EMPTY) { /* All methods failed. * If two or more methods failed, they may have failed for different * reasons. Both would clear Common->status and skip to the next * method. Common->status needs to be restored here to the worst error * obtained in any of the methods. CHOLMOD_INVALID is worse * than CHOLMOD_OUT_OF_MEMORY, since the former implies something may * be wrong with the user's input. CHOLMOD_OUT_OF_MEMORY is simply an * indication of lack of resources. */ if (status >= CHOLMOD_OK) { /* this can occur if nmethods = 1, ordering = CHOLMOD_GIVEN, but UserPerm is NULL */ status = CHOLMOD_INVALID ; } ERROR (status, "all methods failed") ; FREE_WORKSPACE_AND_RETURN ; } /* ---------------------------------------------------------------------- */ /* do the analysis for AMD, if skipped */ /* ---------------------------------------------------------------------- */ Common->fl = Common->method [Common->selected].fl ; Common->lnz = Common->method [Common->selected].lnz ; ASSERT (Common->lnz >= 0) ; if (skip_best) { if (!CHOLMOD(analyze_ordering) (A, L->ordering, Lperm, fset, fsize, Lparent, Post, Lcolcount, First, Level, Common)) { /* out of memory, or method failed */ FREE_WORKSPACE_AND_RETURN ; } } /* ---------------------------------------------------------------------- */ /* postorder the etree, weighted by the column counts */ /* ---------------------------------------------------------------------- */ if (Common->postorder) { /* combine the fill-reducing ordering with the weighted postorder */ /* workspace: Iwork (2*nrow) */ if (CHOLMOD(postorder) (Lparent, n, Lcolcount, Post, Common) == n) { /* use First and Level as workspace [ */ Int *Wi = First, *InvPost = Level ; Int newchild, oldchild, newparent, oldparent ; for (k = 0 ; k < n ; k++) { Wi [k] = Lperm [Post [k]] ; } for (k = 0 ; k < n ; k++) { Lperm [k] = Wi [k] ; } for (k = 0 ; k < n ; k++) { Wi [k] = Lcolcount [Post [k]] ; } for (k = 0 ; k < n ; k++) { Lcolcount [k] = Wi [k] ; } for (k = 0 ; k < n ; k++) { InvPost [Post [k]] = k ; } /* updated Lparent needed only for supernodal case */ for (newchild = 0 ; newchild < n ; newchild++) { oldchild = Post [newchild] ; oldparent = Lparent [oldchild] ; newparent = (oldparent == EMPTY) ? EMPTY : InvPost [oldparent] ; Wi [newchild] = newparent ; } for (k = 0 ; k < n ; k++) { Lparent [k] = Wi [k] ; } /* done using Iwork as workspace ] */ /* L is now postordered, no longer in natural ordering */ if (L->ordering == CHOLMOD_NATURAL) { L->ordering = CHOLMOD_POSTORDERED ; } } } /* ---------------------------------------------------------------------- */ /* supernodal analysis, if requested or if selected automatically */ /* ---------------------------------------------------------------------- */ #ifndef NSUPERNODAL if (Common->supernodal > CHOLMOD_AUTO || (Common->supernodal == CHOLMOD_AUTO && Common->lnz > 0 && (Common->fl / Common->lnz) >= Common->supernodal_switch)) { cholmod_sparse *S, *F, *A2, *A1 ; permute_matrices (A, L->ordering, Lperm, fset, fsize, TRUE, &A1, &A2, &S, &F, Common) ; /* workspace: Flag (nrow), Head (nrow), Iwork (5*nrow) */ CHOLMOD(super_symbolic2) (for_whom, S, F, Lparent, L, Common) ; PRINT1 (("status %d\n", Common->status)) ; CHOLMOD(free_sparse) (&A1, Common) ; CHOLMOD(free_sparse) (&A2, Common) ; } #endif /* ---------------------------------------------------------------------- */ /* free temporary matrices and workspace, and return result L */ /* ---------------------------------------------------------------------- */ FREE_WORKSPACE_AND_RETURN ; } #endif Matrix/src/CHOLMOD/Cholesky/cholmod_amd.c0000644000176200001440000001465113652535054017604 0ustar liggesusers/* ========================================================================== */ /* === Cholesky/cholmod_amd ================================================= */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Cholesky Module. Copyright (C) 2005-2006, Timothy A. Davis * -------------------------------------------------------------------------- */ /* CHOLMOD interface to the AMD ordering routine. Orders A if the matrix is * symmetric. On output, Perm [k] = i if row/column i of A is the kth * row/column of P*A*P'. This corresponds to A(p,p) in MATLAB notation. * * If A is unsymmetric, cholmod_amd orders A*A'. On output, Perm [k] = i if * row/column i of A*A' is the kth row/column of P*A*A'*P'. This corresponds to * A(p,:)*A(p,:)' in MATLAB notation. If f is present, A(p,f)*A(p,f)' is * ordered. * * Computes the flop count for a subsequent LL' factorization, the number * of nonzeros in L, and the number of nonzeros in the matrix ordered (A, * A*A' or A(:,f)*A(:,f)'). * * workspace: Iwork (6*nrow). Head (nrow). * * Allocates a temporary copy of A+A' or A*A' (with * both upper and lower triangular parts) as input to AMD. * * Supports any xtype (pattern, real, complex, or zomplex) */ #ifndef NCHOLESKY #include "cholmod_internal.h" #include "amd.h" #include "cholmod_cholesky.h" #if (!defined (AMD_VERSION) || (AMD_VERSION < AMD_VERSION_CODE (2,0))) #error "AMD v2.0 or later is required" #endif /* ========================================================================== */ /* === cholmod_amd ========================================================== */ /* ========================================================================== */ int CHOLMOD(amd) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ /* ---- output --- */ Int *Perm, /* size A->nrow, output permutation */ /* --------------- */ cholmod_common *Common ) { double Info [AMD_INFO], Control2 [AMD_CONTROL], *Control ; Int *Cp, *Len, *Nv, *Head, *Elen, *Degree, *Wi, *Iwork, *Next ; cholmod_sparse *C ; Int j, n, cnz ; size_t s ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; n = A->nrow ; RETURN_IF_NULL (Perm, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; Common->status = CHOLMOD_OK ; if (n == 0) { /* nothing to do */ Common->fl = 0 ; Common->lnz = 0 ; Common->anz = 0 ; return (TRUE) ; } /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ /* Note: this is less than the space used in cholmod_analyze, so if * cholmod_amd is being called by that routine, no space will be * allocated. */ /* s = MAX (6*n, A->ncol) */ s = CHOLMOD(mult_size_t) (n, 6, &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (FALSE) ; } s = MAX (s, A->ncol) ; CHOLMOD(allocate_work) (n, s, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } Iwork = Common->Iwork ; Degree = Iwork ; /* size n */ Wi = Iwork + n ; /* size n */ Len = Iwork + 2*((size_t) n) ; /* size n */ Nv = Iwork + 3*((size_t) n) ; /* size n */ Next = Iwork + 4*((size_t) n) ; /* size n */ Elen = Iwork + 5*((size_t) n) ; /* size n */ Head = Common->Head ; /* size n+1, but only n is used */ /* ---------------------------------------------------------------------- */ /* construct the input matrix for AMD */ /* ---------------------------------------------------------------------- */ if (A->stype == 0) { /* C = A*A' or A(:,f)*A(:,f)', add extra space of nnz(C)/2+n to C */ C = CHOLMOD(aat) (A, fset, fsize, -2, Common) ; } else { /* C = A+A', but use only the upper triangular part of A if A->stype = 1 * and only the lower part of A if A->stype = -1. Add extra space of * nnz(C)/2+n to C. */ C = CHOLMOD(copy) (A, 0, -2, Common) ; } if (Common->status < CHOLMOD_OK) { /* out of memory, fset invalid, or other error */ return (FALSE) ; } Cp = C->p ; for (j = 0 ; j < n ; j++) { Len [j] = Cp [j+1] - Cp [j] ; } /* C does not include the diagonal, and both upper and lower parts. * Common->anz includes the diagonal, and just the lower part of C */ cnz = Cp [n] ; Common->anz = cnz / 2 + n ; /* ---------------------------------------------------------------------- */ /* order C using AMD */ /* ---------------------------------------------------------------------- */ /* get parameters */ if (Common->current < 0 || Common->current >= CHOLMOD_MAXMETHODS) { /* use AMD defaults */ Control = NULL ; } else { Control = Control2 ; Control [AMD_DENSE] = Common->method [Common->current].prune_dense ; Control [AMD_AGGRESSIVE] = Common->method [Common->current].aggressive ; } #ifdef LONG amd_l2 (n, C->p, C->i, Len, C->nzmax, cnz, Nv, Next, Perm, Head, Elen, Degree, Wi, Control, Info) ; #else amd_2 (n, C->p, C->i, Len, C->nzmax, cnz, Nv, Next, Perm, Head, Elen, Degree, Wi, Control, Info) ; #endif /* LL' flop count. Need to subtract n for LL' flop count. Note that this * is a slight upper bound which is often exact (see AMD/Source/amd_2.c for * details). cholmod_analyze computes an exact flop count and fill-in. */ Common->fl = Info [AMD_NDIV] + 2 * Info [AMD_NMULTSUBS_LDL] + n ; /* Info [AMD_LNZ] excludes the diagonal */ Common->lnz = n + Info [AMD_LNZ] ; /* ---------------------------------------------------------------------- */ /* free the AMD workspace and clear the persistent workspace in Common */ /* ---------------------------------------------------------------------- */ ASSERT (IMPLIES (Common->status == CHOLMOD_OK, CHOLMOD(dump_perm) (Perm, n, n, "AMD2 perm", Common))) ; CHOLMOD(free_sparse) (&C, Common) ; for (j = 0 ; j <= n ; j++) { Head [j] = EMPTY ; } return (TRUE) ; } #endif Matrix/src/CHOLMOD/Cholesky/cholmod_rcond.c0000644000176200001440000001107513652535054020145 0ustar liggesusers/* ========================================================================== */ /* === Cholesky/cholmod_rcond =============================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Cholesky Module. Copyright (C) 2005-2006, Timothy A. Davis * -------------------------------------------------------------------------- */ /* Return a rough estimate of the reciprocal of the condition number: * the minimum entry on the diagonal of L (or absolute entry of D for an LDL' * factorization) divided by the maximum entry (squared for LL'). L can be * real, complex, or zomplex. Returns -1 on error, 0 if the matrix is singular * or has a zero entry on the diagonal of L, 1 if the matrix is 0-by-0, or * min(diag(L))/max(diag(L)) otherwise. Never returns NaN; if L has a NaN on * the diagonal it returns zero instead. * * For an LL' factorization, (min(diag(L))/max(diag(L)))^2 is returned. * For an LDL' factorization, (min(diag(D))/max(diag(D))) is returned. */ #ifndef NCHOLESKY #include "cholmod_internal.h" #include "cholmod_cholesky.h" /* ========================================================================== */ /* === LMINMAX ============================================================== */ /* ========================================================================== */ /* Update lmin and lmax for one entry L(j,j) */ #define FIRST_LMINMAX(Ljj,lmin,lmax) \ { \ double ljj = Ljj ; \ if (IS_NAN (ljj)) \ { \ return (0) ; \ } \ lmin = ljj ; \ lmax = ljj ; \ } #define LMINMAX(Ljj,lmin,lmax) \ { \ double ljj = Ljj ; \ if (IS_NAN (ljj)) \ { \ return (0) ; \ } \ if (ljj < lmin) \ { \ lmin = ljj ; \ } \ else if (ljj > lmax) \ { \ lmax = ljj ; \ } \ } /* ========================================================================== */ /* === cholmod_rcond ======================================================== */ /* ========================================================================== */ double CHOLMOD(rcond) /* return min(diag(L)) / max(diag(L)) */ ( /* ---- input ---- */ cholmod_factor *L, /* --------------- */ cholmod_common *Common ) { double lmin, lmax, rcond ; double *Lx ; Int *Lpi, *Lpx, *Super, *Lp ; Int n, e, nsuper, s, k1, k2, psi, psend, psx, nsrow, nscol, jj, j ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (EMPTY) ; RETURN_IF_NULL (L, EMPTY) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, EMPTY) ; Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ n = L->n ; if (n == 0) { return (1) ; } if (L->minor < L->n) { return (0) ; } e = (L->xtype == CHOLMOD_COMPLEX) ? 2 : 1 ; if (L->is_super) { /* L is supernodal */ nsuper = L->nsuper ; /* number of supernodes in L */ Lpi = L->pi ; /* column pointers for integer pattern */ Lpx = L->px ; /* column pointers for numeric values */ Super = L->super ; /* supernode sizes */ Lx = L->x ; /* numeric values */ FIRST_LMINMAX (Lx [0], lmin, lmax) ; /* first diagonal entry of L */ for (s = 0 ; s < nsuper ; s++) { k1 = Super [s] ; /* first column in supernode s */ k2 = Super [s+1] ; /* last column in supernode is k2-1 */ psi = Lpi [s] ; /* first row index is L->s [psi] */ psend = Lpi [s+1] ; /* last row index is L->s [psend-1] */ psx = Lpx [s] ; /* first numeric entry is Lx [psx] */ nsrow = psend - psi ; /* supernode is nsrow-by-nscol */ nscol = k2 - k1 ; for (jj = 0 ; jj < nscol ; jj++) { LMINMAX (Lx [e * (psx + jj + jj*nsrow)], lmin, lmax) ; } } } else { /* L is simplicial */ Lp = L->p ; Lx = L->x ; if (L->is_ll) { /* LL' factorization */ FIRST_LMINMAX (Lx [Lp [0]], lmin, lmax) ; for (j = 1 ; j < n ; j++) { LMINMAX (Lx [e * Lp [j]], lmin, lmax) ; } } else { /* LDL' factorization, the diagonal might be negative */ FIRST_LMINMAX (fabs (Lx [Lp [0]]), lmin, lmax) ; for (j = 1 ; j < n ; j++) { LMINMAX (fabs (Lx [e * Lp [j]]), lmin, lmax) ; } } } rcond = lmin / lmax ; if (L->is_ll) { rcond = rcond*rcond ; } return (rcond) ; } #endif Matrix/src/CHOLMOD/Cholesky/cholmod_factorize.c0000644000176200001440000003373413652535054021034 0ustar liggesusers/* ========================================================================== */ /* === Cholesky/cholmod_factorize =========================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Cholesky Module. Copyright (C) 2005-2006, Timothy A. Davis * -------------------------------------------------------------------------- */ /* Computes the numerical factorization of a symmetric matrix. The primary * inputs to this routine are a sparse matrix A and the symbolic factor L from * cholmod_analyze or a prior numerical factor L. If A is symmetric, this * routine factorizes A(p,p)+beta*I (beta can be zero), where p is the * fill-reducing permutation (L->Perm). If A is unsymmetric, either * A(p,:)*A(p,:)'+beta*I or A(p,f)*A(p,f)'+beta*I is factorized. The set f and * the nonzero pattern of the matrix A must be the same as the matrix passed to * cholmod_analyze for the supernodal case. For the simplicial case, it can * be different, but it should be the same for best performance. beta is real. * * A simplicial factorization or supernodal factorization is chosen, based on * the type of the factor L. If L->is_super is TRUE, a supernodal LL' * factorization is computed. Otherwise, a simplicial numeric factorization * is computed, either LL' or LDL', depending on Common->final_ll. * * Once the factorization is complete, it can be left as is or optionally * converted into any simplicial numeric type, depending on the * Common->final_* parameters. If converted from a supernodal to simplicial * type, and the Common->final_resymbol parameter is true, then numerically * zero entries in L due to relaxed supernodal amalgamation are removed from * the simplicial factor (they are always left in the supernodal form of L). * Entries that are numerically zero but present in the simplicial symbolic * pattern of L are left in place (that is, the graph of L remains chordal). * This is required for the update/downdate/rowadd/rowdel routines to work * properly. * * workspace: Flag (nrow), Head (nrow+1), * if symmetric: Iwork (2*nrow+2*nsuper) * if unsymmetric: Iwork (2*nrow+MAX(2*nsuper,ncol)) * where nsuper is 0 if simplicial, or the # of relaxed supernodes in * L otherwise (nsuper <= nrow). * if simplicial: W (nrow). * Allocates up to two temporary copies of its input matrix (including * both pattern and numerical values). * * If the matrix is not positive definite the routine returns TRUE, but * sets Common->status to CHOLMOD_NOT_POSDEF and L->minor is set to the * column at which the failure occurred. Columns L->minor to L->n-1 are * set to zero. * * Supports any xtype (pattern, real, complex, or zomplex), except that the * input matrix A cannot be pattern-only. If L is simplicial, its numeric * xtype matches A on output. If L is supernodal, its xtype is real if A is * real, or complex if A is complex or zomplex. */ #ifndef NCHOLESKY #include "cholmod_internal.h" #include "cholmod_cholesky.h" #ifndef NSUPERNODAL #include "cholmod_supernodal.h" #endif /* ========================================================================== */ /* === cholmod_factorize ==================================================== */ /* ========================================================================== */ /* Factorizes PAP' (or PAA'P' if A->stype is 0), using a factor obtained * from cholmod_analyze. The analysis can be re-used simply by calling this * routine a second time with another matrix. A must have the same nonzero * pattern as that passed to cholmod_analyze. */ int CHOLMOD(factorize) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to factorize */ /* ---- in/out --- */ cholmod_factor *L, /* resulting factorization */ /* --------------- */ cholmod_common *Common ) { double zero [2] ; zero [0] = 0 ; zero [1] = 0 ; return (CHOLMOD(factorize_p) (A, zero, NULL, 0, L, Common)) ; } /* ========================================================================== */ /* === cholmod_factorize_p ================================================== */ /* ========================================================================== */ /* Same as cholmod_factorize, but with more options. */ int CHOLMOD(factorize_p) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to factorize */ double beta [2], /* factorize beta*I+A or beta*I+A'*A */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ /* ---- in/out --- */ cholmod_factor *L, /* resulting factorization */ /* --------------- */ cholmod_common *Common ) { cholmod_sparse *S, *F, *A1, *A2 ; Int nrow, ncol, stype, convert, n, nsuper, grow2, status ; size_t s, t, uncol ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; nrow = A->nrow ; ncol = A->ncol ; n = L->n ; stype = A->stype ; if (L->n != A->nrow) { ERROR (CHOLMOD_INVALID, "A and L dimensions do not match") ; return (FALSE) ; } if (stype != 0 && nrow != ncol) { ERROR (CHOLMOD_INVALID, "matrix invalid") ; return (FALSE) ; } DEBUG (CHOLMOD(dump_sparse) (A, "A for cholmod_factorize", Common)) ; Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ nsuper = (L->is_super ? L->nsuper : 0) ; uncol = ((stype != 0) ? 0 : ncol) ; /* s = 2*nrow + MAX (uncol, 2*nsuper) */ s = CHOLMOD(mult_size_t) (nsuper, 2, &ok) ; s = MAX (uncol, s) ; t = CHOLMOD(mult_size_t) (nrow, 2, &ok) ; s = CHOLMOD(add_size_t) (s, t, &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (FALSE) ; } CHOLMOD(allocate_work) (nrow, s, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } S = NULL ; F = NULL ; A1 = NULL ; A2 = NULL ; /* convert to another form when done, if requested */ convert = !(Common->final_asis) ; /* ---------------------------------------------------------------------- */ /* perform supernodal LL' or simplicial LDL' factorization */ /* ---------------------------------------------------------------------- */ if (L->is_super) { #ifndef NSUPERNODAL /* ------------------------------------------------------------------ */ /* supernodal factorization */ /* ------------------------------------------------------------------ */ if (L->ordering == CHOLMOD_NATURAL) { /* -------------------------------------------------------------- */ /* natural ordering */ /* -------------------------------------------------------------- */ if (stype > 0) { /* S = tril (A'), F not needed */ /* workspace: Iwork (nrow) */ A1 = CHOLMOD(ptranspose) (A, 2, NULL, NULL, 0, Common) ; S = A1 ; } else if (stype < 0) { /* This is the fastest option for the natural ordering */ /* S = A; F not needed */ S = A ; } else { /* F = A(:,f)' */ /* workspace: Iwork (nrow) */ /* workspace: Iwork (nrow if no fset; MAX (nrow,ncol) if fset)*/ A1 = CHOLMOD(ptranspose) (A, 2, NULL, fset, fsize, Common) ; F = A1 ; /* S = A */ S = A ; } } else { /* -------------------------------------------------------------- */ /* permute the input matrix before factorization */ /* -------------------------------------------------------------- */ if (stype > 0) { /* This is the fastest option for factoring a permuted matrix */ /* S = tril (PAP'); F not needed */ /* workspace: Iwork (2*nrow) */ A1 = CHOLMOD(ptranspose) (A, 2, L->Perm, NULL, 0, Common) ; S = A1 ; } else if (stype < 0) { /* A2 = triu (PAP') */ /* workspace: Iwork (2*nrow) */ A2 = CHOLMOD(ptranspose) (A, 2, L->Perm, NULL, 0, Common) ; /* S = tril (A2'); F not needed */ /* workspace: Iwork (nrow) */ A1 = CHOLMOD(ptranspose) (A2, 2, NULL, NULL, 0, Common) ; S = A1 ; CHOLMOD(free_sparse) (&A2, Common) ; ASSERT (A2 == NULL) ; } else { /* F = A(p,f)' */ /* workspace: Iwork (nrow if no fset; MAX (nrow,ncol) if fset)*/ A1 = CHOLMOD(ptranspose) (A, 2, L->Perm, fset, fsize, Common) ; F = A1 ; /* S = F' */ /* workspace: Iwork (nrow) */ A2 = CHOLMOD(ptranspose) (F, 2, NULL, NULL, 0, Common) ; S = A2 ; } } /* ------------------------------------------------------------------ */ /* supernodal factorization */ /* ------------------------------------------------------------------ */ /* workspace: Flag (nrow), Head (nrow+1), Iwork (2*nrow+2*nsuper) */ if (Common->status == CHOLMOD_OK) { CHOLMOD(super_numeric) (S, F, beta, L, Common) ; } status = Common->status ; ASSERT (IMPLIES (status >= CHOLMOD_OK, L->xtype != CHOLMOD_PATTERN)) ; /* ------------------------------------------------------------------ */ /* convert to final form, if requested */ /* ------------------------------------------------------------------ */ if (Common->status >= CHOLMOD_OK && convert) { /* workspace: none */ ok = CHOLMOD(change_factor) (L->xtype, Common->final_ll, Common->final_super, Common->final_pack, Common->final_monotonic, L, Common) ; if (ok && Common->final_resymbol && !(L->is_super)) { /* workspace: Flag (nrow), Head (nrow+1), * if symmetric: Iwork (2*nrow) * if unsymmetric: Iwork (2*nrow+ncol) */ CHOLMOD(resymbol_noperm) (S, fset, fsize, Common->final_pack, L, Common) ; } } #else /* ------------------------------------------------------------------ */ /* CHOLMOD Supernodal module not installed */ /* ------------------------------------------------------------------ */ status = CHOLMOD_NOT_INSTALLED ; ERROR (CHOLMOD_NOT_INSTALLED,"Supernodal module not installed") ; #endif } else { /* ------------------------------------------------------------------ */ /* simplicial LDL' factorization */ /* ------------------------------------------------------------------ */ /* Permute the input matrix A if necessary. cholmod_rowfac requires * triu(A) in column form for the symmetric case, and A in column form * for the unsymmetric case (the matrix S). The unsymmetric case * requires A in row form, or equivalently A' in column form (the * matrix F). */ if (L->ordering == CHOLMOD_NATURAL) { /* -------------------------------------------------------------- */ /* natural ordering */ /* -------------------------------------------------------------- */ if (stype > 0) { /* F is not needed, S = A */ S = A ; } else if (stype < 0) { /* F is not needed, S = A' */ /* workspace: Iwork (nrow) */ A2 = CHOLMOD(ptranspose) (A, 2, NULL, NULL, 0, Common) ; S = A2 ; } else { /* F = A (:,f)' */ /* workspace: Iwork (nrow if no fset; MAX (nrow,ncol) if fset)*/ A1 = CHOLMOD(ptranspose) (A, 2, NULL, fset, fsize, Common) ; F = A1 ; S = A ; } } else { /* -------------------------------------------------------------- */ /* permute the input matrix before factorization */ /* -------------------------------------------------------------- */ if (stype > 0) { /* F = tril (A (p,p)') */ /* workspace: Iwork (2*nrow) */ A1 = CHOLMOD(ptranspose) (A, 2, L->Perm, NULL, 0, Common) ; /* A2 = triu (F') */ /* workspace: Iwork (nrow) */ A2 = CHOLMOD(ptranspose) (A1, 2, NULL, NULL, 0, Common) ; /* the symmetric case does not need F, free it and set to NULL*/ CHOLMOD(free_sparse) (&A1, Common) ; } else if (stype < 0) { /* A2 = triu (A (p,p)'), F not needed. This is the fastest * way to factorize a matrix using the simplicial routine * (cholmod_rowfac). */ /* workspace: Iwork (2*nrow) */ A2 = CHOLMOD(ptranspose) (A, 2, L->Perm, NULL, 0, Common) ; } else { /* F = A (p,f)' */ /* workspace: Iwork (nrow if no fset; MAX (nrow,ncol) if fset)*/ A1 = CHOLMOD(ptranspose) (A, 2, L->Perm, fset, fsize, Common) ; F = A1 ; /* A2 = F' */ /* workspace: Iwork (nrow) */ A2 = CHOLMOD(ptranspose) (F, 2, NULL, NULL, 0, Common) ; } S = A2 ; } /* ------------------------------------------------------------------ */ /* simplicial LDL' or LL' factorization */ /* ------------------------------------------------------------------ */ /* factorize beta*I+S (symmetric) or beta*I+F*F' (unsymmetric) */ /* workspace: Flag (nrow), W (nrow), Iwork (2*nrow) */ if (Common->status == CHOLMOD_OK) { grow2 = Common->grow2 ; L->is_ll = BOOLEAN (Common->final_ll) ; if (L->xtype == CHOLMOD_PATTERN && Common->final_pack) { /* allocate a factor with exactly the space required */ Common->grow2 = 0 ; } CHOLMOD(rowfac) (S, F, beta, 0, nrow, L, Common) ; Common->grow2 = grow2 ; } status = Common->status ; /* ------------------------------------------------------------------ */ /* convert to final form, if requested */ /* ------------------------------------------------------------------ */ if (Common->status >= CHOLMOD_OK && convert) { /* workspace: none */ CHOLMOD(change_factor) (L->xtype, L->is_ll, FALSE, Common->final_pack, Common->final_monotonic, L, Common) ; } } /* ---------------------------------------------------------------------- */ /* free A1 and A2 if they exist */ /* ---------------------------------------------------------------------- */ CHOLMOD(free_sparse) (&A1, Common) ; CHOLMOD(free_sparse) (&A2, Common) ; Common->status = MAX (Common->status, status) ; return (Common->status >= CHOLMOD_OK) ; } #endif Matrix/src/CHOLMOD/Cholesky/cholmod_rowfac.c0000644000176200001440000006037313652535054020326 0ustar liggesusers/* ========================================================================== */ /* === Cholesky/cholmod_rowfac ============================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Cholesky Module. Copyright (C) 2005-2013, Timothy A. Davis * -------------------------------------------------------------------------- */ /* Full or incremental numerical LDL' or LL' factorization (simplicial, not * supernodal) cholmod_factorize is the "easy" wrapper for this code, but it * does not provide access to incremental factorization. * * cholmod_rowfac computes the full or incremental LDL' or LL' factorization of * A+beta*I (where A is symmetric) or A*F+beta*I (where A and F are unsymmetric * and only the upper triangular part of A*F+beta*I is used). It computes * L (and D, for LDL') one row at a time. beta is real. * * A is nrow-by-ncol or nrow-by-nrow. In "packed" form it is a conventional * column-oriented sparse matrix. Row indices of column j are in * Ai [Ap [j] ... Ap [j+1]-1] and values in the same locations of Ax. * will be faster if A has sorted columns. In "unpacked" form the column * of A ends at Ap [j] + Anz [j] - 1 instead of Ap [j+1] - 1. * * Row indices in each column of A can be sorted or unsorted, but the routine * routine works fastest if A is sorted, or if only triu(A) is provided * for the symmetric case. * * The unit-diagonal nrow-by-nrow output matrix L is returned in "unpacked" * column form, with row indices of column j in Li [Lp [j] ... * Lp [j] + Lnz [j] - 1] and values in the same location in Lx. The row * indices in each column of L are in sorted order. The unit diagonal of L * is not stored. * * L can be a simplicial symbolic or numeric (L->is_super must be FALSE). * A symbolic factor is converted immediately into a numeric factor containing * the identity matrix. * * For a full factorization, kstart = 0 and kend = nrow. The existing nonzero * entries (numerical values in L->x and L->z for the zomplex case, and indices * in L->i), if any, are overwritten. * * To compute an incremental factorization, select kstart and kend as the range * of rows of L you wish to compute. A correct factorization will be computed * only if all descendants of all nodes k = kstart to kend-1 in the etree have * been factorized by a prior call to this routine, and if rows kstart to kend-1 * have not been factorized. This condition is NOT checked on input. * * --------------- * Symmetric case: * --------------- * * The factorization (in MATLAB notation) is: * * S = beta*I + A * S = triu (S) + triu (S,1)' * L*D*L' = S, or L*L' = S * * A is a conventional sparse matrix in compressed column form. Only the * diagonal and upper triangular part of A is accessed; the lower * triangular part is ignored and assumed to be equal to the upper * triangular part. For an incremental factorization, only columns kstart * to kend-1 of A are accessed. F is not used. * * --------------- * Unsymmetric case: * --------------- * * The factorization (in MATLAB notation) is: * * S = beta*I + A*F * S = triu (S) + triu (S,1)' * L*D*L' = S, or L*L' = S * * The typical case is F=A'. Alternatively, if F=A(:,f)', then this * routine factorizes S = beta*I + A(:,f)*A(:,f)'. * * All of A and F are accessed, but only the upper triangular part of A*F * is used. F must be of size A->ncol by A->nrow. F is used for the * unsymmetric case only. F can be packed or unpacked and it need not be * sorted. * * For a complete factorization of beta*I + A*A', * this routine performs a number of flops exactly equal to: * * sum (for each column j of A) of (Anz (j)^2 + Anz (j)), to form S * + * sum (for each column j of L) of (Lnz (j)^2 + 3*Lnz (j)), to factorize S * * where Anz (j) is the number of nonzeros in column j of A, and Lnz (j) * is the number of nonzero in column j of L below the diagonal. * * * workspace: Flag (nrow), W (nrow if real, 2*nrow if complex/zomplex), * Iwork (nrow) * * Supports any xtype, except a pattern-only input matrix A cannot be * factorized. */ #ifndef NCHOLESKY #include "cholmod_internal.h" #include "cholmod_cholesky.h" /* ========================================================================== */ /* === subtree ============================================================== */ /* ========================================================================== */ /* Compute the nonzero pattern of the sparse triangular solve Lx=b, where L in * this case is L(0:k-1,0:k-1), and b is a column of A. This is done by * traversing the kth row-subtree of the elimination tree of L, starting from * each nonzero entry in b. The pattern is returned postordered, and is valid * for a subsequent numerical triangular solve of Lx=b. The elimination tree * can be provided in a Parent array, or extracted from the pattern of L itself. * * The pattern of x = inv(L)*b is returned in Stack [top...]. * Also scatters b, or a multiple of b, into the work vector W. * * The SCATTER macro is defines how the numerical values of A or A*A' are to be * scattered. * * PARENT(i) is a macro the defines how the etree is accessed. It is either: * #define PARENT(i) Parent [i] * #define PARENT(i) (Lnz [i] > 1) ? (Li [Lp [i] + 1]) : EMPTY */ #define SUBTREE \ for ( ; p < pend ; p++) \ { \ i = Ai [p] ; \ if (i <= k) \ { \ /* scatter the column of A, or A*A' into Wx and Wz */ \ SCATTER ; \ /* start at node i and traverse up the subtree, stop at node k */ \ for (len = 0 ; i < k && i != EMPTY && Flag [i] < mark ; i = parent) \ { \ /* L(k,i) is nonzero, and seen for the first time */ \ Stack [len++] = i ; /* place i on the stack */ \ Flag [i] = mark ; /* mark i as visited */ \ parent = PARENT (i) ; /* traverse up the etree to the parent */ \ } \ /* move the path down to the bottom of the stack */ \ while (len > 0) \ { \ Stack [--top] = Stack [--len] ; \ } \ } \ else if (sorted) \ { \ break ; \ } \ } /* ========================================================================== */ /* === TEMPLATE ============================================================= */ /* ========================================================================== */ #define REAL #include "t_cholmod_rowfac.c" #define COMPLEX #include "t_cholmod_rowfac.c" #define ZOMPLEX #include "t_cholmod_rowfac.c" #define MASK #define REAL #include "t_cholmod_rowfac.c" #define COMPLEX #include "t_cholmod_rowfac.c" #define ZOMPLEX #include "t_cholmod_rowfac.c" #undef MASK /* ========================================================================== */ /* === cholmod_row_subtree ================================================== */ /* ========================================================================== */ /* Compute the nonzero pattern of the solution to the lower triangular system * L(0:k-1,0:k-1) * x = A (0:k-1,k) if A is symmetric, or * L(0:k-1,0:k-1) * x = A (0:k-1,:) * A (:,k)' if A is unsymmetric. * This gives the nonzero pattern of row k of L (excluding the diagonal). * The pattern is returned postordered. * * The symmetric case requires A to be in symmetric-upper form. * * The result is returned in R, a pre-allocated sparse matrix of size nrow-by-1, * with R->nzmax >= nrow. R is assumed to be packed (Rnz [0] is not updated); * the number of entries in R is given by Rp [0]. * * FUTURE WORK: a very minor change to this routine could allow it to compute * the nonzero pattern of x for any system Lx=b. The SUBTREE macro would need * to change, to eliminate its dependence on k. * * workspace: Flag (nrow) */ int CHOLMOD(row_subtree) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to analyze */ cholmod_sparse *F, /* used for A*A' case only. F=A' or A(:,f)' */ size_t krow, /* row k of L */ Int *Parent, /* elimination tree */ /* ---- output --- */ cholmod_sparse *R, /* pattern of L(k,:), 1-by-n with R->nzmax >= n */ /* --------------- */ cholmod_common *Common ) { Int *Rp, *Stack, *Flag, *Ap, *Ai, *Anz, *Fp, *Fi, *Fnz ; Int p, pend, parent, t, stype, nrow, k, pf, pfend, Fpacked, packed, sorted, top, len, i, mark ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (R, FALSE) ; RETURN_IF_NULL (Parent, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (R, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; stype = A->stype ; if (stype == 0) { RETURN_IF_NULL (F, FALSE) ; RETURN_IF_XTYPE_INVALID (F, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; } if (krow >= A->nrow) { ERROR (CHOLMOD_INVALID, "subtree: k invalid") ; return (FALSE) ; } if (R->ncol != 1 || A->nrow != R->nrow || A->nrow > R->nzmax) { ERROR (CHOLMOD_INVALID, "subtree: R invalid") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ nrow = A->nrow ; CHOLMOD(allocate_work) (nrow, 0, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ if (stype > 0) { /* symmetric upper case: F is not needed. It may be NULL */ Fp = NULL ; Fi = NULL ; Fnz = NULL ; Fpacked = TRUE ; } else if (stype == 0) { /* unsymmetric case: F is required. */ Fp = F->p ; Fi = F->i ; Fnz = F->nz ; Fpacked = F->packed ; } else { /* symmetric lower triangular form not supported */ ERROR (CHOLMOD_INVALID, "symmetric lower not supported") ; return (FALSE) ; } Ap = A->p ; Ai = A->i ; Anz = A->nz ; packed = A->packed ; sorted = A->sorted ; k = krow ; Stack = R->i ; /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ Flag = Common->Flag ; /* size nrow, Flag [i] < mark must hold */ /* mark = CHOLMOD(clear_flag) (Common) ; */ CHOLMOD_CLEAR_FLAG (Common) ; mark = Common->mark ; /* ---------------------------------------------------------------------- */ /* compute the pattern of L(k,:) */ /* ---------------------------------------------------------------------- */ top = nrow ; /* Stack is empty */ Flag [k] = mark ; /* do not include diagonal entry in Stack */ #define SCATTER /* do not scatter numerical values */ #define PARENT(i) Parent [i] /* use Parent for etree */ if (stype != 0) { /* scatter kth col of triu (A), get pattern L(k,:) */ p = Ap [k] ; pend = (packed) ? (Ap [k+1]) : (p + Anz [k]) ; SUBTREE ; } else { /* scatter kth col of triu (beta*I+AA'), get pattern L(k,:) */ pf = Fp [k] ; pfend = (Fpacked) ? (Fp [k+1]) : (pf + Fnz [k]) ; for ( ; pf < pfend ; pf++) { /* get nonzero entry F (t,k) */ t = Fi [pf] ; p = Ap [t] ; pend = (packed) ? (Ap [t+1]) : (p + Anz [t]) ; SUBTREE ; } } #undef SCATTER #undef PARENT /* shift the stack upwards, to the first part of R */ len = nrow - top ; for (i = 0 ; i < len ; i++) { Stack [i] = Stack [top + i] ; } Rp = R->p ; Rp [0] = 0 ; Rp [1] = len ; R->sorted = FALSE ; CHOLMOD(clear_flag) (Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; return (TRUE) ; } /* ========================================================================== */ /* === cholmod_lsolve_pattern =============================================== */ /* ========================================================================== */ /* Compute the nonzero pattern of Y=L\B. L must be simplicial, and B * must be a single sparse column vector with B->stype = 0. The values of * B are not used; it just specifies a nonzero pattern. The pattern of * Y is not sorted, but is in topological order instead (suitable for a * sparse forward/backsolve). */ int CHOLMOD(lsolve_pattern) ( /* ---- input ---- */ cholmod_sparse *B, /* sparse right-hand-side (a single sparse column) */ cholmod_factor *L, /* the factor L from which parent(i) is derived */ /* ---- output --- */ cholmod_sparse *Yset, /* pattern of Y=L\B, n-by-1 with Y->nzmax >= n */ /* --------------- */ cholmod_common *Common ) { size_t krow ; RETURN_IF_NULL (B, FALSE) ; krow = B->nrow ; return (CHOLMOD(row_lsubtree) (B, NULL, 0, krow, L, Yset, Common)) ; } /* ========================================================================== */ /* === cholmod_row_lsubtree ================================================= */ /* ========================================================================== */ /* Identical to cholmod_row_subtree, except that the elimination tree is * obtained from L itself, as the first off-diagonal entry in each column. * L must be simplicial, not supernodal. * * If krow = A->nrow, then A must be a single sparse column vector, (A->stype * must be zero), and the nonzero pattern of x=L\b is computed, where b=A(:,0) * is the single sparse right-hand-side. The inputs Fi and fnz are ignored. * See CHOLMOD(lsolve_pattern) above for a simpler interface for this case. */ int CHOLMOD(row_lsubtree) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to analyze */ Int *Fi, size_t fnz, /* nonzero pattern of kth row of A', not required * for the symmetric case. Need not be sorted. */ size_t krow, /* row k of L */ cholmod_factor *L, /* the factor L from which parent(i) is derived */ /* ---- output --- */ cholmod_sparse *R, /* pattern of L(k,:), n-by-1 with R->nzmax >= n */ /* --------------- */ cholmod_common *Common ) { Int *Rp, *Stack, *Flag, *Ap, *Ai, *Anz, *Lp, *Li, *Lnz ; Int p, pend, parent, t, stype, nrow, k, pf, packed, sorted, top, len, i, mark, ka ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (R, FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (R, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ; nrow = A->nrow ; stype = A->stype ; if (stype < 0) { /* symmetric lower triangular form not supported */ ERROR (CHOLMOD_INVALID, "symmetric lower not supported") ; return (FALSE) ; } if (krow > nrow) { ERROR (CHOLMOD_INVALID, "lsubtree: krow invalid") ; return (FALSE) ; } else if (krow == nrow) { /* find pattern of x=L\b where b=A(:,0) */ k = nrow ; /* compute all of the result; don't stop in SUBTREE */ ka = 0 ; /* use column A(:,0) */ if (stype != 0 || A->ncol != 1) { /* A must be unsymmetric (it's a single sparse column vector) */ ERROR (CHOLMOD_INVALID, "lsubtree: A invalid") ; return (FALSE) ; } } else { /* find pattern of L(k,:) using A(:,k) and Fi if A unsymmetric */ k = krow ; /* which row of L to compute */ ka = k ; /* which column of A to use */ if (stype == 0) { RETURN_IF_NULL (Fi, FALSE) ; } } if (R->ncol != 1 || nrow != R->nrow || nrow > R->nzmax || ((krow == nrow || stype != 0) && ka >= A->ncol)) { ERROR (CHOLMOD_INVALID, "lsubtree: R invalid") ; return (FALSE) ; } if (L->is_super) { ERROR (CHOLMOD_INVALID, "lsubtree: L invalid (cannot be supernodal)") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ CHOLMOD(allocate_work) (nrow, 0, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ Ap = A->p ; Ai = A->i ; Anz = A->nz ; packed = A->packed ; sorted = A->sorted ; Stack = R->i ; Lp = L->p ; Li = L->i ; Lnz = L->nz ; /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ Flag = Common->Flag ; /* size nrow, Flag [i] < mark must hold */ mark = CHOLMOD(clear_flag) (Common) ; /* ---------------------------------------------------------------------- */ /* compute the pattern of L(k,:) */ /* ---------------------------------------------------------------------- */ top = nrow ; /* Stack is empty */ if (k < nrow) { Flag [k] = mark ; /* do not include diagonal entry in Stack */ } #define SCATTER /* do not scatter numerical values */ #define PARENT(i) (Lnz [i] > 1) ? (Li [Lp [i] + 1]) : EMPTY if (krow == nrow || stype != 0) { /* scatter kth col of triu (A), get pattern L(k,:) */ p = Ap [ka] ; pend = (packed) ? (Ap [ka+1]) : (p + Anz [ka]) ; SUBTREE ; } else { /* scatter kth col of triu (beta*I+AA'), get pattern L(k,:) */ for (pf = 0 ; pf < (Int) fnz ; pf++) { /* get nonzero entry F (t,k) */ t = Fi [pf] ; p = Ap [t] ; pend = (packed) ? (Ap [t+1]) : (p + Anz [t]) ; SUBTREE ; } } #undef SCATTER #undef PARENT /* shift the stack upwards, to the first part of R */ len = nrow - top ; for (i = 0 ; i < len ; i++) { Stack [i] = Stack [top + i] ; } Rp = R->p ; Rp [0] = 0 ; Rp [1] = len ; R->sorted = FALSE ; CHOLMOD(clear_flag) (Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; return (TRUE) ; } /* ========================================================================== */ /* === cholmod_rowfac ======================================================= */ /* ========================================================================== */ /* This is the incremental factorization for general purpose usage. */ int CHOLMOD(rowfac) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to factorize */ cholmod_sparse *F, /* used for A*A' case only. F=A' or A(:,f)' */ double beta [2], /* factorize beta*I+A or beta*I+AA' */ size_t kstart, /* first row to factorize */ size_t kend, /* last row to factorize is kend-1 */ /* ---- in/out --- */ cholmod_factor *L, /* --------------- */ cholmod_common *Common ) { return (CHOLMOD(rowfac_mask2) (A, F, beta, kstart, kend, NULL, 0, NULL, L, Common)) ; } /* ========================================================================== */ /* === cholmod_rowfac_mask ================================================== */ /* ========================================================================== */ /* This is meant for use in LPDASA only. */ int CHOLMOD(rowfac_mask) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to factorize */ cholmod_sparse *F, /* used for A*A' case only. F=A' or A(:,f)' */ double beta [2], /* factorize beta*I+A or beta*I+AA' */ size_t kstart, /* first row to factorize */ size_t kend, /* last row to factorize is kend-1 */ Int *mask, /* size A->nrow. if mask[i] >= 0 row i is set to zero */ Int *RLinkUp, /* size A->nrow. link list of rows to compute */ /* ---- in/out --- */ cholmod_factor *L, /* --------------- */ cholmod_common *Common ) { Int maskmark = 0 ; return (CHOLMOD(rowfac_mask2) (A, F, beta, kstart, kend, mask, maskmark, RLinkUp, L, Common)) ; } /* ========================================================================== */ /* === cholmod_rowfac_mask2 ================================================= */ /* ========================================================================== */ /* This is meant for use in LPDASA only. */ int CHOLMOD(rowfac_mask2) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to factorize */ cholmod_sparse *F, /* used for A*A' case only. F=A' or A(:,f)' */ double beta [2], /* factorize beta*I+A or beta*I+AA' */ size_t kstart, /* first row to factorize */ size_t kend, /* last row to factorize is kend-1 */ Int *mask, /* size A->nrow. if mask[i] >= maskmark row i is set to zero */ Int maskmark, /* for mask [i] test */ Int *RLinkUp, /* size A->nrow. link list of rows to compute */ /* ---- in/out --- */ cholmod_factor *L, /* --------------- */ cholmod_common *Common ) { Int n ; size_t s ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; if (L->xtype != CHOLMOD_PATTERN && A->xtype != L->xtype) { ERROR (CHOLMOD_INVALID, "xtype of A and L do not match") ; return (FALSE) ; } if (L->is_super) { ERROR (CHOLMOD_INVALID, "can only do simplicial factorization"); return (FALSE) ; } if (A->stype == 0) { RETURN_IF_NULL (F, FALSE) ; if (A->xtype != F->xtype) { ERROR (CHOLMOD_INVALID, "xtype of A and F do not match") ; return (FALSE) ; } } if (A->stype < 0) { /* symmetric lower triangular form not supported */ ERROR (CHOLMOD_INVALID, "symmetric lower not supported") ; return (FALSE) ; } if (kend > L->n) { ERROR (CHOLMOD_INVALID, "kend invalid") ; return (FALSE) ; } if (A->nrow != L->n) { ERROR (CHOLMOD_INVALID, "dimensions of A and L do not match") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; Common->rowfacfl = 0 ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* Xwork is of size n for the real case, 2*n for complex/zomplex */ n = L->n ; /* s = ((A->xtype != CHOLMOD_REAL) ? 2:1)*n */ s = CHOLMOD(mult_size_t) (n, ((A->xtype != CHOLMOD_REAL) ? 2:1), &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (FALSE) ; } CHOLMOD(allocate_work) (n, n, s, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, A->nrow, Common)) ; /* ---------------------------------------------------------------------- */ /* factorize the matrix, using template routine */ /* ---------------------------------------------------------------------- */ if (RLinkUp == NULL) { switch (A->xtype) { case CHOLMOD_REAL: ok = r_cholmod_rowfac (A, F, beta, kstart, kend, L, Common) ; break ; case CHOLMOD_COMPLEX: ok = c_cholmod_rowfac (A, F, beta, kstart, kend, L, Common) ; break ; case CHOLMOD_ZOMPLEX: ok = z_cholmod_rowfac (A, F, beta, kstart, kend, L, Common) ; break ; } } else { switch (A->xtype) { case CHOLMOD_REAL: ok = r_cholmod_rowfac_mask (A, F, beta, kstart, kend, mask, maskmark, RLinkUp, L, Common) ; break ; case CHOLMOD_COMPLEX: ok = c_cholmod_rowfac_mask (A, F, beta, kstart, kend, mask, maskmark, RLinkUp, L, Common) ; break ; case CHOLMOD_ZOMPLEX: ok = z_cholmod_rowfac_mask (A, F, beta, kstart, kend, mask, maskmark, RLinkUp, L, Common) ; break ; } } return (ok) ; } #endif Matrix/src/CHOLMOD/Cholesky/cholmod_colamd.c0000644000176200001440000001506213652535054020277 0ustar liggesusers/* ========================================================================== */ /* === Cholesky/cholmod_colamd ============================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Cholesky Module. Copyright (C) 2005-2006, Timothy A. Davis * -------------------------------------------------------------------------- */ /* CHOLMOD interface to the COLAMD ordering routine (version 2.4 or later). * Finds a permutation p such that the Cholesky factorization of PAA'P' is * sparser than AA' using colamd. If the postorder input parameter is TRUE, * the column etree is found and postordered, and the colamd ordering is then * combined with its postordering. A must be unsymmetric. * * There can be no duplicate entries in f. * f can be length 0 to n if A is m-by-n. * * workspace: Iwork (4*nrow+ncol), Head (nrow+1), Flag (nrow) * Allocates a copy of its input matrix, which * is then used as CCOLAMD's workspace. * * Supports any xtype (pattern, real, complex, or zomplex) */ #ifndef NCHOLESKY #include "cholmod_internal.h" #include "colamd.h" #include "cholmod_cholesky.h" #if (!defined (COLAMD_VERSION) || (COLAMD_VERSION < COLAMD_VERSION_CODE (2,5))) #error "COLAMD v2.5 or later is required" #endif /* ========================================================================== */ /* === cholmod_colamd ======================================================= */ /* ========================================================================== */ int CHOLMOD(colamd) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ int postorder, /* if TRUE, follow with a coletree postorder */ /* ---- output --- */ Int *Perm, /* size A->nrow, output permutation */ /* --------------- */ cholmod_common *Common ) { double knobs [COLAMD_KNOBS] ; cholmod_sparse *C ; Int *NewPerm, *Parent, *Post, *Work2n ; Int k, nrow, ncol ; size_t s, alen ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (Perm, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; if (A->stype != 0) { ERROR (CHOLMOD_INVALID, "matrix must be unsymmetric") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ nrow = A->nrow ; ncol = A->ncol ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* Note: this is less than the space used in cholmod_analyze, so if * cholmod_colamd is being called by that routine, no space will be * allocated. */ /* s = 4*nrow + ncol */ s = CHOLMOD(mult_size_t) (nrow, 4, &ok) ; s = CHOLMOD(add_size_t) (s, ncol, &ok) ; #ifdef LONG alen = colamd_l_recommended (A->nzmax, ncol, nrow) ; colamd_l_set_defaults (knobs) ; #else alen = colamd_recommended (A->nzmax, ncol, nrow) ; colamd_set_defaults (knobs) ; #endif if (!ok || alen == 0) { ERROR (CHOLMOD_TOO_LARGE, "matrix invalid or too large") ; return (FALSE) ; } CHOLMOD(allocate_work) (0, s, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } /* ---------------------------------------------------------------------- */ /* allocate COLAMD workspace */ /* ---------------------------------------------------------------------- */ C = CHOLMOD(allocate_sparse) (ncol, nrow, alen, TRUE, TRUE, 0, CHOLMOD_PATTERN, Common) ; /* ---------------------------------------------------------------------- */ /* copy (and transpose) the input matrix A into the colamd workspace */ /* ---------------------------------------------------------------------- */ /* C = A (:,f)', which also packs A if needed. */ /* workspace: Iwork (nrow if no fset; MAX (nrow,ncol) if fset) */ ok = CHOLMOD(transpose_unsym) (A, 0, NULL, fset, fsize, C, Common) ; /* ---------------------------------------------------------------------- */ /* order the matrix (destroys the contents of C->i and C->p) */ /* ---------------------------------------------------------------------- */ /* get parameters */ if (Common->current < 0 || Common->current >= CHOLMOD_MAXMETHODS) { /* this is the CHOLMOD default, not the COLAMD default */ knobs [COLAMD_DENSE_ROW] = -1 ; } else { /* get the knobs from the Common parameters */ knobs [COLAMD_DENSE_COL] = Common->method[Common->current].prune_dense ; knobs [COLAMD_DENSE_ROW] = Common->method[Common->current].prune_dense2; knobs [COLAMD_AGGRESSIVE] = Common->method[Common->current].aggressive ; } if (ok) { Int *Cp ; Int stats [COLAMD_STATS] ; Cp = C->p ; #ifdef LONG colamd_l (ncol, nrow, alen, C->i, Cp, knobs, stats) ; #else colamd (ncol, nrow, alen, C->i, Cp, knobs, stats) ; #endif ok = stats [COLAMD_STATUS] ; ok = (ok == COLAMD_OK || ok == COLAMD_OK_BUT_JUMBLED) ; /* permutation returned in C->p, if the ordering succeeded */ for (k = 0 ; k < nrow ; k++) { Perm [k] = Cp [k] ; } } CHOLMOD(free_sparse) (&C, Common) ; /* ---------------------------------------------------------------------- */ /* column etree postordering */ /* ---------------------------------------------------------------------- */ if (postorder) { /* use the last 2*n space in Iwork for Parent and Post */ Work2n = Common->Iwork ; Work2n += 2*((size_t) nrow) + ncol ; Parent = Work2n ; /* size nrow (i/i/l) */ Post = Work2n + nrow ; /* size nrow (i/i/l) */ /* workspace: Iwork (2*nrow+ncol), Flag (nrow), Head (nrow+1) */ ok = ok && CHOLMOD(analyze_ordering) (A, CHOLMOD_COLAMD, Perm, fset, fsize, Parent, Post, NULL, NULL, NULL, Common) ; /* combine the colamd permutation with its postordering */ if (ok) { NewPerm = Common->Iwork ; /* size nrow (i/i/l) */ for (k = 0 ; k < nrow ; k++) { NewPerm [k] = Perm [Post [k]] ; } for (k = 0 ; k < nrow ; k++) { Perm [k] = NewPerm [k] ; } } } return (ok) ; } #endif Matrix/src/CHOLMOD/Lib/0000755000176200001440000000000014154165627014113 5ustar liggesusersMatrix/src/CHOLMOD/Lib/Makefile0000644000176200001440000004442314154165630015554 0ustar liggesusers#=============================================================================== # CHOLOMD/Lib/Makefile: for compiling the CHOLMOD library #=============================================================================== default: lib PKG_CPPFLAGS = -I../../AMD/Include -I../../AMD/Source \ -I../../COLAMD/Include \ -I../Include -I../../SuiteSparse_config -DNPARTITION -DNPRINT # -I../../CCOLAMD \ # -I../../CAMD/Include -I../../CAMD/Source \ # -I../../Metis \ #------------------------------------------------------------------------------- # ../Include/ directory contains all include files: #------------------------------------------------------------------------------- INC = ../Include/cholmod.h \ ../Include/cholmod_blas.h \ ../Include/cholmod_check.h \ ../Include/cholmod_cholesky.h \ ../Include/cholmod_complexity.h \ ../Include/cholmod_config.h \ ../Include/cholmod_core.h \ ../Include/cholmod_internal.h \ ../Include/cholmod_matrixops.h \ ../Include/cholmod_modify.h \ ../Include/cholmod_partition.h \ ../Include/cholmod_supernodal.h \ ../Include/cholmod_template.h #------------------------------------------------------------------------------- # The 7 CHOLMOD library modules (int, double) #------------------------------------------------------------------------------- CORE = cholmod_aat.o cholmod_add.o cholmod_band.o \ cholmod_change_factor.o cholmod_common.o cholmod_complex.o \ cholmod_copy.o cholmod_dense.o cholmod_error.o cholmod_factor.o \ cholmod_memory.o cholmod_sparse.o \ cholmod_transpose.o cholmod_triplet.o \ cholmod_version.o CHECK = cholmod_check.o cholmod_read.o cholmod_write.o CHOLESKY = cholmod_amd.o cholmod_analyze.o cholmod_colamd.o \ cholmod_etree.o cholmod_factorize.o cholmod_postorder.o \ cholmod_rcond.o cholmod_resymbol.o cholmod_rowcolcounts.o \ cholmod_rowfac.o cholmod_solve.o cholmod_spsolve.o MATRIXOPS = cholmod_drop.o cholmod_horzcat.o cholmod_norm.o \ cholmod_scale.o cholmod_sdmult.o cholmod_ssmult.o \ cholmod_submatrix.o cholmod_vertcat.o cholmod_symmetry.o PARTITION = cholmod_ccolamd.o cholmod_csymamd.o \ cholmod_metis.o cholmod_nesdis.o cholmod_camd.o MODIFY = cholmod_rowadd.o cholmod_rowdel.o cholmod_updown.o SUPERNODAL = cholmod_super_numeric.o cholmod_super_solve.o \ cholmod_super_symbolic.o DI = $(CORE) $(CHECK) $(CHOLESKY) $(MATRIXOPS) $(MODIFY) $(SUPERNODAL) # $(PARTITION) #------------------------------------------------------------------------------- # CHOLMOD library modules (long, double) #------------------------------------------------------------------------------- LCORE = cholmod_l_aat.o cholmod_l_add.o cholmod_l_band.o \ cholmod_l_change_factor.o cholmod_l_common.o cholmod_l_complex.o \ cholmod_l_copy.o cholmod_l_dense.o cholmod_l_error.o \ cholmod_l_factor.o cholmod_l_memory.o \ cholmod_l_sparse.o cholmod_l_transpose.o cholmod_l_triplet.o \ cholmod_l_version.o LCHECK = cholmod_l_check.o cholmod_l_read.o cholmod_l_write.o LCHOLESKY = cholmod_l_amd.o cholmod_l_analyze.o cholmod_l_colamd.o \ cholmod_l_etree.o cholmod_l_factorize.o cholmod_l_postorder.o \ cholmod_l_rcond.o cholmod_l_resymbol.o cholmod_l_rowcolcounts.o \ cholmod_l_rowfac.o cholmod_l_solve.o cholmod_l_spsolve.o LMATRIXOPS = cholmod_l_drop.o cholmod_l_horzcat.o cholmod_l_norm.o \ cholmod_l_scale.o cholmod_l_sdmult.o cholmod_l_ssmult.o \ cholmod_l_submatrix.o cholmod_l_vertcat.o cholmod_l_symmetry.o LPARTITION = cholmod_l_ccolamd.o cholmod_l_csymamd.o \ cholmod_l_metis.o cholmod_l_nesdis.o cholmod_l_camd.o LMODIFY = cholmod_l_rowadd.o cholmod_l_rowdel.o cholmod_l_updown.o LSUPERNODAL = cholmod_l_super_numeric.o cholmod_l_super_solve.o \ cholmod_l_super_symbolic.o DL = $(LCORE) $(LCHECK) $(LCHOLESKY) $(LMATRIXOPS) $(LMODIFY) $(LSUPERNODAL) #$(LPARTITION) #------------------------------------------------------------------------------- OBJS = $(DI) $(DL) # ^^ FIXME? MM thinks we should be able to only use $(DI) # well, Doug thought so, too .. but it's currently wrong: # --> ../../chm_common.c has a few 'cholmod_l_' left # # Well, it's even reverse now (2016-02): With 64-bit being standard, # we want to have e.g. dense n x m matrices where n x m >> max_int, # and this *only* works for the *_l_* routines, i.e., those compiled with # 'DLONG' defined. LIB = ../../CHOLMOD.a C = $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) lib: $(LIB) $(LIB): $(OBJS) $(AR) -rucs $(LIB) $(OBJS) mostlyclean: clean clean: @-rm -rf .libs _libs $(LIB) @-rm -f $(OBJS) $(OBJ): $(INC) #------------------------------------------------------------------------------- # Check Module: #------------------------------------------------------------------------------- cholmod_check.o: ../Check/cholmod_check.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Check/cholmod_check.c -o $@ cholmod_read.o: ../Check/cholmod_read.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Check/cholmod_read.c -o $@ cholmod_write.o: ../Check/cholmod_write.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Check/cholmod_write.c -o $@ #------------------------------------------------------------------------------- cholmod_l_check.o: ../Check/cholmod_check.c $(C) -DDLONG -c $(I) ../Check/cholmod_check.c -o $@ cholmod_l_read.o: ../Check/cholmod_read.c $(C) -DDLONG -c $(I) ../Check/cholmod_read.c -o $@ cholmod_l_write.o: ../Check/cholmod_write.c $(C) -DDLONG -c $(I) ../Check/cholmod_write.c -o $@ #------------------------------------------------------------------------------- # Core Module: #------------------------------------------------------------------------------- cholmod_common.o: ../Core/cholmod_common.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Core/cholmod_common.c -o $@ cholmod_dense.o: ../Core/cholmod_dense.c ../Core/t_cholmod_dense.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Core/cholmod_dense.c -o $@ cholmod_factor.o: ../Core/cholmod_factor.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Core/cholmod_factor.c -o $@ cholmod_change_factor.o: ../Core/cholmod_change_factor.c \ ../Core/t_cholmod_change_factor.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Core/cholmod_change_factor.c -o $@ cholmod_memory.o: ../Core/cholmod_memory.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Core/cholmod_memory.c -o $@ cholmod_sparse.o: ../Core/cholmod_sparse.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Core/cholmod_sparse.c -o $@ cholmod_complex.o: ../Core/cholmod_complex.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Core/cholmod_complex.c -o $@ cholmod_transpose.o: ../Core/cholmod_transpose.c ../Core/t_cholmod_transpose.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Core/cholmod_transpose.c -o $@ cholmod_band.o: ../Core/cholmod_band.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Core/cholmod_band.c -o $@ cholmod_copy.o: ../Core/cholmod_copy.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Core/cholmod_copy.c -o $@ cholmod_triplet.o: ../Core/cholmod_triplet.c ../Core/t_cholmod_triplet.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Core/cholmod_triplet.c -o $@ cholmod_error.o: ../Core/cholmod_error.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Core/cholmod_error.c -o $@ cholmod_aat.o: ../Core/cholmod_aat.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Core/cholmod_aat.c -o $@ cholmod_add.o: ../Core/cholmod_add.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Core/cholmod_add.c -o $@ cholmod_version.o: ../Core/cholmod_version.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Core/cholmod_version.c -o $@ #------------------------------------------------------------------------------- cholmod_l_common.o: ../Core/cholmod_common.c $(C) -DDLONG -c $(I) ../Core/cholmod_common.c -o $@ cholmod_l_dense.o: ../Core/cholmod_dense.c ../Core/t_cholmod_dense.c $(C) -DDLONG -c $(I) ../Core/cholmod_dense.c -o $@ cholmod_l_factor.o: ../Core/cholmod_factor.c $(C) -DDLONG -c $(I) ../Core/cholmod_factor.c -o $@ cholmod_l_change_factor.o: ../Core/cholmod_change_factor.c \ ../Core/t_cholmod_change_factor.c $(C) -DDLONG -c $(I) ../Core/cholmod_change_factor.c -o $@ cholmod_l_memory.o: ../Core/cholmod_memory.c $(C) -DDLONG -c $(I) ../Core/cholmod_memory.c -o $@ cholmod_l_sparse.o: ../Core/cholmod_sparse.c $(C) -DDLONG -c $(I) ../Core/cholmod_sparse.c -o $@ cholmod_l_complex.o: ../Core/cholmod_complex.c $(C) -DDLONG -c $(I) ../Core/cholmod_complex.c -o $@ cholmod_l_transpose.o: ../Core/cholmod_transpose.c ../Core/t_cholmod_transpose.c $(C) -DDLONG -c $(I) ../Core/cholmod_transpose.c -o $@ cholmod_l_band.o: ../Core/cholmod_band.c $(C) -DDLONG -c $(I) ../Core/cholmod_band.c -o $@ cholmod_l_copy.o: ../Core/cholmod_copy.c $(C) -DDLONG -c $(I) ../Core/cholmod_copy.c -o $@ cholmod_l_triplet.o: ../Core/cholmod_triplet.c ../Core/t_cholmod_triplet.c $(C) -DDLONG -c $(I) ../Core/cholmod_triplet.c -o $@ cholmod_l_error.o: ../Core/cholmod_error.c $(C) -DDLONG -c $(I) ../Core/cholmod_error.c -o $@ cholmod_l_aat.o: ../Core/cholmod_aat.c $(C) -DDLONG -c $(I) ../Core/cholmod_aat.c -o $@ cholmod_l_add.o: ../Core/cholmod_add.c $(C) -DDLONG -c $(I) ../Core/cholmod_add.c -o $@ cholmod_l_version.o: ../Core/cholmod_version.c $(C) -DDLONG -c $(I) ../Core/cholmod_version.c -o $@ #------------------------------------------------------------------------------- # Cholesky Module: #------------------------------------------------------------------------------- cholmod_amd.o: ../Cholesky/cholmod_amd.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Cholesky/cholmod_amd.c -o $@ cholmod_analyze.o: ../Cholesky/cholmod_analyze.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Cholesky/cholmod_analyze.c -o $@ cholmod_colamd.o: ../Cholesky/cholmod_colamd.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Cholesky/cholmod_colamd.c -o $@ cholmod_etree.o: ../Cholesky/cholmod_etree.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Cholesky/cholmod_etree.c -o $@ cholmod_factorize.o: ../Cholesky/cholmod_factorize.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Cholesky/cholmod_factorize.c -o $@ cholmod_postorder.o: ../Cholesky/cholmod_postorder.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Cholesky/cholmod_postorder.c -o $@ cholmod_rcond.o: ../Cholesky/cholmod_rcond.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Cholesky/cholmod_rcond.c -o $@ cholmod_resymbol.o: ../Cholesky/cholmod_resymbol.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Cholesky/cholmod_resymbol.c -o $@ cholmod_rowcolcounts.o: ../Cholesky/cholmod_rowcolcounts.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Cholesky/cholmod_rowcolcounts.c -o $@ cholmod_solve.o: ../Cholesky/cholmod_solve.c ../Cholesky/t_cholmod_lsolve.c \ ../Cholesky/t_cholmod_ltsolve.c ../Cholesky/t_cholmod_solve.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Cholesky/cholmod_solve.c -o $@ cholmod_spsolve.o: ../Cholesky/cholmod_spsolve.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Cholesky/cholmod_spsolve.c -o $@ cholmod_rowfac.o: ../Cholesky/cholmod_rowfac.c ../Cholesky/t_cholmod_rowfac.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Cholesky/cholmod_rowfac.c -o $@ #------------------------------------------------------------------------------- cholmod_l_amd.o: ../Cholesky/cholmod_amd.c $(C) -DDLONG -c $(I) ../Cholesky/cholmod_amd.c -o $@ cholmod_l_analyze.o: ../Cholesky/cholmod_analyze.c $(C) -DDLONG -c $(I) ../Cholesky/cholmod_analyze.c -o $@ cholmod_l_colamd.o: ../Cholesky/cholmod_colamd.c $(C) -DDLONG -c $(I) ../Cholesky/cholmod_colamd.c -o $@ cholmod_l_etree.o: ../Cholesky/cholmod_etree.c $(C) -DDLONG -c $(I) ../Cholesky/cholmod_etree.c -o $@ cholmod_l_factorize.o: ../Cholesky/cholmod_factorize.c $(C) -DDLONG -c $(I) ../Cholesky/cholmod_factorize.c -o $@ cholmod_l_postorder.o: ../Cholesky/cholmod_postorder.c $(C) -DDLONG -c $(I) ../Cholesky/cholmod_postorder.c -o $@ cholmod_l_rcond.o: ../Cholesky/cholmod_rcond.c $(C) -DDLONG -c $(I) ../Cholesky/cholmod_rcond.c -o $@ cholmod_l_resymbol.o: ../Cholesky/cholmod_resymbol.c $(C) -DDLONG -c $(I) ../Cholesky/cholmod_resymbol.c -o $@ cholmod_l_rowcolcounts.o: ../Cholesky/cholmod_rowcolcounts.c $(C) -DDLONG -c $(I) ../Cholesky/cholmod_rowcolcounts.c -o $@ cholmod_l_solve.o: ../Cholesky/cholmod_solve.c ../Cholesky/t_cholmod_lsolve.c \ ../Cholesky/t_cholmod_ltsolve.c ../Cholesky/t_cholmod_solve.c $(C) -DDLONG -c $(I) ../Cholesky/cholmod_solve.c -o $@ cholmod_l_spsolve.o: ../Cholesky/cholmod_spsolve.c $(C) -DDLONG -c $(I) ../Cholesky/cholmod_spsolve.c -o $@ cholmod_l_rowfac.o: ../Cholesky/cholmod_rowfac.c ../Cholesky/t_cholmod_rowfac.c $(C) -DDLONG -c $(I) ../Cholesky/cholmod_rowfac.c -o $@ #------------------------------------------------------------------------------- # Partition Module: #------------------------------------------------------------------------------- cholmod_ccolamd.o: ../Partition/cholmod_ccolamd.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Partition/cholmod_ccolamd.c -o $@ cholmod_csymamd.o: ../Partition/cholmod_csymamd.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Partition/cholmod_csymamd.c -o $@ cholmod_camd.o: ../Partition/cholmod_camd.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Partition/cholmod_camd.c -o $@ cholmod_metis.o: ../Partition/cholmod_metis.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Partition/cholmod_metis.c -o $@ cholmod_nesdis.o: ../Partition/cholmod_nesdis.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Partition/cholmod_nesdis.c -o $@ #------------------------------------------------------------------------------- cholmod_l_ccolamd.o: ../Partition/cholmod_ccolamd.c $(C) -DDLONG -c $(I) ../Partition/cholmod_ccolamd.c -o $@ cholmod_l_csymamd.o: ../Partition/cholmod_csymamd.c $(C) -DDLONG -c $(I) ../Partition/cholmod_csymamd.c -o $@ cholmod_l_camd.o: ../Partition/cholmod_camd.c $(C) -DDLONG -c $(I) ../Partition/cholmod_camd.c -o $@ cholmod_l_metis.o: ../Partition/cholmod_metis.c $(C) -DDLONG -c $(I) ../Partition/cholmod_metis.c -o $@ cholmod_l_nesdis.o: ../Partition/cholmod_nesdis.c $(C) -DDLONG -c $(I) ../Partition/cholmod_nesdis.c -o $@ #------------------------------------------------------------------------------- # MatrixOps Module: #------------------------------------------------------------------------------- cholmod_horzcat.o: ../MatrixOps/cholmod_horzcat.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../MatrixOps/cholmod_horzcat.c -o $@ cholmod_norm.o: ../MatrixOps/cholmod_norm.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../MatrixOps/cholmod_norm.c -o $@ cholmod_scale.o: ../MatrixOps/cholmod_scale.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../MatrixOps/cholmod_scale.c -o $@ cholmod_drop.o: ../MatrixOps/cholmod_drop.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../MatrixOps/cholmod_drop.c -o $@ cholmod_sdmult.o: ../MatrixOps/cholmod_sdmult.c \ ../MatrixOps/t_cholmod_sdmult.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../MatrixOps/cholmod_sdmult.c -o $@ cholmod_ssmult.o: ../MatrixOps/cholmod_ssmult.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../MatrixOps/cholmod_ssmult.c -o $@ cholmod_submatrix.o: ../MatrixOps/cholmod_submatrix.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../MatrixOps/cholmod_submatrix.c -o $@ cholmod_vertcat.o: ../MatrixOps/cholmod_vertcat.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../MatrixOps/cholmod_vertcat.c -o $@ cholmod_symmetry.o: ../MatrixOps/cholmod_symmetry.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../MatrixOps/cholmod_symmetry.c -o $@ #------------------------------------------------------------------------------- cholmod_l_horzcat.o: ../MatrixOps/cholmod_horzcat.c $(C) -DDLONG -c $(I) ../MatrixOps/cholmod_horzcat.c -o $@ cholmod_l_norm.o: ../MatrixOps/cholmod_norm.c $(C) -DDLONG -c $(I) ../MatrixOps/cholmod_norm.c -o $@ cholmod_l_scale.o: ../MatrixOps/cholmod_scale.c $(C) -DDLONG -c $(I) ../MatrixOps/cholmod_scale.c -o $@ cholmod_l_drop.o: ../MatrixOps/cholmod_drop.c $(C) -DDLONG -c $(I) ../MatrixOps/cholmod_drop.c -o $@ cholmod_l_sdmult.o: ../MatrixOps/cholmod_sdmult.c \ ../MatrixOps/t_cholmod_sdmult.c $(C) -DDLONG -c $(I) ../MatrixOps/cholmod_sdmult.c -o $@ cholmod_l_ssmult.o: ../MatrixOps/cholmod_ssmult.c $(C) -DDLONG -c $(I) ../MatrixOps/cholmod_ssmult.c -o $@ cholmod_l_submatrix.o: ../MatrixOps/cholmod_submatrix.c $(C) -DDLONG -c $(I) ../MatrixOps/cholmod_submatrix.c -o $@ cholmod_l_vertcat.o: ../MatrixOps/cholmod_vertcat.c $(C) -DDLONG -c $(I) ../MatrixOps/cholmod_vertcat.c -o $@ cholmod_l_symmetry.o: ../MatrixOps/cholmod_symmetry.c $(C) -DDLONG -c $(I) ../MatrixOps/cholmod_symmetry.c -o $@ #------------------------------------------------------------------------------- # Modify Module: #------------------------------------------------------------------------------- cholmod_rowadd.o: ../Modify/cholmod_rowadd.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Modify/cholmod_rowadd.c -o $@ cholmod_rowdel.o: ../Modify/cholmod_rowdel.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Modify/cholmod_rowdel.c -o $@ cholmod_updown.o: ../Modify/cholmod_updown.c \ ../Modify/t_cholmod_updown.c ../Modify/t_cholmod_updown_numkr.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Modify/cholmod_updown.c -o $@ #------------------------------------------------------------------------------- cholmod_l_rowadd.o: ../Modify/cholmod_rowadd.c $(C) -DDLONG -c $(I) ../Modify/cholmod_rowadd.c -o $@ cholmod_l_rowdel.o: ../Modify/cholmod_rowdel.c $(C) -DDLONG -c $(I) ../Modify/cholmod_rowdel.c -o $@ cholmod_l_updown.o: ../Modify/cholmod_updown.c \ ../Modify/t_cholmod_updown.c ../Modify/t_cholmod_updown_numkr.c $(C) -DDLONG -c $(I) ../Modify/cholmod_updown.c -o $@ #------------------------------------------------------------------------------- # Supernodal Module: #------------------------------------------------------------------------------- cholmod_super_numeric.o: ../Supernodal/cholmod_super_numeric.c \ ../Supernodal/t_cholmod_gpu.c \ ../Supernodal/t_cholmod_super_numeric.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Supernodal/cholmod_super_numeric.c -o $@ cholmod_super_symbolic.o: ../Supernodal/cholmod_super_symbolic.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Supernodal/cholmod_super_symbolic.c -o $@ cholmod_super_solve.o: ../Supernodal/cholmod_super_solve.c \ ../Supernodal/t_cholmod_super_solve.c $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c ../Supernodal/cholmod_super_solve.c -o $@ #------------------------------------------------------------------------------- cholmod_l_super_numeric.o: ../Supernodal/cholmod_super_numeric.c \ ../Supernodal/t_cholmod_super_numeric.c $(C) -DDLONG -c $(I) ../Supernodal/cholmod_super_numeric.c -o $@ cholmod_l_super_symbolic.o: ../Supernodal/cholmod_super_symbolic.c $(C) -DDLONG -c $(I) ../Supernodal/cholmod_super_symbolic.c -o $@ cholmod_l_super_solve.o: ../Supernodal/cholmod_super_solve.c \ ../Supernodal/t_cholmod_super_solve.c $(C) -DDLONG -c $(I) ../Supernodal/cholmod_super_solve.c -o $@ Matrix/src/CHOLMOD/MatrixOps/0000755000176200001440000000000014154165363015330 5ustar liggesusersMatrix/src/CHOLMOD/MatrixOps/cholmod_norm.c0000644000176200001440000002611313652535054020157 0ustar liggesusers/* ========================================================================== */ /* === MatrixOps/cholmod_norm =============================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/MatrixOps Module. Copyright (C) 2005-2006, Timothy A. Davis * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* r = norm (A), compute the infinity-norm, 1-norm, or 2-norm of a sparse or * dense matrix. Can compute the 2-norm only for a dense column vector. * Returns -1 if an error occurs. * * Pattern, real, complex, and zomplex sparse matrices are supported. */ #ifndef NGPL #ifndef NMATRIXOPS #include "cholmod_internal.h" #include "cholmod_matrixops.h" /* ========================================================================== */ /* === abs_value ============================================================ */ /* ========================================================================== */ /* Compute the absolute value of a real, complex, or zomplex value */ static double abs_value ( int xtype, double *Ax, double *Az, Int p, cholmod_common *Common ) { double s = 0 ; switch (xtype) { case CHOLMOD_PATTERN: s = 1 ; break ; case CHOLMOD_REAL: s = fabs (Ax [p]) ; break ; case CHOLMOD_COMPLEX: s = SuiteSparse_config.hypot_func (Ax [2*p], Ax [2*p+1]) ; break ; case CHOLMOD_ZOMPLEX: s = SuiteSparse_config.hypot_func (Ax [p], Az [p]) ; break ; } return (s) ; } /* ========================================================================== */ /* === cholmod_norm_dense =================================================== */ /* ========================================================================== */ double CHOLMOD(norm_dense) ( /* ---- input ---- */ cholmod_dense *X, /* matrix to compute the norm of */ int norm, /* type of norm: 0: inf. norm, 1: 1-norm, 2: 2-norm */ /* --------------- */ cholmod_common *Common ) { double xnorm, s, x, z ; double *Xx, *Xz, *W ; Int nrow, ncol, d, i, j, use_workspace, xtype ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (EMPTY) ; RETURN_IF_NULL (X, EMPTY) ; RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, EMPTY) ; Common->status = CHOLMOD_OK ; ncol = X->ncol ; if (norm < 0 || norm > 2 || (norm == 2 && ncol > 1)) { ERROR (CHOLMOD_INVALID, "invalid norm") ; return (EMPTY) ; } /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ nrow = X->nrow ; d = X->d ; Xx = X->x ; Xz = X->z ; xtype = X->xtype ; /* ---------------------------------------------------------------------- */ /* allocate workspace, if needed */ /* ---------------------------------------------------------------------- */ W = NULL ; use_workspace = (norm == 0 && ncol > 4) ; if (use_workspace) { CHOLMOD(allocate_work) (0, 0, nrow, Common) ; W = Common->Xwork ; if (Common->status < CHOLMOD_OK) { /* oops, no workspace */ use_workspace = FALSE ; } } /* ---------------------------------------------------------------------- */ /* compute the norm */ /* ---------------------------------------------------------------------- */ xnorm = 0 ; if (use_workspace) { /* ------------------------------------------------------------------ */ /* infinity-norm = max row sum, using stride-1 access of X */ /* ------------------------------------------------------------------ */ DEBUG (for (i = 0 ; i < nrow ; i++) ASSERT (W [i] == 0)) ; /* this is faster than stride-d, but requires O(nrow) workspace */ for (j = 0 ; j < ncol ; j++) { for (i = 0 ; i < nrow ; i++) { W [i] += abs_value (xtype, Xx, Xz, i+j*d, Common) ; } } for (i = 0 ; i < nrow ; i++) { s = W [i] ; if ((IS_NAN (s) || s > xnorm) && !IS_NAN (xnorm)) { xnorm = s ; } W [i] = 0 ; } } else if (norm == 0) { /* ------------------------------------------------------------------ */ /* infinity-norm = max row sum, using stride-d access of X */ /* ------------------------------------------------------------------ */ for (i = 0 ; i < nrow ; i++) { s = 0 ; for (j = 0 ; j < ncol ; j++) { s += abs_value (xtype, Xx, Xz, i+j*d, Common) ; } if ((IS_NAN (s) || s > xnorm) && !IS_NAN (xnorm)) { xnorm = s ; } } } else if (norm == 1) { /* ------------------------------------------------------------------ */ /* 1-norm = max column sum */ /* ------------------------------------------------------------------ */ for (j = 0 ; j < ncol ; j++) { s = 0 ; for (i = 0 ; i < nrow ; i++) { s += abs_value (xtype, Xx, Xz, i+j*d, Common) ; } if ((IS_NAN (s) || s > xnorm) && !IS_NAN (xnorm)) { xnorm = s ; } } } else { /* ------------------------------------------------------------------ */ /* 2-norm = sqrt (sum (X.^2)) */ /* ------------------------------------------------------------------ */ switch (xtype) { case CHOLMOD_REAL: for (i = 0 ; i < nrow ; i++) { x = Xx [i] ; xnorm += x*x ; } break ; case CHOLMOD_COMPLEX: for (i = 0 ; i < nrow ; i++) { x = Xx [2*i ] ; z = Xx [2*i+1] ; xnorm += x*x + z*z ; } break ; case CHOLMOD_ZOMPLEX: for (i = 0 ; i < nrow ; i++) { x = Xx [i] ; z = Xz [i] ; xnorm += x*x + z*z ; } break ; } xnorm = sqrt (xnorm) ; } /* ---------------------------------------------------------------------- */ /* return result */ /* ---------------------------------------------------------------------- */ return (xnorm) ; } /* ========================================================================== */ /* === cholmod_norm_sparse ================================================== */ /* ========================================================================== */ double CHOLMOD(norm_sparse) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to compute the norm of */ int norm, /* type of norm: 0: inf. norm, 1: 1-norm */ /* --------------- */ cholmod_common *Common ) { double anorm, s ; double *Ax, *Az, *W ; Int *Ap, *Ai, *Anz ; Int i, j, p, pend, nrow, ncol, packed, xtype ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (EMPTY) ; RETURN_IF_NULL (A, EMPTY) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, EMPTY) ; Common->status = CHOLMOD_OK ; ncol = A->ncol ; nrow = A->nrow ; if (norm < 0 || norm > 1) { ERROR (CHOLMOD_INVALID, "invalid norm") ; return (EMPTY) ; } if (A->stype && nrow != ncol) { ERROR (CHOLMOD_INVALID, "matrix invalid") ; return (EMPTY) ; } /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ Ap = A->p ; Ai = A->i ; Ax = A->x ; Az = A->z ; Anz = A->nz ; packed = A->packed ; xtype = A->xtype ; /* ---------------------------------------------------------------------- */ /* allocate workspace, if needed */ /* ---------------------------------------------------------------------- */ W = NULL ; if (A->stype || norm == 0) { CHOLMOD(allocate_work) (0, 0, nrow, Common) ; W = Common->Xwork ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (EMPTY) ; } DEBUG (for (i = 0 ; i < nrow ; i++) ASSERT (W [i] == 0)) ; } /* ---------------------------------------------------------------------- */ /* compute the norm */ /* ---------------------------------------------------------------------- */ anorm = 0 ; if (A->stype > 0) { /* ------------------------------------------------------------------ */ /* A is symmetric with upper triangular part stored */ /* ------------------------------------------------------------------ */ /* infinity-norm = 1-norm = max row/col sum */ for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; s = abs_value (xtype, Ax, Az, p, Common) ; if (i == j) { W [i] += s ; } else if (i < j) { W [i] += s ; W [j] += s ; } } } } else if (A->stype < 0) { /* ------------------------------------------------------------------ */ /* A is symmetric with lower triangular part stored */ /* ------------------------------------------------------------------ */ /* infinity-norm = 1-norm = max row/col sum */ for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; s = abs_value (xtype, Ax, Az, p, Common) ; if (i == j) { W [i] += s ; } else if (i > j) { W [i] += s ; W [j] += s ; } } } } else if (norm == 0) { /* ------------------------------------------------------------------ */ /* A is unsymmetric, compute the infinity-norm */ /* ------------------------------------------------------------------ */ /* infinity-norm = max row sum */ for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { W [Ai [p]] += abs_value (xtype, Ax, Az, p, Common) ; } } } else { /* ------------------------------------------------------------------ */ /* A is unsymmetric, compute the 1-norm */ /* ------------------------------------------------------------------ */ /* 1-norm = max column sum */ for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; if (xtype == CHOLMOD_PATTERN) { s = pend - p ; } else { s = 0 ; for ( ; p < pend ; p++) { s += abs_value (xtype, Ax, Az, p, Common) ; } } if ((IS_NAN (s) || s > anorm) && !IS_NAN (anorm)) { anorm = s ; } } } /* ---------------------------------------------------------------------- */ /* compute the max row sum */ /* ---------------------------------------------------------------------- */ if (A->stype || norm == 0) { for (i = 0 ; i < nrow ; i++) { s = W [i] ; if ((IS_NAN (s) || s > anorm) && !IS_NAN (anorm)) { anorm = s ; } W [i] = 0 ; } } /* ---------------------------------------------------------------------- */ /* return result */ /* ---------------------------------------------------------------------- */ return (anorm) ; } #endif #endif Matrix/src/CHOLMOD/MatrixOps/cholmod_horzcat.c0000644000176200001440000001371213652535054020657 0ustar liggesusers/* ========================================================================== */ /* === MatrixOps/cholmod_horzcat ============================================ */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/MatrixOps Module. Copyright (C) 2005-2006, Timothy A. Davis * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* Horizontal concatenation, C = [A , B] in MATLAB notation. * * A and B can be up/lo/unsym; C is unsymmetric and packed. * A and B must have the same number of rows. * C is sorted if both A and B are sorted. * * workspace: Iwork (max (A->nrow, A->ncol, B->nrow, B->ncol)). * allocates temporary copies of A and B if they are symmetric. * * A and B must have the same numeric xtype, unless values is FALSE. * A and B cannot be complex or zomplex, unless values is FALSE. */ #ifndef NGPL #ifndef NMATRIXOPS #include "cholmod_internal.h" #include "cholmod_matrixops.h" /* ========================================================================== */ /* === cholmod_horzcat ====================================================== */ /* ========================================================================== */ cholmod_sparse *CHOLMOD(horzcat) ( /* ---- input ---- */ cholmod_sparse *A, /* left matrix to concatenate */ cholmod_sparse *B, /* right matrix to concatenate */ int values, /* if TRUE compute the numerical values of C */ /* --------------- */ cholmod_common *Common ) { double *Ax, *Bx, *Cx ; Int *Ap, *Ai, *Anz, *Bp, *Bi, *Bnz, *Cp, *Ci ; cholmod_sparse *C, *A2, *B2 ; Int apacked, bpacked, ancol, bncol, ncol, nrow, anz, bnz, nz, j, p, pend, pdest ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (A, NULL) ; RETURN_IF_NULL (B, NULL) ; values = values && (A->xtype != CHOLMOD_PATTERN) && (B->xtype != CHOLMOD_PATTERN) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ; RETURN_IF_XTYPE_INVALID (B, CHOLMOD_PATTERN, values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ; if (A->nrow != B->nrow) { /* A and B must have the same number of rows */ ERROR (CHOLMOD_INVALID, "A and B must have same # rows") ; return (NULL) ; } /* A and B must have the same numerical type if values is TRUE (both must * be CHOLMOD_REAL, this is implicitly checked above) */ Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ ancol = A->ncol ; bncol = B->ncol ; nrow = A->nrow ; CHOLMOD(allocate_work) (0, MAX3 (nrow, ancol, bncol), 0, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (NULL) ; } /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ /* convert A to unsymmetric, if necessary */ A2 = NULL ; if (A->stype != 0) { /* workspace: Iwork (max (A->nrow,A->ncol)) */ A2 = CHOLMOD(copy) (A, 0, values, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (NULL) ; } A = A2 ; } /* convert B to unsymmetric, if necessary */ B2 = NULL ; if (B->stype != 0) { /* workspace: Iwork (max (B->nrow,B->ncol)) */ B2 = CHOLMOD(copy) (B, 0, values, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ CHOLMOD(free_sparse) (&A2, Common) ; return (NULL) ; } B = B2 ; } Ap = A->p ; Anz = A->nz ; Ai = A->i ; Ax = A->x ; apacked = A->packed ; Bp = B->p ; Bnz = B->nz ; Bi = B->i ; Bx = B->x ; bpacked = B->packed ; /* ---------------------------------------------------------------------- */ /* allocate C */ /* ---------------------------------------------------------------------- */ anz = CHOLMOD(nnz) (A, Common) ; bnz = CHOLMOD(nnz) (B, Common) ; ncol = ancol + bncol ; nz = anz + bnz ; C = CHOLMOD(allocate_sparse) (nrow, ncol, nz, A->sorted && B->sorted, TRUE, 0, values ? A->xtype : CHOLMOD_PATTERN, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ CHOLMOD(free_sparse) (&A2, Common) ; CHOLMOD(free_sparse) (&B2, Common) ; return (NULL) ; } Cp = C->p ; Ci = C->i ; Cx = C->x ; /* ---------------------------------------------------------------------- */ /* C = [A , B] */ /* ---------------------------------------------------------------------- */ pdest = 0 ; /* copy A as the first A->ncol columns of C */ for (j = 0 ; j < ancol ; j++) { /* A(:,j) is the jth column of C */ p = Ap [j] ; pend = (apacked) ? (Ap [j+1]) : (p + Anz [j]) ; Cp [j] = pdest ; for ( ; p < pend ; p++) { Ci [pdest] = Ai [p] ; if (values) Cx [pdest] = Ax [p] ; pdest++ ; } } /* copy B as the next B->ncol columns of C */ for (j = 0 ; j < bncol ; j++) { /* B(:,j) is the (ancol+j)th column of C */ p = Bp [j] ; pend = (bpacked) ? (Bp [j+1]) : (p + Bnz [j]) ; Cp [ancol + j] = pdest ; for ( ; p < pend ; p++) { Ci [pdest] = Bi [p] ; if (values) Cx [pdest] = Bx [p] ; pdest++ ; } } Cp [ncol] = pdest ; ASSERT (pdest == anz + bnz) ; /* ---------------------------------------------------------------------- */ /* free the unsymmetric copies of A and B, and return C */ /* ---------------------------------------------------------------------- */ CHOLMOD(free_sparse) (&A2, Common) ; CHOLMOD(free_sparse) (&B2, Common) ; return (C) ; } #endif #endif Matrix/src/CHOLMOD/MatrixOps/cholmod_symmetry.c0000644000176200001440000003767213652535054021111 0ustar liggesusers/* ========================================================================== */ /* === MatrixOps/cholmod_symmetry =========================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/MatrixOps Module. Copyright (C) 2005-2006, Timothy A. Davis * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* Determines if a sparse matrix is rectangular, unsymmetric, symmetric, * skew-symmetric, or Hermitian. It does so by looking at its numerical values * of both upper and lower triangular parts of a CHOLMOD "unsymmetric" * matrix, where A->stype == 0. The transpose of A is NOT constructed. * * If not unsymmetric, it also determines if the matrix has a diagonal whose * entries are all real and positive (and thus a candidate for sparse Cholesky * if A->stype is changed to a nonzero value). * * Note that a Matrix Market "general" matrix is either rectangular or * unsymmetric. * * The row indices in the column of each matrix MUST be sorted for this function * to work properly (A->sorted must be TRUE). This routine returns EMPTY if * A->stype is not zero, or if A->sorted is FALSE. The exception to this rule * is if A is rectangular. * * If option == 0, then this routine returns immediately when it finds a * non-positive diagonal entry (or one with nonzero imaginary part). If the * matrix is not a candidate for sparse Cholesky, it returns the value * CHOLMOD_MM_UNSYMMETRIC, even if the matrix might in fact be symmetric or * Hermitian. * * This routine is useful inside the MATLAB backslash, which must look at an * arbitrary matrix (A->stype == 0) and determine if it is a candidate for * sparse Cholesky. In that case, option should be 0. * * This routine is also useful when writing a MATLAB matrix to a file in * Rutherford/Boeing or Matrix Market format. Those formats require a * determination as to the symmetry of the matrix, and thus this routine should * not return upon encountering the first non-positive diagonal. In this case, * option should be 1. * * If option is 2, this function can be used to compute the numerical and * pattern symmetry, where 0 is a completely unsymmetric matrix, and 1 is a * perfectly symmetric matrix. This option is used when computing the following * statistics for the matrices in the UF Sparse Matrix Collection. * * numerical symmetry: number of matched offdiagonal nonzeros over * the total number of offdiagonal entries. A real entry A(i,j), i ~= j, * is matched if A (j,i) == A (i,j), but this is only counted if both * A(j,i) and A(i,j) are nonzero. This does not depend on Z. * (If A is complex, then the above test is modified; A (i,j) is matched * if conj (A (j,i)) == A (i,j)). * * Then numeric symmetry = xmatched / nzoffdiag, or 1 if nzoffdiag = 0. * * pattern symmetry: number of matched offdiagonal entries over the * total number of offdiagonal entries. An entry A(i,j), i ~= j, is * matched if A (j,i) is also an entry. * * Then pattern symmetry = pmatched / nzoffdiag, or 1 if nzoffdiag = 0. * * The symmetry of a matrix with no offdiagonal entries is equal to 1. * * A workspace of size ncol integers is allocated; EMPTY is returned if this * allocation fails. * * Summary of return values: * * EMPTY (-1) out of memory, stype not zero, A not sorted * CHOLMOD_MM_RECTANGULAR 1 A is rectangular * CHOLMOD_MM_UNSYMMETRIC 2 A is unsymmetric * CHOLMOD_MM_SYMMETRIC 3 A is symmetric, but with non-pos. diagonal * CHOLMOD_MM_HERMITIAN 4 A is Hermitian, but with non-pos. diagonal * CHOLMOD_MM_SKEW_SYMMETRIC 5 A is skew symmetric * CHOLMOD_MM_SYMMETRIC_POSDIAG 6 A is symmetric with positive diagonal * CHOLMOD_MM_HERMITIAN_POSDIAG 7 A is Hermitian with positive diagonal * * See also the spsym mexFunction, which is a MATLAB interface for this code. * * If the matrix is a candidate for sparse Cholesky, it will return a result * CHOLMOD_MM_SYMMETRIC_POSDIAG if real, or CHOLMOD_MM_HERMITIAN_POSDIAG if * complex. Otherwise, it will return a value less than this. This is true * regardless of the value of the option parameter. */ #ifndef NGPL #ifndef NMATRIXOPS #include "cholmod_internal.h" #include "cholmod_matrixops.h" /* ========================================================================== */ /* === get_value ============================================================ */ /* ========================================================================== */ /* Get the pth value in the matrix. */ static void get_value ( double *Ax, /* real values, or real/imag. for CHOLMOD_COMPLEX type */ double *Az, /* imaginary values for CHOLMOD_ZOMPLEX type */ Int p, /* get the pth entry */ Int xtype, /* A->xtype: pattern, real, complex, or zomplex */ double *x, /* the real part */ double *z /* the imaginary part */ ) { switch (xtype) { case CHOLMOD_PATTERN: *x = 1 ; *z = 0 ; break ; case CHOLMOD_REAL: *x = Ax [p] ; *z = 0 ; break ; case CHOLMOD_COMPLEX: *x = Ax [2*p] ; *z = Ax [2*p+1] ; break ; case CHOLMOD_ZOMPLEX: *x = Ax [p] ; *z = Az [p] ; break ; } } /* ========================================================================== */ /* === cholmod_symmetry ===================================================== */ /* ========================================================================== */ /* Determine the symmetry of a matrix, and check its diagonal. * * option 0: Do not count # of matched pairs. Quick return if the * the matrix has a zero, negative, or imaginary diagonal entry. * * option 1: Do not count # of matched pairs. Do not return quickly if * the matrix has a zero, negative, or imaginary diagonal entry. * The result 1 to 7 is accurately computed: * * EMPTY (-1) out of memory, stype not zero, A not sorted * CHOLMOD_MM_RECTANGULAR 1 A is rectangular * CHOLMOD_MM_UNSYMMETRIC 2 A is unsymmetric * CHOLMOD_MM_SYMMETRIC 3 A is symmetric, with non-pos. diagonal * CHOLMOD_MM_HERMITIAN 4 A is Hermitian, with non-pos. diagonal * CHOLMOD_MM_SKEW_SYMMETRIC 5 A is skew symmetric * CHOLMOD_MM_SYMMETRIC_POSDIAG 6 is symmetric with positive diagonal * CHOLMOD_MM_HERMITIAN_POSDIAG 7 A is Hermitian with positive diagonal * * The routine returns as soon as the above is determined (that is, it * can return as soon as it determines the matrix is unsymmetric). * * option 2: All of the above, but also compute the number of matched off- * diagonal entries (of two types). xmatched is the number of * nonzero entries for which A(i,j) = conj(A(j,i)). pmatched is * the number of entries (i,j) for which A(i,j) and A(j,i) are both in * the pattern of A (the value doesn't matter). nzoffdiag is the total * number of off-diagonal entries in the pattern. nzdiag is the number of * diagonal entries in the pattern. * * With option 0 or 1, or if the matrix is rectangular, xmatched, pmatched, * nzoffdiag, and nzdiag are not computed. * * Note that a matched pair, A(i,j) and A(j,i) for i != j, is counted twice * (once per entry). */ int CHOLMOD(symmetry) ( /* ---- input ---- */ cholmod_sparse *A, int option, /* option 0, 1, or 2 (see above) */ /* ---- output --- */ /* outputs ignored if any are NULL */ Int *p_xmatched, /* # of matched numerical entries */ Int *p_pmatched, /* # of matched entries in pattern */ Int *p_nzoffdiag, /* # of off diagonal entries */ Int *p_nzdiag, /* # of diagonal entries */ /* --------------- */ cholmod_common *Common ) { double aij_real = 0, aij_imag = 0, aji_real = 0, aji_imag = 0 ; double *Ax, *Az ; Int *Ap, *Ai, *Anz, *munch ; Int packed, nrow, ncol, xtype, is_symmetric, is_skew, is_hermitian, posdiag, j, p, pend, i, piend, result, xmatched, pmatched, nzdiag, i2, found ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (EMPTY) ; RETURN_IF_NULL (A, EMPTY) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, EMPTY) ; Common->status = CHOLMOD_OK ; ASSERT (CHOLMOD(dump_sparse) (A, "cholmod_symmetry", Common) >= 0) ; if (p_xmatched == NULL || p_pmatched == NULL || p_nzoffdiag == NULL || p_nzdiag == NULL) { /* option 2 is not performed if any output parameter is NULL */ option = MAX (option, 1) ; } /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ Ap = A->p ; Ai = A->i ; Ax = A->x ; Az = A->z ; Anz = A->nz ; packed = A->packed ; ncol = A->ncol ; nrow = A->nrow ; xtype = A->xtype ; /* ---------------------------------------------------------------------- */ /* check if rectangular, unsorted, or stype is not zero */ /* ---------------------------------------------------------------------- */ if (nrow != ncol) { /* matrix is rectangular */ return (CHOLMOD_MM_RECTANGULAR) ; } if (!(A->sorted) || A->stype != 0) { /* this function cannot determine the type or symmetry */ return (EMPTY) ; } /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* this function requires uninitialized Int workspace of size ncol */ CHOLMOD(allocate_work) (0, ncol, 0, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (EMPTY) ; } munch = Common->Iwork ; /* the munch array is size ncol */ /* ---------------------------------------------------------------------- */ /* determine symmetry of a square matrix */ /* ---------------------------------------------------------------------- */ /* a complex or zomplex matrix is Hermitian until proven otherwise */ is_hermitian = (xtype >= CHOLMOD_COMPLEX) ; /* any matrix is symmetric until proven otherwise */ is_symmetric = TRUE ; /* a non-pattern matrix is skew-symmetric until proven otherwise */ is_skew = (xtype != CHOLMOD_PATTERN) ; /* a matrix has positive diagonal entries until proven otherwise */ posdiag = TRUE ; /* munch pointers start at the top of each column */ for (j = 0 ; j < ncol ; j++) { munch [j] = Ap [j] ; } xmatched = 0 ; pmatched = 0 ; nzdiag = 0 ; for (j = 0 ; j < ncol ; j++) /* examine each column of A */ { /* ------------------------------------------------------------------ */ /* look at the entire munch column j */ /* ------------------------------------------------------------------ */ /* start at the munch point of column j, and go to end of the column */ p = munch [j] ; pend = (packed) ? (Ap [j+1]) : (Ap [j] + Anz [j]) ; for ( ; p < pend ; p++) { /* get the row index of A(i,j) */ i = Ai [p] ; if (i < j) { /* ---------------------------------------------------------- */ /* A(i,j) in triu(A), but matching A(j,i) not in tril(A) */ /* ---------------------------------------------------------- */ /* entry A(i,j) is unmatched; it appears in the upper triangular * part, but not the lower triangular part. The matrix is * unsymmetric. */ is_hermitian = FALSE ; is_symmetric = FALSE ; is_skew = FALSE ; } else if (i == j) { /* ---------------------------------------------------------- */ /* the diagonal A(j,j) is present; check its value */ /* ---------------------------------------------------------- */ get_value (Ax, Az, p, xtype, &aij_real, &aij_imag) ; if (aij_real != 0. || aij_imag != 0.) { /* diagonal is nonzero; matrix is not skew-symmetric */ nzdiag++ ; is_skew = FALSE ; } if (aij_real <= 0. || aij_imag != 0.) { /* diagonal negative or imaginary; not chol candidate */ posdiag = FALSE ; } if (aij_imag != 0.) { /* imaginary part is present; not Hermitian */ is_hermitian = FALSE ; } } else /* i > j */ { /* ---------------------------------------------------------- */ /* consider column i, up to and including row j */ /* ---------------------------------------------------------- */ /* munch the entry at top of column i up to and incl row j */ piend = (packed) ? (Ap [i+1]) : (Ap [i] + Anz [i]) ; found = FALSE ; for ( ; munch [i] < piend ; munch [i]++) { i2 = Ai [munch [i]] ; if (i2 < j) { /* -------------------------------------------------- */ /* A(i2,i) in triu(A) but A(i,i2) not in tril(A) */ /* -------------------------------------------------- */ /* The matrix is unsymmetric. */ is_hermitian = FALSE ; is_symmetric = FALSE ; is_skew = FALSE ; } else if (i2 == j) { /* -------------------------------------------------- */ /* both A(i,j) and A(j,i) exist in the matrix */ /* -------------------------------------------------- */ /* this is one more matching entry in the pattern */ pmatched += 2 ; found = TRUE ; /* get the value of A(i,j) */ get_value (Ax, Az, p, xtype, &aij_real, &aij_imag) ; /* get the value of A(j,i) */ get_value (Ax, Az, munch [i], xtype, &aji_real, &aji_imag) ; /* compare A(i,j) with A(j,i) */ if (aij_real != aji_real || aij_imag != aji_imag) { /* the matrix cannot be symmetric */ is_symmetric = FALSE ; } if (aij_real != -aji_real || aij_imag != aji_imag) { /* the matrix cannot be skew-symmetric */ is_skew = FALSE ; } if (aij_real != aji_real || aij_imag != -aji_imag) { /* the matrix cannot be Hermitian */ is_hermitian = FALSE ; } else { /* A(i,j) and A(j,i) are numerically matched */ xmatched += 2 ; } } else /* i2 > j */ { /* -------------------------------------------------- */ /* entry A(i2,i) is not munched; consider it later */ /* -------------------------------------------------- */ break ; } } if (!found) { /* A(i,j) in tril(A) but A(j,i) not in triu(A). * The matrix is unsymmetric. */ is_hermitian = FALSE ; is_symmetric = FALSE ; is_skew = FALSE ; } } if (option < 2 && !(is_symmetric || is_skew || is_hermitian)) { /* matrix is unsymmetric; terminate the test */ return (CHOLMOD_MM_UNSYMMETRIC) ; } } /* ------------------------------------------------------------------ */ /* quick return if not Cholesky candidate */ /* ------------------------------------------------------------------ */ if (option < 1 && (!posdiag || nzdiag <= j)) { /* Diagonal entry not present, or present but negative or with * nonzero imaginary part. Quick return for option 0. */ return (CHOLMOD_MM_UNSYMMETRIC) ; } } /* ---------------------------------------------------------------------- */ /* return the results */ /* ---------------------------------------------------------------------- */ if (nzdiag < ncol) { /* not all diagonal entries are present */ posdiag = FALSE ; } if (option >= 2) { *p_xmatched = xmatched ; *p_pmatched = pmatched ; *p_nzoffdiag = CHOLMOD(nnz) (A, Common) - nzdiag ; *p_nzdiag = nzdiag ; } result = CHOLMOD_MM_UNSYMMETRIC ; if (is_hermitian) { /* complex Hermitian matrix, with either pos. or non-pos. diagonal */ result = posdiag ? CHOLMOD_MM_HERMITIAN_POSDIAG : CHOLMOD_MM_HERMITIAN ; } else if (is_symmetric) { /* real or complex symmetric matrix, with pos. or non-pos. diagonal */ result = posdiag ? CHOLMOD_MM_SYMMETRIC_POSDIAG : CHOLMOD_MM_SYMMETRIC ; } else if (is_skew) { /* real or complex skew-symmetric matrix */ result = CHOLMOD_MM_SKEW_SYMMETRIC ; } return (result) ; } #endif #endif Matrix/src/CHOLMOD/MatrixOps/cholmod_ssmult.c0000644000176200001440000003347013652535054020537 0ustar liggesusers/* ========================================================================== */ /* === MatrixOps/cholmod_ssmult ============================================= */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/MatrixOps Module. Copyright (C) 2005-2006, Timothy A. Davis * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* C = A*B. Multiply two sparse matrices. * * A and B can be packed or unpacked, sorted or unsorted, and of any stype. * If A or B are symmetric, an internal unsymmetric copy is made first, however. * C is computed as if A and B are unsymmetric, and then if the stype input * parameter requests a symmetric form (upper or lower) the matrix is converted * into that form. * * C is returned as packed, and either unsorted or sorted, depending on the * "sorted" input parameter. If C is returned sorted, then either C = (B'*A')' * or C = (A*B)'' is computed, depending on the number of nonzeros in A, B, and * C. * * workspace: * if C unsorted: Flag (A->nrow), W (A->nrow) if values * if C sorted: Flag (B->ncol), W (B->ncol) if values * Iwork (max (A->ncol, A->nrow, B->nrow, B->ncol)) * allocates temporary copies for A, B, and C, if required. * * Only pattern and real matrices are supported. Complex and zomplex matrices * are supported only when the numerical values are not computed ("values" * is FALSE). */ #ifndef NGPL #ifndef NMATRIXOPS #include "cholmod_internal.h" #include "cholmod_matrixops.h" /* ========================================================================== */ /* === cholmod_ssmult ======================================================= */ /* ========================================================================== */ cholmod_sparse *CHOLMOD(ssmult) ( /* ---- input ---- */ cholmod_sparse *A, /* left matrix to multiply */ cholmod_sparse *B, /* right matrix to multiply */ int stype, /* requested stype of C */ int values, /* TRUE: do numerical values, FALSE: pattern only */ int sorted, /* if TRUE then return C with sorted columns */ /* --------------- */ cholmod_common *Common ) { double bjt ; double *Ax, *Bx, *Cx, *W ; Int *Ap, *Anz, *Ai, *Bp, *Bnz, *Bi, *Cp, *Ci, *Flag ; cholmod_sparse *C, *A2, *B2, *A3, *B3, *C2 ; Int apacked, bpacked, j, i, pa, paend, pb, pbend, ncol, mark, cnz, t, p, nrow, anz, bnz, do_swap_and_transpose, n1, n2 ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (A, NULL) ; RETURN_IF_NULL (B, NULL) ; values = values && (A->xtype != CHOLMOD_PATTERN) && (B->xtype != CHOLMOD_PATTERN) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ; RETURN_IF_XTYPE_INVALID (B, CHOLMOD_PATTERN, values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ; if (A->ncol != B->nrow) { /* inner dimensions must agree */ ERROR (CHOLMOD_INVALID, "A and B inner dimensions must match") ; return (NULL) ; } /* A and B must have the same numerical type if values is TRUE (both must * be CHOLMOD_REAL, this is implicitly checked above) */ Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ if (A->nrow <= 1) { /* C will be implicitly sorted, so no need to sort it here */ sorted = FALSE ; } if (sorted) { n1 = MAX (A->nrow, B->ncol) ; } else { n1 = A->nrow ; } n2 = MAX4 (A->ncol, A->nrow, B->nrow, B->ncol) ; CHOLMOD(allocate_work) (n1, n2, values ? n1 : 0, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (NULL) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1 : 0, Common)) ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ /* convert A to unsymmetric, if necessary */ A2 = NULL ; B2 = NULL ; if (A->stype) { /* workspace: Iwork (max (A->nrow,A->ncol)) */ A2 = CHOLMOD(copy) (A, 0, values, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ; return (NULL) ; } A = A2 ; } /* convert B to unsymmetric, if necessary */ if (B->stype) { /* workspace: Iwork (max (B->nrow,B->ncol)) */ B2 = CHOLMOD(copy) (B, 0, values, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ CHOLMOD(free_sparse) (&A2, Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ; return (NULL) ; } B = B2 ; } ASSERT (CHOLMOD(dump_sparse) (A, "A", Common) >= 0) ; ASSERT (CHOLMOD(dump_sparse) (B, "B", Common) >= 0) ; /* get the A matrix */ Ap = A->p ; Anz = A->nz ; Ai = A->i ; Ax = A->x ; apacked = A->packed ; /* get the B matrix */ Bp = B->p ; Bnz = B->nz ; Bi = B->i ; Bx = B->x ; bpacked = B->packed ; /* get the size of C */ nrow = A->nrow ; ncol = B->ncol ; /* get workspace */ W = Common->Xwork ; /* size nrow, unused if values is FALSE */ Flag = Common->Flag ; /* size nrow, Flag [0..nrow-1] < mark on input*/ /* ---------------------------------------------------------------------- */ /* count the number of entries in the result C */ /* ---------------------------------------------------------------------- */ cnz = 0 ; for (j = 0 ; j < ncol ; j++) { /* clear the Flag array */ /* mark = CHOLMOD(clear_flag) (Common) ; */ CHOLMOD_CLEAR_FLAG (Common) ; mark = Common->mark ; /* for each nonzero B(t,j) in column j, do: */ pb = Bp [j] ; pbend = (bpacked) ? (Bp [j+1]) : (pb + Bnz [j]) ; for ( ; pb < pbend ; pb++) { /* B(t,j) is nonzero */ t = Bi [pb] ; /* add the nonzero pattern of A(:,t) to the pattern of C(:,j) */ pa = Ap [t] ; paend = (apacked) ? (Ap [t+1]) : (pa + Anz [t]) ; for ( ; pa < paend ; pa++) { i = Ai [pa] ; if (Flag [i] != mark) { Flag [i] = mark ; cnz++ ; } } } if (cnz < 0) { break ; /* integer overflow case */ } } /* mark = CHOLMOD(clear_flag) (Common) ; */ CHOLMOD_CLEAR_FLAG (Common) ; mark = Common->mark ; /* ---------------------------------------------------------------------- */ /* check for integer overflow */ /* ---------------------------------------------------------------------- */ if (cnz < 0) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; CHOLMOD(free_sparse) (&A2, Common) ; CHOLMOD(free_sparse) (&B2, Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ; return (NULL) ; } /* ---------------------------------------------------------------------- */ /* Determine how to return C sorted (if requested) */ /* ---------------------------------------------------------------------- */ do_swap_and_transpose = FALSE ; if (sorted) { /* Determine the best way to return C with sorted columns. Computing * C = (B'*A')' takes cnz + anz + bnz time (ignoring O(n) terms). * Sorting C when done, C = (A*B)'', takes 2*cnz time. Pick the one * with the least amount of work. */ anz = CHOLMOD(nnz) (A, Common) ; bnz = CHOLMOD(nnz) (B, Common) ; do_swap_and_transpose = (anz + bnz < cnz) ; if (do_swap_and_transpose) { /* -------------------------------------------------------------- */ /* C = (B'*A')' */ /* -------------------------------------------------------------- */ /* workspace: Iwork (A->nrow) */ A3 = CHOLMOD(ptranspose) (A, values, NULL, NULL, 0, Common) ; CHOLMOD(free_sparse) (&A2, Common) ; A2 = A3 ; if (Common->status < CHOLMOD_OK) { /* out of memory */ CHOLMOD(free_sparse) (&A2, Common) ; CHOLMOD(free_sparse) (&B2, Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)); return (NULL) ; } /* workspace: Iwork (B->nrow) */ B3 = CHOLMOD(ptranspose) (B, values, NULL, NULL, 0, Common) ; CHOLMOD(free_sparse) (&B2, Common) ; B2 = B3 ; if (Common->status < CHOLMOD_OK) { /* out of memory */ CHOLMOD(free_sparse) (&A2, Common) ; CHOLMOD(free_sparse) (&B2, Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)); return (NULL) ; } A = B2 ; B = A2 ; /* get the new A matrix */ Ap = A->p ; Anz = A->nz ; Ai = A->i ; Ax = A->x ; apacked = A->packed ; /* get the new B matrix */ Bp = B->p ; Bnz = B->nz ; Bi = B->i ; Bx = B->x ; bpacked = B->packed ; /* get the size of C' */ nrow = A->nrow ; ncol = B->ncol ; } } /* ---------------------------------------------------------------------- */ /* allocate C */ /* ---------------------------------------------------------------------- */ C = CHOLMOD(allocate_sparse) (nrow, ncol, cnz, FALSE, TRUE, 0, values ? A->xtype : CHOLMOD_PATTERN, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ CHOLMOD(free_sparse) (&A2, Common) ; CHOLMOD(free_sparse) (&B2, Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ; return (NULL) ; } Cp = C->p ; Ci = C->i ; Cx = C->x ; /* ---------------------------------------------------------------------- */ /* C = A*B */ /* ---------------------------------------------------------------------- */ cnz = 0 ; if (values) { /* pattern and values */ for (j = 0 ; j < ncol ; j++) { /* clear the Flag array */ /* mark = CHOLMOD(clear_flag (Common)) ; */ CHOLMOD_CLEAR_FLAG (Common) ; mark = Common->mark ; /* start column j of C */ Cp [j] = cnz ; /* for each nonzero B(t,j) in column j, do: */ pb = Bp [j] ; pbend = (bpacked) ? (Bp [j+1]) : (pb + Bnz [j]) ; for ( ; pb < pbend ; pb++) { /* B(t,j) is nonzero */ t = Bi [pb] ; bjt = Bx [pb] ; /* add the nonzero pattern of A(:,t) to the pattern of C(:,j) * and scatter the values into W */ pa = Ap [t] ; paend = (apacked) ? (Ap [t+1]) : (pa + Anz [t]) ; for ( ; pa < paend ; pa++) { i = Ai [pa] ; if (Flag [i] != mark) { Flag [i] = mark ; Ci [cnz++] = i ; } W [i] += Ax [pa] * bjt ; } } /* gather the values into C(:,j) */ for (p = Cp [j] ; p < cnz ; p++) { i = Ci [p] ; Cx [p] = W [i] ; W [i] = 0 ; } } } else { /* pattern only */ for (j = 0 ; j < ncol ; j++) { /* clear the Flag array */ /* mark = CHOLMOD(clear_flag) (Common) ; */ CHOLMOD_CLEAR_FLAG (Common) ; mark = Common->mark ; /* start column j of C */ Cp [j] = cnz ; /* for each nonzero B(t,j) in column j, do: */ pb = Bp [j] ; pbend = (bpacked) ? (Bp [j+1]) : (pb + Bnz [j]) ; for ( ; pb < pbend ; pb++) { /* B(t,j) is nonzero */ t = Bi [pb] ; /* add the nonzero pattern of A(:,t) to the pattern of C(:,j) */ pa = Ap [t] ; paend = (apacked) ? (Ap [t+1]) : (pa + Anz [t]) ; for ( ; pa < paend ; pa++) { i = Ai [pa] ; if (Flag [i] != mark) { Flag [i] = mark ; Ci [cnz++] = i ; } } } } } Cp [ncol] = cnz ; ASSERT (MAX (1,cnz) == C->nzmax) ; /* ---------------------------------------------------------------------- */ /* clear workspace and free temporary matrices */ /* ---------------------------------------------------------------------- */ CHOLMOD(free_sparse) (&A2, Common) ; CHOLMOD(free_sparse) (&B2, Common) ; /* CHOLMOD(clear_flag) (Common) ; */ CHOLMOD_CLEAR_FLAG (Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ; /* ---------------------------------------------------------------------- */ /* convert C to a symmetric upper/lower matrix if requested */ /* ---------------------------------------------------------------------- */ /* convert C in place, which cannot fail since no memory is allocated */ if (stype > 0) { /* C = triu (C), in place */ (void) CHOLMOD(band_inplace) (0, ncol, values, C, Common) ; C->stype = 1 ; } else if (stype < 0) { /* C = tril (C), in place */ (void) CHOLMOD(band_inplace) (-nrow, 0, values, C, Common) ; C->stype = -1 ; } ASSERT (Common->status >= CHOLMOD_OK) ; /* ---------------------------------------------------------------------- */ /* sort C, if requested */ /* ---------------------------------------------------------------------- */ if (sorted) { if (do_swap_and_transpose) { /* workspace: Iwork (C->ncol), which is A->nrow since C=(B'*A') */ C2 = CHOLMOD(ptranspose) (C, values, NULL, NULL, 0, Common) ; CHOLMOD(free_sparse) (&C, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)); return (NULL) ; } C = C2 ; } else { /* workspace: Iwork (max (C->nrow,C->ncol)) */ if (!CHOLMOD(sort) (C, Common)) { /* out of memory */ CHOLMOD(free_sparse) (&C, Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)); return (NULL) ; } } } /* ---------------------------------------------------------------------- */ /* return result */ /* ---------------------------------------------------------------------- */ DEBUG (CHOLMOD(dump_sparse) (C, "ssmult", Common) >= 0) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ; return (C) ; } #endif #endif Matrix/src/CHOLMOD/MatrixOps/cholmod_scale.c0000644000176200001440000001406513652535054020276 0ustar liggesusers/* ========================================================================== */ /* === MatrixOps/cholmod_scale ============================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/MatrixOps Module. Copyright (C) 2005-2006, Timothy A. Davis * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* scale a matrix: A = diag(s)*A, A*diag(s), s*A, or diag(s)*A*diag(s) * * A can be of any type (packed/unpacked, upper/lower/unsymmetric). * The symmetry of A is ignored; all entries in the matrix are modified. * * If A is m-by-n unsymmetric but scaled symmtrically, the result is * A = diag (s (1:m)) * A * diag (s (1:n)). * * Note: diag(s) should be interpretted as spdiags(s,0,n,n) where n=length(s). * * Row or column scaling of a symmetric matrix still results in a symmetric * matrix, since entries are still ignored by other routines. * For example, when row-scaling a symmetric matrix where just the upper * triangular part is stored (and lower triangular entries ignored) * A = diag(s)*triu(A) is performed, where the result A is also * symmetric-upper. This has the effect of modifying the implicit lower * triangular part. In MATLAB notation: * * U = diag(s)*triu(A) ; * L = tril (U',-1) * A = L + U ; * * The scale parameter determines the kind of scaling to perform: * * CHOLMOD_SCALAR: s[0]*A * CHOLMOD_ROW: diag(s)*A * CHOLMOD_COL: A*diag(s) * CHOLMOD_SYM: diag(s)*A*diag(s) * * The size of S depends on the scale parameter: * * CHOLMOD_SCALAR: size 1 * CHOLMOD_ROW: size nrow-by-1 or 1-by-nrow * CHOLMOD_COL: size ncol-by-1 or 1-by-ncol * CHOLMOD_SYM: size max(nrow,ncol)-by-1, or 1-by-max(nrow,ncol) * * workspace: none * * Only real matrices are supported. */ #ifndef NGPL #ifndef NMATRIXOPS #include "cholmod_internal.h" #include "cholmod_matrixops.h" /* ========================================================================== */ /* === cholmod_scale ======================================================== */ /* ========================================================================== */ int CHOLMOD(scale) ( /* ---- input ---- */ cholmod_dense *S, /* scale factors (scalar or vector) */ int scale, /* type of scaling to compute */ /* ---- in/out --- */ cholmod_sparse *A, /* matrix to scale */ /* --------------- */ cholmod_common *Common ) { double t ; double *Ax, *s ; Int *Ap, *Anz, *Ai ; Int packed, j, ncol, nrow, p, pend, sncol, snrow, nn, ok ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (S, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ; RETURN_IF_XTYPE_INVALID (S, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ; ncol = A->ncol ; nrow = A->nrow ; sncol = S->ncol ; snrow = S->nrow ; if (scale == CHOLMOD_SCALAR) { ok = (snrow == 1 && sncol == 1) ; } else if (scale == CHOLMOD_ROW) { ok = (snrow == nrow && sncol == 1) || (snrow == 1 && sncol == nrow) ; } else if (scale == CHOLMOD_COL) { ok = (snrow == ncol && sncol == 1) || (snrow == 1 && sncol == ncol) ; } else if (scale == CHOLMOD_SYM) { nn = MAX (nrow, ncol) ; ok = (snrow == nn && sncol == 1) || (snrow == 1 && sncol == nn) ; } else { /* scale invalid */ ERROR (CHOLMOD_INVALID, "invalid scaling option") ; return (FALSE) ; } if (!ok) { /* S is wrong size */ ERROR (CHOLMOD_INVALID, "invalid scale factors") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ Ap = A->p ; Anz = A->nz ; Ai = A->i ; Ax = A->x ; packed = A->packed ; s = S->x ; /* ---------------------------------------------------------------------- */ /* scale the matrix */ /* ---------------------------------------------------------------------- */ if (scale == CHOLMOD_ROW) { /* ------------------------------------------------------------------ */ /* A = diag(s)*A, row scaling */ /* ------------------------------------------------------------------ */ for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { Ax [p] *= s [Ai [p]] ; } } } else if (scale == CHOLMOD_COL) { /* ------------------------------------------------------------------ */ /* A = A*diag(s), column scaling */ /* ------------------------------------------------------------------ */ for (j = 0 ; j < ncol ; j++) { t = s [j] ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { Ax [p] *= t ; } } } else if (scale == CHOLMOD_SYM) { /* ------------------------------------------------------------------ */ /* A = diag(s)*A*diag(s), symmetric scaling */ /* ------------------------------------------------------------------ */ for (j = 0 ; j < ncol ; j++) { t = s [j] ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { Ax [p] *= t * s [Ai [p]] ; } } } else if (scale == CHOLMOD_SCALAR) { /* ------------------------------------------------------------------ */ /* A = s[0] * A, scalar scaling */ /* ------------------------------------------------------------------ */ t = s [0] ; for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { Ax [p] *= t ; } } } ASSERT (CHOLMOD(dump_sparse) (A, "A scaled", Common) >= 0) ; return (TRUE) ; } #endif #endif Matrix/src/CHOLMOD/MatrixOps/License.txt0000644000176200001440000000203011770402705017441 0ustar liggesusersCHOLMOD/MatrixOps Module. Copyright (C) 2005-2006, Timothy A. Davis CHOLMOD is also available under other licenses; contact authors for details. http://www.suitesparse.com Note that this license is for the CHOLMOD/MatrixOps module only. All CHOLMOD modules are licensed separately. -------------------------------------------------------------------------------- This Module 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 of the License, or (at your option) any later version. This Module 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 Module; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. Matrix/src/CHOLMOD/MatrixOps/cholmod_vertcat.c0000644000176200001440000001351313652535054020654 0ustar liggesusers/* ========================================================================== */ /* === MatrixOps/cholmod_vertcat ============================================ */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/MatrixOps Module. Copyright (C) 2005-2006, Timothy A. Davis * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* Vertical concatenation, C = [A ; B] in MATLAB notation. * * A and B can be up/lo/unsym; C is unsymmetric and packed. * A and B must have the same number of columns. * C is sorted if both A and B are sorted. * * workspace: Iwork (max (A->nrow, A->ncol, B->nrow, B->ncol)). * allocates temporary copies of A and B if they are symmetric. * * Only pattern and real matrices are supported. Complex and zomplex matrices * are supported only if "values" is FALSE. */ #ifndef NGPL #ifndef NMATRIXOPS #include "cholmod_internal.h" #include "cholmod_matrixops.h" /* ========================================================================== */ /* === cholmod_vertcat ====================================================== */ /* ========================================================================== */ cholmod_sparse *CHOLMOD(vertcat) ( /* ---- input ---- */ cholmod_sparse *A, /* left matrix to concatenate */ cholmod_sparse *B, /* right matrix to concatenate */ int values, /* if TRUE compute the numerical values of C */ /* --------------- */ cholmod_common *Common ) { double *Ax, *Bx, *Cx ; Int *Ap, *Ai, *Anz, *Bp, *Bi, *Bnz, *Cp, *Ci ; cholmod_sparse *C, *A2, *B2 ; Int apacked, bpacked, anrow, bnrow, ncol, nrow, anz, bnz, nz, j, p, pend, pdest ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (A, NULL) ; RETURN_IF_NULL (B, NULL) ; values = values && (A->xtype != CHOLMOD_PATTERN) && (B->xtype != CHOLMOD_PATTERN) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ; RETURN_IF_XTYPE_INVALID (B, CHOLMOD_PATTERN, values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ; if (A->ncol != B->ncol) { /* A and B must have the same number of columns */ ERROR (CHOLMOD_INVALID, "A and B must have same # of columns") ; return (NULL) ; } /* A and B must have the same numerical type if values is TRUE (both must * be CHOLMOD_REAL, this is implicitly checked above) */ Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ anrow = A->nrow ; bnrow = B->nrow ; ncol = A->ncol ; CHOLMOD(allocate_work) (0, MAX3 (anrow, bnrow, ncol), 0, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (NULL) ; } /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ /* convert A to unsymmetric, if necessary */ A2 = NULL ; if (A->stype != 0) { /* workspace: Iwork (max (A->nrow,A->ncol)) */ A2 = CHOLMOD(copy) (A, 0, values, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (NULL) ; } A = A2 ; } /* convert B to unsymmetric, if necessary */ B2 = NULL ; if (B->stype != 0) { /* workspace: Iwork (max (B->nrow,B->ncol)) */ B2 = CHOLMOD(copy) (B, 0, values, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ CHOLMOD(free_sparse) (&A2, Common) ; return (NULL) ; } B = B2 ; } Ap = A->p ; Anz = A->nz ; Ai = A->i ; Ax = A->x ; apacked = A->packed ; Bp = B->p ; Bnz = B->nz ; Bi = B->i ; Bx = B->x ; bpacked = B->packed ; /* ---------------------------------------------------------------------- */ /* allocate C */ /* ---------------------------------------------------------------------- */ anz = CHOLMOD(nnz) (A, Common) ; bnz = CHOLMOD(nnz) (B, Common) ; nrow = anrow + bnrow ; nz = anz + bnz ; C = CHOLMOD(allocate_sparse) (nrow, ncol, nz, A->sorted && B->sorted, TRUE, 0, values ? A->xtype : CHOLMOD_PATTERN, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ CHOLMOD(free_sparse) (&A2, Common) ; CHOLMOD(free_sparse) (&B2, Common) ; return (NULL) ; } Cp = C->p ; Ci = C->i ; Cx = C->x ; /* ---------------------------------------------------------------------- */ /* C = [A ; B] */ /* ---------------------------------------------------------------------- */ pdest = 0 ; for (j = 0 ; j < ncol ; j++) { /* attach A(:,j) as the first part of C(:,j) */ p = Ap [j] ; pend = (apacked) ? (Ap [j+1]) : (p + Anz [j]) ; Cp [j] = pdest ; for ( ; p < pend ; p++) { Ci [pdest] = Ai [p] ; if (values) { Cx [pdest] = Ax [p] ; } pdest++ ; } /* attach B(:,j) as the second part of C(:,j) */ p = Bp [j] ; pend = (bpacked) ? (Bp [j+1]) : (p + Bnz [j]) ; for ( ; p < pend ; p++) { Ci [pdest] = Bi [p] + anrow ; if (values) { Cx [pdest] = Bx [p] ; } pdest++ ; } } Cp [ncol] = pdest ; ASSERT (pdest == nz) ; /* ---------------------------------------------------------------------- */ /* free the unsymmetric copies of A and B, and return C */ /* ---------------------------------------------------------------------- */ CHOLMOD(free_sparse) (&A2, Common) ; CHOLMOD(free_sparse) (&B2, Common) ; return (C) ; } #endif #endif Matrix/src/CHOLMOD/MatrixOps/cholmod_sdmult.c0000644000176200001440000001207213652535054020513 0ustar liggesusers/* ========================================================================== */ /* === MatrixOps/cholmod_sdmult ============================================= */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/MatrixOps Module. Copyright (C) 2005-2006, Timothy A. Davis * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* Sparse matrix times dense matrix: * Y = alpha*(A*X) + beta*Y or Y = alpha*(A'*X) + beta*Y, * where A is sparse and X and Y are dense. * * when using A, X has A->ncol columns and Y has A->nrow rows * when using A', X has A->nrow columns and Y has A->ncol rows * * workspace: none in Common. Temporary workspace of size 4*(X->nrow) is used * if A is stored in symmetric form and X has four columns or more. If the * workspace is not available, a slower method is used instead that requires * no workspace. * * transpose = 0: use A * otherwise, use A' (complex conjugate transpose) * * transpose is ignored if the matrix is symmetric or Hermitian. * (the array transpose A.' is not supported). * * Supports real, complex, and zomplex matrices, but the xtypes of A, X, and Y * must all match. */ #ifndef NGPL #ifndef NMATRIXOPS #include "cholmod_internal.h" #include "cholmod_matrixops.h" /* ========================================================================== */ /* === TEMPLATE ============================================================= */ /* ========================================================================== */ #define REAL #include "t_cholmod_sdmult.c" #define COMPLEX #include "t_cholmod_sdmult.c" #define ZOMPLEX #include "t_cholmod_sdmult.c" /* ========================================================================== */ /* === cholmod_sdmult ======================================================= */ /* ========================================================================== */ int CHOLMOD(sdmult) ( /* ---- input ---- */ cholmod_sparse *A, /* sparse matrix to multiply */ int transpose, /* use A if 0, otherwise use A' */ double alpha [2], /* scale factor for A */ double beta [2], /* scale factor for Y */ cholmod_dense *X, /* dense matrix to multiply */ /* ---- in/out --- */ cholmod_dense *Y, /* resulting dense matrix */ /* --------------- */ cholmod_common *Common ) { double *w ; size_t nx, ny ; Int e ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (X, FALSE) ; RETURN_IF_NULL (Y, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (Y, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ; ny = transpose ? A->ncol : A->nrow ; /* required length of Y */ nx = transpose ? A->nrow : A->ncol ; /* required length of X */ if (X->nrow != nx || X->ncol != Y->ncol || Y->nrow != ny) { /* X and/or Y have the wrong dimension */ ERROR (CHOLMOD_INVALID, "X and/or Y have wrong dimensions") ; return (FALSE) ; } if (A->xtype != X->xtype || A->xtype != Y->xtype) { ERROR (CHOLMOD_INVALID, "A, X, and Y must have same xtype") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace, if required */ /* ---------------------------------------------------------------------- */ w = NULL ; e = (A->xtype == CHOLMOD_REAL ? 1:2) ; if (A->stype && X->ncol >= 4) { w = CHOLMOD(malloc) (nx, 4*e*sizeof (double), Common) ; } if (Common->status < CHOLMOD_OK) { return (FALSE) ; /* out of memory */ } /* ---------------------------------------------------------------------- */ /* Y = alpha*op(A)*X + beta*Y via template routine */ /* ---------------------------------------------------------------------- */ ASSERT (CHOLMOD(dump_sparse) (A, "A", Common) >= 0) ; DEBUG (CHOLMOD(dump_dense) (X, "X", Common)) ; DEBUG (if (IS_NONZERO (beta [0]) || (IS_NONZERO (beta [1]) && A->xtype != CHOLMOD_REAL)) CHOLMOD(dump_dense) (Y, "Y", Common)) ; switch (A->xtype) { case CHOLMOD_REAL: r_cholmod_sdmult (A, transpose, alpha, beta, X, Y, w) ; break ; case CHOLMOD_COMPLEX: c_cholmod_sdmult (A, transpose, alpha, beta, X, Y, w) ; break ; case CHOLMOD_ZOMPLEX: z_cholmod_sdmult (A, transpose, alpha, beta, X, Y, w) ; break ; } /* ---------------------------------------------------------------------- */ /* free workspace */ /* ---------------------------------------------------------------------- */ CHOLMOD(free) (4*nx, e*sizeof (double), w, Common) ; DEBUG (CHOLMOD(dump_dense) (Y, "Y", Common)) ; return (TRUE) ; } #endif #endif Matrix/src/CHOLMOD/MatrixOps/cholmod_drop.c0000644000176200001440000001154513652535054020153 0ustar liggesusers/* ========================================================================== */ /* === MatrixOps/cholmod_drop =============================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/MatrixOps Module. Copyright (C) 2005-2006, Timothy A. Davis * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* Drop small entries from A, and entries in the ignored part of A if A * is symmetric. None of the matrix operations drop small numerical entries * from a matrix, except for this one. NaN's and Inf's are kept. * * workspace: none * * Supports pattern and real matrices, complex and zomplex not supported. */ #ifndef NGPL #ifndef NMATRIXOPS #include "cholmod_internal.h" #include "cholmod_matrixops.h" /* ========================================================================== */ /* === cholmod_drop ========================================================= */ /* ========================================================================== */ int CHOLMOD(drop) ( /* ---- input ---- */ double tol, /* keep entries with absolute value > tol */ /* ---- in/out --- */ cholmod_sparse *A, /* matrix to drop entries from */ /* --------------- */ cholmod_common *Common ) { double aij ; double *Ax ; Int *Ap, *Ai, *Anz ; Int packed, i, j, nrow, ncol, p, pend, nz, values ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_REAL, FALSE) ; Common->status = CHOLMOD_OK ; ASSERT (CHOLMOD(dump_sparse) (A, "A predrop", Common) >= 0) ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ Ap = A->p ; Ai = A->i ; Ax = A->x ; Anz = A->nz ; packed = A->packed ; ncol = A->ncol ; nrow = A->nrow ; values = (A->xtype != CHOLMOD_PATTERN) ; nz = 0 ; if (values) { /* ------------------------------------------------------------------ */ /* drop small numerical entries from A, and entries in ignored part */ /* ------------------------------------------------------------------ */ if (A->stype > 0) { /* -------------------------------------------------------------- */ /* A is symmetric, with just upper triangular part stored */ /* -------------------------------------------------------------- */ for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; Ap [j] = nz ; for ( ; p < pend ; p++) { i = Ai [p] ; aij = Ax [p] ; if (i <= j && (fabs (aij) > tol || IS_NAN (aij))) { Ai [nz] = i ; Ax [nz] = aij ; nz++ ; } } } } else if (A->stype < 0) { /* -------------------------------------------------------------- */ /* A is symmetric, with just lower triangular part stored */ /* -------------------------------------------------------------- */ for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; Ap [j] = nz ; for ( ; p < pend ; p++) { i = Ai [p] ; aij = Ax [p] ; if (i >= j && (fabs (aij) > tol || IS_NAN (aij))) { Ai [nz] = i ; Ax [nz] = aij ; nz++ ; } } } } else { /* -------------------------------------------------------------- */ /* both parts of A present, just drop small entries */ /* -------------------------------------------------------------- */ for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; Ap [j] = nz ; for ( ; p < pend ; p++) { i = Ai [p] ; aij = Ax [p] ; if (fabs (aij) > tol || IS_NAN (aij)) { Ai [nz] = i ; Ax [nz] = aij ; nz++ ; } } } } Ap [ncol] = nz ; /* reduce A->i and A->x in size */ ASSERT (MAX (1,nz) <= A->nzmax) ; CHOLMOD(reallocate_sparse) (nz, A, Common) ; ASSERT (Common->status >= CHOLMOD_OK) ; } else { /* ------------------------------------------------------------------ */ /* consider only the pattern of A */ /* ------------------------------------------------------------------ */ /* Note that cholmod_band_inplace calls cholmod_reallocate_sparse */ if (A->stype > 0) { CHOLMOD(band_inplace) (0, ncol, 0, A, Common) ; } else if (A->stype < 0) { CHOLMOD(band_inplace) (-nrow, 0, 0, A, Common) ; } } ASSERT (CHOLMOD(dump_sparse) (A, "A dropped", Common) >= 0) ; return (TRUE) ; } #endif #endif Matrix/src/CHOLMOD/MatrixOps/t_cholmod_sdmult.c0000644000176200001440000004422713652535054021045 0ustar liggesusers/* ========================================================================== */ /* === MatrixOps/t_cholmod_sdmult =========================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/MatrixOps Module. Copyright (C) 2005-2006, Timothy A. Davis * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* Template routine for cholmod_sdmult */ #include "cholmod_template.h" #undef ADVANCE #ifdef REAL #define ADVANCE(x,z,d) x += d #elif defined (COMPLEX) #define ADVANCE(x,z,d) x += 2*d #else #define ADVANCE(x,z,d) x += d ; z += d #endif /* ========================================================================== */ /* === t_cholmod_sdmult ===================================================== */ /* ========================================================================== */ static void TEMPLATE (cholmod_sdmult) ( /* ---- input ---- */ cholmod_sparse *A, /* sparse matrix to multiply */ int transpose, /* use A if 0, or A' otherwise */ double alpha [2], /* scale factor for A */ double beta [2], /* scale factor for Y */ cholmod_dense *X, /* dense matrix to multiply */ /* ---- in/out --- */ cholmod_dense *Y, /* resulting dense matrix */ /* -- workspace -- */ double *W /* size 4*nx if needed, twice that for c/zomplex case */ ) { double yx [8], xx [8], ax [2] ; #ifdef ZOMPLEX double yz [4], xz [4], az [1] ; double betaz [1], alphaz [1] ; #endif double *Ax, *Az, *Xx, *Xz, *Yx, *Yz, *w, *Wz ; Int *Ap, *Ai, *Anz ; size_t nx, ny, dx, dy ; Int packed, nrow, ncol, j, k, p, pend, kcol, i ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ #ifdef ZOMPLEX betaz [0] = beta [1] ; alphaz [0] = alpha [1] ; #endif ny = transpose ? A->ncol : A->nrow ; /* required length of Y */ nx = transpose ? A->nrow : A->ncol ; /* required length of X */ nrow = A->nrow ; ncol = A->ncol ; Ap = A->p ; Anz = A->nz ; Ai = A->i ; Ax = A->x ; Az = A->z ; packed = A->packed ; Xx = X->x ; Xz = X->z ; Yx = Y->x ; Yz = Y->z ; kcol = X->ncol ; dy = Y->d ; dx = X->d ; w = W ; Wz = W + 4*nx ; /* ---------------------------------------------------------------------- */ /* Y = beta * Y */ /* ---------------------------------------------------------------------- */ if (ENTRY_IS_ZERO (beta, betaz, 0)) { for (k = 0 ; k < kcol ; k++) { for (i = 0 ; i < ((Int) ny) ; i++) { /* y [i] = 0. ; */ CLEAR (Yx, Yz, i) ; } /* y += dy ; */ ADVANCE (Yx,Yz,dy) ; } } else if (!ENTRY_IS_ONE (beta, betaz, 0)) { for (k = 0 ; k < kcol ; k++) { for (i = 0 ; i < ((Int) ny) ; i++) { /* y [i] *= beta [0] ; */ MULT (Yx,Yz,i, Yx,Yz,i, beta,betaz, 0) ; } /* y += dy ; */ ADVANCE (Yx,Yz,dy) ; } } if (ENTRY_IS_ZERO (alpha, alphaz, 0)) { /* nothing else to do */ return ; } /* ---------------------------------------------------------------------- */ /* Y += alpha * op(A) * X, where op(A)=A or A' */ /* ---------------------------------------------------------------------- */ Yx = Y->x ; Yz = Y->z ; k = 0 ; if (A->stype == 0) { if (transpose) { /* -------------------------------------------------------------- */ /* Y += alpha * A' * x, unsymmetric case */ /* -------------------------------------------------------------- */ if (kcol % 4 == 1) { for (j = 0 ; j < ncol ; j++) { /* yj = 0. ; */ CLEAR (yx, yz, 0) ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { /* yj += conj(Ax [p]) * x [Ai [p]] ; */ i = Ai [p] ; ASSIGN_CONJ (ax,az,0, Ax,Az,p) ; MULTADD (yx,yz,0, ax,az,0, Xx,Xz,i) ; } /* y [j] += alpha [0] * yj ; */ MULTADD (Yx,Yz,j, alpha,alphaz,0, yx,yz,0) ; } /* y += dy ; */ /* x += dx ; */ ADVANCE (Yx,Yz,dy) ; ADVANCE (Xx,Xz,dx) ; k++ ; } else if (kcol % 4 == 2) { for (j = 0 ; j < ncol ; j++) { /* yj0 = 0. ; */ /* yj1 = 0. ; */ CLEAR (yx,yz,0) ; CLEAR (yx,yz,1) ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; /* aij = conj (Ax [p]) ; */ ASSIGN_CONJ (ax,az,0, Ax,Az,p) ; /* yj0 += aij * x [i ] ; */ /* yj1 += aij * x [i+dx] ; */ MULTADD (yx,yz,0, ax,az,0, Xx,Xz,i) ; MULTADD (yx,yz,1, ax,az,0, Xx,Xz,i+dx) ; } /* y [j ] += alpha [0] * yj0 ; */ /* y [j+dy] += alpha [0] * yj1 ; */ MULTADD (Yx,Yz,j, alpha,alphaz,0, yx,yz,0) ; MULTADD (Yx,Yz,j+dy, alpha,alphaz,0, yx,yz,1) ; } /* y += 2*dy ; */ /* x += 2*dx ; */ ADVANCE (Yx,Yz,2*dy) ; ADVANCE (Xx,Xz,2*dx) ; k += 2 ; } else if (kcol % 4 == 3) { for (j = 0 ; j < ncol ; j++) { /* yj0 = 0. ; */ /* yj1 = 0. ; */ /* yj2 = 0. ; */ CLEAR (yx,yz,0) ; CLEAR (yx,yz,1) ; CLEAR (yx,yz,2) ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; /* aij = conj (Ax [p]) ; */ ASSIGN_CONJ (ax,az,0, Ax,Az,p) ; /* yj0 += aij * x [i ] ; */ /* yj1 += aij * x [i+ dx] ; */ /* yj2 += aij * x [i+2*dx] ; */ MULTADD (yx,yz,0, ax,az,0, Xx,Xz,i) ; MULTADD (yx,yz,1, ax,az,0, Xx,Xz,i+dx) ; MULTADD (yx,yz,2, ax,az,0, Xx,Xz,i+2*dx) ; } /* y [j ] += alpha [0] * yj0 ; */ /* y [j+ dy] += alpha [0] * yj1 ; */ /* y [j+2*dy] += alpha [0] * yj2 ; */ MULTADD (Yx,Yz,j, alpha,alphaz,0, yx,yz,0) ; MULTADD (Yx,Yz,j+dy, alpha,alphaz,0, yx,yz,1) ; MULTADD (Yx,Yz,j+2*dy, alpha,alphaz,0, yx,yz,2) ; } /* y += 3*dy ; */ /* x += 3*dx ; */ ADVANCE (Yx,Yz,3*dy) ; ADVANCE (Xx,Xz,3*dx) ; k += 3 ; } for ( ; k < kcol ; k += 4) { for (j = 0 ; j < ncol ; j++) { /* yj0 = 0. ; */ /* yj1 = 0. ; */ /* yj2 = 0. ; */ /* yj3 = 0. ; */ CLEAR (yx,yz,0) ; CLEAR (yx,yz,1) ; CLEAR (yx,yz,2) ; CLEAR (yx,yz,3) ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; /* aij = conj(Ax [p]) ; */ ASSIGN_CONJ (ax,az,0, Ax,Az,p) ; /* yj0 += aij * x [i ] ; */ /* yj1 += aij * x [i+ dx] ; */ /* yj2 += aij * x [i+2*dx] ; */ /* yj3 += aij * x [i+3*dx] ; */ MULTADD (yx,yz,0, ax,az,0, Xx,Xz,i) ; MULTADD (yx,yz,1, ax,az,0, Xx,Xz,i+dx) ; MULTADD (yx,yz,2, ax,az,0, Xx,Xz,i+2*dx) ; MULTADD (yx,yz,3, ax,az,0, Xx,Xz,i+3*dx) ; } /* y [j ] += alpha [0] * yj0 ; */ /* y [j+ dy] += alpha [0] * yj1 ; */ /* y [j+2*dy] += alpha [0] * yj2 ; */ /* y [j+3*dy] += alpha [0] * yj3 ; */ MULTADD (Yx,Yz,j, alpha,alphaz,0, yx,yz,0) ; MULTADD (Yx,Yz,j+dy, alpha,alphaz,0, yx,yz,1) ; MULTADD (Yx,Yz,j+2*dy, alpha,alphaz,0, yx,yz,2) ; MULTADD (Yx,Yz,j+3*dy, alpha,alphaz,0, yx,yz,3) ; } /* y += 4*dy ; */ /* x += 4*dx ; */ ADVANCE (Yx,Yz,4*dy) ; ADVANCE (Xx,Xz,4*dx) ; } } else { /* -------------------------------------------------------------- */ /* Y += alpha * A * x, unsymmetric case */ /* -------------------------------------------------------------- */ if (kcol % 4 == 1) { for (j = 0 ; j < ncol ; j++) { /* xj = alpha [0] * x [j] ; */ MULT (xx,xz,0, alpha,alphaz,0, Xx,Xz,j) ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { /* y [Ai [p]] += Ax [p] * xj ; */ i = Ai [p] ; MULTADD (Yx,Yz,i, Ax,Az,p, xx,xz,0) ; } } /* y += dy ; */ /* x += dx ; */ ADVANCE (Yx,Yz,dy) ; ADVANCE (Xx,Xz,dx) ; k++ ; } else if (kcol % 4 == 2) { for (j = 0 ; j < ncol ; j++) { /* xj0 = alpha [0] * x [j ] ; */ /* xj1 = alpha [0] * x [j+dx] ; */ MULT (xx,xz,0, alpha,alphaz,0, Xx,Xz,j) ; MULT (xx,xz,1, alpha,alphaz,0, Xx,Xz,j+dx) ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; /* aij = Ax [p] ; */ ASSIGN (ax,az,0, Ax,Az,p) ; /* y [i ] += aij * xj0 ; */ /* y [i+dy] += aij * xj1 ; */ MULTADD (Yx,Yz,i, ax,az,0, xx,xz,0) ; MULTADD (Yx,Yz,i+dy, ax,az,0, xx,xz,1) ; } } /* y += 2*dy ; */ /* x += 2*dx ; */ ADVANCE (Yx,Yz,2*dy) ; ADVANCE (Xx,Xz,2*dx) ; k += 2 ; } else if (kcol % 4 == 3) { for (j = 0 ; j < ncol ; j++) { /* xj0 = alpha [0] * x [j ] ; */ /* xj1 = alpha [0] * x [j+ dx] ; */ /* xj2 = alpha [0] * x [j+2*dx] ; */ MULT (xx,xz,0, alpha,alphaz,0, Xx,Xz,j) ; MULT (xx,xz,1, alpha,alphaz,0, Xx,Xz,j+dx) ; MULT (xx,xz,2, alpha,alphaz,0, Xx,Xz,j+2*dx) ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; /* aij = Ax [p] ; */ ASSIGN (ax,az,0, Ax,Az,p) ; /* y [i ] += aij * xj0 ; */ /* y [i+ dy] += aij * xj1 ; */ /* y [i+2*dy] += aij * xj2 ; */ MULTADD (Yx,Yz,i, ax,az,0, xx,xz,0) ; MULTADD (Yx,Yz,i+dy, ax,az,0, xx,xz,1) ; MULTADD (Yx,Yz,i+2*dy, ax,az,0, xx,xz,2) ; } } /* y += 3*dy ; */ /* x += 3*dx ; */ ADVANCE (Yx,Yz,3*dy) ; ADVANCE (Xx,Xz,3*dx) ; k += 3 ; } for ( ; k < kcol ; k += 4) { for (j = 0 ; j < ncol ; j++) { /* xj0 = alpha [0] * x [j ] ; */ /* xj1 = alpha [0] * x [j+ dx] ; */ /* xj2 = alpha [0] * x [j+2*dx] ; */ /* xj3 = alpha [0] * x [j+3*dx] ; */ MULT (xx,xz,0, alpha,alphaz,0, Xx,Xz,j) ; MULT (xx,xz,1, alpha,alphaz,0, Xx,Xz,j+dx) ; MULT (xx,xz,2, alpha,alphaz,0, Xx,Xz,j+2*dx) ; MULT (xx,xz,3, alpha,alphaz,0, Xx,Xz,j+3*dx) ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; /* aij = Ax [p] ; */ ASSIGN (ax,az,0, Ax,Az,p) ; /* y [i ] += aij * xj0 ; */ /* y [i+ dy] += aij * xj1 ; */ /* y [i+2*dy] += aij * xj2 ; */ /* y [i+3*dy] += aij * xj3 ; */ MULTADD (Yx,Yz,i, ax,az,0, xx,xz,0) ; MULTADD (Yx,Yz,i+dy, ax,az,0, xx,xz,1) ; MULTADD (Yx,Yz,i+2*dy, ax,az,0, xx,xz,2) ; MULTADD (Yx,Yz,i+3*dy, ax,az,0, xx,xz,3) ; } } /* y += 4*dy ; */ /* x += 4*dx ; */ ADVANCE (Yx,Yz,4*dy) ; ADVANCE (Xx,Xz,4*dx) ; } } } else { /* ------------------------------------------------------------------ */ /* Y += alpha * (A or A') * x, symmetric case (upper/lower) */ /* ------------------------------------------------------------------ */ /* Only the upper/lower triangular part and the diagonal of A is used. * Since both x and y are written to in the innermost loop, this * code can experience cache bank conflicts if x is used directly. * Thus, a copy is made of x, four columns at a time, if x has * four or more columns. */ if (kcol % 4 == 1) { for (j = 0 ; j < ncol ; j++) { /* yj = 0. ; */ CLEAR (yx,yz,0) ; /* xj = alpha [0] * x [j] ; */ MULT (xx,xz,0, alpha,alphaz,0, Xx,Xz,j) ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i == j) { /* y [i] += Ax [p] * xj ; */ MULTADD (Yx,Yz,i, Ax,Az,p, xx,xz,0) ; } else if ((A->stype > 0 && i < j) || (A->stype < 0 && i > j)) { /* aij = Ax [p] ; */ ASSIGN (ax,az,0, Ax,Az,p) ; /* y [i] += aij * xj ; */ /* yj += aij * x [i] ; */ MULTADD (Yx,Yz,i, ax,az,0, xx,xz,0) ; MULTADDCONJ (yx,yz,0, ax,az,0, Xx,Xz,i) ; } } /* y [j] += alpha [0] * yj ; */ MULTADD (Yx,Yz,j, alpha,alphaz,0, yx,yz,0) ; } /* y += dy ; */ /* x += dx ; */ ADVANCE (Yx,Yz,dy) ; ADVANCE (Xx,Xz,dx) ; k++ ; } else if (kcol % 4 == 2) { for (j = 0 ; j < ncol ; j++) { /* yj0 = 0. ; */ /* yj1 = 0. ; */ CLEAR (yx,yz,0) ; CLEAR (yx,yz,1) ; /* xj0 = alpha [0] * x [j ] ; */ /* xj1 = alpha [0] * x [j+dx] ; */ MULT (xx,xz,0, alpha,alphaz,0, Xx,Xz,j) ; MULT (xx,xz,1, alpha,alphaz,0, Xx,Xz,j+dx) ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i == j) { /* aij = Ax [p] ; */ ASSIGN (ax,az,0, Ax,Az,p) ; /* y [i ] += aij * xj0 ; */ /* y [i+dy] += aij * xj1 ; */ MULTADD (Yx,Yz,i, ax,az,0, xx,xz,0) ; MULTADD (Yx,Yz,i+dy, ax,az,0, xx,xz,1) ; } else if ((A->stype > 0 && i < j) || (A->stype < 0 && i > j)) { /* aij = Ax [p] ; */ ASSIGN (ax,az,0, Ax,Az,p) ; /* y [i ] += aij * xj0 ; */ /* y [i+dy] += aij * xj1 ; */ /* yj0 += aij * x [i ] ; */ /* yj1 += aij * x [i+dx] ; */ MULTADD (Yx,Yz,i, ax,az,0, xx,xz,0) ; MULTADD (Yx,Yz,i+dy, ax,az,0, xx,xz,1) ; MULTADDCONJ (yx,yz,0, ax,az,0, Xx,Xz,i) ; MULTADDCONJ (yx,yz,1, ax,az,0, Xx,Xz,i+dx) ; } } /* y [j ] += alpha [0] * yj0 ; */ /* y [j+dy] += alpha [0] * yj1 ; */ MULTADD (Yx,Yz,j, alpha,alphaz,0, yx,yz,0) ; MULTADD (Yx,Yz,j+dy, alpha,alphaz,0, yx,yz,1) ; } /* y += 2*dy ; */ /* x += 2*dx ; */ ADVANCE (Yx,Yz,2*dy) ; ADVANCE (Xx,Xz,2*dx) ; k += 2 ; } else if (kcol % 4 == 3) { for (j = 0 ; j < ncol ; j++) { /* yj0 = 0. ; */ /* yj1 = 0. ; */ /* yj2 = 0. ; */ CLEAR (yx,yz,0) ; CLEAR (yx,yz,1) ; CLEAR (yx,yz,2) ; /* xj0 = alpha [0] * x [j ] ; */ /* xj1 = alpha [0] * x [j+ dx] ; */ /* xj2 = alpha [0] * x [j+2*dx] ; */ MULT (xx,xz,0, alpha,alphaz,0, Xx,Xz,j) ; MULT (xx,xz,1, alpha,alphaz,0, Xx,Xz,j+dx) ; MULT (xx,xz,2, alpha,alphaz,0, Xx,Xz,j+2*dx) ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i == j) { /* aij = Ax [p] ; */ ASSIGN (ax,az,0, Ax,Az,p) ; /* y [i ] += aij * xj0 ; */ /* y [i+ dy] += aij * xj1 ; */ /* y [i+2*dy] += aij * xj2 ; */ MULTADD (Yx,Yz,i, ax,az,0, xx,xz,0) ; MULTADD (Yx,Yz,i+dy, ax,az,0, xx,xz,1) ; MULTADD (Yx,Yz,i+2*dy, ax,az,0, xx,xz,2) ; } else if ((A->stype > 0 && i < j) || (A->stype < 0 && i > j)) { /* aij = Ax [p] ; */ ASSIGN (ax,az,0, Ax,Az,p) ; /* y [i ] += aij * xj0 ; */ /* y [i+ dy] += aij * xj1 ; */ /* y [i+2*dy] += aij * xj2 ; */ /* yj0 += aij * x [i ] ; */ /* yj1 += aij * x [i+ dx] ; */ /* yj2 += aij * x [i+2*dx] ; */ MULTADD (Yx,Yz,i, ax,az,0, xx,xz,0) ; MULTADD (Yx,Yz,i+dy, ax,az,0, xx,xz,1) ; MULTADD (Yx,Yz,i+2*dy, ax,az,0, xx,xz,2) ; MULTADDCONJ (yx,yz,0, ax,az,0, Xx,Xz,i) ; MULTADDCONJ (yx,yz,1, ax,az,0, Xx,Xz,i+dx) ; MULTADDCONJ (yx,yz,2, ax,az,0, Xx,Xz,i+2*dx) ; } } /* y [j ] += alpha [0] * yj0 ; */ /* y [j+ dy] += alpha [0] * yj1 ; */ /* y [j+2*dy] += alpha [0] * yj2 ; */ MULTADD (Yx,Yz,j, alpha,alphaz,0, yx,yz,0) ; MULTADD (Yx,Yz,j+dy, alpha,alphaz,0, yx,yz,1) ; MULTADD (Yx,Yz,j+2*dy, alpha,alphaz,0, yx,yz,2) ; } /* y += 3*dy ; */ /* x += 3*dx ; */ ADVANCE (Yx,Yz,3*dy) ; ADVANCE (Xx,Xz,3*dx) ; k += 3 ; } /* copy four columns of X into W, and put in row form */ for ( ; k < kcol ; k += 4) { for (j = 0 ; j < ncol ; j++) { /* w [4*j ] = x [j ] ; */ /* w [4*j+1] = x [j+ dx] ; */ /* w [4*j+2] = x [j+2*dx] ; */ /* w [4*j+3] = x [j+3*dx] ; */ ASSIGN (w,Wz,4*j , Xx,Xz,j ) ; ASSIGN (w,Wz,4*j+1, Xx,Xz,j+dx ) ; ASSIGN (w,Wz,4*j+2, Xx,Xz,j+2*dx) ; ASSIGN (w,Wz,4*j+3, Xx,Xz,j+3*dx) ; } for (j = 0 ; j < ncol ; j++) { /* yj0 = 0. ; */ /* yj1 = 0. ; */ /* yj2 = 0. ; */ /* yj3 = 0. ; */ CLEAR (yx,yz,0) ; CLEAR (yx,yz,1) ; CLEAR (yx,yz,2) ; CLEAR (yx,yz,3) ; /* xj0 = alpha [0] * w [4*j ] ; */ /* xj1 = alpha [0] * w [4*j+1] ; */ /* xj2 = alpha [0] * w [4*j+2] ; */ /* xj3 = alpha [0] * w [4*j+3] ; */ MULT (xx,xz,0, alpha,alphaz,0, w,Wz,4*j) ; MULT (xx,xz,1, alpha,alphaz,0, w,Wz,4*j+1) ; MULT (xx,xz,2, alpha,alphaz,0, w,Wz,4*j+2) ; MULT (xx,xz,3, alpha,alphaz,0, w,Wz,4*j+3) ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i == j) { /* aij = Ax [p] ; */ ASSIGN (ax,az,0, Ax,Az,p) ; /* y [i ] += aij * xj0 ; */ /* y [i+ dy] += aij * xj1 ; */ /* y [i+2*dy] += aij * xj2 ; */ /* y [i+3*dy] += aij * xj3 ; */ MULTADD (Yx,Yz,i , ax,az,0, xx,xz,0) ; MULTADD (Yx,Yz,i+dy , ax,az,0, xx,xz,1) ; MULTADD (Yx,Yz,i+2*dy, ax,az,0, xx,xz,2) ; MULTADD (Yx,Yz,i+3*dy, ax,az,0, xx,xz,3) ; } else if ((A->stype > 0 && i < j) || (A->stype < 0 && i > j)) { /* aij = Ax [p] ; */ ASSIGN (ax,az,0, Ax,Az,p) ; /* y [i ] += aij * xj0 ; */ /* y [i+ dy] += aij * xj1 ; */ /* y [i+2*dy] += aij * xj2 ; */ /* y [i+3*dy] += aij * xj3 ; */ /* yj0 += aij * w [4*i ] ; */ /* yj1 += aij * w [4*i+1] ; */ /* yj2 += aij * w [4*i+2] ; */ /* yj3 += aij * w [4*i+3] ; */ MULTADD (Yx,Yz,i, ax,az,0, xx,xz,0) ; MULTADD (Yx,Yz,i+dy, ax,az,0, xx,xz,1) ; MULTADD (Yx,Yz,i+2*dy, ax,az,0, xx,xz,2) ; MULTADD (Yx,Yz,i+3*dy, ax,az,0, xx,xz,3) ; MULTADDCONJ (yx,yz,0, ax,az,0, w,Wz,4*i) ; MULTADDCONJ (yx,yz,1, ax,az,0, w,Wz,4*i+1) ; MULTADDCONJ (yx,yz,2, ax,az,0, w,Wz,4*i+2) ; MULTADDCONJ (yx,yz,3, ax,az,0, w,Wz,4*i+3) ; } } /* y [j ] += alpha [0] * yj0 ; */ /* y [j+ dy] += alpha [0] * yj1 ; */ /* y [j+2*dy] += alpha [0] * yj2 ; */ /* y [j+3*dy] += alpha [0] * yj3 ; */ MULTADD (Yx,Yz,j , alpha,alphaz,0, yx,yz,0) ; MULTADD (Yx,Yz,j+dy , alpha,alphaz,0, yx,yz,1) ; MULTADD (Yx,Yz,j+2*dy, alpha,alphaz,0, yx,yz,2) ; MULTADD (Yx,Yz,j+3*dy, alpha,alphaz,0, yx,yz,3) ; } /* y += 4*dy ; */ /* x += 4*dx ; */ ADVANCE (Yx,Yz,4*dy) ; ADVANCE (Xx,Xz,4*dx) ; } } } #undef PATTERN #undef REAL #undef COMPLEX #undef ZOMPLEX Matrix/src/CHOLMOD/MatrixOps/cholmod_submatrix.c0000644000176200001440000003133413652535054021223 0ustar liggesusers/* ========================================================================== */ /* === MatrixOps/cholmod_submatrix ========================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/MatrixOps Module. Copyright (C) 2005-2006, Timothy A. Davis * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* C = A (rset,cset), where C becomes length(rset)-by-length(cset) in dimension. * rset and cset can have duplicate entries. A and C must be unsymmetric. C * is packed. If the sorted flag is TRUE on input, or rset is sorted and A is * sorted, then C is sorted; otherwise C is unsorted. * * A NULL rset or cset means "[ ]" in MATLAB notation. * If the length of rset or cset is negative, it denotes ":" in MATLAB notation. * * For permuting a matrix, this routine is an alternative to cholmod_ptranspose * (which permutes and transposes a matrix and can work on symmetric matrices). * * The time taken by this routine is O(A->nrow) if the Common workspace needs * to be initialized, plus O(C->nrow + C->ncol + nnz (A (:,cset))). Thus, if C * is small and the workspace is not initialized, the time can be dominated by * the call to cholmod_allocate_work. However, once the workspace is * allocated, subsequent calls take less time. * * workspace: Iwork (max (A->nrow + length (rset), length (cset))). * allocates temporary copy of C if it is to be returned sorted. * * Future work: A common case occurs where A has sorted columns, and rset is in * the form lo:hi in MATLAB notation. This routine could exploit that case * to run even faster when the matrix is sorted, particularly when lo is small. * * Only pattern and real matrices are supported. Complex and zomplex matrices * are supported only when "values" is FALSE. */ #ifndef NGPL #ifndef NMATRIXOPS #include "cholmod_internal.h" #include "cholmod_matrixops.h" /* ========================================================================== */ /* === check_subset ========================================================= */ /* ========================================================================== */ /* Check the rset or cset, and return TRUE if valid, FALSE if invalid */ static int check_subset (Int *set, Int len, Int n) { Int k ; if (set == NULL) { return (TRUE) ; } for (k = 0 ; k < len ; k++) { if (set [k] < 0 || set [k] >= n) { return (FALSE) ; } } return (TRUE) ; } /* ========================================================================== */ /* === cholmod_submatrix ==================================================== */ /* ========================================================================== */ cholmod_sparse *CHOLMOD(submatrix) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to subreference */ Int *rset, /* set of row indices, duplicates OK */ SuiteSparse_long rsize, /* size of rset, or -1 for ":" */ Int *cset, /* set of column indices, duplicates OK */ SuiteSparse_long csize, /* size of cset, or -1 for ":" */ int values, /* if TRUE compute the numerical values of C */ int sorted, /* if TRUE then return C with sorted columns */ /* --------------- */ cholmod_common *Common ) { double aij = 0 ; double *Ax, *Cx ; Int *Ap, *Ai, *Anz, *Ci, *Cp, *Head, *Rlen, *Rnext, *Iwork ; cholmod_sparse *C ; Int packed, ancol, anrow, cnrow, cncol, nnz, i, j, csorted, ilast, p, pend, pdest, ci, cj, head, nr, nc ; size_t s ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (A, NULL) ; values = (values && (A->xtype != CHOLMOD_PATTERN)) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ; if (A->stype != 0) { /* A must be unsymmetric */ ERROR (CHOLMOD_INVALID, "symmetric upper or lower case not supported") ; return (NULL) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ ancol = A->ncol ; anrow = A->nrow ; nr = rsize ; nc = csize ; if (rset == NULL) { /* nr = 0 denotes rset = [ ], nr < 0 denotes rset = 0:anrow-1 */ nr = (nr < 0) ? (-1) : 0 ; } if (cset == NULL) { /* nr = 0 denotes cset = [ ], nr < 0 denotes cset = 0:ancol-1 */ nc = (nc < 0) ? (-1) : 0 ; } cnrow = (nr < 0) ? anrow : nr ; /* negative rset means rset = 0:anrow-1 */ cncol = (nc < 0) ? ancol : nc ; /* negative cset means cset = 0:ancol-1 */ if (nr < 0 && nc < 0) { /* ------------------------------------------------------------------ */ /* C = A (:,:), use cholmod_copy instead */ /* ------------------------------------------------------------------ */ /* workspace: Iwork (max (C->nrow,C->ncol)) */ PRINT1 (("submatrix C = A (:,:)\n")) ; C = CHOLMOD(copy) (A, 0, values, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (NULL) ; } return (C) ; } PRINT1 (("submatrix nr "ID" nc "ID" Cnrow "ID" Cncol "ID"" " Anrow "ID" Ancol "ID"\n", nr, nc, cnrow, cncol, anrow, ancol)) ; /* s = MAX3 (anrow+MAX(0,nr), cncol, cnrow) ; */ s = CHOLMOD(add_size_t) (anrow, MAX (0,nr), &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (NULL) ; } s = MAX3 (s, ((size_t) cncol), ((size_t) cnrow)) ; CHOLMOD(allocate_work) (anrow, s, 0, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (NULL) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ Ap = A->p ; Anz = A->nz ; Ai = A->i ; Ax = A->x ; packed = A->packed ; /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ Head = Common->Head ; /* size anrow */ Iwork = Common->Iwork ; Rlen = Iwork ; /* size anrow (i/i/l) */ Rnext = Iwork + anrow ; /* size nr (i/i/l), not used if nr < 0 */ /* ---------------------------------------------------------------------- */ /* construct inverse of rset and compute nnz (C) */ /* ---------------------------------------------------------------------- */ PRINT1 (("nr "ID" nc "ID"\n", nr, nc)) ; PRINT1 (("anrow "ID" ancol "ID"\n", anrow, ancol)) ; PRINT1 (("cnrow "ID" cncol "ID"\n", cnrow, cncol)) ; DEBUG (for (i = 0 ; i < nr ; i++) PRINT2 (("rset ["ID"] = "ID"\n", i, rset [i]))); DEBUG (for (i = 0 ; i < nc ; i++) PRINT2 (("cset ["ID"] = "ID"\n", i, cset [i]))); /* C is sorted if A and rset are sorted, or if C has one row or less */ csorted = A->sorted || (cnrow <= 1) ; if (!check_subset (rset, nr, anrow)) { ERROR (CHOLMOD_INVALID, "invalid rset") ; return (NULL) ; } if (!check_subset (cset, nc, ancol)) { ERROR (CHOLMOD_INVALID, "invalid cset") ; return (NULL) ; } nnz = 0 ; if (nr < 0) { /* C = A (:,cset) where cset = [ ] or cset is not empty */ ASSERT (IMPLIES (cncol > 0, cset != NULL)) ; for (cj = 0 ; cj < cncol ; cj++) { /* construct column cj of C, which is column j of A */ j = cset [cj] ; nnz += (packed) ? (Ap [j+1] - Ap [j]) : MAX (0, Anz [j]) ; } } else { /* C = A (rset,cset), where rset is not empty but cset might be empty */ /* create link lists in reverse order to preserve natural order */ ilast = anrow ; for (ci = nr-1 ; ci >= 0 ; ci--) { /* row i of A becomes row ci of C; add ci to ith link list */ i = rset [ci] ; head = Head [i] ; Rlen [i] = (head == EMPTY) ? 1 : (Rlen [i] + 1) ; Rnext [ci] = head ; Head [i] = ci ; if (i > ilast) { /* row indices in columns of C will not be sorted */ csorted = FALSE ; } ilast = i ; } #ifndef NDEBUG for (i = 0 ; i < anrow ; i++) { Int k = 0 ; Int rlen = (Head [i] != EMPTY) ? Rlen [i] : -1 ; PRINT1 (("Row "ID" Rlen "ID": ", i, rlen)) ; for (ci = Head [i] ; ci != EMPTY ; ci = Rnext [ci]) { k++ ; PRINT2 ((""ID" ", ci)) ; } PRINT1 (("\n")) ; ASSERT (IMPLIES (Head [i] != EMPTY, k == Rlen [i])) ; } #endif /* count nonzeros in C */ for (cj = 0 ; cj < cncol ; cj++) { /* count rows in column cj of C, which is column j of A */ j = (nc < 0) ? cj : (cset [cj]) ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { /* row i of A becomes multiple rows (ci) of C */ i = Ai [p] ; ASSERT (i >= 0 && i < anrow) ; if (Head [i] != EMPTY) { nnz += Rlen [i] ; } } } } PRINT1 (("nnz (C) "ID"\n", nnz)) ; /* rset and cset are now valid */ DEBUG (CHOLMOD(dump_subset) (rset, rsize, anrow, "rset", Common)) ; DEBUG (CHOLMOD(dump_subset) (cset, csize, ancol, "cset", Common)) ; /* ---------------------------------------------------------------------- */ /* allocate C */ /* ---------------------------------------------------------------------- */ C = CHOLMOD(allocate_sparse) (cnrow, cncol, nnz, csorted, TRUE, 0, values ? A->xtype : CHOLMOD_PATTERN, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ for (i = 0 ; i < anrow ; i++) { Head [i] = EMPTY ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; return (NULL) ; } Cp = C->p ; Ci = C->i ; Cx = C->x ; /* ---------------------------------------------------------------------- */ /* C = A (rset,cset) */ /* ---------------------------------------------------------------------- */ pdest = 0 ; if (nnz == 0) { /* C has no nonzeros */ for (cj = 0 ; cj <= cncol ; cj++) { Cp [cj] = 0 ; } } else if (nr < 0) { /* C = A (:,cset), where cset is not empty */ for (cj = 0 ; cj < cncol ; cj++) { /* construct column cj of C, which is column j of A */ PRINT1 (("construct cj = j = "ID"\n", cj)) ; j = cset [cj] ; Cp [cj] = pdest ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { Ci [pdest] = Ai [p] ; if (values) { Cx [pdest] = Ax [p] ; } pdest++ ; ASSERT (pdest <= nnz) ; } } } else { /* C = A (rset,cset), where rset is not empty but cset might be empty */ for (cj = 0 ; cj < cncol ; cj++) { /* construct column cj of C, which is column j of A */ PRINT1 (("construct cj = "ID"\n", cj)) ; j = (nc < 0) ? cj : (cset [cj]) ; PRINT1 (("cj = "ID"\n", j)) ; Cp [cj] = pdest ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { /* row (Ai [p]) of A becomes multiple rows (ci) of C */ PRINT2 (("i: "ID" becomes: ", Ai [p])) ; if (values) { aij = Ax [p] ; } for (ci = Head [Ai [p]] ; ci != EMPTY ; ci = Rnext [ci]) { PRINT3 ((""ID" ", ci)) ; Ci [pdest] = ci ; if (values) { Cx [pdest] = aij ; } pdest++ ; ASSERT (pdest <= nnz) ; } PRINT2 (("\n")) ; } } } Cp [cncol] = pdest ; ASSERT (nnz == pdest) ; /* ---------------------------------------------------------------------- */ /* clear workspace */ /* ---------------------------------------------------------------------- */ for (ci = 0 ; ci < nr ; ci++) { Head [rset [ci]] = EMPTY ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; /* ---------------------------------------------------------------------- */ /* sort C, if requested */ /* ---------------------------------------------------------------------- */ ASSERT (CHOLMOD(dump_sparse) (C , "C before sort", Common) >= 0) ; if (sorted && !csorted) { /* workspace: Iwork (max (C->nrow,C->ncol)) */ if (!CHOLMOD(sort) (C, Common)) { /* out of memory */ CHOLMOD(free_sparse) (&C, Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; return (NULL) ; } } /* ---------------------------------------------------------------------- */ /* return result */ /* ---------------------------------------------------------------------- */ ASSERT (CHOLMOD(dump_sparse) (C , "Final C", Common) >= 0) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; return (C) ; } #endif #endif Matrix/src/CHOLMOD/Makefile0000644000176200001440000000122314154165630015035 0ustar liggesusers#------------------------------------------------------------------------------- # CHOLMOD Makefile #------------------------------------------------------------------------------- .PHONY : default all library purge clean distclean ccode default: all # Compile the C-callable libraries and the Demo programs. all: ( cd Lib ; $(MAKE) ) # Compile the C-callable libraries only. library: ( cd Lib ; $(MAKE) ) # Remove all files not in the original distribution purge: ( cd Lib ; $(MAKE) purge ) # Remove all files not in the original distribution, except keep the # compiled libraries. clean: ( cd Lib ; $(MAKE) clean ) distclean: purge ccode: all Matrix/src/CHOLMOD/Partition/0000755000176200001440000000000014154165363015353 5ustar liggesusersMatrix/src/CHOLMOD/Partition/cholmod_nesdis.c0000644000176200001440000020646113652535054020522 0ustar liggesusers/* ========================================================================== */ /* === Partition/cholmod_nesdis ============================================= */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Partition Module. * Copyright (C) 2005-2006, Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* CHOLMOD nested dissection and graph partitioning. * * cholmod_bisect: * * Finds a set of nodes that partitions the graph into two parts. * Compresses the graph first. Requires METIS. * * cholmod_nested_dissection: * * Nested dissection, using its own compression and connected-commponents * algorithms, an external graph partitioner (METIS), and a constrained * minimum degree ordering algorithm (CCOLAMD or CSYMAMD). Typically * gives better orderings than METIS_NodeND (about 5% to 10% fewer * nonzeros in L). * * cholmod_collapse_septree: * * Prune the separator tree returned by cholmod_nested_dissection. * * This file contains several routines private to this file: * * partition compress and partition a graph * clear_flag clear Common->Flag, but do not modify negative entries * find_components find the connected components of a graph * * Supports any xtype (pattern, real, complex, or zomplex). */ #ifndef NPARTITION #include "cholmod_internal.h" #include "cholmod_partition.h" #include "cholmod_cholesky.h" /* ========================================================================== */ /* === partition ============================================================ */ /* ========================================================================== */ /* Find a set of nodes that partition a graph. The graph must be symmetric * with no diagonal entries. To compress the graph first, compress is TRUE * and on input Hash [j] holds the hash key for node j, which must be in the * range 0 to csize-1. The input graph (Cp, Ci) is destroyed. Cew is all 1's * on input and output. Cnw [j] > 0 is the initial weight of node j. On * output, Cnw [i] = 0 if node i is absorbed into j and the original weight * Cnw [i] is added to Cnw [j]. If compress is FALSE, the graph is not * compressed and Cnw and Hash are unmodified. The partition itself is held in * the output array Part of size n. Part [j] is 0, 1, or 2, depending on * whether node j is in the left part of the graph, the right part, or the * separator, respectively. Note that the input graph need not be connected, * and the output subgraphs (the three parts) may also be unconnected. * * Returns the size of the separator, in terms of the sum of the weights of * the nodes. It is guaranteed to be between 1 and the total weight of all * the nodes. If it is of size less than the total weight, then both the left * and right parts are guaranteed to be non-empty (this guarantee depends on * cholmod_metis_bisector). */ static SuiteSparse_long partition /* size of separator or -1 if failure */ ( /* inputs, not modified on output */ #ifndef NDEBUG Int csize, /* upper bound on # of edges in the graph; * csize >= MAX (n, nnz(C)) must hold. */ #endif int compress, /* if TRUE the compress the graph first */ /* input/output */ Int Hash [ ], /* Hash [i] = hash >= 0 is the hash function for node * i on input. On output, Hash [i] = FLIP (j) if node * i is absorbed into j. Hash [i] >= 0 if i has not * been absorbed. */ /* input graph, compressed graph of cn nodes on output */ cholmod_sparse *C, /* input/output */ Int Cnw [ ], /* size n. Cnw [j] > 0 is the weight of node j on * input. On output, if node i is absorbed into * node j, then Cnw [i] = 0 and the original weight of * node i is added to Cnw [j]. The sum of Cnw [0..n-1] * is not modified. */ /* workspace */ Int Cew [ ], /* size csize, all 1's on input and output */ /* more workspace, undefined on input and output */ Int Cmap [ ], /* size n (i/i/l) */ /* output */ Int Part [ ], /* size n, Part [j] = 0, 1, or 2. */ cholmod_common *Common ) { Int n, hash, head, i, j, k, p, pend, ilen, ilast, pi, piend, jlen, ok, cn, csep, pdest, nodes_pruned, nz, total_weight, jscattered ; Int *Cp, *Ci, *Next, *Hhead ; #ifndef NDEBUG Int cnt, pruned ; double work = 0, goodwork = 0 ; #endif /* ---------------------------------------------------------------------- */ /* quick return for small or empty graphs */ /* ---------------------------------------------------------------------- */ n = C->nrow ; Cp = C->p ; Ci = C->i ; nz = Cp [n] ; PRINT2 (("Partition start, n "ID" nz "ID"\n", n, nz)) ; total_weight = 0 ; for (j = 0 ; j < n ; j++) { ASSERT (Cnw [j] > 0) ; total_weight += Cnw [j] ; } if (n <= 2) { /* very small graph */ for (j = 0 ; j < n ; j++) { Part [j] = 2 ; } return (total_weight) ; } else if (nz <= 0) { /* no edges, this is easy */ PRINT2 (("diagonal matrix\n")) ; k = n/2 ; for (j = 0 ; j < k ; j++) { Part [j] = 0 ; } for ( ; j < n ; j++) { Part [j] = 1 ; } /* ensure the separator is not empty (required by nested dissection) */ Part [n-1] = 2 ; return (Cnw [n-1]) ; } #ifndef NDEBUG ASSERT (n > 1 && nz > 0) ; PRINT2 (("original graph:\n")) ; for (j = 0 ; j < n ; j++) { PRINT2 ((""ID": ", j)) ; for (p = Cp [j] ; p < Cp [j+1] ; p++) { i = Ci [p] ; PRINT3 ((""ID" ", i)) ; ASSERT (i >= 0 && i < n && i != j) ; } PRINT2 (("hash: "ID"\n", Hash [j])) ; } DEBUG (for (p = 0 ; p < csize ; p++) ASSERT (Cew [p] == 1)) ; #endif nodes_pruned = 0 ; if (compress) { /* ------------------------------------------------------------------ */ /* get workspace */ /* ------------------------------------------------------------------ */ Next = Part ; /* use Part as workspace for Next [ */ Hhead = Cew ; /* use Cew as workspace for Hhead [ */ /* ------------------------------------------------------------------ */ /* create the hash buckets */ /* ------------------------------------------------------------------ */ for (j = 0 ; j < n ; j++) { /* get the hash key for node j */ hash = Hash [j] ; ASSERT (hash >= 0 && hash < csize) ; head = Hhead [hash] ; if (head > EMPTY) { /* hash bucket for this hash key is empty. */ head = EMPTY ; } else { /* hash bucket for this hash key is not empty. get old head */ head = FLIP (head) ; ASSERT (head >= 0 && head < n) ; } /* node j becomes the new head of the hash bucket. FLIP it so that * we can tell the difference between an empty or non-empty hash * bucket. */ Hhead [hash] = FLIP (j) ; Next [j] = head ; ASSERT (head >= EMPTY && head < n) ; } #ifndef NDEBUG for (cnt = 0, k = 0 ; k < n ; k++) { ASSERT (Hash [k] >= 0 && Hash [k] < csize) ; /* k is alive */ hash = Hash [k] ; ASSERT (hash >= 0 && hash < csize) ; head = Hhead [hash] ; ASSERT (head < EMPTY) ; /* hash bucket not empty */ j = FLIP (head) ; ASSERT (j >= 0 && j < n) ; if (j == k) { PRINT2 (("hash "ID": ", hash)) ; for ( ; j != EMPTY ; j = Next [j]) { PRINT3 ((" "ID"", j)) ; ASSERT (j >= 0 && j < n) ; ASSERT (Hash [j] == hash) ; cnt++ ; ASSERT (cnt <= n) ; } PRINT2 (("\n")) ; } } ASSERT (cnt == n) ; #endif /* ------------------------------------------------------------------ */ /* scan the non-empty hash buckets for indistinguishable nodes */ /* ------------------------------------------------------------------ */ /* If there are no hash collisions and no compression occurs, this takes * O(n) time. If no hash collisions, but some nodes are removed, this * takes time O(n+e) where e is the sum of the degress of the nodes * that are removed. Even with many hash collisions (a rare case), * this algorithm has never been observed to perform more than nnz(A) * useless work. * * Cmap is used as workspace to mark nodes of the graph, [ * for comparing the nonzero patterns of two nodes i and j. */ #define Cmap_MARK(i) Cmap [i] = j #define Cmap_MARKED(i) (Cmap [i] == j) for (i = 0 ; i < n ; i++) { Cmap [i] = EMPTY ; } for (k = 0 ; k < n ; k++) { hash = Hash [k] ; ASSERT (hash >= FLIP (n-1) && hash < csize) ; if (hash < 0) { /* node k has already been absorbed into some other node */ ASSERT (FLIP (Hash [k]) >= 0 && FLIP (Hash [k] < n)) ; continue ; } head = Hhead [hash] ; ASSERT (head < EMPTY || head == 1) ; if (head == 1) { /* hash bucket is already empty */ continue ; } PRINT2 (("\n--------------------hash "ID":\n", hash)) ; for (j = FLIP (head) ; j != EMPTY && Next[j] > EMPTY ; j = Next [j]) { /* compare j with all nodes i following it in hash bucket */ ASSERT (j >= 0 && j < n && Hash [j] == hash) ; p = Cp [j] ; pend = Cp [j+1] ; jlen = pend - p ; jscattered = FALSE ; DEBUG (for (i = 0 ; i < n ; i++) ASSERT (!Cmap_MARKED (i))) ; DEBUG (pruned = FALSE) ; ilast = j ; for (i = Next [j] ; i != EMPTY ; i = Next [i]) { ASSERT (i >= 0 && i < n && Hash [i] == hash && i != j) ; pi = Cp [i] ; piend = Cp [i+1] ; ilen = piend - pi ; DEBUG (work++) ; if (ilen != jlen) { /* i and j have different degrees */ ilast = i ; continue ; } /* scatter the pattern of node j, if not already */ if (!jscattered) { Cmap_MARK (j) ; for ( ; p < pend ; p++) { Cmap_MARK (Ci [p]) ; } jscattered = TRUE ; DEBUG (work += jlen) ; } for (ok = Cmap_MARKED (i) ; ok && pi < piend ; pi++) { ok = Cmap_MARKED (Ci [pi]) ; DEBUG (work++) ; } if (ok) { /* found it. kill node i and merge it into j */ PRINT2 (("found "ID" absorbed into "ID"\n", i, j)) ; Hash [i] = FLIP (j) ; Cnw [j] += Cnw [i] ; Cnw [i] = 0 ; ASSERT (ilast != i && ilast >= 0 && ilast < n) ; Next [ilast] = Next [i] ; /* delete i from bucket */ nodes_pruned++ ; DEBUG (goodwork += (ilen+1)) ; DEBUG (pruned = TRUE) ; } else { /* i and j are different */ ilast = i ; } } DEBUG (if (pruned) goodwork += jlen) ; } /* empty the hash bucket, restoring Cew */ Hhead [hash] = 1 ; } DEBUG (if (((work - goodwork) / (double) nz) > 0.20) PRINT0 (( "work %12g good %12g nz %12g (wasted work/nz: %6.2f )\n", work, goodwork, (double) nz, (work - goodwork) / ((double) nz)))) ; /* All hash buckets now empty. Cmap no longer needed as workspace. ] * Cew no longer needed as Hhead; Cew is now restored to all ones. ] * Part no longer needed as workspace for Next. ] */ } /* Edge weights are all one, node weights reflect node absorption */ DEBUG (for (p = 0 ; p < csize ; p++) ASSERT (Cew [p] == 1)) ; DEBUG (for (cnt = 0, j = 0 ; j < n ; j++) cnt += Cnw [j]) ; ASSERT (cnt == total_weight) ; /* ---------------------------------------------------------------------- */ /* compress and partition the graph */ /* ---------------------------------------------------------------------- */ if (nodes_pruned == 0) { /* ------------------------------------------------------------------ */ /* no pruning done at all. Do not create the compressed graph */ /* ------------------------------------------------------------------ */ /* FUTURE WORK: could call CHACO, SCOTCH, ... here too */ csep = CHOLMOD(metis_bisector) (C, Cnw, Cew, Part, Common) ; } else if (nodes_pruned == n-1) { /* ------------------------------------------------------------------ */ /* only one node left. This is a dense graph */ /* ------------------------------------------------------------------ */ PRINT2 (("completely dense graph\n")) ; csep = total_weight ; for (j = 0 ; j < n ; j++) { Part [j] = 2 ; } } else { /* ------------------------------------------------------------------ */ /* compress the graph and partition the compressed graph */ /* ------------------------------------------------------------------ */ /* ------------------------------------------------------------------ */ /* create the map from the uncompressed graph to the compressed graph */ /* ------------------------------------------------------------------ */ /* Cmap [j] = k if node j is alive and the kth node of compressed graph. * The mapping is done monotonically (that is, k <= j) to simplify the * uncompression later on. Cmap [j] = EMPTY if node j is dead. */ for (j = 0 ; j < n ; j++) { Cmap [j] = EMPTY ; } k = 0 ; for (j = 0 ; j < n ; j++) { if (Cnw [j] > 0) { ASSERT (k <= j) ; Cmap [j] = k++ ; } } cn = k ; /* # of nodes in compressed graph */ PRINT2 (("compressed graph from "ID" to "ID" nodes\n", n, cn)) ; ASSERT (cn > 1 && cn == n - nodes_pruned) ; /* ------------------------------------------------------------------ */ /* create the compressed graph */ /* ------------------------------------------------------------------ */ k = 0 ; pdest = 0 ; for (j = 0 ; j < n ; j++) { if (Cnw [j] > 0) { /* node j in the full graph is node k in the compressed graph */ ASSERT (k <= j && Cmap [j] == k) ; p = Cp [j] ; pend = Cp [j+1] ; Cp [k] = pdest ; Cnw [k] = Cnw [j] ; for ( ; p < pend ; p++) { /* prune dead nodes, and remap to new node numbering */ i = Ci [p] ; ASSERT (i >= 0 && i < n && i != j) ; i = Cmap [i] ; ASSERT (i >= EMPTY && i < cn && i != k) ; if (i > EMPTY) { ASSERT (pdest <= p) ; Ci [pdest++] = i ; } } k++ ; } } Cp [cn] = pdest ; C->nrow = cn ; C->ncol = cn ; /* affects mem stats unless restored when C free'd */ #ifndef NDEBUG PRINT2 (("pruned graph ("ID"/"ID") nodes, ("ID"/"ID") edges\n", cn, n, pdest, nz)) ; PRINT2 (("compressed graph:\n")) ; for (cnt = 0, j = 0 ; j < cn ; j++) { PRINT2 ((""ID": ", j)) ; for (p = Cp [j] ; p < Cp [j+1] ; p++) { i = Ci [p] ; PRINT3 ((""ID" ", i)) ; ASSERT (i >= 0 && i < cn && i != j) ; } PRINT2 (("weight: "ID"\n", Cnw [j])) ; ASSERT (Cnw [j] > 0) ; cnt += Cnw [j] ; } ASSERT (cnt == total_weight) ; for (j = 0 ; j < n ; j++) PRINT2 (("Cmap ["ID"] = "ID"\n", j, Cmap[j])); ASSERT (k == cn) ; #endif /* ------------------------------------------------------------------ */ /* find the separator of the compressed graph */ /* ------------------------------------------------------------------ */ /* FUTURE WORK: could call CHACO, SCOTCH, ... here too */ csep = CHOLMOD(metis_bisector) (C, Cnw, Cew, Part, Common) ; if (csep < 0) { /* failed */ return (-1) ; } PRINT2 (("Part: ")) ; DEBUG (for (j = 0 ; j < cn ; j++) PRINT2 ((""ID" ", Part [j]))) ; PRINT2 (("\n")) ; /* Cp and Ci no longer needed */ /* ------------------------------------------------------------------ */ /* find the separator of the uncompressed graph */ /* ------------------------------------------------------------------ */ /* expand the separator to live nodes in the uncompressed graph */ for (j = n-1 ; j >= 0 ; j--) { /* do this in reverse order so that Cnw can be expanded in place */ k = Cmap [j] ; ASSERT (k >= EMPTY && k < n) ; if (k > EMPTY) { /* node k in compressed graph and is node j in full graph */ ASSERT (k <= j) ; ASSERT (Hash [j] >= EMPTY) ; Part [j] = Part [k] ; Cnw [j] = Cnw [k] ; } else { /* node j is a dead node */ Cnw [j] = 0 ; DEBUG (Part [j] = EMPTY) ; ASSERT (Hash [j] < EMPTY) ; } } /* find the components for the dead nodes */ for (i = 0 ; i < n ; i++) { if (Hash [i] < EMPTY) { /* node i has been absorbed into node j */ j = FLIP (Hash [i]) ; ASSERT (Part [i] == EMPTY && j >= 0 && j < n && Cnw [i] == 0) ; Part [i] = Part [j] ; } ASSERT (Part [i] >= 0 && Part [i] <= 2) ; } #ifndef NDEBUG PRINT2 (("Part: ")) ; for (cnt = 0, j = 0 ; j < n ; j++) { ASSERT (Part [j] != EMPTY) ; PRINT2 ((""ID" ", Part [j])) ; if (Part [j] == 2) cnt += Cnw [j] ; } PRINT2 (("\n")) ; PRINT2 (("csep "ID" "ID"\n", cnt, csep)) ; ASSERT (cnt == csep) ; for (cnt = 0, j = 0 ; j < n ; j++) cnt += Cnw [j] ; ASSERT (cnt == total_weight) ; #endif } /* ---------------------------------------------------------------------- */ /* return the separator (or -1 if error) */ /* ---------------------------------------------------------------------- */ PRINT2 (("Partition done, n "ID" csep "ID"\n", n, csep)) ; return (csep) ; } /* ========================================================================== */ /* === clear_flag =========================================================== */ /* ========================================================================== */ /* A node j has been removed from the graph if Flag [j] < EMPTY. * If Flag [j] >= EMPTY && Flag [j] < mark, then node j is alive but unmarked. * Flag [j] == mark means that node j is alive and marked. Incrementing mark * means that all nodes are either (still) dead, or live but unmarked. * * If Map is NULL, then on output, Common->mark < Common->Flag [i] for all i * from 0 to Common->nrow. This is the same output condition as * cholmod_clear_flag, except that this routine maintains the Flag [i] < EMPTY * condition as well, if that condition was true on input. * * If Map is non-NULL, then on output, Common->mark < Common->Flag [i] for all * i in the set Map [0..cn-1]. * * workspace: Flag (nrow) */ static SuiteSparse_long clear_flag (Int *Map, Int cn, cholmod_common *Common) { Int nrow, i ; Int *Flag ; PRINT2 (("old mark %ld\n", Common->mark)) ; Common->mark++ ; PRINT2 (("new mark %ld\n", Common->mark)) ; if (Common->mark <= 0) { nrow = Common->nrow ; Flag = Common->Flag ; if (Map != NULL) { for (i = 0 ; i < cn ; i++) { /* if Flag [Map [i]] < EMPTY, leave it alone */ if (Flag [Map [i]] >= EMPTY) { Flag [Map [i]] = EMPTY ; } } /* now Flag [Map [i]] <= EMPTY for all i */ } else { for (i = 0 ; i < nrow ; i++) { /* if Flag [i] < EMPTY, leave it alone */ if (Flag [i] >= EMPTY) { Flag [i] = EMPTY ; } } /* now Flag [i] <= EMPTY for all i */ } Common->mark = 0 ; } return (Common->mark) ; } /* ========================================================================== */ /* === find_components ====================================================== */ /* ========================================================================== */ /* Find all connected components of the current subgraph C. The subgraph C * consists of the nodes of B that appear in the set Map [0..cn-1]. If Map * is NULL, then it is assumed to be the identity mapping * (Map [0..cn-1] = 0..cn-1). * * A node j does not appear in B if it has been ordered (Flag [j] < EMPTY, * which means that j has been ordered and is "deleted" from B). * * If the size of a component is large, it is placed on the component stack, * Cstack. Otherwise, its nodes are ordered and it is not placed on the Cstack. * * A component S is defined by a "representative node" (repnode for short) * called the snode, which is one of the nodes in the subgraph. Likewise, the * subgraph C is defined by its repnode, called cnode. * * If Part is not NULL on input, then Part [i] determines how the components * are placed on the stack. Components containing nodes i with Part [i] == 0 * are placed first, followed by components with Part [i] == 1. * * The first node placed in each of the two parts is flipped when placed in * the Cstack. This allows the components of the two parts to be found simply * by traversing the Cstack. * * workspace: Flag (nrow) */ static void find_components ( /* inputs, not modified on output */ cholmod_sparse *B, Int Map [ ], /* size n, only Map [0..cn-1] used */ Int cn, /* # of nodes in C */ Int cnode, /* root node of component C, or EMPTY if C is the * entire graph B */ Int Part [ ], /* size cn, optional */ /* input/output */ Int Bnz [ ], /* size n. Bnz [j] = # nonzeros in column j of B. * Reduce since B is pruned of dead nodes. */ Int CParent [ ], /* CParent [i] = j if component with repnode j is * the parent of the component with repnode i. * CParent [i] = EMPTY if the component with * repnode i is a root of the separator tree. * CParent [i] is -2 if i is not a repnode. */ Int Cstack [ ], /* component stack for nested dissection */ Int *top, /* Cstack [0..top] contains root nodes of the * the components currently in the stack */ /* workspace, undefined on input and output: */ Int Queue [ ], /* size n, for breadth-first search */ cholmod_common *Common ) { Int n, mark, cj, j, sj, sn, p, i, snode, pstart, pdest, pend, nd_components, part, first, save_mark ; Int *Bp, *Bi, *Flag ; /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ PRINT2 (("find components: cn %d\n", cn)) ; Flag = Common->Flag ; /* size n */ /* force initialization of Flag [Map [0..cn-1]] */ save_mark = Common->mark ; /* save the current mark */ Common->mark = EMPTY ; /* clear Flag; preserve Flag [Map [i]] if Flag [Map [i]] already < EMPTY */ /* this takes O(cn) time */ mark = clear_flag (Map, cn, Common) ; Bp = B->p ; Bi = B->i ; n = B->nrow ; ASSERT (cnode >= EMPTY && cnode < n) ; ASSERT (IMPLIES (cnode >= 0, Flag [cnode] < EMPTY)) ; /* get ordering parameters */ nd_components = Common->method [Common->current].nd_components ; /* ---------------------------------------------------------------------- */ /* find the connected components of C via a breadth-first search */ /* ---------------------------------------------------------------------- */ part = (Part == NULL) ? 0 : 1 ; /* examine each part (part 1 and then part 0) */ for (part = (Part == NULL) ? 0 : 1 ; part >= 0 ; part--) { /* first is TRUE for the first connected component in each part */ first = TRUE ; /* find all connected components in the current part */ for (cj = 0 ; cj < cn ; cj++) { /* get node snode, which is node cj of C. It might already be in * the separator of C (and thus ordered, with Flag [snode] < EMPTY) */ snode = (Map == NULL) ? (cj) : (Map [cj]) ; ASSERT (snode >= 0 && snode < n) ; if (Flag [snode] >= EMPTY && Flag [snode] < mark && ((Part == NULL) || Part [cj] == part)) { /* ---------------------------------------------------------- */ /* find new connected component S */ /* ---------------------------------------------------------- */ /* node snode is the repnode of a connected component S, the * parent of which is cnode, the repnode of C. If cnode is * EMPTY then C is the original graph B. */ PRINT2 (("----------:::snode "ID" cnode "ID"\n", snode, cnode)); ASSERT (CParent [snode] == -2) ; if (first || nd_components) { /* If this is the first node in this part, then it becomes * the repnode of all components in this part, and all * components in this part form a single node in the * separator tree. If nd_components is TRUE, then all * connected components form their own node in the * separator tree. */ CParent [snode] = cnode ; } /* place j in the queue and mark it */ Queue [0] = snode ; Flag [snode] = mark ; sn = 1 ; /* breadth-first traversal, starting at node j */ for (sj = 0 ; sj < sn ; sj++) { /* get node j from head of Queue and traverse its edges */ j = Queue [sj] ; PRINT2 ((" j: "ID"\n", j)) ; ASSERT (j >= 0 && j < n) ; ASSERT (Flag [j] == mark) ; pstart = Bp [j] ; pdest = pstart ; pend = pstart + Bnz [j] ; for (p = pstart ; p < pend ; p++) { i = Bi [p] ; if (i != j && Flag [i] >= EMPTY) { /* node is still in the graph */ Bi [pdest++] = i ; if (Flag [i] < mark) { /* node i is in this component S, and unflagged * (first time node i has been seen in this BFS) * place node i in the queue and mark it */ Queue [sn++] = i ; Flag [i] = mark ; } } } /* edges to dead nodes have been removed */ Bnz [j] = pdest - pstart ; } /* ---------------------------------------------------------- */ /* order S if it is small; place it on Cstack otherwise */ /* ---------------------------------------------------------- */ PRINT2 (("sn "ID"\n", sn)) ; /* place the new component on the Cstack. Flip the node if * is the first connected component of the current part, * or if all components are treated as their own node in * the separator tree. */ Cstack [++(*top)] = (first || nd_components) ? FLIP (snode) : snode ; first = FALSE ; } } } /* restore the flag (normally taking O(1) time except for Int overflow) */ Common->mark = save_mark++ ; clear_flag (NULL, 0, Common) ; DEBUG (for (i = 0 ; i < n ; i++) ASSERT (Flag [i] < Common->mark)) ; } /* ========================================================================== */ /* === cholmod_bisect ======================================================= */ /* ========================================================================== */ /* Finds a node bisector of A, A*A', A(:,f)*A(:,f)'. * * workspace: Flag (nrow), * Iwork (nrow if symmetric, max (nrow,ncol) if unsymmetric). * Allocates a temporary matrix B=A*A' or B=A, * and O(nnz(A)) temporary memory space. */ SuiteSparse_long CHOLMOD(bisect) /* returns # of nodes in separator */ ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to bisect */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ int compress, /* if TRUE, compress the graph first */ /* ---- output --- */ Int *Partition, /* size A->nrow. Node i is in the left graph if * Partition [i] = 0, the right graph if 1, and in the * separator if 2. */ /* --------------- */ cholmod_common *Common ) { Int *Bp, *Bi, *Hash, *Cmap, *Bnw, *Bew, *Iwork ; cholmod_sparse *B ; unsigned Int hash ; Int j, n, bnz, sepsize, p, pend ; size_t csize, s ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (EMPTY) ; RETURN_IF_NULL (A, EMPTY) ; RETURN_IF_NULL (Partition, EMPTY) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, EMPTY) ; Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* quick return */ /* ---------------------------------------------------------------------- */ n = A->nrow ; if (n == 0) { return (0) ; } /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* s = n + MAX (n, A->ncol) */ s = CHOLMOD(add_size_t) (A->nrow, MAX (A->nrow, A->ncol), &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (EMPTY) ; } CHOLMOD(allocate_work) (n, s, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (EMPTY) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; Iwork = Common->Iwork ; Hash = Iwork ; /* size n, (i/l/l) */ Cmap = Iwork + n ; /* size n, (i/i/l) */ /* ---------------------------------------------------------------------- */ /* convert the matrix to adjacency list form */ /* ---------------------------------------------------------------------- */ /* The input graph to must be symmetric, with no diagonal entries * present. The columns need not be sorted. */ /* B = A, A*A', or A(:,f)*A(:,f)', upper and lower parts present */ if (A->stype) { /* Add the upper/lower part to a symmetric lower/upper matrix by * converting to unsymmetric mode */ /* workspace: Iwork (nrow) */ B = CHOLMOD(copy) (A, 0, -1, Common) ; } else { /* B = A*A' or A(:,f)*A(:,f)', no diagonal */ /* workspace: Flag (nrow), Iwork (max (nrow,ncol)) */ B = CHOLMOD(aat) (A, fset, fsize, -1, Common) ; } if (Common->status < CHOLMOD_OK) { return (EMPTY) ; } Bp = B->p ; Bi = B->i ; bnz = Bp [n] ; ASSERT ((Int) (B->nrow) == n && (Int) (B->ncol) == n) ; /* B does not include the diagonal, and both upper and lower parts. * Common->anz includes the diagonal, and just the lower part of B */ Common->anz = bnz / 2 + ((double) n) ; /* Bew should be at least size n for the hash function to work well */ /* this cannot cause overflow, because the matrix is already created */ csize = MAX (((size_t) n) + 1, (size_t) bnz) ; /* create the graph using Flag as workspace for node weights [ */ Bnw = Common->Flag ; /* size n workspace */ /* compute hash for each node if compression requested */ if (compress) { for (j = 0 ; j < n ; j++) { hash = j ; pend = Bp [j+1] ; for (p = Bp [j] ; p < pend ; p++) { hash += Bi [p] ; ASSERT (Bi [p] != j) ; } /* finalize the hash key for node j */ hash %= csize ; Hash [j] = (Int) hash ; ASSERT (Hash [j] >= 0 && Hash [j] < csize) ; } } /* allocate edge weights */ Bew = CHOLMOD(malloc) (csize, sizeof (Int), Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ CHOLMOD(free_sparse) (&B, Common) ; CHOLMOD(free) (csize, sizeof (Int), Bew, Common) ; return (EMPTY) ; } /* graph has unit node and edge weights */ for (j = 0 ; j < n ; j++) { Bnw [j] = 1 ; } for (s = 0 ; s < csize ; s++) { Bew [s] = 1 ; } /* ---------------------------------------------------------------------- */ /* compress and partition the graph */ /* ---------------------------------------------------------------------- */ sepsize = partition ( #ifndef NDEBUG csize, #endif compress, Hash, B, Bnw, Bew, Cmap, Partition, Common) ; /* contents of Bp, Bi, Bnw, and Bew no longer needed ] */ /* If partition fails, free the workspace below and return sepsize < 0 */ /* ---------------------------------------------------------------------- */ /* free workspace */ /* ---------------------------------------------------------------------- */ B->ncol = n ; /* restore size for memory usage statistics */ CHOLMOD(free_sparse) (&B, Common) ; Common->mark = EMPTY ; CHOLMOD_CLEAR_FLAG (Common) ; CHOLMOD(free) (csize, sizeof (Int), Bew, Common) ; return (sepsize) ; } /* ========================================================================== */ /* === cholmod_nested_dissection ============================================ */ /* ========================================================================== */ /* This method uses a node bisector, applied recursively (but using a * non-recursive algorithm). Once the graph is partitioned, it calls a * constrained min degree code (CAMD or CSYMAMD for A+A', and CCOLAMD for A*A') * to order all the nodes in the graph - but obeying the constraints determined * by the separators. This routine is similar to METIS_NodeND, except for how * it treats the leaf nodes. METIS_NodeND orders the leaves of the separator * tree with MMD, ignoring the rest of the matrix when ordering a single leaf. * This routine orders the whole matrix with CSYMAMD or CCOLAMD, all at once, * when the graph partitioning is done. * * This function also returns a postorderd separator tree (CParent), and a * mapping of nodes in the graph to nodes in the separator tree (Cmember). * * workspace: Flag (nrow), Head (nrow+1), Iwork (4*nrow + (ncol if unsymmetric)) * Allocates a temporary matrix B=A*A' or B=A, * and O(nnz(A)) temporary memory space. * Allocates an additional 3*n*sizeof(Int) temporary workspace */ SuiteSparse_long CHOLMOD(nested_dissection) /* returns # of components, or -1 if error */ ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ /* ---- output --- */ Int *Perm, /* size A->nrow, output permutation */ Int *CParent, /* size A->nrow. On output, CParent [c] is the parent * of component c, or EMPTY if c is a root, and where * c is in the range 0 to # of components minus 1 */ Int *Cmember, /* size A->nrow. Cmember [j] = c if node j of A is * in component c */ /* --------------- */ cholmod_common *Common ) { double prune_dense, nd_oksep ; Int *Bp, *Bi, *Bnz, *Cstack, *Imap, *Map, *Flag, *Head, *Next, *Bnw, *Iwork, *Ipost, *NewParent, *Hash, *Cmap, *Cp, *Ci, *Cew, *Cnw, *Part, *Post, *Work3n ; unsigned Int hash ; Int n, bnz, top, i, j, k, cnode, cdense, p, cj, cn, ci, cnz, mark, c, uncol, sepsize, parent, ncomponents, threshold, ndense, pstart, pdest, pend, nd_compress, nd_camd, csize, jnext, nd_small, total_weight, nchild, child = EMPTY ; cholmod_sparse *B, *C ; size_t s ; int ok = TRUE ; DEBUG (Int cnt) ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (EMPTY) ; RETURN_IF_NULL (A, EMPTY) ; RETURN_IF_NULL (Perm, EMPTY) ; RETURN_IF_NULL (CParent, EMPTY) ; RETURN_IF_NULL (Cmember, EMPTY) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, EMPTY) ; Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* quick return */ /* ---------------------------------------------------------------------- */ n = A->nrow ; if (n == 0) { return (1) ; } /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ /* get ordering parameters */ prune_dense = Common->method [Common->current].prune_dense ; nd_compress = Common->method [Common->current].nd_compress ; nd_oksep = Common->method [Common->current].nd_oksep ; nd_oksep = MAX (0, nd_oksep) ; nd_oksep = MIN (1, nd_oksep) ; nd_camd = Common->method [Common->current].nd_camd ; nd_small = Common->method [Common->current].nd_small ; nd_small = MAX (4, nd_small) ; PRINT0 (("nd_components %d nd_small %d nd_oksep %g\n", Common->method [Common->current].nd_components, nd_small, nd_oksep)) ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* s = 4*n + uncol */ uncol = (A->stype == 0) ? A->ncol : 0 ; s = CHOLMOD(mult_size_t) (n, 4, &ok) ; s = CHOLMOD(add_size_t) (s, uncol, &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (EMPTY) ; } CHOLMOD(allocate_work) (n, s, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (EMPTY) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ Flag = Common->Flag ; /* size n */ Head = Common->Head ; /* size n+1, all equal to -1 */ Iwork = Common->Iwork ; Imap = Iwork ; /* size n, same as Queue in find_components */ Map = Iwork + n ; /* size n */ Bnz = Iwork + 2*((size_t) n) ; /* size n */ Hash = Iwork + 3*((size_t) n) ; /* size n */ Work3n = CHOLMOD(malloc) (n, 3*sizeof (Int), Common) ; Part = Work3n ; /* size n */ Bnw = Part + n ; /* size n */ Cnw = Bnw + n ; /* size n */ Cstack = Perm ; /* size n, use Perm as workspace for Cstack [ */ Cmap = Cmember ; /* size n, use Cmember as workspace [ */ if (Common->status < CHOLMOD_OK) { return (EMPTY) ; } /* ---------------------------------------------------------------------- */ /* convert B to symmetric form with both upper/lower parts present */ /* ---------------------------------------------------------------------- */ /* B = A+A', A*A', or A(:,f)*A(:,f)', upper and lower parts present */ if (A->stype) { /* Add the upper/lower part to a symmetric lower/upper matrix by * converting to unsymmetric mode */ /* workspace: Iwork (nrow) */ B = CHOLMOD(copy) (A, 0, -1, Common) ; } else { /* B = A*A' or A(:,f)*A(:,f)', no diagonal */ /* workspace: Flag (nrow), Iwork (max (nrow,ncol)) */ B = CHOLMOD(aat) (A, fset, fsize, -1, Common) ; } if (Common->status < CHOLMOD_OK) { CHOLMOD(free) (3*n, sizeof (Int), Work3n, Common) ; return (EMPTY) ; } Bp = B->p ; Bi = B->i ; bnz = CHOLMOD(nnz) (B, Common) ; ASSERT ((Int) (B->nrow) == n && (Int) (B->ncol) == n) ; csize = MAX (n, bnz) ; ASSERT (CHOLMOD(dump_sparse) (B, "B for nd:", Common) >= 0) ; /* ---------------------------------------------------------------------- */ /* initializations */ /* ---------------------------------------------------------------------- */ /* all nodes start out unmarked and unordered (Type 4, see below) */ Common->mark = EMPTY ; CHOLMOD_CLEAR_FLAG (Common) ; ASSERT (Flag == Common->Flag) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; for (j = 0 ; j < n ; j++) { CParent [j] = -2 ; } /* prune dense nodes from B */ if (IS_NAN (prune_dense) || prune_dense < 0) { /* only remove completely dense nodes */ threshold = n-2 ; } else { /* remove nodes with degree more than threshold */ threshold = (Int) (MAX (16, prune_dense * sqrt ((double) (n)))) ; threshold = MIN (n, threshold) ; } ndense = 0 ; cnode = EMPTY ; cdense = EMPTY ; for (j = 0 ; j < n ; j++) { Bnz [j] = Bp [j+1] - Bp [j] ; if (Bnz [j] > threshold) { /* node j is dense, prune it from B */ PRINT2 (("j is dense %d\n", j)) ; ndense++ ; if (cnode == EMPTY) { /* first dense node found becomes root of this component, * which contains all of the dense nodes found here */ cdense = j ; cnode = j ; CParent [cnode] = EMPTY ; } Flag [j] = FLIP (cnode) ; } } B->packed = FALSE ; ASSERT (B->nz == NULL) ; if (ndense == n) { /* all nodes removed: Perm is identity, all nodes in component zero, * and the separator tree has just one node. */ PRINT2 (("all nodes are dense\n")) ; for (k = 0 ; k < n ; k++) { Perm [k] = k ; Cmember [k] = 0 ; } CParent [0] = EMPTY ; CHOLMOD(free_sparse) (&B, Common) ; CHOLMOD(free) (3*n, sizeof (Int), Work3n, Common) ; Common->mark = EMPTY ; CHOLMOD_CLEAR_FLAG (Common) ; return (1) ; } /* Cp and Ci are workspace to construct the subgraphs to partition */ C = CHOLMOD(allocate_sparse) (n, n, csize, FALSE, TRUE, 0, CHOLMOD_PATTERN, Common) ; Cew = CHOLMOD(malloc) (csize, sizeof (Int), Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ CHOLMOD(free_sparse) (&C, Common) ; CHOLMOD(free_sparse) (&B, Common) ; CHOLMOD(free) (csize, sizeof (Int), Cew, Common) ; CHOLMOD(free) (3*n, sizeof (Int), Work3n, Common) ; Common->mark = EMPTY ; CHOLMOD_CLEAR_FLAG (Common) ; PRINT2 (("out of memory for C, etc\n")) ; return (EMPTY) ; } Cp = C->p ; Ci = C->i ; /* create initial unit node and edge weights */ for (j = 0 ; j < n ; j++) { Bnw [j] = 1 ; } for (p = 0 ; p < csize ; p++) { Cew [p] = 1 ; } /* push the initial connnected components of B onto the Cstack */ top = EMPTY ; /* Cstack is empty */ /* workspace: Flag (nrow), Iwork (nrow); use Imap as workspace for Queue [*/ find_components (B, NULL, n, cnode, NULL, Bnz, CParent, Cstack, &top, Imap, Common) ; /* done using Imap as workspace for Queue ] */ /* Nodes can now be of Type 0, 1, 2, or 4 (see definition below) */ /* ---------------------------------------------------------------------- */ /* while Cstack is not empty, do: */ /* ---------------------------------------------------------------------- */ while (top >= 0) { /* clear the Flag array, but do not modify negative entries in Flag */ mark = clear_flag (NULL, 0, Common) ; DEBUG (for (i = 0 ; i < n ; i++) Imap [i] = EMPTY) ; /* ------------------------------------------------------------------ */ /* get node(s) from the top of the Cstack */ /* ------------------------------------------------------------------ */ /* i is the repnode of its (unordered) connected component. Get * all repnodes for all connected components of a single part. If * each connected component is to be ordered separately (nd_components * is TRUE), then this while loop iterates just once. */ cnode = EMPTY ; cn = 0 ; while (cnode == EMPTY) { i = Cstack [top--] ; if (i < 0) { /* this is the last node in this component */ i = FLIP (i) ; cnode = i ; } ASSERT (i >= 0 && i < n && Flag [i] >= EMPTY) ; /* place i in the queue and mark it */ Map [cn] = i ; Flag [i] = mark ; Imap [i] = cn ; cn++ ; } ASSERT (cnode != EMPTY) ; /* During ordering, there are five kinds of nodes in the graph of B, * based on Flag [j] and CParent [j] for nodes j = 0 to n-1: * * Type 0: If cnode is a repnode of an unordered component, then * CParent [cnode] is in the range EMPTY to n-1 and * Flag [cnode] >= EMPTY. This is a "live" node. * * Type 1: If cnode is a repnode of an ordered separator component, * then Flag [cnode] < EMPTY and FLAG [cnode] = FLIP (cnode). * CParent [cnode] is in the range EMPTY to n-1. cnode is a root of * the separator tree if CParent [cnode] == EMPTY. This node is dead. * * Type 2: If node j isn't a repnode, has not been absorbed via * graph compression into another node, but is in an ordered separator * component, then cnode = FLIP (Flag [j]) gives the repnode of the * component that contains j and CParent [j] is -2. This node is dead. * Note that Flag [j] < EMPTY. * * Type 3: If node i has been absorbed via graph compression into some * other node j = FLIP (Flag [i]) where j is not a repnode. * CParent [j] is -2. Node i may or may not be in an ordered * component. This node is dead. Note that Flag [j] < EMPTY. * * Type 4: If node j is "live" (not in an ordered component, and not * absorbed into any other node), then Flag [j] >= EMPTY. * * Only "live" nodes (of type 0 or 4) are placed in a subgraph to be * partitioned. Node j is alive if Flag [j] >= EMPTY, and dead if * Flag [j] < EMPTY. */ /* ------------------------------------------------------------------ */ /* create the subgraph for this connected component C */ /* ------------------------------------------------------------------ */ /* Do a breadth-first search of the graph starting at cnode. * use Map [0..cn-1] for nodes in the component C [ * use Cnw and Cew for node and edge weights of the resulting subgraph [ * use Cp and Ci for the resulting subgraph [ * use Imap [i] for all nodes i in B that are in the component C [ */ cnz = 0 ; total_weight = 0 ; for (cj = 0 ; cj < cn ; cj++) { /* get node j from the head of the queue; it is node cj of C */ j = Map [cj] ; ASSERT (Flag [j] == mark) ; Cp [cj] = cnz ; Cnw [cj] = Bnw [j] ; ASSERT (Cnw [cj] >= 0) ; total_weight += Cnw [cj] ; pstart = Bp [j] ; pdest = pstart ; pend = pstart + Bnz [j] ; hash = cj ; for (p = pstart ; p < pend ; p++) { i = Bi [p] ; /* prune diagonal entries and dead edges from B */ if (i != j && Flag [i] >= EMPTY) { /* live node i is in the current component */ Bi [pdest++] = i ; if (Flag [i] != mark) { /* First time node i has been seen, it is a new node * of C. place node i in the queue and mark it */ Map [cn] = i ; Flag [i] = mark ; Imap [i] = cn ; cn++ ; } /* place the edge (cj,ci) in the adjacency list of cj */ ci = Imap [i] ; ASSERT (ci >= 0 && ci < cn && ci != cj && cnz < csize) ; Ci [cnz++] = ci ; hash += ci ; } } /* edges to dead nodes have been removed */ Bnz [j] = pdest - pstart ; /* finalize the hash key for column j */ hash %= csize ; Hash [cj] = (Int) hash ; ASSERT (Hash [cj] >= 0 && Hash [cj] < csize) ; } Cp [cn] = cnz ; C->nrow = cn ; C->ncol = cn ; /* affects mem stats unless restored when C free'd */ /* contents of Imap no longer needed ] */ #ifndef NDEBUG for (cj = 0 ; cj < cn ; cj++) { j = Map [cj] ; PRINT2 (("----------------------------C column cj: "ID" j: "ID"\n", cj, j)) ; ASSERT (j >= 0 && j < n) ; ASSERT (Flag [j] >= EMPTY) ; for (p = Cp [cj] ; p < Cp [cj+1] ; p++) { ci = Ci [p] ; i = Map [ci] ; PRINT3 (("ci: "ID" i: "ID"\n", ci, i)) ; ASSERT (ci != cj && ci >= 0 && ci < cn) ; ASSERT (i != j && i >= 0 && i < n) ; ASSERT (Flag [i] >= EMPTY) ; } } #endif PRINT0 (("consider cn %d nd_small %d ", cn, nd_small)) ; if (cn < nd_small) /* could be 'total_weight < nd_small' instead */ { /* place all nodes in the separator */ PRINT0 ((" too small\n")) ; sepsize = total_weight ; } else { /* Cp and Ci now contain the component, with cn nodes and cnz * nonzeros. The mapping of a node cj into node j the main graph * B is given by Map [cj] = j */ PRINT0 ((" cut\n")) ; /* -------------------------------------------------------------- */ /* compress and partition the graph C */ /* -------------------------------------------------------------- */ /* The edge weights Cew [0..csize-1] are all 1's on input to and * output from the partition routine. */ sepsize = partition ( #ifndef NDEBUG csize, #endif nd_compress, Hash, C, Cnw, Cew, Cmap, Part, Common) ; /* contents of Cp and Ci no longer needed ] */ if (sepsize < 0) { /* failed */ C->ncol = n ; /* restore size for memory usage statistics */ CHOLMOD(free_sparse) (&C, Common) ; CHOLMOD(free_sparse) (&B, Common) ; CHOLMOD(free) (csize, sizeof (Int), Cew, Common) ; CHOLMOD(free) (3*n, sizeof (Int), Work3n, Common) ; Common->mark = EMPTY ; CHOLMOD_CLEAR_FLAG (Common) ; return (EMPTY) ; } /* -------------------------------------------------------------- */ /* compress B based on how C was compressed */ /* -------------------------------------------------------------- */ for (ci = 0 ; ci < cn ; ci++) { if (Hash [ci] < EMPTY) { /* ci is dead in C, having been absorbed into cj */ cj = FLIP (Hash [ci]) ; PRINT2 (("In C, "ID" absorbed into "ID" (wgt now "ID")\n", ci, cj, Cnw [cj])) ; /* i is dead in B, having been absorbed into j */ i = Map [ci] ; j = Map [cj] ; PRINT2 (("In B, "ID" (wgt "ID") => "ID" (wgt "ID")\n", i, Bnw [i], j, Bnw [j], Cnw [cj])) ; /* more than one node may be absorbed into j. This is * accounted for in Cnw [cj]. Assign it here rather * than += Bnw [i] */ Bnw [i] = 0 ; Bnw [j] = Cnw [cj] ; Flag [i] = FLIP (j) ; } } DEBUG (for (cnt = 0, j = 0 ; j < n ; j++) cnt += Bnw [j]) ; ASSERT (cnt == n) ; } /* contents of Cnw [0..cn-1] no longer needed ] */ /* ------------------------------------------------------------------ */ /* order the separator, and stack the components when C is split */ /* ------------------------------------------------------------------ */ /* one more component has been found: either the separator of C, * or all of C */ ASSERT (sepsize >= 0 && sepsize <= total_weight) ; PRINT0 (("sepsize %d tot %d : %8.4f ", sepsize, total_weight, ((double) sepsize) / ((double) total_weight))) ; if (sepsize == total_weight || sepsize == 0 || sepsize > nd_oksep * total_weight) { /* Order the nodes in the component. The separator is too large, * or empty. Note that the partition routine cannot return a * sepsize of zero, but it can return a separator consisting of the * whole graph. The "sepsize == 0" test is kept, above, in case the * partition routine changes. In either case, this component * remains unsplit, and becomes a leaf of the separator tree. */ PRINT2 (("cnode %d sepsize zero or all of graph: "ID"\n", cnode, sepsize)) ; for (cj = 0 ; cj < cn ; cj++) { j = Map [cj] ; Flag [j] = FLIP (cnode) ; PRINT2 ((" node cj: "ID" j: "ID" ordered\n", cj, j)) ; } ASSERT (Flag [cnode] == FLIP (cnode)) ; ASSERT (cnode != EMPTY && Flag [cnode] < EMPTY) ; PRINT0 (("discarded\n")) ; } else { /* Order the nodes in the separator of C and find a new repnode * cnode that is in the separator of C. This requires the separator * to be non-empty. */ PRINT0 (("sepsize not tiny: "ID"\n", sepsize)) ; parent = CParent [cnode] ; ASSERT (parent >= EMPTY && parent < n) ; CParent [cnode] = -2 ; cnode = EMPTY ; for (cj = 0 ; cj < cn ; cj++) { j = Map [cj] ; if (Part [cj] == 2) { /* All nodes in the separator become part of a component * whose repnode is cnode */ PRINT2 (("node cj: "ID" j: "ID" ordered\n", cj, j)) ; if (cnode == EMPTY) { PRINT2(("------------new cnode: cj "ID" j "ID"\n", cj, j)) ; cnode = j ; } Flag [j] = FLIP (cnode) ; } else { PRINT2 ((" node cj: "ID" j: "ID" not ordered\n", cj, j)) ; } } ASSERT (cnode != EMPTY && Flag [cnode] < EMPTY) ; ASSERT (CParent [cnode] == -2) ; CParent [cnode] = parent ; /* find the connected components when C is split, and push * them on the Cstack. Use Imap as workspace for Queue. [ */ /* workspace: Flag (nrow) */ find_components (B, Map, cn, cnode, Part, Bnz, CParent, Cstack, &top, Imap, Common) ; /* done using Imap as workspace for Queue ] */ } /* contents of Map [0..cn-1] no longer needed ] */ } /* done using Cmember as workspace for Cmap ] */ /* done using Perm as workspace for Cstack ] */ /* ---------------------------------------------------------------------- */ /* place nodes removed via compression into their proper component */ /* ---------------------------------------------------------------------- */ /* At this point, all nodes are of Type 1, 2, or 3, as defined above. */ for (i = 0 ; i < n ; i++) { /* find the repnode cnode that contains node i */ j = FLIP (Flag [i]) ; PRINT2 (("\nfind component for "ID", in: "ID"\n", i, j)) ; ASSERT (j >= 0 && j < n) ; DEBUG (cnt = 0) ; while (CParent [j] == -2) { j = FLIP (Flag [j]) ; PRINT2 ((" walk up to "ID" ", j)) ; ASSERT (j >= 0 && j < n) ; PRINT2 ((" CParent "ID"\n", CParent [j])) ; ASSERT (cnt < n) ; DEBUG (cnt++) ; } cnode = j ; ASSERT (cnode >= 0 && cnode < n) ; ASSERT (CParent [cnode] >= EMPTY && CParent [cnode] < n) ; PRINT2 (("i "ID" is in component with cnode "ID"\n", i, cnode)) ; ASSERT (Flag [cnode] == FLIP (cnode)) ; /* Mark all nodes along the path from i to cnode as being in the * component whos repnode is cnode. Perform path compression. */ j = FLIP (Flag [i]) ; Flag [i] = FLIP (cnode) ; DEBUG (cnt = 0) ; while (CParent [j] == -2) { ASSERT (j >= 0 && j < n) ; jnext = FLIP (Flag [j]) ; PRINT2 ((" "ID" walk "ID" set cnode to "ID"\n", i, j, cnode)) ; ASSERT (cnt < n) ; DEBUG (cnt++) ; Flag [j] = FLIP (cnode) ; j = jnext ; } } /* At this point, all nodes fall into Types 1 or 2, as defined above. */ #ifndef NDEBUG for (j = 0 ; j < n ; j++) { PRINT2 (("j %d CParent %d ", j, CParent [j])) ; if (CParent [j] >= EMPTY && CParent [j] < n) { /* case 1: j is a repnode of a component */ cnode = j ; PRINT2 ((" a repnode\n")) ; } else { /* case 2: j is not a repnode of a component */ cnode = FLIP (Flag [j]) ; PRINT2 ((" repnode is %d\n", cnode)) ; ASSERT (cnode >= 0 && cnode < n) ; ASSERT (CParent [cnode] >= EMPTY && CParent [cnode] < n) ; } ASSERT (Flag [cnode] == FLIP (cnode)) ; /* case 3 no longer holds */ } #endif /* ---------------------------------------------------------------------- */ /* free workspace */ /* ---------------------------------------------------------------------- */ C->ncol = n ; /* restore size for memory usage statistics */ CHOLMOD(free_sparse) (&C, Common) ; CHOLMOD(free_sparse) (&B, Common) ; CHOLMOD(free) (csize, sizeof (Int), Cew, Common) ; CHOLMOD(free) (3*n, sizeof (Int), Work3n, Common) ; /* ---------------------------------------------------------------------- */ /* handle dense nodes */ /* ---------------------------------------------------------------------- */ /* The separator tree has nodes with either no children or two or more * children - with one exception. There may exist a single root node with * exactly one child, which holds the dense rows/columns of the matrix. * Delete this node if it exists. */ if (ndense > 0) { ASSERT (CParent [cdense] == EMPTY) ; /* cdense has no parent */ /* find the children of cdense */ nchild = 0 ; for (j = 0 ; j < n ; j++) { if (CParent [j] == cdense) { nchild++ ; child = j ; } } if (nchild == 1) { /* the cdense node has just one child; merge the two nodes */ PRINT1 (("root has one child\n")) ; CParent [cdense] = -2 ; /* cdense is deleted */ CParent [child] = EMPTY ; /* child becomes a root */ for (j = 0 ; j < n ; j++) { if (Flag [j] == FLIP (cdense)) { /* j is a dense node */ PRINT1 (("dense %d\n", j)) ; Flag [j] = FLIP (child) ; } } } } /* ---------------------------------------------------------------------- */ /* postorder the components */ /* ---------------------------------------------------------------------- */ DEBUG (for (cnt = 0, j = 0 ; j < n ; j++) if (CParent [j] != -2) cnt++) ; /* use Cmember as workspace for Post [ */ Post = Cmember ; /* cholmod_postorder uses Head and Iwork [0..2n]. It does not use Flag, * which here holds the mapping of nodes to repnodes. It ignores all nodes * for which CParent [j] < -1, so it operates just on the repnodes. */ /* workspace: Head (n), Iwork (2*n) */ ncomponents = CHOLMOD(postorder) (CParent, n, NULL, Post, Common) ; ASSERT (cnt == ncomponents) ; /* use Iwork [0..n-1] as workspace for Ipost ( */ Ipost = Iwork ; DEBUG (for (j = 0 ; j < n ; j++) Ipost [j] = EMPTY) ; /* compute inverse postorder */ for (c = 0 ; c < ncomponents ; c++) { cnode = Post [c] ; ASSERT (cnode >= 0 && cnode < n) ; Ipost [cnode] = c ; ASSERT (Head [c] == EMPTY) ; } /* adjust the parent array */ /* Iwork [n..2n-1] used for NewParent [ */ NewParent = Iwork + n ; for (c = 0 ; c < ncomponents ; c++) { parent = CParent [Post [c]] ; NewParent [c] = (parent == EMPTY) ? EMPTY : (Ipost [parent]) ; } for (c = 0 ; c < ncomponents ; c++) { CParent [c] = NewParent [c] ; } ASSERT (CHOLMOD(dump_parent) (CParent, ncomponents, "CParent", Common)) ; /* Iwork [n..2n-1] no longer needed for NewParent ] */ /* Cmember no longer needed for Post ] */ #ifndef NDEBUG /* count the number of children of each node */ for (c = 0 ; c < ncomponents ; c++) { Cmember [c] = 0 ; } for (c = 0 ; c < ncomponents ; c++) { if (CParent [c] != EMPTY) Cmember [CParent [c]]++ ; } for (c = 0 ; c < ncomponents ; c++) { /* a node is either a leaf, or has 2 or more children */ ASSERT (Cmember [c] == 0 || Cmember [c] >= 2) ; } #endif /* ---------------------------------------------------------------------- */ /* place each node in its component */ /* ---------------------------------------------------------------------- */ for (j = 0 ; j < n ; j++) { /* node j is in the cth component, whose repnode is cnode */ cnode = FLIP (Flag [j]) ; PRINT2 (("j "ID" flag "ID" cnode "ID"\n", j, Flag [j], FLIP (Flag [j]))) ; ASSERT (cnode >= 0 && cnode < n) ; c = Ipost [cnode] ; ASSERT (c >= 0 && c < ncomponents) ; Cmember [j] = c ; } /* Flag no longer needed for the node-to-component mapping */ /* done using Iwork [0..n-1] as workspace for Ipost ) */ /* ---------------------------------------------------------------------- */ /* clear the Flag array */ /* ---------------------------------------------------------------------- */ Common->mark = EMPTY ; CHOLMOD_CLEAR_FLAG (Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; /* ---------------------------------------------------------------------- */ /* find the permutation */ /* ---------------------------------------------------------------------- */ PRINT1 (("nd_camd: %d A->stype %d\n", nd_camd, A->stype)) ; if (nd_camd) { /* ------------------------------------------------------------------ */ /* apply camd, csymamd, or ccolamd using the Cmember constraints */ /* ------------------------------------------------------------------ */ if (A->stype != 0) { /* ordering A+A', so fset and fsize are ignored. * Add the upper/lower part to a symmetric lower/upper matrix by * converting to unsymmetric mode * workspace: Iwork (nrow) */ B = CHOLMOD(copy) (A, 0, -1, Common) ; if (Common->status < CHOLMOD_OK) { PRINT0 (("make symmetric failed\n")) ; return (EMPTY) ; } ASSERT ((Int) (B->nrow) == n && (Int) (B->ncol) == n) ; PRINT2 (("nested dissection (2)\n")) ; B->stype = -1 ; if (nd_camd == 2) { /* workspace: Head (nrow+1), Iwork (nrow) if symmetric-upper */ ok = CHOLMOD(csymamd) (B, Cmember, Perm, Common) ; } else { /* workspace: Head (nrow), Iwork (4*nrow) */ ok = CHOLMOD(camd) (B, NULL, 0, Cmember, Perm, Common) ; } CHOLMOD(free_sparse) (&B, Common) ; if (!ok) { /* failed */ PRINT0 (("camd/csymamd failed\n")) ; return (EMPTY) ; } } else { /* ordering A*A' or A(:,f)*A(:,f)' */ /* workspace: Iwork (nrow if no fset; MAX(nrow,ncol) if fset) */ if (!CHOLMOD(ccolamd) (A, fset, fsize, Cmember, Perm, Common)) { /* ccolamd failed */ PRINT2 (("ccolamd failed\n")) ; return (EMPTY) ; } } } else { /* ------------------------------------------------------------------ */ /* natural ordering of each component */ /* ------------------------------------------------------------------ */ /* use Iwork [0..n-1] for Next [ */ Next = Iwork ; /* ------------------------------------------------------------------ */ /* place the nodes in link lists, one list per component */ /* ------------------------------------------------------------------ */ /* do so in reverse order, to preserve original ordering */ for (j = n-1 ; j >= 0 ; j--) { /* node j is in the cth component */ c = Cmember [j] ; ASSERT (c >= 0 && c < ncomponents) ; /* place node j in link list for component c */ Next [j] = Head [c] ; Head [c] = j ; } /* ------------------------------------------------------------------ */ /* order each node in each component */ /* ------------------------------------------------------------------ */ k = 0 ; for (c = 0 ; c < ncomponents ; c++) { for (j = Head [c] ; j != EMPTY ; j = Next [j]) { Perm [k++] = j ; } Head [c] = EMPTY ; } ASSERT (k == n) ; /* done using Iwork [0..n-1] for Next ] */ } /* ---------------------------------------------------------------------- */ /* clear workspace and return number of components */ /* ---------------------------------------------------------------------- */ ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; return (ncomponents) ; } /* ========================================================================== */ /* === cholmod_collapse_septree ============================================= */ /* ========================================================================== */ /* cholmod_nested_dissection returns the separator tree that was used in the * constrained minimum degree algorithm. Parameter settings (nd_small, * nd_oksep, etc) that give a good fill-reducing ordering may give too fine of * a separator tree for other uses (parallelism, multi-level LPDASA, etc). This * function takes as input the separator tree computed by * cholmod_nested_dissection, and collapses selected subtrees into single * nodes. A subtree is collapsed if its root node (the separator) is large * compared to the total number of nodes in the subtree, or if the subtree is * small. Note that the separator tree may actually be a forest. * * nd_oksep and nd_small act just like the ordering parameters in Common. * Returns the new number of nodes in the separator tree. */ SuiteSparse_long CHOLMOD(collapse_septree) ( /* ---- input ---- */ size_t n, /* # of nodes in the graph */ size_t ncomponents, /* # of nodes in the separator tree (must be <= n) */ double nd_oksep, /* collapse if #sep >= nd_oksep * #nodes in subtree */ size_t nd_small, /* collapse if #nodes in subtree < nd_small */ /* ---- in/out --- */ Int *CParent, /* size ncomponents; from cholmod_nested_dissection */ Int *Cmember, /* size n; from cholmod_nested_dissection */ /* --------------- */ cholmod_common *Common ) { Int *First, *Count, *Csubtree, *W, *Map ; Int c, j, k, nc, sepsize, total_weight, parent, nc_new, first ; int collapse = FALSE, ok = TRUE ; size_t s ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (EMPTY) ; RETURN_IF_NULL (CParent, EMPTY) ; RETURN_IF_NULL (Cmember, EMPTY) ; if (n < ncomponents) { ERROR (CHOLMOD_INVALID, "invalid separator tree") ; return (EMPTY) ; } Common->status = CHOLMOD_OK ; nc = ncomponents ; if (n <= 1 || ncomponents <= 1) { /* no change; tree is one node already */ return (nc) ; } nd_oksep = MAX (0, nd_oksep) ; nd_oksep = MIN (1, nd_oksep) ; nd_small = MAX (4, nd_small) ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* s = 3*ncomponents */ s = CHOLMOD(mult_size_t) (ncomponents, 3, &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (EMPTY) ; } CHOLMOD(allocate_work) (0, s, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (EMPTY) ; } W = Common->Iwork ; Count = W ; W += ncomponents ; /* size ncomponents */ Csubtree = W ; W += ncomponents ; /* size ncomponents */ First = W ; W += ncomponents ; /* size ncomponents */ /* ---------------------------------------------------------------------- */ /* find the first descendant of each node of the separator tree */ /* ---------------------------------------------------------------------- */ for (c = 0 ; c < nc ; c++) { First [c] = EMPTY ; } for (k = 0 ; k < nc ; k++) { for (c = k ; c != EMPTY && First [c] == -1 ; c = CParent [c]) { ASSERT (c >= 0 && c < nc) ; First [c] = k ; } } /* ---------------------------------------------------------------------- */ /* find the number of nodes of the graph in each node of the tree */ /* ---------------------------------------------------------------------- */ for (c = 0 ; c < nc ; c++) { Count [c] = 0 ; } for (j = 0 ; j < (Int) n ; j++) { ASSERT (Cmember [j] >= 0 && Cmember [j] < nc) ; Count [Cmember [j]]++ ; } /* ---------------------------------------------------------------------- */ /* find the number of nodes in each subtree */ /* ---------------------------------------------------------------------- */ for (c = 0 ; c < nc ; c++) { /* each subtree includes its root */ Csubtree [c] = Count [c] ; PRINT1 ((ID" size "ID" parent "ID" first "ID"\n", c, Count [c], CParent [c], First [c])) ; } for (c = 0 ; c < nc ; c++) { /* add the subtree of the child, c, into the count of its parent */ parent = CParent [c] ; ASSERT (parent >= EMPTY && parent < nc) ; if (parent != EMPTY) { Csubtree [parent] += Csubtree [c] ; } } #ifndef NDEBUG /* the sum of the roots should be n */ j = 0 ; for (c = 0 ; c < nc ; c++) if (CParent [c] == EMPTY) j += Csubtree [c] ; ASSERT (j == (Int) n) ; #endif /* ---------------------------------------------------------------------- */ /* find subtrees to collapse */ /* ---------------------------------------------------------------------- */ /* consider all nodes in reverse post-order */ for (c = nc-1 ; c >= 0 ; c--) { /* consider the subtree rooted at node c */ sepsize = Count [c] ; total_weight = Csubtree [c] ; PRINT1 (("Node "ID" sepsize "ID" subtree "ID" ratio %g\n", c, sepsize, total_weight, ((double) sepsize)/((double) total_weight))) ; first = First [c] ; if (first < c && /* c must not be a leaf */ (sepsize > nd_oksep * total_weight || total_weight < (int) nd_small)) { /* this separator is too large, or the subtree is too small. * collapse the tree, by converting the entire subtree rooted at * c into a single node. The subtree consists of all nodes from * First[c] to the root c. Flag all nodes from First[c] to c-1 * as dead. */ collapse = TRUE ; for (k = first ; k < c ; k++) { CParent [k] = -2 ; PRINT1 ((" collapse node "ID"\n", k)) ; } /* continue at the next node, first-1 */ c = first ; } } PRINT1 (("collapse: %d\n", collapse)) ; /* ---------------------------------------------------------------------- */ /* compress the tree */ /* ---------------------------------------------------------------------- */ Map = Count ; /* Count no longer needed */ nc_new = nc ; if (collapse) { nc_new = 0 ; for (c = 0 ; c < nc ; c++) { Map [c] = nc_new ; if (CParent [c] >= EMPTY) { /* node c is alive, and becomes node Map[c] in the new tree. * Increment nc_new for the next node c. */ nc_new++ ; } } PRINT1 (("Collapse the tree from "ID" to "ID" nodes\n", nc, nc_new)) ; ASSERT (nc_new > 0) ; for (c = 0 ; c < nc ; c++) { parent = CParent [c] ; if (parent >= EMPTY) { /* node c is alive */ CParent [Map [c]] = (parent == EMPTY) ? EMPTY : Map [parent] ; } } for (j = 0 ; j < (Int) n ; j++) { PRINT1 (("j "ID" Cmember[j] "ID" Map[Cmember[j]] "ID"\n", j, Cmember [j], Map [Cmember [j]])) ; Cmember [j] = Map [Cmember [j]] ; } } /* ---------------------------------------------------------------------- */ /* return new size of separator tree */ /* ---------------------------------------------------------------------- */ return (nc_new) ; } #endif Matrix/src/CHOLMOD/Partition/cholmod_ccolamd.c0000644000176200001440000001447213652535054020636 0ustar liggesusers/* ========================================================================== */ /* === Partition/cholmod_ccolamd ============================================ */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Partition Module. * Copyright (C) 2005-2013, Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* CHOLMOD interface to the CCOLAMD ordering routine. Finds a permutation * p such that the Cholesky factorization of PAA'P' is sparser than AA'. * The column etree is found and postordered, and the ccolamd ordering is then * combined with its postordering. A must be unsymmetric. * * workspace: Iwork (MAX (nrow,ncol)) * Allocates a copy of its input matrix, which is * then used as CCOLAMD's workspace. * * Supports any xtype (pattern, real, complex, or zomplex). */ #ifndef NCAMD #include "cholmod_internal.h" #include "ccolamd.h" #include "cholmod_camd.h" #if (CCOLAMD_VERSION < CCOLAMD_VERSION_CODE (2,5)) #error "CCOLAMD v2.0 or later is required" #endif /* ========================================================================== */ /* === ccolamd_interface ==================================================== */ /* ========================================================================== */ /* Order with ccolamd */ static int ccolamd_interface ( cholmod_sparse *A, size_t alen, Int *Perm, Int *Cmember, Int *fset, Int fsize, cholmod_sparse *C, cholmod_common *Common ) { double knobs [CCOLAMD_KNOBS] ; Int *Cp = NULL ; Int ok, k, nrow, ncol, stats [CCOLAMD_STATS] ; nrow = A->nrow ; ncol = A->ncol ; /* ---------------------------------------------------------------------- */ /* copy (and transpose) the input matrix A into the ccolamd workspace */ /* ---------------------------------------------------------------------- */ /* C = A (:,f)', which also packs A if needed. */ /* workspace: Iwork (nrow if no fset; MAX (nrow,ncol) if fset non-NULL) */ ok = CHOLMOD(transpose_unsym) (A, 0, NULL, fset, fsize, C, Common) ; /* ---------------------------------------------------------------------- */ /* order the matrix (destroys the contents of C->i and C->p) */ /* ---------------------------------------------------------------------- */ /* get parameters */ #ifdef LONG ccolamd_l_set_defaults (knobs) ; #else ccolamd_set_defaults (knobs) ; #endif if (Common->current < 0 || Common->current >= CHOLMOD_MAXMETHODS) { /* this is the CHOLMOD default, not the CCOLAMD default */ knobs [CCOLAMD_DENSE_ROW] = -1 ; } else { /* get the knobs from the Common parameters */ knobs [CCOLAMD_DENSE_COL] =Common->method[Common->current].prune_dense ; knobs [CCOLAMD_DENSE_ROW] =Common->method[Common->current].prune_dense2; knobs [CCOLAMD_AGGRESSIVE]=Common->method[Common->current].aggressive ; knobs [CCOLAMD_LU] =Common->method[Common->current].order_for_lu; } if (ok) { #ifdef LONG ccolamd_l (ncol, nrow, alen, C->i, C->p, knobs, stats, Cmember) ; #else ccolamd (ncol, nrow, alen, C->i, C->p, knobs, stats, Cmember) ; #endif ok = stats [CCOLAMD_STATUS] ; ok = (ok == CCOLAMD_OK || ok == CCOLAMD_OK_BUT_JUMBLED) ; /* permutation returned in C->p, if the ordering succeeded */ Cp = C->p ; for (k = 0 ; k < nrow ; k++) { Perm [k] = Cp [k] ; } } return (ok) ; } /* ========================================================================== */ /* === cholmod_ccolamd ====================================================== */ /* ========================================================================== */ /* Order AA' or A(:,f)*A(:,f)' using CCOLAMD. */ int CHOLMOD(ccolamd) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ Int *Cmember, /* size A->nrow. Cmember [i] = c if row i is in the * constraint set c. c must be >= 0. The # of * constraint sets is max (Cmember) + 1. If Cmember is * NULL, then it is interpretted as Cmember [i] = 0 for * all i */ /* ---- output --- */ Int *Perm, /* size A->nrow, output permutation */ /* --------------- */ cholmod_common *Common ) { cholmod_sparse *C ; Int ok, nrow, ncol ; size_t alen ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (Perm, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; if (A->stype != 0) { ERROR (CHOLMOD_INVALID, "matrix must be unsymmetric") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ nrow = A->nrow ; ncol = A->ncol ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ #ifdef LONG alen = ccolamd_l_recommended (A->nzmax, ncol, nrow) ; #else alen = ccolamd_recommended (A->nzmax, ncol, nrow) ; #endif if (alen == 0) { ERROR (CHOLMOD_TOO_LARGE, "matrix invalid or too large") ; return (FALSE) ; } CHOLMOD(allocate_work) (0, MAX (nrow,ncol), 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } C = CHOLMOD(allocate_sparse) (ncol, nrow, alen, TRUE, TRUE, 0, CHOLMOD_PATTERN, Common) ; /* ---------------------------------------------------------------------- */ /* order with ccolamd */ /* ---------------------------------------------------------------------- */ ok = ccolamd_interface (A, alen, Perm, Cmember, fset, fsize, C, Common) ; /* ---------------------------------------------------------------------- */ /* free the workspace and return result */ /* ---------------------------------------------------------------------- */ CHOLMOD(free_sparse) (&C, Common) ; return (ok) ; } #endif Matrix/src/CHOLMOD/Partition/cholmod_metis.c0000644000176200001440000006304413652535054020354 0ustar liggesusers/* ========================================================================== */ /* === Partition/cholmod_metis ============================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Partition Module. * Copyright (C) 2005-2006, Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* CHOLMOD interface to the METIS package (Version 5.1.0): * * cholmod_metis_bisector: * * Wrapper for the METIS node separator function, * METIS_ComputeVertexSeparator (METIS 5.1). * * Finds a set of nodes that partitions the graph into two parts. METIS * 4.0 (the function METIS_ComputeVertexSeparator) allowed for edge * weights to be passed to the bisector. This feature is removed in METIS * 5.1. CHOLMOD itself does not rely on this feature (it calls the METIS * bisector with edge weights of all 1s). However, user code can call * cholmod_metis_bisector directly, and pass in edge weights. If you use * METIS 5.1, these edge weights are now ignored; if you pass a non-NULL * entry for edge weights, an error will be returned. * * cholmod_metis: * * Wrapper for METIS_NodeND, METIS's own nested dissection algorithm. * Typically faster than cholmod_nested_dissection, mostly because it * uses minimum degree on just the leaves of the separator tree, rather * than the whole matrix. * * Note that METIS does not return an error if it runs out of memory. Instead, * it terminates the program. This interface attempts to avoid that problem * by preallocating space that should be large enough for any memory allocations * within METIS, and then freeing that space, just before the call to METIS. * While this is not guaranteed to work, it is very unlikely to fail. If you * encounter this problem, increase Common->metis_memory. If you don't mind * having your program terminated, set Common->metis_memory to zero (a value of * 2.0 is usually safe). Several other METIS workarounds are made in the * routines in this file. See the description of metis_memory_ok, just below, * for more details. * * FUTURE WORK: interfaces to other partitioners (CHACO, SCOTCH, JOSTLE, ... ) * * workspace: several size-nz and size-n temporary arrays. Uses no workspace * in Common. * * Supports any xtype (pattern, real, complex, or zomplex). */ #ifndef NPARTITION #include "cholmod_internal.h" #include "metis.h" #include "cholmod_partition.h" #include "cholmod_cholesky.h" /* ========================================================================== */ /* === dumpgraph ============================================================ */ /* ========================================================================== */ /* For dumping the input graph to METIS_NodeND, to check with METIS's onmetis * and graphchk programs. For debugging only. To use, uncomment this #define: #define DUMP_GRAPH */ #ifdef DUMP_GRAPH #include /* After dumping the graph with this routine, run "onmetis metisgraph" */ static void dumpgraph (idx_t *Mp, idx_t *Mi, SuiteSparse_long n, cholmod_common *Common) { SuiteSparse_long i, j, p, nz ; FILE *f ; nz = Mp [n] ; printf ("Dumping METIS graph n %ld nz %ld\n", n, nz) ; /* DUMP_GRAPH */ f = fopen ("metisgraph", "w") ; if (f == NULL) { ERROR (-99, "cannot open metisgraph") ; return ; } fprintf (f, "%ld %ld\n", n, nz/2) ; /* DUMP_GRAPH */ for (j = 0 ; j < n ; j++) { for (p = Mp [j] ; p < Mp [j+1] ; p++) { i = Mi [p] ; fprintf (f, " %ld", i+1) ; /* DUMP_GRAPH */ } fprintf (f, "\n") ; /* DUMP_GRAPH */ } fclose (f) ; } #endif /* ========================================================================== */ /* === metis_memory_ok ====================================================== */ /* ========================================================================== */ /* METIS will terminate your program if * they run out of memory. In an attempt to workaround METIS' behavior, this * routine allocates a single block of memory of size equal to an observed * upper bound on METIS' memory usage. It then immediately deallocates the * block. If the allocation fails, METIS is not called. * * Median memory usage for a graph with n nodes and nz edges (counting each * edge twice, or both upper and lower triangular parts of a matrix) is * 4*nz + 40*n + 4096 integers. A "typical" upper bound is 10*nz + 50*n + 4096 * integers. Nearly all matrices tested fit within that upper bound, with the * exception two in the UF sparse matrix collection: Schenk_IBMNA/c-64 and * Gupta/gupta2. The latter exceeds the "upper bound" by a factor of just less * than 2. * * If you do not mind having your program terminated if it runs out of memory, * set Common->metis_memory to zero. Its default value is 2, which allows for * some memory fragmentation, and also accounts for the Gupta/gupta2 matrix. */ #define GUESS(nz,n) (10 * (nz) + 50 * (n) + 4096) static int metis_memory_ok ( Int n, Int nz, cholmod_common *Common ) { double s ; void *p ; size_t metis_guard ; if (Common->metis_memory <= 0) { /* do not prevent METIS from running out of memory */ return (TRUE) ; } n = MAX (1, n) ; nz = MAX (0, nz) ; /* compute in double, to avoid integer overflow */ s = GUESS ((double) nz, (double) n) ; s *= Common->metis_memory ; if (s * sizeof (idx_t) >= ((double) Size_max)) { /* don't even attempt to malloc such a large block */ return (FALSE) ; } /* recompute in size_t */ metis_guard = GUESS ((size_t) nz, (size_t) n) ; metis_guard *= Common->metis_memory ; /* attempt to malloc the block */ p = CHOLMOD(malloc) (metis_guard, sizeof (idx_t), Common) ; if (p == NULL) { /* failure - return out-of-memory condition */ return (FALSE) ; } /* success - free the block */ CHOLMOD(free) (metis_guard, sizeof (idx_t), p, Common) ; return (TRUE) ; } /* ========================================================================== */ /* === cholmod_metis_bisector =============================================== */ /* ========================================================================== */ /* Finds a set of nodes that bisects the graph of A or AA' (direct interface * to METIS_ComputeVertexSeparator. * * The input matrix A must be square, symmetric (with both upper and lower * parts present) and with no diagonal entries. These conditions are NOT * checked. */ SuiteSparse_long CHOLMOD(metis_bisector) /* returns separator size */ ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to bisect */ Int *Anw, /* size A->nrow, node weights, can be NULL, */ /* which means the graph is unweighted. */ Int *Aew, /* size nz, edge weights (silently ignored). */ /* This option was available with METIS 4, but not */ /* in METIS 5. This argument is now unused, but */ /* it remains for backward compatibilty, so as not */ /* to change the API for cholmod_metis_bisector. */ /* ---- output --- */ Int *Partition, /* size A->nrow */ /* --------------- */ cholmod_common *Common ) { Int *Ap, *Ai ; idx_t *Mp, *Mi, *Mnw, *Mpart ; Int n, nleft, nright, j, p, csep, total_weight, lightest, nz ; idx_t nn, csp ; size_t n1 ; int ok ; DEBUG (Int nsep) ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (EMPTY) ; RETURN_IF_NULL (A, EMPTY) ; /* RETURN_IF_NULL (Anw, EMPTY) ; */ /* RETURN_IF_NULL (Aew, EMPTY) ; */ RETURN_IF_NULL (Partition, EMPTY) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, EMPTY) ; if (A->stype || A->nrow != A->ncol) { /* A must be square, with both upper and lower parts present */ ERROR (CHOLMOD_INVALID, "matrix must be square, symmetric," " and with both upper/lower parts present") ; return (EMPTY) ; } Common->status = CHOLMOD_OK ; ASSERT (CHOLMOD(dump_sparse) (A, "A for bisector", Common) >= 0) ; /* ---------------------------------------------------------------------- */ /* quick return */ /* ---------------------------------------------------------------------- */ n = A->nrow ; if (n == 0) { return (0) ; } n1 = ((size_t) n) + 1 ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ Ap = A->p ; Ai = A->i ; nz = Ap [n] ; if (Anw != NULL) DEBUG (for (j = 0 ; j < n ; j++) ASSERT (Anw [j] > 0)) ; /* ---------------------------------------------------------------------- */ /* copy Int to METIS idx_t, if necessary */ /* ---------------------------------------------------------------------- */ if (sizeof (Int) == sizeof (idx_t)) { /* this is the typical case */ Mi = (idx_t *) Ai ; Mp = (idx_t *) Ap ; Mnw = (idx_t *) Anw ; Mpart = (idx_t *) Partition ; } else { /* idx_t and Int differ; copy the graph into the METIS idx_t */ Mi = CHOLMOD(malloc) (nz, sizeof (idx_t), Common) ; Mp = CHOLMOD(malloc) (n1, sizeof (idx_t), Common) ; Mnw = Anw ? (CHOLMOD(malloc) (n, sizeof (idx_t), Common)) : NULL ; Mpart = CHOLMOD(malloc) (n, sizeof (idx_t), Common) ; if (Common->status < CHOLMOD_OK) { CHOLMOD(free) (nz, sizeof (idx_t), Mi, Common) ; CHOLMOD(free) (n1, sizeof (idx_t), Mp, Common) ; CHOLMOD(free) (n, sizeof (idx_t), Mnw, Common) ; CHOLMOD(free) (n, sizeof (idx_t), Mpart, Common) ; return (EMPTY) ; } for (p = 0 ; p < nz ; p++) { Mi [p] = Ai [p] ; } for (j = 0 ; j <= n ; j++) { Mp [j] = Ap [j] ; } if (Anw != NULL) { for (j = 0 ; j < n ; j++) { Mnw [j] = Anw [j] ; } } } /* ---------------------------------------------------------------------- */ /* METIS workaround: try to ensure METIS doesn't run out of memory */ /* ---------------------------------------------------------------------- */ if (!metis_memory_ok (n, nz, Common)) { /* METIS might ask for too much memory and thus terminate the program */ if (sizeof (Int) != sizeof (idx_t)) { CHOLMOD(free) (nz, sizeof (idx_t), Mi, Common) ; CHOLMOD(free) (n1, sizeof (idx_t), Mp, Common) ; CHOLMOD(free) (n, sizeof (idx_t), Mnw, Common) ; CHOLMOD(free) (n, sizeof (idx_t), Mpart, Common) ; } return (EMPTY) ; } /* ---------------------------------------------------------------------- */ /* partition the graph */ /* ---------------------------------------------------------------------- */ #ifndef NDEBUG PRINT1 (("Metis graph, n = "ID"\n", n)) ; for (j = 0 ; j < n ; j++) { Int ppp, nodeweight = (Mnw ? Mnw [j] : 1) ; PRINT2 (("M(:,"ID") node weight "ID"\n", j, nodeweight)) ; ASSERT (nodeweight > 0) ; for (ppp = Mp [j] ; ppp < Mp [j+1] ; ppp++) { PRINT3 ((" "ID "\n", (Int) Mi [ppp])) ; ASSERT (Mi [ppp] != j) ; } } #endif /* METIS_ComputeVertexSeparator( idx_t *nvtxs, number of nodes idx_t *xadj, column pointers idx_t *adjncy, row indices idx_t *vwgt, vertex weights (NULL means unweighted) idx_t *options, options (NULL means defaults) idx_t *sepsize, separator size idx_t *part); partition. part [i] = 0,1,2, where: 0:left, 1:right, 2:separator */ nn = n ; ok = METIS_ComputeVertexSeparator (&nn, Mp, Mi, Mnw, NULL, &csp, Mpart) ; csep = csp ; PRINT1 (("METIS csep "ID"\n", csep)) ; /* ---------------------------------------------------------------------- */ /* copy the results back from idx_t, if required */ /* ---------------------------------------------------------------------- */ if (ok == METIS_OK && (sizeof (Int) != sizeof (idx_t))) { for (j = 0 ; j < n ; j++) { Partition [j] = Mpart [j] ; } } /* ---------------------------------------------------------------------- */ /* free the workspace for METIS, if allocated */ /* ---------------------------------------------------------------------- */ if (sizeof (Int) != sizeof (idx_t)) { CHOLMOD(free) (nz, sizeof (idx_t), Mi, Common) ; CHOLMOD(free) (n1, sizeof (idx_t), Mp, Common) ; CHOLMOD(free) (n, sizeof (idx_t), Mnw, Common) ; CHOLMOD(free) (n, sizeof (idx_t), Mpart, Common) ; } if (ok == METIS_ERROR_MEMORY) { ERROR (CHOLMOD_OUT_OF_MEMORY, "out of memory in METIS") ; return (EMPTY) ; } else if (ok == METIS_ERROR_INPUT) { ERROR (CHOLMOD_INVALID, "invalid input to METIS") ; return (EMPTY) ; } else if (ok == METIS_ERROR) { ERROR (CHOLMOD_INVALID, "unspecified METIS error") ; return (EMPTY) ; } /* ---------------------------------------------------------------------- */ /* ensure a reasonable separator */ /* ---------------------------------------------------------------------- */ /* METIS can return a valid separator with no nodes in (for example) the * left part. In this case, there really is no separator. CHOLMOD * prefers, in this case, for all nodes to be in the separator (and both * left and right parts to be empty). Also, if the graph is unconnected, * METIS can return a valid empty separator. CHOLMOD prefers at least one * node in the separator. Note that cholmod_nested_dissection only calls * this routine on connected components, but cholmod_bisect can call this * routine for any graph. */ if (csep == 0) { /* The separator is empty, select lightest node as separator. If * ties, select the highest numbered node. */ if (Anw == NULL) { lightest = n-1 ; } else { lightest = 0 ; for (j = 0 ; j < n ; j++) { if (Anw [j] <= Anw [lightest]) { lightest = j ; } } } PRINT1 (("Force "ID" as sep\n", lightest)) ; Partition [lightest] = 2 ; csep = (Anw ? (Anw [lightest]) : 1) ; } /* determine the node weights in the left and right part of the graph */ nleft = 0 ; nright = 0 ; DEBUG (nsep = 0) ; for (j = 0 ; j < n ; j++) { PRINT1 (("Partition ["ID"] = "ID"\n", j, Partition [j])) ; if (Partition [j] == 0) { nleft += (Anw ? (Anw [j]) : 1) ; } else if (Partition [j] == 1) { nright += (Anw ? (Anw [j]) : 1) ; } #ifndef NDEBUG else { ASSERT (Partition [j] == 2) ; nsep += (Anw ? (Anw [j]) : 1) ; } #endif } ASSERT (csep == nsep) ; total_weight = nleft + nright + csep ; if (csep < total_weight) { /* The separator is less than the whole graph. Make sure the left and * right parts are either both empty or both non-empty. */ PRINT1 (("nleft "ID" nright "ID" csep "ID" tot "ID"\n", nleft, nright, csep, total_weight)) ; ASSERT (nleft + nright + csep == total_weight) ; ASSERT (nleft > 0 || nright > 0) ; if ((nleft == 0 && nright > 0) || (nleft > 0 && nright == 0)) { /* left or right is empty; put all nodes in the separator */ PRINT1 (("Force all in sep\n")) ; csep = total_weight ; for (j = 0 ; j < n ; j++) { Partition [j] = 2 ; } } } ASSERT (CHOLMOD(dump_partition) (n, Ap, Ai, Anw, Partition, csep, Common)) ; /* ---------------------------------------------------------------------- */ /* return the sum of the weights of nodes in the separator */ /* ---------------------------------------------------------------------- */ return (csep) ; } /* ========================================================================== */ /* === cholmod_metis ======================================================== */ /* ========================================================================== */ /* CHOLMOD wrapper for the METIS_NodeND ordering routine. Creates A+A', * A*A' or A(:,f)*A(:,f)' and then calls METIS_NodeND on the resulting graph. * This routine is comparable to cholmod_nested_dissection, except that it * calls METIS_NodeND directly, and it does not return the separator tree. * * workspace: Flag (nrow), Iwork (4*n+uncol) * Allocates a temporary matrix B=A*A' or B=A. */ int CHOLMOD(metis) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ int postorder, /* if TRUE, follow with etree or coletree postorder */ /* ---- output --- */ Int *Perm, /* size A->nrow, output permutation */ /* --------------- */ cholmod_common *Common ) { double d ; Int *Iperm, *Iwork, *Bp, *Bi ; idx_t *Mp, *Mi, *Mperm, *Miperm ; cholmod_sparse *B ; Int i, j, n, nz, p, identity, uncol ; idx_t nn, zero = 0 ; size_t n1, s ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (Perm, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* quick return */ /* ---------------------------------------------------------------------- */ n = A->nrow ; if (n == 0) { return (TRUE) ; } n1 = ((size_t) n) + 1 ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* s = 4*n + uncol */ uncol = (A->stype == 0) ? A->ncol : 0 ; s = CHOLMOD(mult_size_t) (n, 4, &ok) ; s = CHOLMOD(add_size_t) (s, uncol, &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (FALSE) ; } CHOLMOD(allocate_work) (n, s, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; /* ---------------------------------------------------------------------- */ /* convert the matrix to adjacency list form */ /* ---------------------------------------------------------------------- */ /* The input graph for METIS must be symmetric, with both upper and lower * parts present, and with no diagonal entries. The columns need not be * sorted. * B = A+A', A*A', or A(:,f)*A(:,f)', upper and lower parts present */ if (A->stype) { /* Add the upper/lower part to a symmetric lower/upper matrix by * converting to unsymmetric mode */ /* workspace: Iwork (nrow) */ B = CHOLMOD(copy) (A, 0, -1, Common) ; } else { /* B = A*A' or A(:,f)*A(:,f)', no diagonal */ /* workspace: Flag (nrow), Iwork (max (nrow,ncol)) */ B = CHOLMOD(aat) (A, fset, fsize, -1, Common) ; } ASSERT (CHOLMOD(dump_sparse) (B, "B for NodeND", Common) >= 0) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } ASSERT (B->nrow == A->nrow) ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ Iwork = Common->Iwork ; Iperm = Iwork ; /* size n (i/i/l) */ Bp = B->p ; Bi = B->i ; nz = Bp [n] ; /* B does not include the diagonal, and both upper and lower parts. * Common->anz includes the diagonal, and just the lower part of B */ Common->anz = nz / 2 + n ; /* ---------------------------------------------------------------------- */ /* allocate the METIS input arrays, if needed */ /* ---------------------------------------------------------------------- */ if (sizeof (Int) == sizeof (idx_t)) { /* This is the typical case. */ Miperm = (idx_t *) Iperm ; Mperm = (idx_t *) Perm ; Mp = (idx_t *) Bp ; Mi = (idx_t *) Bi ; } else { /* allocate graph for METIS only if Int and idx_t differ */ Miperm = CHOLMOD(malloc) (n, sizeof (idx_t), Common) ; Mperm = CHOLMOD(malloc) (n, sizeof (idx_t), Common) ; Mp = CHOLMOD(malloc) (n1, sizeof (idx_t), Common) ; Mi = CHOLMOD(malloc) (nz, sizeof (idx_t), Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ CHOLMOD(free_sparse) (&B, Common) ; CHOLMOD(free) (n, sizeof (idx_t), Miperm, Common) ; CHOLMOD(free) (n, sizeof (idx_t), Mperm, Common) ; CHOLMOD(free) (n1, sizeof (idx_t), Mp, Common) ; CHOLMOD(free) (nz, sizeof (idx_t), Mi, Common) ; return (FALSE) ; } for (j = 0 ; j <= n ; j++) { Mp [j] = Bp [j] ; } for (p = 0 ; p < nz ; p++) { Mi [p] = Bi [p] ; } } /* ---------------------------------------------------------------------- */ /* METIS workarounds */ /* ---------------------------------------------------------------------- */ identity = FALSE ; if (nz == 0) { /* The matrix has no off-diagonal entries. METIS_NodeND fails in this * case, so avoid using it. The best permutation is identity anyway, * so this is an easy fix. */ identity = TRUE ; PRINT1 (("METIS:: no nz\n")) ; } else if (Common->metis_nswitch > 0) { /* METIS_NodeND in METIS 4.0.1 gives a seg fault with one matrix of * order n = 3005 and nz = 6,036,025, including the diagonal entries. * The workaround is to return the identity permutation instead of using * METIS for matrices of dimension 3000 or more and with density of 66% * or more - admittedly an uncertain fix, but such matrices are so dense * that any reasonable ordering will do, even identity (n^2 is only 50% * higher than nz in this case). CHOLMOD's nested dissection method * (cholmod_nested_dissection) has no problems with the same matrix, * even though it too uses METIS_ComputeVertexSeparator. The matrix is * derived from LPnetlib/lpi_cplex1 in the UF sparse matrix collection. * If C is the lpi_cplex matrix (of order 3005-by-5224), A = (C*C')^2 * results in the seg fault. The seg fault also occurs in the stand- * alone onmetis program that comes with METIS. If a future version of * METIS fixes this problem, then set Common->metis_nswitch to zero. */ d = ((double) nz) / (((double) n) * ((double) n)) ; if (n > (Int) (Common->metis_nswitch) && d > Common->metis_dswitch) { identity = TRUE ; PRINT1 (("METIS:: nswitch/dswitch activated\n")) ; } } if (!identity && !metis_memory_ok (n, nz, Common)) { /* METIS might ask for too much memory and thus terminate the program */ identity = TRUE ; } /* ---------------------------------------------------------------------- */ /* find the permutation */ /* ---------------------------------------------------------------------- */ if (identity) { /* no need to do the postorder */ postorder = FALSE ; for (i = 0 ; i < n ; i++) { Mperm [i] = i ; } } else { #ifdef DUMP_GRAPH /* DUMP_GRAPH */ printf ("Calling METIS_NodeND n "ID" nz "ID"" "density %g\n", n, nz, ((double) nz) / (((double) n) * ((double) n))); dumpgraph (Mp, Mi, n, Common) ; #endif /* int METIS_NodeND( idx_t *nvtxs, number of nodes idx_t *xadj, column pointers idx_t *adjncy, row indices idx_t *vwgt, vertex weights (NULL means unweighted) idx_t *options, options (NULL means defaults) idx_t *perm, fill-reducing ordering idx_t *iperm); inverse of perm */ nn = n ; METIS_NodeND (&nn, Mp, Mi, NULL, NULL, Mperm, Miperm) ; PRINT0 (("METIS_NodeND done\n")) ; } /* ---------------------------------------------------------------------- */ /* free the METIS input arrays */ /* ---------------------------------------------------------------------- */ if (sizeof (Int) != sizeof (idx_t)) { for (i = 0 ; i < n ; i++) { Perm [i] = (Int) (Mperm [i]) ; } CHOLMOD(free) (n, sizeof (idx_t), Miperm, Common) ; CHOLMOD(free) (n, sizeof (idx_t), Mperm, Common) ; CHOLMOD(free) (n+1, sizeof (idx_t), Mp, Common) ; CHOLMOD(free) (nz, sizeof (idx_t), Mi, Common) ; } CHOLMOD(free_sparse) (&B, Common) ; /* ---------------------------------------------------------------------- */ /* etree or column-etree postordering, using the Cholesky Module */ /* ---------------------------------------------------------------------- */ if (postorder) { Int *Parent, *Post, *NewPerm ; Int k ; Parent = Iwork + 2*((size_t) n) + uncol ; /* size n = nrow */ Post = Parent + n ; /* size n */ /* workspace: Iwork (2*nrow+uncol), Flag (nrow), Head (nrow+1) */ CHOLMOD(analyze_ordering) (A, CHOLMOD_METIS, Perm, fset, fsize, Parent, Post, NULL, NULL, NULL, Common) ; if (Common->status == CHOLMOD_OK) { /* combine the METIS permutation with its postordering */ NewPerm = Parent ; /* use Parent as workspace */ for (k = 0 ; k < n ; k++) { NewPerm [k] = Perm [Post [k]] ; } for (k = 0 ; k < n ; k++) { Perm [k] = NewPerm [k] ; } } } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; PRINT1 (("cholmod_metis done\n")) ; return (Common->status == CHOLMOD_OK) ; } #endif Matrix/src/CHOLMOD/Partition/cholmod_csymamd.c0000644000176200001440000001077613652535054020674 0ustar liggesusers/* ========================================================================== */ /* === Partition/cholmod_csymamd ============================================ */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Partition Module. * Copyright (C) 2005-2013, Univ. of Florida. Author: Timothy A. Davis * -------------------------------------------------------------------------- */ /* CHOLMOD interface to the CSYMAMD ordering routine. Finds a permutation * p such that the Cholesky factorization of PAP' is sparser than A. * The column etree is found and postordered, and the CSYMAMD * ordering is then combined with its postordering. If A is unsymmetric, * A+A' is ordered (A must be square). * * workspace: Head (nrow+1) * * Supports any xtype (pattern, real, complex, or zomplex). */ #ifndef NCAMD #include "cholmod_internal.h" #include "ccolamd.h" #include "cholmod_camd.h" #if (CCOLAMD_VERSION < CCOLAMD_VERSION_CODE (2,5)) #error "CCOLAMD v2.0 or later is required" #endif /* ========================================================================== */ /* === cholmod_csymamd ====================================================== */ /* ========================================================================== */ int CHOLMOD(csymamd) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order */ /* ---- output --- */ Int *Cmember, /* size nrow. see cholmod_ccolamd.c for description */ Int *Perm, /* size A->nrow, output permutation */ /* --------------- */ cholmod_common *Common ) { double knobs [CCOLAMD_KNOBS] ; Int *perm, *Head ; Int ok, i, nrow, stats [CCOLAMD_STATS] ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (Perm, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; Common->status = CHOLMOD_OK ; if (A->nrow != A->ncol || !(A->packed)) { ERROR (CHOLMOD_INVALID, "matrix must be square and packed") ; return (FALSE) ; } /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ nrow = A->nrow ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ CHOLMOD(allocate_work) (nrow, 0, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } /* ---------------------------------------------------------------------- */ /* order the matrix (does not affect A->p or A->i) */ /* ---------------------------------------------------------------------- */ perm = Common->Head ; /* size nrow+1 (i/l/l) */ /* get parameters */ #ifdef LONG ccolamd_l_set_defaults (knobs) ; #else ccolamd_set_defaults (knobs) ; #endif if (Common->current >= 0 && Common->current < CHOLMOD_MAXMETHODS) { /* get the knobs from the Common parameters */ knobs [CCOLAMD_DENSE_ROW] =Common->method[Common->current].prune_dense ; knobs [CCOLAMD_AGGRESSIVE]=Common->method[Common->current].aggressive ; } { #ifdef LONG csymamd_l (nrow, A->i, A->p, perm, knobs, stats, SuiteSparse_config.calloc_func, SuiteSparse_config.free_func, Cmember, A->stype) ; #else csymamd (nrow, A->i, A->p, perm, knobs, stats, SuiteSparse_config.calloc_func, SuiteSparse_config.free_func, Cmember, A->stype) ; #endif ok = stats [CCOLAMD_STATUS] ; } if (ok == CCOLAMD_ERROR_out_of_memory) { ERROR (CHOLMOD_OUT_OF_MEMORY, "out of memory") ; } ok = (ok == CCOLAMD_OK || ok == CCOLAMD_OK_BUT_JUMBLED) ; /* ---------------------------------------------------------------------- */ /* free the workspace and return result */ /* ---------------------------------------------------------------------- */ /* permutation returned in perm [0..n-1] */ for (i = 0 ; i < nrow ; i++) { Perm [i] = perm [i] ; } /* clear Head workspace (used for perm, in csymamd): */ Head = Common->Head ; for (i = 0 ; i <= nrow ; i++) { Head [i] = EMPTY ; } return (ok) ; } #endif Matrix/src/CHOLMOD/Partition/License.txt0000644000176200001440000000210411770402705017466 0ustar liggesusersCHOLMOD/Partition Module. Copyright (C) 2005-2006, Univ. of Florida. Author: Timothy A. Davis CHOLMOD is also available under other licenses; contact authors for details. http://www.suitesparse.com Note that this license is for the CHOLMOD/Partition module only. All CHOLMOD modules are licensed separately. -------------------------------------------------------------------------------- This Module is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This Module 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this Module; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Matrix/src/CHOLMOD/Partition/cholmod_camd.c0000644000176200001440000001602213652535054020131 0ustar liggesusers/* ========================================================================== */ /* === Partition/cholmod_camd =============================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Partition Module. Copyright (C) 2005-2013, Timothy A. Davis * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* CHOLMOD interface to the CAMD ordering routine. Orders A if the matrix is * symmetric. On output, Perm [k] = i if row/column i of A is the kth * row/column of P*A*P'. This corresponds to A(p,p) in MATLAB notation. * * If A is unsymmetric, cholmod_camd orders A*A'. On output, Perm [k] = i if * row/column i of A*A' is the kth row/column of P*A*A'*P'. This corresponds to * A(p,:)*A(p,:)' in MATLAB notation. If f is present, A(p,f)*A(p,f)' is * ordered. * * Computes the flop count for a subsequent LL' factorization, the number * of nonzeros in L, and the number of nonzeros in the matrix ordered (A, * A*A' or A(:,f)*A(:,f)'). * * workspace: Iwork (4*nrow). Head (nrow). * * Allocates a temporary copy of A+A' or A*A' (with * both upper and lower triangular parts) as input to CAMD. * Also allocates 3*(n+1) additional integer workspace (not in Common). * * Supports any xtype (pattern, real, complex, or zomplex) */ #ifndef NCAMD #include "cholmod_internal.h" #include "camd.h" #include "cholmod_camd.h" #if (CAMD_VERSION < CAMD_VERSION_CODE (2,0)) #error "CAMD v2.0 or later is required" #endif /* ========================================================================== */ /* === cholmod_camd ========================================================= */ /* ========================================================================== */ int CHOLMOD(camd) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ Int *Cmember, /* size nrow. see cholmod_ccolamd.c for description.*/ /* ---- output ---- */ Int *Perm, /* size A->nrow, output permutation */ /* --------------- */ cholmod_common *Common ) { double Info [CAMD_INFO], Control2 [CAMD_CONTROL], *Control ; Int *Cp, *Len, *Nv, *Head, *Elen, *Degree, *Wi, *Next, *BucketSet, *Work3n, *p ; cholmod_sparse *C ; Int j, n, cnz ; size_t s ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; n = A->nrow ; /* s = 4*n */ s = CHOLMOD(mult_size_t) (n, 4, &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (FALSE) ; } RETURN_IF_NULL (Perm, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; Common->status = CHOLMOD_OK ; if (n == 0) { /* nothing to do */ Common->fl = 0 ; Common->lnz = 0 ; Common->anz = 0 ; return (TRUE) ; } /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ /* cholmod_analyze has allocated Cmember at Common->Iwork + 5*n+uncol, and * CParent at Common->Iwork + 4*n+uncol, where uncol is 0 if A is symmetric * or A->ncol otherwise. Thus, only the first 4n integers in Common->Iwork * can be used here. */ CHOLMOD(allocate_work) (n, s, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } p = Common->Iwork ; Degree = p ; p += n ; /* size n */ Elen = p ; p += n ; /* size n */ Len = p ; p += n ; /* size n */ Nv = p ; p += n ; /* size n */ Work3n = CHOLMOD(malloc) (n+1, 3*sizeof (Int), Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } p = Work3n ; Next = p ; p += n ; /* size n */ Wi = p ; p += (n+1) ; /* size n+1 */ BucketSet = p ; /* size n */ Head = Common->Head ; /* size n+1 */ /* ---------------------------------------------------------------------- */ /* construct the input matrix for CAMD */ /* ---------------------------------------------------------------------- */ if (A->stype == 0) { /* C = A*A' or A(:,f)*A(:,f)', add extra space of nnz(C)/2+n to C */ C = CHOLMOD(aat) (A, fset, fsize, -2, Common) ; } else { /* C = A+A', but use only the upper triangular part of A if A->stype = 1 * and only the lower part of A if A->stype = -1. Add extra space of * nnz(C)/2+n to C. */ C = CHOLMOD(copy) (A, 0, -2, Common) ; } if (Common->status < CHOLMOD_OK) { /* out of memory, fset invalid, or other error */ CHOLMOD(free) (n+1, 3*sizeof (Int), Work3n, Common) ; return (FALSE) ; } Cp = C->p ; for (j = 0 ; j < n ; j++) { Len [j] = Cp [j+1] - Cp [j] ; } /* C does not include the diagonal, and both upper and lower parts. * Common->anz includes the diagonal, and just the lower part of C */ cnz = Cp [n] ; Common->anz = cnz / 2 + n ; /* ---------------------------------------------------------------------- */ /* order C using CAMD */ /* ---------------------------------------------------------------------- */ /* get parameters */ if (Common->current < 0 || Common->current >= CHOLMOD_MAXMETHODS) { /* use CAMD defaults */ Control = NULL ; } else { Control = Control2 ; Control [CAMD_DENSE] = Common->method [Common->current].prune_dense ; Control [CAMD_AGGRESSIVE] = Common->method [Common->current].aggressive; } #ifdef LONG /* DEBUG (camd_l_debug_init ("cholmod_l_camd")) ; */ camd_l2 (n, C->p, C->i, Len, C->nzmax, cnz, Nv, Next, Perm, Head, Elen, Degree, Wi, Control, Info, Cmember, BucketSet) ; #else /* DEBUG (camd_debug_init ("cholmod_camd")) ; */ camd_2 (n, C->p, C->i, Len, C->nzmax, cnz, Nv, Next, Perm, Head, Elen, Degree, Wi, Control, Info, Cmember, BucketSet) ; #endif /* LL' flop count. Need to subtract n for LL' flop count. Note that this * is a slight upper bound which is often exact (see CAMD/Source/camd_2.c * for details). cholmod_analyze computes an exact flop count and * fill-in. */ Common->fl = Info [CAMD_NDIV] + 2 * Info [CAMD_NMULTSUBS_LDL] + n ; /* Info [CAMD_LNZ] excludes the diagonal */ Common->lnz = n + Info [CAMD_LNZ] ; /* ---------------------------------------------------------------------- */ /* free the CAMD workspace and clear the persistent workspace in Common */ /* ---------------------------------------------------------------------- */ ASSERT (IMPLIES (Common->status == CHOLMOD_OK, CHOLMOD(dump_perm) (Perm, n, n, "CAMD2 perm", Common))) ; CHOLMOD(free_sparse) (&C, Common) ; for (j = 0 ; j <= n ; j++) { Head [j] = EMPTY ; } CHOLMOD(free) (n+1, 3*sizeof (Int), Work3n, Common) ; return (TRUE) ; } #endif Matrix/src/CHOLMOD/Modify/0000755000176200001440000000000014154165363014631 5ustar liggesusersMatrix/src/CHOLMOD/Modify/cholmod_rowadd.c0000644000176200001440000004612313652535054017770 0ustar liggesusers/* ========================================================================== */ /* === Modify/cholmod_rowadd ================================================ */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Modify Module. * Copyright (C) 2005-2006, Timothy A. Davis and William W. Hager. * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* Adds a row and column to an LDL' factorization, and optionally updates the * solution to Lx=b. * * workspace: Flag (nrow), Head (nrow+1), W (2*nrow), Iwork (2*nrow) * * Only real matrices are supported. A symbolic L is converted into a * numeric identity matrix before the row is added. */ #ifndef NGPL #ifndef NMODIFY #include "cholmod_internal.h" #include "cholmod_modify.h" /* ========================================================================== */ /* === cholmod_rowadd ======================================================= */ /* ========================================================================== */ /* cholmod_rowadd adds a row to the LDL' factorization. It computes the kth * row and kth column of L, and then updates the submatrix L (k+1:n,k+1:n) * accordingly. The kth row and column of L should originally be equal to the * kth row and column of the identity matrix (they are treated as such, if they * are not). The kth row/column of L is computed as the factorization of the * kth row/column of the matrix to factorize, which is provided as a single * n-by-1 sparse matrix R. The sparse vector R need not be sorted. */ int CHOLMOD(rowadd) ( /* ---- input ---- */ size_t k, /* row/column index to add */ cholmod_sparse *R, /* row/column of matrix to factorize (n-by-1) */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ /* --------------- */ cholmod_common *Common ) { double bk [2] ; bk [0] = 0. ; bk [1] = 0. ; return (CHOLMOD(rowadd_mark) (k, R, bk, NULL, L, NULL, NULL, Common)) ; } /* ========================================================================== */ /* === cholmod_rowadd_solve ================================================= */ /* ========================================================================== */ /* Does the same as cholmod_rowadd, and also updates the solution to Lx=b * See cholmod_updown for a description of how Lx=b is updated. There is on * additional parameter: bk specifies the new kth entry of b. */ int CHOLMOD(rowadd_solve) ( /* ---- input ---- */ size_t k, /* row/column index to add */ cholmod_sparse *R, /* row/column of matrix to factorize (n-by-1) */ double bk [2], /* kth entry of the right-hand-side b */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ cholmod_dense *X, /* solution to Lx=b (size n-by-1) */ cholmod_dense *DeltaB, /* change in b, zero on output */ /* --------------- */ cholmod_common *Common ) { return (CHOLMOD(rowadd_mark) (k, R, bk, NULL, L, X, DeltaB, Common)) ; } /* ========================================================================== */ /* === icomp ================================================================ */ /* ========================================================================== */ /* for sorting by qsort */ static int icomp (Int *i, Int *j) { if (*i < *j) { return (-1) ; } else { return (1) ; } } /* ========================================================================== */ /* === cholmod_rowadd_mark ================================================== */ /* ========================================================================== */ /* Does the same as cholmod_rowadd_solve, except only part of L is used in * the update/downdate of the solution to Lx=b. This routine is an "expert" * routine. It is meant for use in LPDASA only. */ int CHOLMOD(rowadd_mark) ( /* ---- input ---- */ size_t kadd, /* row/column index to add */ cholmod_sparse *R, /* row/column of matrix to factorize (n-by-1) */ double bk [2], /* kth entry of the right hand side, b */ Int *colmark, /* Int array of size 1. See cholmod_updown.c */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ cholmod_dense *X, /* solution to Lx=b (size n-by-1) */ cholmod_dense *DeltaB, /* change in b, zero on output */ /* --------------- */ cholmod_common *Common ) { double dk, yj, l_kj, lx, l_ij, sqrt_dk, dj, xk, rnz, fl ; double *Lx, *W, *Cx, *Rx, *Xx, *Nx ; Int *Li, *Lp, *Lnz, *Flag, *Stack, *Ci, *Rj, *Rp, *Lnext, *Iwork, *Rnz ; cholmod_sparse *C, Cmatrix ; Int i, j, p, pend, top, len, kk, li, lnz, mark, k, n, parent, Cp [2], do_solve, do_update ; size_t s ; int ok = TRUE ; DEBUG (Int lastrow) ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_NULL (R, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_REAL, FALSE) ; RETURN_IF_XTYPE_INVALID (R, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ; n = L->n ; k = kadd ; if (kadd >= L->n || k < 0) { ERROR (CHOLMOD_INVALID, "k invalid") ; return (FALSE) ; } if (R->ncol != 1 || R->nrow != L->n) { ERROR (CHOLMOD_INVALID, "R invalid") ; return (FALSE) ; } Rj = R->i ; Rx = R->x ; Rp = R->p ; Rnz = R->nz ; rnz = (R->packed) ? (Rp [1]) : (Rnz [0]) ; do_solve = (X != NULL) && (DeltaB != NULL) ; if (do_solve) { RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ; RETURN_IF_XTYPE_INVALID (DeltaB, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ; Xx = X->x ; Nx = DeltaB->x ; if (X->nrow != L->n || X->ncol != 1 || DeltaB->nrow != L->n || DeltaB->ncol != 1 || Xx == NULL || Nx == NULL) { ERROR (CHOLMOD_INVALID, "X and/or DeltaB invalid") ; return (FALSE) ; } } else { Xx = NULL ; Nx = NULL ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* s = 2*n */ s = CHOLMOD(mult_size_t) (n, 2, &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (FALSE) ; } CHOLMOD(allocate_work) (n, s, s, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, s, Common)) ; /* ---------------------------------------------------------------------- */ /* convert to simplicial numeric LDL' factor, if not already */ /* ---------------------------------------------------------------------- */ if (L->xtype == CHOLMOD_PATTERN || L->is_super || L->is_ll) { /* can only update/downdate a simplicial LDL' factorization */ CHOLMOD(change_factor) (CHOLMOD_REAL, FALSE, FALSE, FALSE, FALSE, L, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory, L is returned unchanged */ return (FALSE) ; } } /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ /* inputs, not modified on output: */ Lp = L->p ; /* size n+1. input, not modified on output */ /* outputs, contents defined on input for incremental case only: */ Lnz = L->nz ; /* size n */ Li = L->i ; /* size L->nzmax. Can change in size. */ Lx = L->x ; /* size L->nzmax. Can change in size. */ Lnext = L->next ; /* size n+2 */ ASSERT (L->nz != NULL) ; PRINT1 (("rowadd:\n")) ; fl = 0 ; #if 0 #ifndef NDEBUG /* column k of L should be zero, except for the diagonal. This test is * overly cautious. */ for (p = Lp [k] + 1 ; p < Lp [k] + Lnz [k] ; p++) ASSERT (Lx [p] == 0) ; #endif #endif /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ Flag = Common->Flag ; /* size n */ W = Common->Xwork ; /* size n */ Cx = W + n ; /* size n (use 2nd column of Xwork for C) */ Iwork = Common->Iwork ; Stack = Iwork ; /* size n (i/i/l), also in cholmod_updown */ Ci = Iwork + n ; /* size n (i/i/l) */ /* NOTE: cholmod_updown uses Iwork [0..n-1] (i/i/l) as Stack as well */ mark = Common->mark ; /* copy Rj/Rx into W/Ci */ for (p = 0 ; p < rnz ; p++) { i = Rj [p] ; ASSERT (i >= 0 && i < n) ; W [i] = Rx [p] ; Ci [p] = i ; } /* At this point, W [Ci [0..rnz-1]] holds the sparse vector to add */ /* The nonzero pattern of column W is held in Ci (it may be unsorted). */ /* ---------------------------------------------------------------------- */ /* symbolic factorization to get pattern of kth row of L */ /* ---------------------------------------------------------------------- */ DEBUG (for (p = 0 ; p < rnz ; p++) PRINT1 (("C ("ID",%g)\n", Ci [p], W [Ci [p]]))) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; /* flag the diagonal */ Flag [k] = mark ; /* find the union of all the paths */ top = n ; lnz = 0 ; /* # of nonzeros in column k of L, excluding diagonal */ for (p = 0 ; p < rnz ; p++) { i = Ci [p] ; if (i < k) { /* walk from i = entry in Ci to root (and stop if i marked)*/ PRINT2 (("\nwalk from i = "ID" towards k = "ID"\n", i, k)) ; len = 0 ; /* walk up tree, but stop if we go below the diagonal */ while (i < k && i != EMPTY && Flag [i] < mark) { PRINT2 ((" Add "ID" to path\n", i)) ; ASSERT (i >= 0 && i < k) ; Stack [len++] = i ; /* place i on the stack */ Flag [i] = mark ; /* mark i as visited */ /* parent is the first entry in the column after the diagonal */ ASSERT (Lnz [i] > 0) ; parent = (Lnz [i] > 1) ? (Li [Lp [i] + 1]) : EMPTY ; PRINT2 ((" parent: "ID"\n", parent)) ; i = parent ; /* go up the tree */ } ASSERT (len <= top) ; /* move the path down to the bottom of the stack */ /* this shifts Stack [0..len-1] down to [ ... oldtop-1] */ while (len > 0) { Stack [--top] = Stack [--len] ; } } else if (i > k) { /* prune the diagonal and upper triangular entries from Ci */ Ci [lnz++] = i ; Flag [i] = mark ; } } #ifndef NDEBUG PRINT1 (("length of S after prune: "ID"\n", lnz)) ; for (p = 0 ; p < lnz ; p++) { PRINT1 (("After prune Ci ["ID"] = "ID"\n", p, Ci [p])) ; ASSERT (Ci [p] > k) ; } #endif /* ---------------------------------------------------------------------- */ /* ensure each column of L has enough space to grow */ /* ---------------------------------------------------------------------- */ for (kk = top ; kk < n ; kk++) { /* could skip this if we knew column j already included row k */ j = Stack [kk] ; if (Lp [j] + Lnz [j] >= Lp [Lnext [j]]) { PRINT1 (("Col "ID" realloc, old Lnz "ID"\n", j, Lnz [j])) ; if (!CHOLMOD(reallocate_column) (j, Lnz [j] + 1, L, Common)) { /* out of memory, L is now simplicial symbolic */ /* CHOLMOD(clear_flag) (Common) ; */ CHOLMOD_CLEAR_FLAG (Common) ; for (i = 0 ; i < n ; i++) { W [i] = 0 ; } return (FALSE) ; } /* L->i and L->x may have moved */ Li = L->i ; Lx = L->x ; } ASSERT (Lp [j] + Lnz [j] < Lp [Lnext [j]] || (Lp [Lnext [j]] - Lp [j] == n-j)) ; } /* ---------------------------------------------------------------------- */ /* compute kth row of L and store in column form */ /* ---------------------------------------------------------------------- */ /* solve L (1:k-1, 1:k-1) * y (1:k-1) = b (1:k-1) */ /* where b (1:k) is in W and Ci */ /* L (k, 1:k-1) = y (1:k-1) ./ D (1:k-1) */ /* D (k) = B (k,k) - L (k, 1:k-1) * y (1:k-1) */ PRINT2 (("\nForward solve: "ID" to "ID"\n", top, n)) ; ASSERT (Lnz [k] >= 1 && Li [Lp [k]] == k) ; DEBUG (for (i = top ; i < n ; i++) PRINT2 ((" Path: "ID"\n", Stack [i]))) ; dk = W [k] ; W [k] = 0.0 ; /* if do_solve: compute x (k) = b (k) - L (k, 1:k-1) * x (1:k-1) */ xk = bk [0] ; PRINT2 (("B [k] = %g\n", xk)) ; for (kk = top ; kk < n ; kk++) { j = Stack [kk] ; i = j ; PRINT2 (("Forward solve col j = "ID":\n", j)) ; ASSERT (j >= 0 && j < k) ; /* forward solve using L (j+1:k-1,j) */ yj = W [j] ; W [j] = 0.0 ; p = Lp [j] ; pend = p + Lnz [j] ; ASSERT (Lnz [j] > 0) ; dj = Lx [p++] ; for ( ; p < pend ; p++) { i = Li [p] ; PRINT2 ((" row "ID"\n", i)) ; ASSERT (i > j) ; ASSERT (i < n) ; /* stop at row k */ if (i >= k) { break ; } W [i] -= Lx [p] * yj ; } /* each iteration of the above for loop did 2 flops, and 3 flops * are done below. so: fl += 2 * (Lp [j] - p - 1) + 3 becomes: */ fl += 2 * (Lp [j] - p) + 1 ; /* scale L (k,1:k-1) and compute dot product for D (k,k) */ l_kj = yj / dj ; dk -= l_kj * yj ; /* compute dot product for X(k) */ if (do_solve) { xk -= l_kj * Xx [j] ; } /* store l_kj in the jth column of L */ /* and shift the rest of the column down */ li = k ; lx = l_kj ; if (i == k) { /* no need to modify the nonzero pattern of L, since it already * contains row index k. */ ASSERT (Li [p] == k) ; Lx [p] = l_kj ; for (p++ ; p < pend ; p++) { i = Li [p] ; l_ij = Lx [p] ; ASSERT (i > k && i < n) ; PRINT2 ((" apply to row "ID" of column k of L\n", i)) ; /* add to the pattern of the kth column of L */ if (Flag [i] < mark) { PRINT2 ((" add Ci["ID"] = "ID"\n", lnz, i)) ; ASSERT (i > k) ; Ci [lnz++] = i ; Flag [i] = mark ; } /* apply the update to the kth column of L */ /* yj is equal to l_kj * d_j */ W [i] -= l_ij * yj ; } } else { PRINT2 (("Shift col j = "ID", apply saxpy to col k of L\n", j)) ; for ( ; p < pend ; p++) { /* swap (Li [p],Lx [p]) with (li,lx) */ i = Li [p] ; l_ij = Lx [p] ; Li [p] = li ; Lx [p] = lx ; li = i ; lx = l_ij ; ASSERT (i > k && i < n) ; PRINT2 ((" apply to row "ID" of column k of L\n", i)) ; /* add to the pattern of the kth column of L */ if (Flag [i] < mark) { PRINT2 ((" add Ci["ID"] = "ID"\n", lnz, i)) ; ASSERT (i > k) ; Ci [lnz++] = i ; Flag [i] = mark ; } /* apply the update to the kth column of L */ /* yj is equal to l_kj * d_j */ W [i] -= l_ij * yj ; } /* store the last value in the jth column of L */ Li [p] = li ; Lx [p] = lx ; Lnz [j]++ ; } } /* ---------------------------------------------------------------------- */ /* merge C with the pattern of the existing column of L */ /* ---------------------------------------------------------------------- */ /* This column should be zero, but it may contain explicit zero entries. * These entries should be kept, not dropped. */ p = Lp [k] ; pend = p + Lnz [k] ; for (p++ ; p < pend ; p++) { i = Li [p] ; /* add to the pattern of the kth column of L */ if (Flag [i] < mark) { PRINT2 ((" add Ci["ID"] = "ID" from existing col k\n", lnz, i)) ; ASSERT (i > k) ; Ci [lnz++] = i ; Flag [i] = mark ; } } /* ---------------------------------------------------------------------- */ if (do_solve) { Xx [k] = xk ; PRINT2 (("Xx [k] = %g\n", Xx [k])) ; } /* ---------------------------------------------------------------------- */ /* ensure abs (dk) >= dbound, if dbound is given */ /* ---------------------------------------------------------------------- */ dk = (IS_GT_ZERO (Common->dbound)) ? (CHOLMOD(dbound) (dk, Common)) : dk ; PRINT2 (("D [k = "ID"] = %g\n", k, dk)) ; /* ---------------------------------------------------------------------- */ /* store the kth column of L */ /* ---------------------------------------------------------------------- */ /* ensure the new column of L has enough space */ if (Lp [k] + lnz + 1 > Lp [Lnext [k]]) { PRINT1 (("New Col "ID" realloc, old Lnz "ID"\n", k, Lnz [k])) ; if (!CHOLMOD(reallocate_column) (k, lnz + 1, L, Common)) { /* out of memory, L is now simplicial symbolic */ CHOLMOD(clear_flag) (Common) ; for (i = 0 ; i < n ; i++) { W [i] = 0 ; } return (FALSE) ; } /* L->i and L->x may have moved */ Li = L->i ; Lx = L->x ; } ASSERT (Lp [k] + lnz + 1 <= Lp [Lnext [k]]) ; #ifndef NDEBUG PRINT2 (("\nPrior to sort: lnz "ID" (excluding diagonal)\n", lnz)) ; for (kk = 0 ; kk < lnz ; kk++) { i = Ci [kk] ; PRINT2 (("L ["ID"] kept: "ID" %e\n", kk, i, W [i] / dk)) ; } #endif /* sort Ci */ qsort (Ci, lnz, sizeof (Int), (int (*) (const void *, const void *)) icomp); /* store the kth column of L */ DEBUG (lastrow = k) ; p = Lp [k] ; Lx [p++] = dk ; Lnz [k] = lnz + 1 ; fl += lnz ; for (kk = 0 ; kk < lnz ; kk++, p++) { i = Ci [kk] ; PRINT2 (("L ["ID"] after sort: "ID", %e\n", kk, i, W [i] / dk)) ; ASSERT (i > lastrow) ; Li [p] = i ; Lx [p] = W [i] / dk ; W [i] = 0.0 ; DEBUG (lastrow = i) ; } /* compute DeltaB for updown (in DeltaB) */ if (do_solve) { p = Lp [k] ; pend = p + Lnz [k] ; for (p++ ; p < pend ; p++) { ASSERT (Li [p] > k) ; Nx [Li [p]] -= Lx [p] * xk ; } } /* clear the flag for the update */ mark = CHOLMOD(clear_flag) (Common) ; /* workspaces are now cleared */ ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 2*n, Common)) ; /* ---------------------------------------------------------------------- */ /* update/downdate */ /* ---------------------------------------------------------------------- */ /* update or downdate L (k+1:n, k+1:n) with the vector * C = L (:,k) * sqrt (abs (D [k])). * Do a numeric update if D[k] < 0, numeric downdate otherwise. */ ok = TRUE ; Common->modfl = 0 ; PRINT1 (("rowadd update lnz = "ID"\n", lnz)) ; if (lnz > 0) { do_update = IS_LT_ZERO (dk) ; if (do_update) { dk = -dk ; } sqrt_dk = sqrt (dk) ; p = Lp [k] + 1 ; for (kk = 0 ; kk < lnz ; kk++, p++) { Cx [kk] = Lx [p] * sqrt_dk ; } fl += lnz + 1 ; /* create a n-by-1 sparse matrix to hold the single column */ C = &Cmatrix ; C->nrow = n ; C->ncol = 1 ; C->nzmax = lnz ; C->sorted = TRUE ; C->packed = TRUE ; C->p = Cp ; C->i = Ci ; C->x = Cx ; C->nz = NULL ; C->itype = L->itype ; C->xtype = L->xtype ; C->dtype = L->dtype ; C->z = NULL ; C->stype = 0 ; Cp [0] = 0 ; Cp [1] = lnz ; /* numeric downdate if dk > 0, and optional Lx=b change */ /* workspace: Flag (nrow), Head (nrow+1), W (nrow), Iwork (2*nrow) */ ok = CHOLMOD(updown_mark) (do_update ? (1) : (0), C, colmark, L, X, DeltaB, Common) ; /* clear workspace */ for (kk = 0 ; kk < lnz ; kk++) { Cx [kk] = 0 ; } } Common->modfl += fl ; DEBUG (CHOLMOD(dump_factor) (L, "LDL factorization, L:", Common)) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 2*n, Common)) ; return (ok) ; } #endif #endif Matrix/src/CHOLMOD/Modify/t_cholmod_updown_numkr.c0000644000176200001440000005132113652535054021557 0ustar liggesusers/* ========================================================================== */ /* === Modify/t_cholmod_updown_numkr ======================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Modify Module. Copyright (C) 2005-2006, * Timothy A. Davis and William W. Hager. * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* Supernodal numerical update/downdate of rank K = RANK, along a single path. * This routine operates on a simplicial factor, but operates on adjacent * columns of L that would fit within a single supernode. "Adjacent" means * along a single path in the elimination tree; they may or may not be * adjacent in the matrix L. * * external defines: NUMERIC, WDIM, RANK. * * WDIM is 1, 2, 4, or 8. RANK can be 1 to WDIM. * * A simple method is included (#define SIMPLE). The code works, but is slow. * It is meant only to illustrate what this routine is doing. * * A rank-K update proceeds along a single path, using single-column, dual- * column, or quad-column updates of L. If a column j and the next column * in the path (its parent) do not have the same nonzero pattern, a single- * column update is used. If they do, but the 3rd and 4th column from j do * not have the same pattern, a dual-column update is used, in which the two * columns are treated as if they were a single supernode of two columns. If * there are 4 columns in the path that all have the same nonzero pattern, then * a quad-column update is used. All three kinds of updates can be used along * a single path, in a single call to this function. * * Single-column update: * * When updating a single column of L, each iteration of the for loop, * below, processes four rows of W (all columns involved) and one column * of L. Suppose we have a rank-5 update, and columns 2 through 6 of W * are involved. In this case, W in this routine is a pointer to column * 2 of the matrix W in the caller. W (in the caller, shown as 'W') is * held in row-major order, and is 8-by-n (a dense matrix storage format), * but shown below in column form to match the column of L. Suppose there * are 13 nonzero entries in column 27 of L, with row indices 27 (the * diagonal, D), 28, 30, 31, 42, 43, 44, 50, 51, 67, 81, 83, and 84. This * pattern is held in Li [Lp [27] ... Lp [27 + Lnz [27] - 1], where * Lnz [27] = 13. The modification of the current column j of L is done * in the following order. A dot (.) means the entry of W is not accessed. * * W0 points to row 27 of W, and G is a 1-by-8 temporary vector. * * G[0] G[4] * G x x x x x . . . * * W0 * | * v * 27 . . x x x x x . W0 points to W (27,2) * * * row 'W' W column j = 27 * | | | of L * v v v | * first iteration of for loop: v * * 28 . . 1 5 9 13 17 . x * 30 . . 2 6 10 14 18 . x * 31 . . 3 7 11 15 19 . x * 42 . . 4 8 12 16 20 . x * * second iteration of for loop: * * 43 . . 1 5 9 13 17 . x * 44 . . 2 6 10 14 18 . x * 50 . . 3 7 11 15 19 . x * 51 . . 4 8 12 16 20 . x * * third iteration of for loop: * * 67 . . 1 5 9 13 17 . x * 81 . . 2 6 10 14 18 . x * 83 . . 3 7 11 15 19 . x * 84 . . 4 8 12 16 20 . x * * If the number of offdiagonal nonzeros in column j of L is not divisible * by 4, then the switch-statement does the work for the first nz % 4 rows. * * Dual-column update: * * In this case, two columns of L that are adjacent in the path are being * updated, by 1 to 8 columns of W. Suppose columns j=27 and j=28 are * adjacent columns in the path (they need not be j and j+1). Two rows * of G and W are used as coefficients during the update: (G0, G1) and * (W0, W1). * * G0 x x x x x . . . * G1 x x x x x . . . * * 27 . . x x x x x . W0 points to W (27,2) * 28 . . x x x x x . W1 points to W (28,2) * * * row 'W' W0,W1 column j = 27 * | | | of L * v v v | * | |-- column j = 28 of L * v v * update L (j1,j): * * 28 . . 1 2 3 4 5 . x - ("-" is not stored in L) * * cleanup iteration since length is odd: * * 30 . . 1 2 3 4 5 . x x * * then each iteration does two rows of both columns of L: * * 31 . . 1 3 5 7 9 . x x * 42 . . 2 4 6 8 10 . x x * * 43 . . 1 3 5 7 9 . x x * 44 . . 2 4 6 8 10 . x x * * 50 . . 1 3 5 7 9 . x x * 51 . . 2 4 6 8 10 . x x * * 67 . . 1 3 5 7 9 . x x * 81 . . 2 4 6 8 10 . x x * * 83 . . 1 3 5 7 9 . x x * 84 . . 2 4 6 8 10 . x x * * If the number of offdiagonal nonzeros in column j of L is not even, * then the cleanup iteration does the work for the first row. * * Quad-column update: * * In this case, four columns of L that are adjacent in the path are being * updated, by 1 to 8 columns of W. Suppose columns j=27, 28, 30, and 31 * are adjacent columns in the path (they need not be j, j+1, ...). Four * rows of G and W are used as coefficients during the update: (G0 through * G3) and (W0 through W3). j=27, j1=28, j2=30, and j3=31. * * G0 x x x x x . . . * G1 x x x x x . . . * G3 x x x x x . . . * G4 x x x x x . . . * * 27 . . x x x x x . W0 points to W (27,2) * 28 . . x x x x x . W1 points to W (28,2) * 30 . . x x x x x . W2 points to W (30,2) * 31 . . x x x x x . W3 points to W (31,2) * * * row 'W' W0,W1,.. column j = 27 * | | | of L * v v v | * | |-- column j = 28 of L * | | |-- column j = 30 of L * | | | |-- column j = 31 of L * v v v v * update L (j1,j): * 28 . . 1 2 3 4 5 . x - - - * * update L (j2,j): * 30 . . 1 2 3 4 5 . # x - - (# denotes modified) * * update L (j2,j1) * 30 . . 1 2 3 4 5 . x # - - * * update L (j3,j) * 31 . . 1 2 3 4 5 . # x x - * * update L (j3,j1) * 31 . . 1 2 3 4 5 . x # x - * * update L (j3,j2) * 31 . . 1 2 3 4 5 . x x # - * * cleanup iteration since length is odd: * 42 . . 1 2 3 4 5 . x x x x * * * ----- CHOLMOD v1.1.1 did the following -------------------------------------- * then each iteration does two rows of all four colummns of L: * * 43 . . 1 3 5 7 9 . x x x x * 44 . . 2 4 6 8 10 . x x x x * * 50 . . 1 3 5 7 9 . x x x x * 51 . . 2 4 6 8 10 . x x x x * * 67 . . 1 3 5 7 9 . x x x x * 81 . . 2 4 6 8 10 . x x x x * * 83 . . 1 3 5 7 9 . x x x x * 84 . . 2 4 6 8 10 . x x x x * * ----- CHOLMOD v1.2.0 does the following ------------------------------------- * then each iteration does one rows of all four colummns of L: * * 43 . . 1 2 3 4 5 . x x x x * 44 . . 1 2 3 4 5 . x x x x * 50 . . 1 3 5 4 5 . x x x x * 51 . . 1 2 3 4 5 . x x x x * 67 . . 1 3 5 4 5 . x x x x * 81 . . 1 2 3 4 5 . x x x x * 83 . . 1 3 5 4 5 . x x x x * 84 . . 1 2 3 4 5 . x x x x * * This file is included in t_cholmod_updown.c, only. * It is not compiled separately. It contains no user-callable routines. * * workspace: Xwork (WDIM*nrow) */ /* ========================================================================== */ /* === loop unrolling macros ================================================ */ /* ========================================================================== */ #undef RANK1 #undef RANK2 #undef RANK3 #undef RANK4 #undef RANK5 #undef RANK6 #undef RANK7 #undef RANK8 #define RANK1(statement) statement #if RANK < 2 #define RANK2(statement) #else #define RANK2(statement) statement #endif #if RANK < 3 #define RANK3(statement) #else #define RANK3(statement) statement #endif #if RANK < 4 #define RANK4(statement) #else #define RANK4(statement) statement #endif #if RANK < 5 #define RANK5(statement) #else #define RANK5(statement) statement #endif #if RANK < 6 #define RANK6(statement) #else #define RANK6(statement) statement #endif #if RANK < 7 #define RANK7(statement) #else #define RANK7(statement) statement #endif #if RANK < 8 #define RANK8(statement) #else #define RANK8(statement) statement #endif #define FOR_ALL_K \ RANK1 (DO (0)) \ RANK2 (DO (1)) \ RANK3 (DO (2)) \ RANK4 (DO (3)) \ RANK5 (DO (4)) \ RANK6 (DO (5)) \ RANK7 (DO (6)) \ RANK8 (DO (7)) /* ========================================================================== */ /* === alpha/gamma ========================================================== */ /* ========================================================================== */ #undef ALPHA_GAMMA #define ALPHA_GAMMA(Dj,Alpha,Gamma,W) \ { \ double dj = Dj ; \ if (update) \ { \ for (k = 0 ; k < RANK ; k++) \ { \ double w = W [k] ; \ double alpha = Alpha [k] ; \ double a = alpha + (w * w) / dj ; \ dj *= a ; \ Alpha [k] = a ; \ Gamma [k] = (- w / dj) ; \ dj /= alpha ; \ } \ } \ else \ { \ for (k = 0 ; k < RANK ; k++) \ { \ double w = W [k] ; \ double alpha = Alpha [k] ; \ double a = alpha - (w * w) / dj ; \ dj *= a ; \ Alpha [k] = a ; \ Gamma [k] = w / dj ; \ dj /= alpha ; \ } \ } \ Dj = ((use_dbound) ? (CHOLMOD(dbound) (dj, Common)) : (dj)) ; \ } /* ========================================================================== */ /* === numeric update/downdate along one path =============================== */ /* ========================================================================== */ static void NUMERIC (WDIM, RANK) ( int update, /* TRUE for update, FALSE for downdate */ Int j, /* first column in the path */ Int e, /* last column in the path */ double Alpha [ ], /* alpha, for each column of W */ double W [ ], /* W is an n-by-WDIM array, stored in row-major order */ cholmod_factor *L, /* with unit diagonal (diagonal not stored) */ cholmod_common *Common ) { #ifdef SIMPLE #define w(row,col) W [WDIM*(row) + (col)] /* ---------------------------------------------------------------------- */ /* concise but slow version for illustration only */ /* ---------------------------------------------------------------------- */ double Gamma [WDIM] ; double *Lx ; Int *Li, *Lp, *Lnz ; Int p, k ; Int use_dbound = IS_GT_ZERO (Common->dbound) ; Li = L->i ; Lx = L->x ; Lp = L->p ; Lnz = L->nz ; /* walk up the etree from node j to its ancestor e */ for ( ; j <= e ; j = (Lnz [j] > 1) ? (Li [Lp [j] + 1]) : Int_max) { /* update the diagonal entry D (j,j) with each column of W */ ALPHA_GAMMA (Lx [Lp [j]], Alpha, Gamma, (&(w (j,0)))) ; /* update column j of L */ for (p = Lp [j] + 1 ; p < Lp [j] + Lnz [j] ; p++) { /* update row Li [p] of column j of L with each column of W */ Int i = Li [p] ; for (k = 0 ; k < RANK ; k++) { w (i,k) -= w (j,k) * Lx [p] ; Lx [p] -= Gamma [k] * w (i,k) ; } } /* clear workspace W */ for (k = 0 ; k < RANK ; k++) { w (j,k) = 0 ; } } #else /* ---------------------------------------------------------------------- */ /* dynamic supernodal version: supernodes detected dynamically */ /* ---------------------------------------------------------------------- */ double G0 [RANK], G1 [RANK], G2 [RANK], G3 [RANK] ; double Z0 [RANK], Z1 [RANK], Z2 [RANK], Z3 [RANK] ; double *W0, *W1, *W2, *W3, *Lx ; Int *Li, *Lp, *Lnz ; Int j1, j2, j3, p0, p1, p2, p3, parent, lnz, pend, k ; Int use_dbound = IS_GT_ZERO (Common->dbound) ; Li = L->i ; Lx = L->x ; Lp = L->p ; Lnz = L->nz ; /* walk up the etree from node j to its ancestor e */ for ( ; j <= e ; j = parent) { p0 = Lp [j] ; /* col j is Li,Lx [p0 ... p0+lnz-1] */ lnz = Lnz [j] ; W0 = W + WDIM * j ; /* pointer to row j of W */ pend = p0 + lnz ; /* for k = 0 to RANK-1 do: */ #define DO(k) Z0 [k] = W0 [k] ; FOR_ALL_K #undef DO /* for k = 0 to RANK-1 do: */ #define DO(k) W0 [k] = 0 ; FOR_ALL_K #undef DO /* update D (j,j) */ ALPHA_GAMMA (Lx [p0], Alpha, G0, Z0) ; p0++ ; /* determine how many columns of L to update at the same time */ parent = (lnz > 1) ? (Li [p0]) : Int_max ; if (parent <= e && lnz == Lnz [parent] + 1) { /* -------------------------------------------------------------- */ /* node j and its parent j1 can be updated at the same time */ /* -------------------------------------------------------------- */ j1 = parent ; j2 = (lnz > 2) ? (Li [p0+1]) : Int_max ; j3 = (lnz > 3) ? (Li [p0+2]) : Int_max ; W1 = W + WDIM * j1 ; /* pointer to row j1 of W */ p1 = Lp [j1] ; /* for k = 0 to RANK-1 do: */ #define DO(k) Z1 [k] = W1 [k] ; FOR_ALL_K #undef DO /* for k = 0 to RANK-1 do: */ #define DO(k) W1 [k] = 0 ; FOR_ALL_K #undef DO /* update L (j1,j) */ { double lx = Lx [p0] ; /* for k = 0 to RANK-1 do: */ #define DO(k) \ Z1 [k] -= Z0 [k] * lx ; \ lx -= G0 [k] * Z1 [k] ; FOR_ALL_K #undef DO Lx [p0++] = lx ; } /* update D (j1,j1) */ ALPHA_GAMMA (Lx [p1], Alpha, G1, Z1) ; p1++ ; /* -------------------------------------------------------------- */ /* update 2 or 4 columns of L */ /* -------------------------------------------------------------- */ if ((j2 <= e) && /* j2 in the current path */ (j3 <= e) && /* j3 in the current path */ (lnz == Lnz [j2] + 2) && /* column j2 matches */ (lnz == Lnz [j3] + 3)) /* column j3 matches */ { /* ---------------------------------------------------------- */ /* update 4 columns of L */ /* ---------------------------------------------------------- */ /* p0 and p1 currently point to row j2 in cols j and j1 of L */ parent = (lnz > 4) ? (Li [p0+2]) : Int_max ; W2 = W + WDIM * j2 ; /* pointer to row j2 of W */ W3 = W + WDIM * j3 ; /* pointer to row j3 of W */ p2 = Lp [j2] ; p3 = Lp [j3] ; /* for k = 0 to RANK-1 do: */ #define DO(k) Z2 [k] = W2 [k] ; FOR_ALL_K #undef DO /* for k = 0 to RANK-1 do: */ #define DO(k) Z3 [k] = W3 [k] ; FOR_ALL_K #undef DO /* for k = 0 to RANK-1 do: */ #define DO(k) W2 [k] = 0 ; FOR_ALL_K #undef DO /* for k = 0 to RANK-1 do: */ #define DO(k) W3 [k] = 0 ; FOR_ALL_K #undef DO /* update L (j2,j) and update L (j2,j1) */ { double lx [2] ; lx [0] = Lx [p0] ; lx [1] = Lx [p1] ; /* for k = 0 to RANK-1 do: */ #define DO(k) \ Z2 [k] -= Z0 [k] * lx [0] ; lx [0] -= G0 [k] * Z2 [k] ; \ Z2 [k] -= Z1 [k] * lx [1] ; lx [1] -= G1 [k] * Z2 [k] ; FOR_ALL_K #undef DO Lx [p0++] = lx [0] ; Lx [p1++] = lx [1] ; } /* update D (j2,j2) */ ALPHA_GAMMA (Lx [p2], Alpha, G2, Z2) ; p2++ ; /* update L (j3,j), L (j3,j1), and L (j3,j2) */ { double lx [3] ; lx [0] = Lx [p0] ; lx [1] = Lx [p1] ; lx [2] = Lx [p2] ; /* for k = 0 to RANK-1 do: */ #define DO(k) \ Z3 [k] -= Z0 [k] * lx [0] ; lx [0] -= G0 [k] * Z3 [k] ; \ Z3 [k] -= Z1 [k] * lx [1] ; lx [1] -= G1 [k] * Z3 [k] ; \ Z3 [k] -= Z2 [k] * lx [2] ; lx [2] -= G2 [k] * Z3 [k] ; FOR_ALL_K #undef DO Lx [p0++] = lx [0] ; Lx [p1++] = lx [1] ; Lx [p2++] = lx [2] ; } /* update D (j3,j3) */ ALPHA_GAMMA (Lx [p3], Alpha, G3, Z3) ; p3++ ; /* each iteration updates L (i, [j j1 j2 j3]) */ for ( ; p0 < pend ; p0++, p1++, p2++, p3++) { double lx [4], *w0 ; lx [0] = Lx [p0] ; lx [1] = Lx [p1] ; lx [2] = Lx [p2] ; lx [3] = Lx [p3] ; w0 = W + WDIM * Li [p0] ; /* for k = 0 to RANK-1 do: */ #define DO(k) \ w0 [k] -= Z0 [k] * lx [0] ; lx [0] -= G0 [k] * w0 [k] ; \ w0 [k] -= Z1 [k] * lx [1] ; lx [1] -= G1 [k] * w0 [k] ; \ w0 [k] -= Z2 [k] * lx [2] ; lx [2] -= G2 [k] * w0 [k] ; \ w0 [k] -= Z3 [k] * lx [3] ; lx [3] -= G3 [k] * w0 [k] ; FOR_ALL_K #undef DO Lx [p0] = lx [0] ; Lx [p1] = lx [1] ; Lx [p2] = lx [2] ; Lx [p3] = lx [3] ; } } else { /* ---------------------------------------------------------- */ /* update 2 columns of L */ /* ---------------------------------------------------------- */ parent = j2 ; /* cleanup iteration if length is odd */ if ((lnz - 2) % 2) { double lx [2] , *w0 ; lx [0] = Lx [p0] ; lx [1] = Lx [p1] ; w0 = W + WDIM * Li [p0] ; /* for k = 0 to RANK-1 do: */ #define DO(k) \ w0 [k] -= Z0 [k] * lx [0] ; lx [0] -= G0 [k] * w0 [k] ; \ w0 [k] -= Z1 [k] * lx [1] ; lx [1] -= G1 [k] * w0 [k] ; FOR_ALL_K #undef DO Lx [p0++] = lx [0] ; Lx [p1++] = lx [1] ; } for ( ; p0 < pend ; p0 += 2, p1 += 2) { double lx [2][2], w [2], *w0, *w1 ; lx [0][0] = Lx [p0 ] ; lx [1][0] = Lx [p0+1] ; lx [0][1] = Lx [p1 ] ; lx [1][1] = Lx [p1+1] ; w0 = W + WDIM * Li [p0 ] ; w1 = W + WDIM * Li [p0+1] ; /* for k = 0 to RANK-1 do: */ #define DO(k) \ w [0] = w0 [k] - Z0 [k] * lx [0][0] ; \ w [1] = w1 [k] - Z0 [k] * lx [1][0] ; \ lx [0][0] -= G0 [k] * w [0] ; \ lx [1][0] -= G0 [k] * w [1] ; \ w0 [k] = w [0] -= Z1 [k] * lx [0][1] ; \ w1 [k] = w [1] -= Z1 [k] * lx [1][1] ; \ lx [0][1] -= G1 [k] * w [0] ; \ lx [1][1] -= G1 [k] * w [1] ; FOR_ALL_K #undef DO Lx [p0 ] = lx [0][0] ; Lx [p0+1] = lx [1][0] ; Lx [p1 ] = lx [0][1] ; Lx [p1+1] = lx [1][1] ; } } } else { /* -------------------------------------------------------------- */ /* update one column of L */ /* -------------------------------------------------------------- */ /* cleanup iteration if length is not a multiple of 4 */ switch ((lnz - 1) % 4) { case 1: { double lx , *w0 ; lx = Lx [p0] ; w0 = W + WDIM * Li [p0] ; /* for k = 0 to RANK-1 do: */ #define DO(k) \ w0 [k] -= Z0 [k] * lx ; lx -= G0 [k] * w0 [k] ; FOR_ALL_K #undef DO Lx [p0++] = lx ; } break ; case 2: { double lx [2], *w0, *w1 ; lx [0] = Lx [p0 ] ; lx [1] = Lx [p0+1] ; w0 = W + WDIM * Li [p0 ] ; w1 = W + WDIM * Li [p0+1] ; /* for k = 0 to RANK-1 do: */ #define DO(k) \ w0 [k] -= Z0 [k] * lx [0] ; \ w1 [k] -= Z0 [k] * lx [1] ; \ lx [0] -= G0 [k] * w0 [k] ; \ lx [1] -= G0 [k] * w1 [k] ; FOR_ALL_K #undef DO Lx [p0++] = lx [0] ; Lx [p0++] = lx [1] ; } break ; case 3: { double lx [3], *w0, *w1, *w2 ; lx [0] = Lx [p0 ] ; lx [1] = Lx [p0+1] ; lx [2] = Lx [p0+2] ; w0 = W + WDIM * Li [p0 ] ; w1 = W + WDIM * Li [p0+1] ; w2 = W + WDIM * Li [p0+2] ; /* for k = 0 to RANK-1 do: */ #define DO(k) \ w0 [k] -= Z0 [k] * lx [0] ; \ w1 [k] -= Z0 [k] * lx [1] ; \ w2 [k] -= Z0 [k] * lx [2] ; \ lx [0] -= G0 [k] * w0 [k] ; \ lx [1] -= G0 [k] * w1 [k] ; \ lx [2] -= G0 [k] * w2 [k] ; FOR_ALL_K #undef DO Lx [p0++] = lx [0] ; Lx [p0++] = lx [1] ; Lx [p0++] = lx [2] ; } } for ( ; p0 < pend ; p0 += 4) { double lx [4], *w0, *w1, *w2, *w3 ; lx [0] = Lx [p0 ] ; lx [1] = Lx [p0+1] ; lx [2] = Lx [p0+2] ; lx [3] = Lx [p0+3] ; w0 = W + WDIM * Li [p0 ] ; w1 = W + WDIM * Li [p0+1] ; w2 = W + WDIM * Li [p0+2] ; w3 = W + WDIM * Li [p0+3] ; /* for k = 0 to RANK-1 do: */ #define DO(k) \ w0 [k] -= Z0 [k] * lx [0] ; \ w1 [k] -= Z0 [k] * lx [1] ; \ w2 [k] -= Z0 [k] * lx [2] ; \ w3 [k] -= Z0 [k] * lx [3] ; \ lx [0] -= G0 [k] * w0 [k] ; \ lx [1] -= G0 [k] * w1 [k] ; \ lx [2] -= G0 [k] * w2 [k] ; \ lx [3] -= G0 [k] * w3 [k] ; FOR_ALL_K #undef DO Lx [p0 ] = lx [0] ; Lx [p0+1] = lx [1] ; Lx [p0+2] = lx [2] ; Lx [p0+3] = lx [3] ; } } } #endif } /* prepare this file for another inclusion in t_cholmod_updown.c: */ #undef RANK Matrix/src/CHOLMOD/Modify/cholmod_updown.c0000644000176200001440000014475313652535054020034 0ustar liggesusers/* ========================================================================== */ /* === Modify/cholmod_updown ================================================ */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Modify Module. * Copyright (C) 2005-2006, Timothy A. Davis and William W. Hager. * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* Updates/downdates the LDL' factorization (symbolic, then numeric), by * computing a new factorization of * * Lnew * Dnew * Lnew' = Lold * Dold * Lold' +/- C*C' * * C must be sorted. It can be either packed or unpacked. As in all CHOLMOD * routines, the columns of L are sorted on input, and also on output. * * If the factor is not an unpacked LDL' or dynamic LDL', it is converted * to an LDL' dynamic factor. An unpacked LDL' factor may be updated, but if * any one column runs out of space, the factor is converted to an LDL' * dynamic one. If the initial conversion fails, the factor is returned * unchanged. * * If memory runs out during the update, the factor is returned as a simplicial * symbolic factor. That is, everything is freed except for the fill-reducing * ordering and its corresponding column counts (typically computed by * cholmod_analyze). * * Note that the fill-reducing permutation L->Perm is NOT used. The row * indices of C refer to the rows of L, not A. If your original system is * LDL' = PAP' (where P = L->Perm), and you want to compute the LDL' * factorization of A+CC', then you must permute C first. That is: * * PAP' = LDL' * P(A+CC')P' = PAP'+PCC'P' = LDL' + (PC)(PC)' = LDL' + Cnew*Cnew' * where Cnew = P*C. * * You can use the cholmod_submatrix routine in the MatrixOps module * to permute C, with: * * Cnew = cholmod_submatrix (C, L->Perm, L->n, NULL, -1, TRUE, TRUE, Common) ; * * Note that the sorted input parameter to cholmod_submatrix must be TRUE, * because cholmod_updown requires C with sorted columns. * * The system Lx=b can also be updated/downdated. The old system was Lold*x=b. * The new system is Lnew*xnew = b + deltab. The old solution x is overwritten * with xnew. Note that as in the update/downdate of L itself, the fill- * reducing permutation L->Perm is not used. x and b are in the permuted * ordering, not your original ordering. x and b are n-by-1; this routine * does not handle multiple right-hand-sides. * * workspace: Flag (nrow), Head (nrow+1), W (maxrank*nrow), Iwork (nrow), * where maxrank is 2, 4, or 8. * * Only real matrices are supported. A symbolic L is converted into a * numeric identity matrix. */ #ifndef NGPL #ifndef NMODIFY #include "cholmod_internal.h" #include "cholmod_modify.h" /* ========================================================================== */ /* === cholmod_updown ======================================================= */ /* ========================================================================== */ /* Compute the new LDL' factorization of LDL'+CC' (an update) or LDL'-CC' * (a downdate). The factor object L need not be an LDL' factorization; it * is converted to one if it isn't. */ int CHOLMOD(updown) ( /* ---- input ---- */ int update, /* TRUE for update, FALSE for downdate */ cholmod_sparse *C, /* the incoming sparse update */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ /* --------------- */ cholmod_common *Common ) { return (CHOLMOD(updown_mask2) (update, C, NULL, NULL, 0, L, NULL, NULL, Common)) ; } /* ========================================================================== */ /* === cholmod_updown_solve ================================================= */ /* ========================================================================== */ /* Does the same as cholmod_updown, except that it also updates/downdates the * solution to Lx=b+DeltaB. x and b must be n-by-1 dense matrices. b is not * need as input to this routine, but a sparse change to b is (DeltaB). Only * entries in DeltaB corresponding to columns modified in L are accessed; the * rest are ignored. */ int CHOLMOD(updown_solve) ( /* ---- input ---- */ int update, /* TRUE for update, FALSE for downdate */ cholmod_sparse *C, /* the incoming sparse update */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ cholmod_dense *X, /* solution to Lx=b (size n-by-1) */ cholmod_dense *DeltaB, /* change in b, zero on output */ /* --------------- */ cholmod_common *Common ) { return (CHOLMOD(updown_mask2) (update, C, NULL, NULL, 0, L, X, DeltaB, Common)) ; } /* ========================================================================== */ /* === Power2 =============================================================== */ /* ========================================================================== */ /* Power2 [i] is smallest power of 2 that is >= i (for i in range 0 to 8) */ static Int Power2 [ ] = { /* 0 1 2 3 4 5 6 7 8 */ 0, 1, 2, 4, 4, 8, 8, 8, 8 } ; /* ========================================================================== */ /* === debug routines ======================================================= */ /* ========================================================================== */ #ifndef NDEBUG static void dump_set (Int s, Int **Set_ps1, Int **Set_ps2, Int j, Int n, cholmod_common *Common) { Int *p, len, i, ilast ; if (CHOLMOD(dump) < -1) { /* no checks if debug level is -2 or less */ return ; } len = Set_ps2 [s] - Set_ps1 [s] ; PRINT2 (("Set s: "ID" len: "ID":", s, len)) ; ASSERT (len > 0) ; ilast = j ; for (p = Set_ps1 [s] ; p < Set_ps2 [s] ; p++) { i = *p ; PRINT3 ((" "ID"", i)) ; ASSERT (i > ilast && i < n) ; ilast = i ; } PRINT3 (("\n")) ; } static void dump_col ( char *w, Int j, Int p1, Int p2, Int *Li, double *Lx, Int n, cholmod_common *Common ) { Int p, row, lastrow ; if (CHOLMOD(dump) < -1) { /* no checks if debug level is -2 or less */ return ; } PRINT3 (("\n\nDUMP COL==== j = "ID" %s: p1="ID" p2="ID" \n", j, w, p1,p2)); lastrow = -1 ; for (p = p1 ; p < p2 ; p++) { PRINT3 ((" "ID": ", p)) ; row = Li [p] ; PRINT3 ((""ID" ", Li [p])) ; PRINT3 (("%g ", Lx [p])) ; PRINT3 (("\n")) ; ASSERT (row > lastrow && row < n) ; lastrow = row ; } ASSERT (p1 < p2) ; ASSERT (Li [p1] == j) ; PRINT3 (("\n")) ; } #endif /* ========================================================================== */ /* === a path =============================================================== */ /* ========================================================================== */ /* A path is a set of nodes of the etree which are all affected by the same * columns of C. */ typedef struct Path_struct { Int start ; /* column at which to start, or EMPTY if initial */ Int end ; /* column at which to end, or EMPTY if initial */ Int ccol ; /* column of C to which path refers */ Int parent ; /* parent path */ Int c ; /* child of j along this path */ Int next ; /* next path in link list */ Int rank ; /* number of rank-1 paths merged onto this path */ Int order ; /* dfs order of this path */ Int wfirst ; /* first column of W to affect this path */ Int pending ; /* column at which the path is pending */ Int botrow ; /* for partial update/downdate of solution to Lx=b */ } Path_type ; /* ========================================================================== */ /* === dfs ================================================================== */ /* ========================================================================== */ /* Compute the DFS order of the set of paths. This can be recursive because * there are at most 23 paths to sort: one for each column of C (8 at most), * and one for each node in a balanced binary tree with 8 leaves (15). * Stack overflow is thus not a problem. */ static void dfs ( Path_type *Path, /* the set of Paths */ Int k, /* the rank of the update/downdate */ Int path, /* which path to work on */ Int *path_order, /* the current path order */ Int *w_order, /* the current order of the columns of W */ Int depth, Int npaths /* total number of paths */ ) { Int c ; /* child path */ ASSERT (path >= 0 && path < npaths) ; if (path < k) { /* this is a leaf node, corresponding to column W (:,path) */ /* and column C (:, Path [path].ccol) */ ASSERT (Path [path].ccol >= 0) ; Path [path].wfirst = *w_order ; Path [path].order = *w_order ; (*w_order)++ ; } else { /* this is a non-leaf path, within the tree */ ASSERT (Path [path].c != EMPTY) ; ASSERT (Path [path].ccol == EMPTY) ; /* order each child path */ for (c = Path [path].c ; c != EMPTY ; c = Path [c].next) { dfs (Path, k, c, path_order, w_order, depth+1, npaths) ; if (Path [path].wfirst == EMPTY) { Path [path].wfirst = Path [c].wfirst ; } } /* order this path next */ Path [path].order = (*path_order)++ ; } } /* ========================================================================== */ /* === numeric update/downdate routines ===================================== */ /* ========================================================================== */ #define WDIM 1 #include "t_cholmod_updown.c" #define WDIM 2 #include "t_cholmod_updown.c" #define WDIM 4 #include "t_cholmod_updown.c" #define WDIM 8 #include "t_cholmod_updown.c" /* ========================================================================== */ /* === cholmod_updown_mark ================================================== */ /* ========================================================================== */ /* Update/downdate LDL' +/- C*C', and update/downdate selected portions of the * solution to Lx=b. * * The original system is L*x = b. The new system is Lnew*xnew = b + deltab. * deltab(i) can be nonzero only if column i of L is modified by the update/ * downdate. If column i is not modified, the deltab(i) is not accessed. * * The solution to Lx=b is not modified if either X or DeltaB are NULL. * * Rowmark and colmark: * -------------------- * * rowmark and colmark affect which portions of L take part in the update/ * downdate of the solution to Lx=b. They do not affect how L itself is * updated/downdated. They are both ignored if X or DeltaB are NULL. * * If not NULL, rowmark is an integer array of size n where L is n-by-n. * rowmark [j] defines the part of column j of L that takes part in the update/ * downdate of the forward solve, Lx=b. Specifically, if i = rowmark [j], * then L(j:i-1,j) is used, and L(i:end,j) is ignored. * * If not NULL, colmark is an integer array of size C->ncol. colmark [ccol] * for a column C(:,ccol) redefines those parts of L that take part in the * update/downdate of Lx=b. Each column of C affects a set of columns of L. * If column ccol of C affects column j of L, then the new rowmark [j] of * column j of L is defined as colmark [ccol]. In a multiple-rank update/ * downdate, if two or more columns of C affect column j, its new rowmark [j] * is the colmark of the least-numbered column of C. colmark is ignored if * it is NULL, in which case rowmark is not modified. If colmark [ccol] is * EMPTY (-1), then rowmark is not modified for that particular column of C. * colmark is ignored if it is NULL, or rowmark, X, or DeltaB are NULL. * * The algorithm for modifying the solution to Lx=b when rowmark and colmark * are NULL is as follows: * * for each column j of L that is modified: * deltab (j:end) += L (j:end,j) * x(j) * modify L * for each column j of L that is modified: * x (j) = deltab (j) * deltab (j) = 0 * deltab (j+1:end) -= L (j+1:end,j) * x(j) * * If rowmark is non-NULL but colmark is NULL: * * for each column j of L that is modified: * deltab (j:rowmark(j)-1) += L (j:rowmark(j)-1,j) * x(j) * modify L * for each column j of L that is modified: * x (j) = deltab (j) * deltab (j) = 0 * deltab (j+1:rowmark(j)-1) -= L (j+1:rowmark(j)-1,j) * x(j) * * If both rowmark and colmark are non-NULL: * * for each column j of L that is modified: * deltab (j:rowmark(j)-1) += L (j:rowmark(j)-1,j) * x(j) * modify L * for each column j of L that is modified: * modify rowmark (j) according to colmark * for each column j of L that is modified: * x (j) = deltab (j) * deltab (j) = 0 * deltab (j+1:rowmark(j)-1) -= L (j+1:rowmark(j)-1,j) * x(j) * * Note that if the rank of C exceeds k = Common->maxrank (which is 2, 4, or 8), * then the update/downdate is done as a series of rank-k updates. In this * case, the above algorithm is repeated for each block of k columns of C. * * Unless it leads to no changes in rowmark, colmark should be used only if * C->ncol <= Common->maxrank, because the update/downdate is done with maxrank * columns at a time. Otherwise, the results are undefined. * * This routine is an "expert" routine. It is meant for use in LPDASA only. */ int CHOLMOD(updown_mark) ( /* ---- input ---- */ int update, /* TRUE for update, FALSE for downdate */ cholmod_sparse *C, /* the incoming sparse update */ Int *colmark, /* Int array of size n. */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ cholmod_dense *X, /* solution to Lx=b (size n-by-1) */ cholmod_dense *DeltaB, /* change in b, zero on output */ /* --------------- */ cholmod_common *Common ) { return (CHOLMOD(updown_mask2) (update, C, colmark, NULL, 0, L, X, DeltaB, Common)) ; } /* ========================================================================== */ /* === cholmod_updown_mask ================================================== */ /* ========================================================================== */ int CHOLMOD(updown_mask) ( /* ---- input ---- */ int update, /* TRUE for update, FALSE for downdate */ cholmod_sparse *C, /* the incoming sparse update */ Int *colmark, /* Int array of size n. See cholmod_updown.c */ Int *mask, /* size n */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ cholmod_dense *X, /* solution to Lx=b (size n-by-1) */ cholmod_dense *DeltaB, /* change in b, zero on output */ /* --------------- */ cholmod_common *Common ) { Int maskmark = 0 ; return (CHOLMOD(updown_mask2) (update, C, colmark, mask, maskmark, L, X, DeltaB, Common)) ; } /* ========================================================================== */ /* === cholmod_updown_mask2 ================================================= */ /* ========================================================================== */ int CHOLMOD(updown_mask2) ( /* ---- input ---- */ int update, /* TRUE for update, FALSE for downdate */ cholmod_sparse *C, /* the incoming sparse update */ Int *colmark, /* Int array of size n. See cholmod_updown.c */ Int *mask, /* size n */ Int maskmark, /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ cholmod_dense *X, /* solution to Lx=b (size n-by-1) */ cholmod_dense *DeltaB, /* change in b, zero on output */ /* --------------- */ cholmod_common *Common ) { double xj, fl ; double *Lx, *W, *Xx, *Nx ; Int *Li, *Lp, *Lnz, *Cp, *Ci, *Cnz, *Head, *Flag, *Stack, *Lnext, *Iwork, *Set_ps1 [32], *Set_ps2 [32], *ps1, *ps2 ; size_t maxrank ; Path_type OrderedPath [32], Path [32] ; Int n, wdim, k1, k2, npaths, i, j, row, packed, ccol, p, cncol, do_solve, mark, jj, j2, kk, nextj, p1, p2, c, use_colmark, newlnz, k, newpath, path_order, w_order, scattered, path, newparent, pp1, pp2, smax, maxrow, row1, nsets, s, p3, newlnz1, Set [32], top, len, lnz, m, botrow ; size_t w ; int ok = TRUE ; DEBUG (Int oldparent) ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (C, FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_REAL, FALSE) ; RETURN_IF_XTYPE_INVALID (C, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ; n = L->n ; cncol = C->ncol ; if (!(C->sorted)) { ERROR (CHOLMOD_INVALID, "C must have sorted columns") ; return (FALSE) ; } if (n != (Int) (C->nrow)) { ERROR (CHOLMOD_INVALID, "C and L dimensions do not match") ; return (FALSE) ; } do_solve = (X != NULL) && (DeltaB != NULL) ; if (do_solve) { RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ; RETURN_IF_XTYPE_INVALID (DeltaB, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ; Xx = X->x ; Nx = DeltaB->x ; if (X->nrow != L->n || X->ncol != 1 || DeltaB->nrow != L->n || DeltaB->ncol != 1 || Xx == NULL || Nx == NULL) { ERROR (CHOLMOD_INVALID, "X and/or DeltaB invalid") ; return (FALSE) ; } } else { Xx = NULL ; Nx = NULL ; } Common->status = CHOLMOD_OK ; Common->modfl = 0 ; fl = 0 ; use_colmark = (colmark != NULL) ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* Note: cholmod_rowadd and cholmod_rowdel use the second n doubles in * Common->Xwork for Cx, and then perform a rank-1 update here, which uses * the first n doubles in Common->Xwork. Both the rowadd and rowdel * routines allocate enough workspace so that Common->Xwork isn't destroyed * below. Also, both cholmod_rowadd and cholmod_rowdel use the second n * ints in Common->Iwork for Ci. */ /* make sure maxrank is in the proper range */ maxrank = CHOLMOD(maxrank) (n, Common) ; k = MIN (cncol, (Int) maxrank) ; /* maximum k is wdim */ wdim = Power2 [k] ; /* number of columns needed in W */ ASSERT (wdim <= (Int) maxrank) ; PRINT1 (("updown wdim final "ID" k "ID"\n", wdim, k)) ; /* w = wdim * n */ w = CHOLMOD(mult_size_t) (n, wdim, &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (FALSE) ; } CHOLMOD(allocate_work) (n, n, w, Common) ; if (Common->status < CHOLMOD_OK || maxrank == 0) { /* out of memory, L is returned unchanged */ return (FALSE) ; } /* ---------------------------------------------------------------------- */ /* convert to simplicial numeric LDL' factor, if not already */ /* ---------------------------------------------------------------------- */ if (L->xtype == CHOLMOD_PATTERN || L->is_super || L->is_ll) { /* can only update/downdate a simplicial LDL' factorization */ CHOLMOD(change_factor) (CHOLMOD_REAL, FALSE, FALSE, FALSE, FALSE, L, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory, L is returned unchanged */ return (FALSE) ; } } /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ /* mark = CHOLMOD(clear_flag) (Common) ; */ CHOLMOD_CLEAR_FLAG (Common) ; mark = Common->mark ; PRINT1 (("updown, rank %g update %d\n", (double) C->ncol, update)) ; DEBUG (CHOLMOD(dump_factor) (L, "input L for updown", Common)) ; ASSERT (CHOLMOD(dump_sparse) (C, "input C for updown", Common) >= 0) ; Ci = C->i ; Cp = C->p ; Cnz = C->nz ; packed = C->packed ; ASSERT (IMPLIES (!packed, Cnz != NULL)) ; /* ---------------------------------------------------------------------- */ /* quick return */ /* ---------------------------------------------------------------------- */ if (cncol <= 0 || n == 0) { /* nothing to do */ return (TRUE) ; } /* ---------------------------------------------------------------------- */ /* get L */ /* ---------------------------------------------------------------------- */ Li = L->i ; Lx = L->x ; Lp = L->p ; Lnz = L->nz ; Lnext = L->next ; ASSERT (Lnz != NULL) ; /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ Flag = Common->Flag ; /* size n, Flag [i] <= mark must hold */ Head = Common->Head ; /* size n, Head [i] == EMPTY must hold */ W = Common->Xwork ; /* size n-by-wdim, zero on input and output*/ /* note that Iwork [n .. 2*n-1] (i/i/l) may be in use in rowadd/rowdel: */ Iwork = Common->Iwork ; Stack = Iwork ; /* size n, uninitialized (i/i/l) */ /* ---------------------------------------------------------------------- */ /* entire rank-cncol update, done as a sequence of rank-k updates */ /* ---------------------------------------------------------------------- */ ps1 = NULL ; ps2 = NULL ; for (k1 = 0 ; k1 < cncol ; k1 += k) { /* ------------------------------------------------------------------ */ /* get the next k columns of C for the update/downdate */ /* ------------------------------------------------------------------ */ /* the last update/downdate might be less than rank-k */ if (k > cncol - k1) { k = cncol - k1 ; wdim = Power2 [k] ; } k2 = k1 + k - 1 ; /* workspaces are in the following state, on input and output */ ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, wdim, Common)) ; /* ------------------------------------------------------------------ */ /* create a zero-length path for each column of W */ /* ------------------------------------------------------------------ */ nextj = n ; path = 0 ; for (ccol = k1 ; ccol <= k2 ; ccol++) { PRINT1 (("Column ["ID"]: "ID"\n", path, ccol)) ; ASSERT (ccol >= 0 && ccol <= cncol) ; pp1 = Cp [ccol] ; pp2 = (packed) ? (Cp [ccol+1]) : (pp1 + Cnz [ccol]) ; /* get the row index j of the first entry in C (:,ccol) */ if (pp2 > pp1) { /* Column ccol of C has at least one entry. */ j = Ci [pp1] ; } else { /* Column ccol of C is empty. Pretend it has one entry in * the last column with numerical value of zero. */ j = n-1 ; } ASSERT (j >= 0 && j < n) ; /* find first column to work on */ nextj = MIN (nextj, j) ; Path [path].ccol = ccol ; /* which column of C this path is for */ Path [path].start = EMPTY ; /* paths for C have zero length */ Path [path].end = EMPTY ; Path [path].parent = EMPTY ; /* no parent yet */ Path [path].rank = 1 ; /* one column of W */ Path [path].c = EMPTY ; /* no child of this path (case A) */ Path [path].next = Head [j] ; /* this path is pending at col j */ Path [path].pending = j ; /* this path is pending at col j */ Head [j] = path ; /* this path is pending at col j */ PRINT1(("Path "ID" starts: start "ID" end "ID" parent "ID" c "ID"" "j "ID" ccol "ID"\n", path, Path [path].start, Path [path].end, Path [path].parent, Path [path].c, j, ccol)) ; /* initialize botrow for this path */ Path [path].botrow = (use_colmark) ? colmark [ccol] : n ; path++ ; } /* we start with paths 0 to k-1. Next one (now unused) is npaths */ npaths = k ; j = nextj ; ASSERT (j < n) ; scattered = FALSE ; /* ------------------------------------------------------------------ */ /* symbolic update of columns of L */ /* ------------------------------------------------------------------ */ while (j < n) { ASSERT (j >= 0 && j < n && Lnz [j] > 0) ; /* the old column, Li [p1..p2-1]. D (j,j) is stored in Lx [p1] */ p1 = Lp [j] ; newlnz = Lnz [j] ; p2 = p1 + newlnz ; #ifndef NDEBUG PRINT1 (("\n=========Column j="ID" p1 "ID" p2 "ID" lnz "ID" \n", j, p1, p2, newlnz)) ; dump_col ("Old", j, p1, p2, Li, Lx, n, Common) ; oldparent = (Lnz [j] > 1) ? (Li [p1 + 1]) : EMPTY ; ASSERT (CHOLMOD(dump_work) (TRUE, FALSE, 0, Common)) ; ASSERT (!scattered) ; PRINT1 (("Col "ID": Checking paths, npaths: "ID"\n", j, npaths)) ; for (kk = 0 ; kk < npaths ; kk++) { Int kk2, found, j3 = Path [kk].pending ; PRINT2 (("Path "ID" pending at "ID".\n", kk, j3)) ; if (j3 != EMPTY) { /* Path kk must be somewhere in link list for column j3 */ ASSERT (Head [j3] != EMPTY) ; PRINT3 ((" List at "ID": ", j3)) ; found = FALSE ; for (kk2 = Head [j3] ; kk2 != EMPTY ; kk2 = Path [kk2].next) { PRINT3 ((""ID" ", kk2)) ; ASSERT (Path [kk2].pending == j3) ; found = found || (kk2 == kk) ; } PRINT3 (("\n")) ; ASSERT (found) ; } } PRINT1 (("\nCol "ID": Paths at this column, head "ID"\n", j, Head [j])); ASSERT (Head [j] != EMPTY) ; for (kk = Head [j] ; kk != EMPTY ; kk = Path [kk].next) { PRINT1 (("path "ID": (c="ID" j="ID") npaths "ID"\n", kk, Path[kk].c, j, npaths)) ; ASSERT (kk >= 0 && kk < npaths) ; ASSERT (Path [kk].pending == j) ; } #endif /* -------------------------------------------------------------- */ /* determine the path we're on */ /* -------------------------------------------------------------- */ /* get the first old path at column j */ path = Head [j] ; /* -------------------------------------------------------------- */ /* update/downdate of forward solve, Lx=b */ /* -------------------------------------------------------------- */ if (do_solve) { xj = Xx [j] ; if (IS_NONZERO (xj)) { xj = Xx [j] ; /* This is first time column j has been seen for entire */ /* rank-k update/downdate. */ /* DeltaB += Lold (j:botrow-1,j) * X (j) */ Nx [j] += xj ; /* diagonal of L */ /* find the botrow for this column */ botrow = (use_colmark) ? Path [path].botrow : n ; for (p = p1 + 1 ; p < p2 ; p++) { i = Li [p] ; if (i >= botrow) { break ; } Nx [i] += Lx [p] * xj ; } /* clear X[j] to flag col j of Lold as having been seen. If * X (j) was initially zero, then the above code is never * executed for column j. This is safe, since if xj=0 the * code above does not do anything anyway. */ Xx [j] = 0.0 ; } } /* -------------------------------------------------------------- */ /* start a new path at this column if two or more paths merge */ /* -------------------------------------------------------------- */ newpath = /* start a new path if paths have merged */ (Path [path].next != EMPTY) /* or if j is the first node on a path (case A). */ || (Path [path].c == EMPTY) ; if (newpath) { /* get the botrow of the first path at column j */ botrow = (use_colmark) ? Path [path].botrow : n ; path = npaths++ ; ASSERT (npaths <= 3*k) ; Path [path].ccol = EMPTY ; /* no single col of C for this path*/ Path [path].start = j ; /* path starts at this column j */ Path [path].end = EMPTY ; /* don't know yet where it ends */ Path [path].parent = EMPTY ;/* don't know parent path yet */ Path [path].rank = 0 ; /* rank is sum of child path ranks */ PRINT1 (("Path "ID" starts: start "ID" end "ID" parent "ID"\n", path, Path [path].start, Path [path].end, Path [path].parent)) ; /* set the botrow of the new path */ Path [path].botrow = (use_colmark) ? botrow : n ; } /* -------------------------------------------------------------- */ /* for each path kk pending at column j */ /* -------------------------------------------------------------- */ /* make a list of the sets that need to be merged into column j */ nsets = 0 ; for (kk = Head [j] ; kk != EMPTY ; kk = Path [kk].next) { /* ---------------------------------------------------------- */ /* path kk is at (c,j) */ /* ---------------------------------------------------------- */ c = Path [kk].c ; ASSERT (c < j) ; PRINT1 (("TUPLE on path "ID" (c="ID" j="ID")\n", kk, c, j)) ; ASSERT (Path [kk].pending == j) ; if (newpath) { /* finalize path kk and find rank of this path */ Path [kk].end = c ; /* end of old path is previous node c */ Path [kk].parent = path ; /* parent is this path */ Path [path].rank += Path [kk].rank ; /* sum up ranks */ Path [kk].pending = EMPTY ; PRINT1 (("Path "ID" done:start "ID" end "ID" parent "ID"\n", kk, Path [kk].start, Path [kk].end, Path [kk].parent)) ; } if (c == EMPTY) { /* ------------------------------------------------------ */ /* CASE A: first node in path */ /* ------------------------------------------------------ */ /* update: add pattern of incoming column */ /* Column ccol of C is in Ci [pp1 ... pp2-1] */ ccol = Path [kk].ccol ; pp1 = Cp [ccol] ; pp2 = (packed) ? (Cp [ccol+1]) : (pp1 + Cnz [ccol]) ; PRINT1 (("Case A, ccol = "ID" len "ID"\n", ccol, pp2-pp1)) ; ASSERT (IMPLIES (pp2 > pp1, Ci [pp1] == j)) ; if (!scattered) { /* scatter the original pattern of column j of L */ for (p = p1 ; p < p2 ; p++) { Flag [Li [p]] = mark ; } scattered = TRUE ; } /* scatter column ccol of C (skip first entry, j) */ newlnz1 = newlnz ; for (p = pp1 + 1 ; p < pp2 ; p++) { row = Ci [p] ; if (Flag [row] < mark) { /* this is a new entry in Lj' */ Flag [row] = mark ; newlnz++ ; } } if (newlnz1 != newlnz) { /* column ccol of C adds something to column j of L */ Set [nsets++] = FLIP (ccol) ; } } else if (Head [c] == 1) { /* ------------------------------------------------------ */ /* CASE B: c is old, but changed, child of j */ /* CASE C: new child of j */ /* ------------------------------------------------------ */ /* Head [c] is 1 if col c of L has new entries, * EMPTY otherwise */ Flag [c] = 0 ; Head [c] = EMPTY ; /* update: add Lc' */ /* column c of L is in Li [pp1 .. pp2-1] */ pp1 = Lp [c] ; pp2 = pp1 + Lnz [c] ; PRINT1 (("Case B/C: c = "ID"\n", c)) ; DEBUG (dump_col ("Child", c, pp1, pp2, Li, Lx, n, Common)) ; ASSERT (j == Li [pp1 + 1]) ; /* j is new parent of c */ if (!scattered) { /* scatter the original pattern of column j of L */ for (p = p1 ; p < p2 ; p++) { Flag [Li [p]] = mark ; } scattered = TRUE ; } /* scatter column c of L (skip first two entries, c and j)*/ newlnz1 = newlnz ; for (p = pp1 + 2 ; p < pp2 ; p++) { row = Li [p] ; if (Flag [row] < mark) { /* this is a new entry in Lj' */ Flag [row] = mark ; newlnz++ ; } } PRINT2 (("\n")) ; if (newlnz1 != newlnz) { /* column c of L adds something to column j of L */ Set [nsets++] = c ; } } } /* -------------------------------------------------------------- */ /* update the pattern of column j of L */ /* -------------------------------------------------------------- */ /* Column j of L will be in Li/Lx [p1 .. p3-1] */ p3 = p1 + newlnz ; ASSERT (IMPLIES (nsets == 0, newlnz == Lnz [j])) ; PRINT1 (("p1 "ID" p2 "ID" p3 "ID" nsets "ID"\n", p1, p2, p3,nsets)); /* -------------------------------------------------------------- */ /* ensure we have enough space for the longer column */ /* -------------------------------------------------------------- */ if (nsets > 0 && p3 > Lp [Lnext [j]]) { PRINT1 (("Col realloc: j "ID" newlnz "ID"\n", j, newlnz)) ; if (!CHOLMOD(reallocate_column) (j, newlnz, L, Common)) { /* out of memory, L is now simplicial symbolic */ CHOLMOD(clear_flag) (Common) ; for (j = 0 ; j <= n ; j++) { Head [j] = EMPTY ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, wdim, Common)) ; return (FALSE) ; } /* L->i and L->x may have moved. Column j has moved too */ Li = L->i ; Lx = L->x ; p1 = Lp [j] ; p2 = p1 + Lnz [j] ; p3 = p1 + newlnz ; } /* -------------------------------------------------------------- */ /* create set pointers */ /* -------------------------------------------------------------- */ for (s = 0 ; s < nsets ; s++) { /* Pattern of Set s is *(Set_ps1 [s] ... Set_ps2 [s]-1) */ c = Set [s] ; if (c < EMPTY) { /* column ccol of C, skip first entry (j) */ ccol = FLIP (c) ; pp1 = Cp [ccol] ; pp2 = (packed) ? (Cp [ccol+1]) : (pp1 + Cnz [ccol]) ; ASSERT (pp2 - pp1 > 1) ; Set_ps1 [s] = &(Ci [pp1 + 1]) ; Set_ps2 [s] = &(Ci [pp2]) ; PRINT1 (("set "ID" is ccol "ID"\n", s, ccol)) ; } else { /* column c of L, skip first two entries (c and j) */ pp1 = Lp [c] ; pp2 = pp1 + Lnz [c] ; ASSERT (Lnz [c] > 2) ; Set_ps1 [s] = &(Li [pp1 + 2]) ; Set_ps2 [s] = &(Li [pp2]) ; PRINT1 (("set "ID" is L "ID"\n", s, c)) ; } DEBUG (dump_set (s, Set_ps1, Set_ps2, j, n, Common)) ; } /* -------------------------------------------------------------- */ /* multiset merge */ /* -------------------------------------------------------------- */ /* Merge the sets into a single sorted set, Lj'. Before the merge * starts, column j is located in Li/Lx [p1 ... p2-1] and the * space Li/Lx [p2 ... p3-1] is empty. p1 is Lp [j], p2 is * Lp [j] + Lnz [j] (the old length of the column), and p3 is * Lp [j] + newlnz (the new and longer length of the column). * * The sets 0 to nsets-1 are defined by the Set_ps1 and Set_ps2 * pointers. Set s is located in *(Set_ps1 [s] ... Set_ps2 [s]-1). * It may be a column of C, or a column of L. All row indices i in * the sets are in the range i > j and i < n. All sets are sorted. * * The merge into column j of L is done in place. * * During the merge, p2 and p3 are updated. Li/Lx [p1..p2-1] * reflects the indices of the old column j of L that are yet to * be merged into the new column. Entries in their proper place in * the new column j of L are located in Li/Lx [p3 ... p1+newlnz-1]. * The merge finishes when p2 == p3. * * During the merge, set s consumed as it is merged into column j of * L. Its unconsumed contents are *(Set_ps1 [s] ... Set_ps2 [s]-1). * When a set is completely consumed, it is removed from the set of * sets, and nsets is decremented. * * The multiset merge and 2-set merge finishes when p2 == p3. */ PRINT1 (("Multiset merge p3 "ID" p2 "ID" nsets "ID"\n", p3, p2, nsets)) ; while (p3 > p2 && nsets > 1) { #ifndef NDEBUG PRINT2 (("\nMultiset merge. nsets = "ID"\n", nsets)) ; PRINT2 (("Source col p1 = "ID", p2 = "ID", p3= "ID"\n", p1, p2, p3)) ; for (p = p1 + 1 ; p < p2 ; p++) { PRINT2 ((" p: "ID" source row "ID" %g\n", p, Li[p], Lx[p])) ; ASSERT (Li [p] > j && Li [p] < n) ; } PRINT2 (("---\n")) ; for (p = p3 ; p < p1 + newlnz ; p++) { PRINT2 ((" p: "ID" target row "ID" %g\n", p, Li[p], Lx[p])) ; ASSERT (Li [p] > j && Li [p] < n) ; } for (s = 0 ; s < nsets ; s++) { dump_set (s, Set_ps1, Set_ps2, j, n, Common) ; } #endif /* get the entry at the tail end of source column Lj */ row1 = Li [p2 - 1] ; ASSERT (row1 >= j && p2 >= p1) ; /* find the largest row in all the sets */ maxrow = row1 ; smax = EMPTY ; for (s = nsets-1 ; s >= 0 ; s--) { ASSERT (Set_ps1 [s] < Set_ps2 [s]) ; row = *(Set_ps2 [s] - 1) ; if (row == maxrow) { /* skip past this entry in set s (it is a duplicate) */ Set_ps2 [s]-- ; if (Set_ps1 [s] == Set_ps2 [s]) { /* nothing more in this set */ nsets-- ; Set_ps1 [s] = Set_ps1 [nsets] ; Set_ps2 [s] = Set_ps2 [nsets] ; if (smax == nsets) { /* Set smax redefined; it is now this set */ smax = s ; } } } else if (row > maxrow) { maxrow = row ; smax = s ; } } ASSERT (maxrow > j) ; /* move the row onto the stack of the target column */ if (maxrow == row1) { /* next entry is in Lj, move to the bottom of Lj' */ ASSERT (smax == EMPTY) ; p2-- ; p3-- ; Li [p3] = maxrow ; Lx [p3] = Lx [p2] ; } else { /* new entry in Lj' */ ASSERT (smax >= 0 && smax < nsets) ; Set_ps2 [smax]-- ; p3-- ; Li [p3] = maxrow ; Lx [p3] = 0.0 ; if (Set_ps1 [smax] == Set_ps2 [smax]) { /* nothing more in this set */ nsets-- ; Set_ps1 [smax] = Set_ps1 [nsets] ; Set_ps2 [smax] = Set_ps2 [nsets] ; PRINT1 (("Set "ID" now empty\n", smax)) ; } } } /* -------------------------------------------------------------- */ /* 2-set merge: */ /* -------------------------------------------------------------- */ /* This the same as the multi-set merge, except there is only one * set s = 0 left. The source column j and the set 0 are being * merged into the target column j. */ if (nsets > 0) { ps1 = Set_ps1 [0] ; ps2 = Set_ps2 [0] ; } while (p3 > p2) { #ifndef NDEBUG PRINT2 (("\n2-set merge.\n")) ; ASSERT (nsets == 1) ; PRINT2 (("Source col p1 = "ID", p2 = "ID", p3= "ID"\n", p1, p2, p3)) ; for (p = p1 + 1 ; p < p2 ; p++) { PRINT2 ((" p: "ID" source row "ID" %g\n", p, Li[p], Lx[p])) ; ASSERT (Li [p] > j && Li [p] < n) ; } PRINT2 (("---\n")) ; for (p = p3 ; p < p1 + newlnz ; p++) { PRINT2 ((" p: "ID" target row "ID" %g\n", p, Li[p], Lx[p])) ; ASSERT (Li [p] > j && Li [p] < n) ; } dump_set (0, Set_ps1, Set_ps2, j, n, Common) ; #endif if (p2 == p1 + 1) { /* the top of Lj is empty; copy the set and quit */ while (p3 > p2) { /* new entry in Lj' */ row = *(--ps2) ; p3-- ; Li [p3] = row ; Lx [p3] = 0.0 ; } } else { /* get the entry at the tail end of Lj */ row1 = Li [p2 - 1] ; ASSERT (row1 > j && row1 < n) ; /* get the entry at the tail end of the incoming set */ ASSERT (ps1 < ps2) ; row = *(ps2-1) ; ASSERT (row > j && row1 < n) ; /* move the larger of the two entries to the target set */ if (row1 >= row) { /* next entry is in Lj, move to the bottom */ if (row1 == row) { /* skip past this entry in the set */ ps2-- ; } p2-- ; p3-- ; Li [p3] = row1 ; Lx [p3] = Lx [p2] ; } else { /* new entry in Lj' */ ps2-- ; p3-- ; Li [p3] = row ; Lx [p3] = 0.0 ; } } } /* -------------------------------------------------------------- */ /* The new column j of L is now in Li/Lx [p1 ... p2-1] */ /* -------------------------------------------------------------- */ p2 = p1 + newlnz ; DEBUG (dump_col ("After merge: ", j, p1, p2, Li, Lx, n, Common)) ; fl += Path [path].rank * (6 + 4 * (double) newlnz) ; /* -------------------------------------------------------------- */ /* clear Flag; original pattern of column j L no longer marked */ /* -------------------------------------------------------------- */ mark = CHOLMOD(clear_flag) (Common) ; scattered = FALSE ; /* -------------------------------------------------------------- */ /* find the new parent */ /* -------------------------------------------------------------- */ newparent = (newlnz > 1) ? (Li [p1 + 1]) : EMPTY ; PRINT1 (("\nNew parent, Lnz: "ID": "ID" "ID"\n", j, newparent,newlnz)); ASSERT (oldparent == EMPTY || newparent <= oldparent) ; /* -------------------------------------------------------------- */ /* go to the next node in the path */ /* -------------------------------------------------------------- */ /* path moves to (j,nextj) unless j is a root */ nextj = (newparent == EMPTY) ? n : newparent ; /* place path at head of list for nextj, or terminate the path */ PRINT1 (("\n j = "ID" nextj = "ID"\n\n", j, nextj)) ; Path [path].c = j ; if (nextj < n) { /* put path on link list of pending paths at column nextj */ Path [path].next = Head [nextj] ; Path [path].pending = nextj ; Head [nextj] = path ; PRINT1 (("Path "ID" continues to ("ID","ID"). Rank "ID"\n", path, Path [path].c, nextj, Path [path].rank)) ; } else { /* path has ended here, at a root */ Path [path].next = EMPTY ; Path [path].pending = EMPTY ; Path [path].end = j ; PRINT1 (("Path "ID" ends at root ("ID"). Rank "ID"\n", path, Path [path].end, Path [path].rank)) ; } /* The link list Head [j] can now be emptied. Set Head [j] to 1 * if column j has changed (it is no longer used as a link list). */ PRINT1 (("column "ID", oldlnz = "ID"\n", j, Lnz [j])) ; Head [j] = (Lnz [j] != newlnz) ? 1 : EMPTY ; Lnz [j] = newlnz ; PRINT1 (("column "ID", newlnz = "ID"\n", j, newlnz)) ; DEBUG (dump_col ("New", j, p1, p2, Li, Lx, n, Common)) ; /* move to the next column */ if (k == Path [path].rank) { /* only one path left */ j = nextj ; } else { /* The current path is moving from column j to column nextj * (nextj is n if the path has ended). However, there may be * other paths pending in columns j+1 to nextj-1. There are * two methods for looking for the next column with a pending * update. The first one looks at all columns j+1 to nextj-1 * for a non-empty link list. This can be costly if j and * nextj differ by a large amount (it can be O(n), but this * entire routine may take Omega(1) time). The second method * looks at all paths and finds the smallest column at which any * path is pending. It takes O(# of paths), which is bounded * by 23: one for each column of C (up to 8), and then 15 for a * balanced binary tree with 8 leaves. However, if j and * nextj differ by a tiny amount (nextj is often j+1 near * the end of the matrix), looking at columns j+1 to nextj * would be faster. Both methods give the same answer. */ if (nextj - j < npaths) { /* there are fewer columns to search than paths */ PRINT1 (("check j="ID" to nextj="ID"\n", j, nextj)) ; for (j2 = j + 1 ; j2 < nextj ; j2++) { PRINT1 (("check j="ID" "ID"\n", j2, Head [j2])) ; if (Head [j2] != EMPTY) { PRINT1 (("found, j="ID"\n", j2)) ; ASSERT (Path [Head [j2]].pending == j2) ; break ; } } } else { /* there are fewer paths than columns to search */ j2 = nextj ; for (kk = 0 ; kk < npaths ; kk++) { jj = Path [kk].pending ; PRINT2 (("Path "ID" pending at "ID"\n", kk, jj)) ; if (jj != EMPTY) j2 = MIN (j2, jj) ; } } j = j2 ; } } /* ensure workspaces are back to the values required on input */ ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, TRUE, Common)) ; /* ------------------------------------------------------------------ */ /* depth-first-search of tree to order the paths */ /* ------------------------------------------------------------------ */ /* create lists of child paths */ PRINT1 (("\n\nDFS search:\n\n")) ; for (path = 0 ; path < npaths ; path++) { Path [path].c = EMPTY ; /* first child of path */ Path [path].next = EMPTY ; /* next sibling of path */ Path [path].order = EMPTY ; /* path is not ordered yet */ Path [path].wfirst = EMPTY ; /* 1st column of W not found yet */ #ifndef NDEBUG j = Path [path].start ; PRINT1 (("Path "ID" : start "ID" end "ID" parent "ID" ccol "ID"\n", path, j, Path [path].end, Path [path].parent, Path [path].ccol)) ; for ( ; ; ) { PRINT1 ((" column "ID"\n", j)) ; ASSERT (j == EMPTY || (j >= 0 && j < n)) ; if (j == Path [path].end) { break ; } ASSERT (j >= 0 && j < n) ; j = (Lnz [j] > 1) ? (Li [Lp [j] + 1]) : EMPTY ; } #endif } for (path = 0 ; path < npaths ; path++) { p = Path [path].parent ; /* add path to child list of parent */ if (p != EMPTY) { ASSERT (p < npaths) ; Path [path].next = Path [p].c ; Path [p].c = path ; } } path_order = k ; w_order = 0 ; for (path = npaths-1 ; path >= 0 ; path--) { if (Path [path].order == EMPTY) { /* this path is the root of a subtree of Tbar */ PRINT1 (("Root path "ID"\n", path)) ; ASSERT (path >= k) ; dfs (Path, k, path, &path_order, &w_order, 0, npaths) ; } } ASSERT (path_order == npaths) ; ASSERT (w_order == k) ; /* reorder the paths */ for (path = 0 ; path < npaths ; path++) { /* old order is path, new order is Path [path].order */ OrderedPath [Path [path].order] = Path [path] ; } #ifndef NDEBUG for (path = 0 ; path < npaths ; path++) { PRINT1 (("Ordered Path "ID": start "ID" end "ID" wfirst "ID" rank " ""ID" ccol "ID"\n", path, OrderedPath [path].start, OrderedPath [path].end, OrderedPath [path].wfirst, OrderedPath [path].rank, OrderedPath [path].ccol)) ; if (path < k) { ASSERT (OrderedPath [path].ccol >= 0) ; } else { ASSERT (OrderedPath [path].ccol == EMPTY) ; } } #endif /* ------------------------------------------------------------------ */ /* numeric update/downdate for all paths */ /* ------------------------------------------------------------------ */ ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, wdim, Common)) ; switch (wdim) { case 1: updown_1_r (update, C, k, L, W, OrderedPath, npaths, mask, maskmark, Common) ; break ; case 2: updown_2_r (update, C, k, L, W, OrderedPath, npaths, mask, maskmark, Common) ; break ; case 4: updown_4_r (update, C, k, L, W, OrderedPath, npaths, mask, maskmark, Common) ; break ; case 8: updown_8_r (update, C, k, L, W, OrderedPath, npaths, mask, maskmark, Common) ; break ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, wdim, Common)) ; } /* ---------------------------------------------------------------------- */ /* update/downdate the forward solve */ /* ---------------------------------------------------------------------- */ if (do_solve) { /* We now have DeltaB += Lold (:,j) * X (j) for all columns j in union * of all paths seen during the entire rank-cncol update/downdate. For * each j in path, do DeltaB -= Lnew (:,j)*DeltaB(j) * in topological order. */ #ifndef NDEBUG PRINT1 (("\ndo_solve, DeltaB + Lold(:,Path)*X(Path):\n")) ; for (i = 0 ; i < n ; i++) { PRINT1 (("do_solve: "ID" %30.20e\n", i, Nx [i])) ; } #endif /* Note that the downdate, if it deleted entries, would need to compute * the Stack prior to doing any downdates. */ /* find the union of all the paths in the new L */ top = n ; /* "top" is stack pointer, not a row or column index */ for (ccol = 0 ; ccol < cncol ; ccol++) { /* -------------------------------------------------------------- */ /* j = first row index of C (:,ccol) */ /* -------------------------------------------------------------- */ pp1 = Cp [ccol] ; pp2 = (packed) ? (Cp [ccol+1]) : (pp1 + Cnz [ccol]) ; if (pp2 > pp1) { /* Column ccol of C has at least one entry. */ j = Ci [pp1] ; } else { /* Column ccol of C is empty */ j = n-1 ; } PRINT1 (("\ndo_solve: ccol= "ID"\n", ccol)) ; ASSERT (j >= 0 && j < n) ; len = 0 ; /* -------------------------------------------------------------- */ /* find the new rowmark */ /* -------------------------------------------------------------- */ /* Each column of C can redefine the region of L that takes part in * the update/downdate of the triangular solve Lx=b. If * i = colmark [ccol] for column C(:,ccol), then i = rowmark [j] is * redefined for all columns along the path modified by C(:,ccol). * If more than one column modifies any given column j of L, then * the rowmark of j is determined by the colmark of the least- * numbered column that affects column j. That is, if both * C(:,ccol1) and C(:,ccol2) affect column j of L, then * rowmark [j] = colmark [MIN (ccol1, ccol2)]. * * rowmark [j] is not modified if rowmark or colmark are NULL, * or if colmark [ccol] is EMPTY. */ botrow = (use_colmark) ? (colmark [ccol]) : EMPTY ; /* -------------------------------------------------------------- */ /* traverse from j towards root, stopping if node already visited */ /* -------------------------------------------------------------- */ while (j != EMPTY && Flag [j] < mark) { PRINT1 (("do_solve: subpath j= "ID"\n", j)) ; ASSERT (j >= 0 && j < n) ; Stack [len++] = j ; /* place j on the stack */ Flag [j] = mark ; /* flag j as visited */ /* if using colmark, mark column j with botrow */ ASSERT (Li [Lp [j]] == j) ; /* diagonal is always present */ if (use_colmark) { Li [Lp [j]] = botrow ; /* use the space for botrow */ } /* go up the tree, to the parent of j */ j = (Lnz [j] > 1) ? (Li [Lp [j] + 1]) : EMPTY ; } /* -------------------------------------------------------------- */ /* move the path down to the bottom of the stack */ /* -------------------------------------------------------------- */ ASSERT (len <= top) ; while (len > 0) { Stack [--top] = Stack [--len] ; } } #ifndef NDEBUG /* Union of paths now in Stack [top..n-1] in topological order */ PRINT1 (("\nTopological order:\n")) ; for (i = top ; i < n ; i++) { PRINT1 (("column "ID" in full path\n", Stack [i])) ; } #endif /* Do the forward solve for the full path part of L */ for (m = top ; m < n ; m++) { j = Stack [m] ; ASSERT (j >= 0 && j < n) ; PRINT1 (("do_solve: path j= "ID"\n", j)) ; p1 = Lp [j] ; lnz = Lnz [j] ; p2 = p1 + lnz ; xj = Nx [j] ; /* copy new solution onto old one, for all cols in full path */ Xx [j] = xj ; Nx [j] = 0. ; /* DeltaB -= Lnew (j+1:botrow-1,j) * deltab(j) */ if (use_colmark) { botrow = Li [p1] ; /* get botrow */ Li [p1] = j ; /* restore diagonal entry */ for (p = p1 + 1 ; p < p2 ; p++) { i = Li [p] ; if (i >= botrow) break ; Nx [i] -= Lx [p] * xj ; } } else { for (p = p1 + 1 ; p < p2 ; p++) { Nx [Li [p]] -= Lx [p] * xj ; } } } /* clear the Flag */ mark = CHOLMOD(clear_flag) (Common) ; } /* ---------------------------------------------------------------------- */ /* successful update/downdate */ /* ---------------------------------------------------------------------- */ Common->modfl = fl ; DEBUG (for (j = 0 ; j < n ; j++) ASSERT (IMPLIES (do_solve, Nx[j] == 0.))) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, TRUE, Common)) ; DEBUG (CHOLMOD(dump_factor) (L, "output L for updown", Common)) ; return (TRUE) ; } #endif #endif Matrix/src/CHOLMOD/Modify/License.txt0000644000176200001440000000204611770402705016751 0ustar liggesusersCHOLMOD/Modify Module. Copyright (C) 2005-2006, Timothy A. Davis and William W. Hager CHOLMOD is also available under other licenses; contact authors for details. http://www.suitesparse.com Note that this license is for the CHOLMOD/Modify module only. All CHOLMOD modules are licensed separately. -------------------------------------------------------------------------------- This Module 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 of the License, or (at your option) any later version. This Module 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 Module; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. Matrix/src/CHOLMOD/Modify/t_cholmod_updown.c0000644000176200001440000001454513652535054020352 0ustar liggesusers/* ========================================================================== */ /* === Modify/t_cholmod_updown ============================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Modify Module. Copyright (C) 2005-2006, * Timothy A. Davis and William W. Hager. * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* Updates/downdates the LDL' factorization, by computing a new factorization of * * Lnew * Dnew * Lnew' = Lold * Dold * Lold' +/- C*C' * * This file is not compiled separately. It is included into * cholmod_updown.c. There are no user-callable routines in this file. * * The next include statements, below, create the numerical update/downdate * kernels from t_cholmod_updown_numkr.c. There are 4 compiled versions of this * file, one for each value of WDIM in the set 1, 2, 4, and 8. Each calls * multiple versions of t_cholmod_updown_numkr; the number of versions of each * is equal to WDIM. Each t_cholmod_updown_numkr version is included as a * static function within its t_cholmod_updown.c caller routine. Thus: * * t*_updown.c creates these versions of t_cholmod_updown_numkr.c: * --------- --------------------------------------------------- * * updown_1_r updown_1_1 * * updown_2_r updown_2_1 updown_2_2 * * updown_4_r updown_4_1 updown_4_2 updown_4_3 updown_4_4 * * updown_8_r updown_8_1 updown_8_2 updown_8_3 updown_8_4 * updown_8_5 updown_8_6 updown_8_7 updown_8_8 * * workspace: Xwork (nrow*wdim) */ /* ========================================================================== */ /* === routines for numeric update/downdate along one path ================== */ /* ========================================================================== */ #undef FORM_NAME #undef NUMERIC #define FORM_NAME(k,rank) updown_ ## k ## _ ## rank #define NUMERIC(k,rank) FORM_NAME(k,rank) #define RANK 1 #include "t_cholmod_updown_numkr.c" #if WDIM >= 2 #define RANK 2 #include "t_cholmod_updown_numkr.c" #endif #if WDIM >= 4 #define RANK 3 #include "t_cholmod_updown_numkr.c" #define RANK 4 #include "t_cholmod_updown_numkr.c" #endif #if WDIM == 8 #define RANK 5 #include "t_cholmod_updown_numkr.c" #define RANK 6 #include "t_cholmod_updown_numkr.c" #define RANK 7 #include "t_cholmod_updown_numkr.c" #define RANK 8 #include "t_cholmod_updown_numkr.c" #endif /* ========================================================================== */ /* === numeric update/downdate for all paths ================================ */ /* ========================================================================== */ static void NUMERIC (WDIM, r) ( int update, /* TRUE for update, FALSE for downdate */ cholmod_sparse *C, /* in packed or unpacked, and sorted form */ /* no empty columns */ Int rank, /* rank of the update/downdate */ cholmod_factor *L, /* with unit diagonal (diagonal not stored) */ /* temporary workspaces: */ double W [ ], /* n-by-WDIM dense matrix, initially zero */ Path_type Path [ ], Int npaths, Int mask [ ], /* size n */ Int maskmark, cholmod_common *Common ) { double Alpha [8] ; double *Cx, *Wpath, *W1, *a ; Int i, j, p, ccol, pend, wfirst, e, path, packed ; Int *Ci, *Cp, *Cnz ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ Ci = C->i ; Cx = C->x ; Cp = C->p ; Cnz = C->nz ; packed = C->packed ; ASSERT (IMPLIES (!packed, Cnz != NULL)) ; ASSERT (L->n == C->nrow) ; DEBUG (CHOLMOD(dump_real) ("num_d: in W:", W, WDIM, L->n, FALSE, 1,Common)); /* ---------------------------------------------------------------------- */ /* scatter C into W */ /* ---------------------------------------------------------------------- */ for (path = 0 ; path < rank ; path++) { /* W (:, path) = C (:, Path [path].col) */ ccol = Path [path].ccol ; Wpath = W + path ; PRINT1 (("Ordered Columns [path = "ID"] = "ID"\n", path, ccol)) ; p = Cp [ccol] ; pend = (packed) ? (Cp [ccol+1]) : (p + Cnz [ccol]) ; /* column C can be empty */ for ( ; p < pend ; p++) { i = Ci [p] ; ASSERT (i >= 0 && i < (Int) (C->nrow)) ; if (mask == NULL || mask [i] < maskmark) { Wpath [WDIM * i] = Cx [p] ; } PRINT1 ((" row "ID" : %g mask "ID"\n", i, Cx [p], (mask) ? mask [i] : 0)) ; } Alpha [path] = 1.0 ; } DEBUG (CHOLMOD(dump_real) ("num_d: W:", W, WDIM, L->n, FALSE, 1,Common)) ; /* ---------------------------------------------------------------------- */ /* numeric update/downdate of the paths */ /* ---------------------------------------------------------------------- */ /* for each disjoint subpath in Tbar in DFS order do */ for (path = rank ; path < npaths ; path++) { /* determine which columns of W to use */ wfirst = Path [path].wfirst ; e = Path [path].end ; j = Path [path].start ; ASSERT (e >= 0 && e < (Int) (L->n)) ; ASSERT (j >= 0 && j < (Int) (L->n)) ; W1 = W + wfirst ; /* pointer to row 0, column wfirst of W */ a = Alpha + wfirst ; /* pointer to Alpha [wfirst] */ PRINT1 (("Numerical update/downdate of path "ID"\n", path)) ; PRINT1 (("start "ID" end "ID" wfirst "ID" rank "ID" ccol "ID"\n", j, e, wfirst, Path [path].rank, Path [path].ccol)) ; #if WDIM == 1 NUMERIC (WDIM,1) (update, j, e, a, W1, L, Common) ; #else switch (Path [path].rank) { case 1: NUMERIC (WDIM,1) (update, j, e, a, W1, L, Common) ; break ; #if WDIM >= 2 case 2: NUMERIC (WDIM,2) (update, j, e, a, W1, L, Common) ; break ; #endif #if WDIM >= 4 case 3: NUMERIC (WDIM,3) (update, j, e, a, W1, L, Common) ; break ; case 4: NUMERIC (WDIM,4) (update, j, e, a, W1, L, Common) ; break ; #endif #if WDIM == 8 case 5: NUMERIC (WDIM,5) (update, j, e, a, W1, L, Common) ; break ; case 6: NUMERIC (WDIM,6) (update, j, e, a, W1, L, Common) ; break ; case 7: NUMERIC (WDIM,7) (update, j, e, a, W1, L, Common) ; break ; case 8: NUMERIC (WDIM,8) (update, j, e, a, W1, L, Common) ; break ; #endif } #endif } } /* prepare for the next inclusion of this file in cholmod_updown.c */ #undef WDIM Matrix/src/CHOLMOD/Modify/cholmod_rowdel.c0000644000176200001440000003142313652535054020001 0ustar liggesusers/* ========================================================================== */ /* === Modify/cholmod_rowdel ================================================ */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Modify Module. * Copyright (C) 2005-2006, Timothy A. Davis and William W. Hager. * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* Deletes a row and column from an LDL' factorization. The row and column k * is set to the kth row and column of the identity matrix. Optionally * downdates the solution to Lx=b. * * workspace: Flag (nrow), Head (nrow+1), W (nrow*2), Iwork (2*nrow) * * Only real matrices are supported (exception: since only the pattern of R * is used, it can have any valid xtype). */ #ifndef NGPL #ifndef NMODIFY #include "cholmod_internal.h" #include "cholmod_modify.h" /* ========================================================================== */ /* === cholmod_rowdel ======================================================= */ /* ========================================================================== */ /* Sets the kth row and column of L to be the kth row and column of the identity * matrix, and updates L(k+1:n,k+1:n) accordingly. To reduce the running time, * the caller can optionally provide the nonzero pattern (or an upper bound) of * kth row of L, as the sparse n-by-1 vector R. Provide R as NULL if you want * CHOLMOD to determine this itself, which is easier for the caller, but takes * a little more time. */ int CHOLMOD(rowdel) ( /* ---- input ---- */ size_t k, /* row/column index to delete */ cholmod_sparse *R, /* NULL, or the nonzero pattern of kth row of L */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ /* --------------- */ cholmod_common *Common ) { double yk [2] ; yk [0] = 0. ; yk [1] = 0. ; return (CHOLMOD(rowdel_mark) (k, R, yk, NULL, L, NULL, NULL, Common)) ; } /* ========================================================================== */ /* === cholmod_rowdel_solve ================================================= */ /* ========================================================================== */ /* Does the same as cholmod_rowdel, but also downdates the solution to Lx=b. * When row/column k of A is "deleted" from the system A*y=b, this can induce * a change to x, in addition to changes arising when L and b are modified. * If this is the case, the kth entry of y is required as input (yk) */ int CHOLMOD(rowdel_solve) ( /* ---- input ---- */ size_t k, /* row/column index to delete */ cholmod_sparse *R, /* NULL, or the nonzero pattern of kth row of L */ double yk [2], /* kth entry in the solution to A*y=b */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ cholmod_dense *X, /* solution to Lx=b (size n-by-1) */ cholmod_dense *DeltaB, /* change in b, zero on output */ /* --------------- */ cholmod_common *Common ) { return (CHOLMOD(rowdel_mark) (k, R, yk, NULL, L, X, DeltaB, Common)) ; } /* ========================================================================== */ /* === cholmod_rowdel_mark ================================================== */ /* ========================================================================== */ /* Does the same as cholmod_rowdel_solve, except only part of L is used in * the update/downdate of the solution to Lx=b. This routine is an "expert" * routine. It is meant for use in LPDASA only. * * if R == NULL then columns 0:k-1 of L are searched for row k. Otherwise, it * searches columns in the set defined by the pattern of the first column of R. * This is meant to be the pattern of row k of L (a superset of that pattern is * OK too). R must be a permutation of a subset of 0:k-1. */ int CHOLMOD(rowdel_mark) ( /* ---- input ---- */ size_t kdel, /* row/column index to delete */ cholmod_sparse *R, /* NULL, or the nonzero pattern of kth row of L */ double yk [2], /* kth entry in the solution to A*y=b */ Int *colmark, /* Int array of size 1. See cholmod_updown.c */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ cholmod_dense *X, /* solution to Lx=b (size n-by-1) */ cholmod_dense *DeltaB, /* change in b, zero on output */ /* --------------- */ cholmod_common *Common ) { double dk, sqrt_dk, xk, dj, fl ; double *Lx, *Cx, *W, *Xx, *Nx ; Int *Li, *Lp, *Lnz, *Ci, *Rj, *Rp, *Iwork ; cholmod_sparse *C, Cmatrix ; Int j, p, pend, kk, lnz, n, Cp [2], do_solve, do_update, left, k, right, middle, i, klast, given_row, rnz ; size_t s ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_REAL, FALSE) ; n = L->n ; k = kdel ; if (kdel >= L->n || k < 0) { ERROR (CHOLMOD_INVALID, "k invalid") ; return (FALSE) ; } if (R == NULL) { Rj = NULL ; rnz = EMPTY ; } else { RETURN_IF_XTYPE_INVALID (R, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; if (R->ncol != 1 || R->nrow != L->n) { ERROR (CHOLMOD_INVALID, "R invalid") ; return (FALSE) ; } Rj = R->i ; Rp = R->p ; rnz = Rp [1] ; } do_solve = (X != NULL) && (DeltaB != NULL) ; if (do_solve) { RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ; RETURN_IF_XTYPE_INVALID (DeltaB, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ; Xx = X->x ; Nx = DeltaB->x ; if (X->nrow != L->n || X->ncol != 1 || DeltaB->nrow != L->n || DeltaB->ncol != 1 || Xx == NULL || Nx == NULL) { ERROR (CHOLMOD_INVALID, "X and/or DeltaB invalid") ; return (FALSE) ; } } else { Xx = NULL ; Nx = NULL ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* s = 2*n */ s = CHOLMOD(mult_size_t) (n, 2, &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (FALSE) ; } CHOLMOD(allocate_work) (n, s, s, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 2*n, Common)) ; /* ---------------------------------------------------------------------- */ /* convert to simplicial numeric LDL' factor, if not already */ /* ---------------------------------------------------------------------- */ if (L->xtype == CHOLMOD_PATTERN || L->is_super || L->is_ll) { /* can only update/downdate a simplicial LDL' factorization */ CHOLMOD(change_factor) (CHOLMOD_REAL, FALSE, FALSE, FALSE, FALSE, L, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory, L is returned unchanged */ return (FALSE) ; } } /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ /* inputs, not modified on output: */ Lp = L->p ; /* size n+1 */ /* outputs, contents defined on input for incremental case only: */ Lnz = L->nz ; /* size n */ Li = L->i ; /* size L->nzmax. Can change in size. */ Lx = L->x ; /* size L->nzmax. Can change in size. */ ASSERT (L->nz != NULL) ; /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ W = Common->Xwork ; /* size n, used only in cholmod_updown */ Cx = W + n ; /* use 2nd column of Xwork for C (size n) */ Iwork = Common->Iwork ; Ci = Iwork + n ; /* size n (i/i/l) */ /* NOTE: cholmod_updown uses Iwork [0..n-1] (i/i/l) as Stack */ /* ---------------------------------------------------------------------- */ /* prune row k from all columns of L */ /* ---------------------------------------------------------------------- */ given_row = (rnz >= 0) ; klast = given_row ? rnz : k ; PRINT2 (("given_row "ID"\n", given_row)) ; for (kk = 0 ; kk < klast ; kk++) { /* either search j = 0:k-1 or j = Rj [0:rnz-1] */ j = given_row ? (Rj [kk]) : (kk) ; if (j < 0 || j >= k) { ERROR (CHOLMOD_INVALID, "R invalid") ; return (FALSE) ; } PRINT2 (("Prune col j = "ID":\n", j)) ; lnz = Lnz [j] ; dj = Lx [Lp [j]] ; ASSERT (Lnz [j] > 0 && Li [Lp [j]] == j) ; if (lnz > 1) { left = Lp [j] ; pend = left + lnz ; right = pend - 1 ; i = Li [right] ; if (i < k) { /* row k is not in column j */ continue ; } else if (i == k) { /* k is the last row index in this column (quick delete) */ if (do_solve) { Xx [j] -= yk [0] * dj * Lx [right] ; } Lx [right] = 0 ; } else { /* binary search for row k in column j */ PRINT2 (("\nBinary search: lnz "ID" k = "ID"\n", lnz, k)) ; while (left < right) { middle = (left + right) / 2 ; PRINT2 (("left "ID" right "ID" middle "ID": ["ID" "ID"" ""ID"]\n", left, right, middle, Li [left], Li [middle], Li [right])) ; if (k > Li [middle]) { left = middle + 1 ; } else { right = middle ; } } ASSERT (left >= Lp [j] && left < pend) ; #ifndef NDEBUG /* brute force, linear-time search */ { Int p3 = Lp [j] ; i = EMPTY ; PRINT2 (("Brute force:\n")) ; for ( ; p3 < pend ; p3++) { i = Li [p3] ; PRINT2 (("p "ID" ["ID"]\n", p3, i)) ; if (i >= k) { break ; } } if (i == k) { ASSERT (k == Li [p3]) ; ASSERT (p3 == left) ; } } #endif if (k == Li [left]) { if (do_solve) { Xx [j] -= yk [0] * dj * Lx [left] ; } /* found row k in column j. Prune it from the column.*/ Lx [left] = 0 ; } } } } #ifndef NDEBUG /* ensure that row k has been deleted from the matrix L */ for (j = 0 ; j < k ; j++) { Int lasti ; lasti = EMPTY ; p = Lp [j] ; pend = p + Lnz [j] ; /* look for row k in column j */ PRINT1 (("Pruned column "ID"\n", j)) ; for ( ; p < pend ; p++) { i = Li [p] ; PRINT2 ((" "ID"", i)) ; PRINT2 ((" %g\n", Lx [p])) ; ASSERT (IMPLIES (i == k, Lx [p] == 0)) ; ASSERT (i > lasti) ; lasti = i ; } PRINT1 (("\n")) ; } #endif /* ---------------------------------------------------------------------- */ /* set diagonal and clear column k of L */ /* ---------------------------------------------------------------------- */ lnz = Lnz [k] - 1 ; ASSERT (Lnz [k] > 0) ; /* ---------------------------------------------------------------------- */ /* update/downdate */ /* ---------------------------------------------------------------------- */ /* update or downdate L (k+1:n, k+1:n) with the vector * C = L (:,k) * sqrt (abs (D [k])) * Do a numeric update if D[k] > 0, numeric downdate otherwise. */ PRINT1 (("rowdel downdate lnz = "ID"\n", lnz)) ; /* store the new unit diagonal */ p = Lp [k] ; pend = p + lnz + 1 ; dk = Lx [p] ; Lx [p++] = 1 ; PRINT2 (("D [k = "ID"] = %g\n", k, dk)) ; ok = TRUE ; fl = 0 ; if (lnz > 0) { /* compute DeltaB for updown (in DeltaB) */ if (do_solve) { xk = Xx [k] - yk [0] * dk ; for ( ; p < pend ; p++) { Nx [Li [p]] += Lx [p] * xk ; } } do_update = IS_GT_ZERO (dk) ; if (!do_update) { dk = -dk ; } sqrt_dk = sqrt (dk) ; p = Lp [k] + 1 ; for (kk = 0 ; kk < lnz ; kk++, p++) { Ci [kk] = Li [p] ; Cx [kk] = Lx [p] * sqrt_dk ; Lx [p] = 0 ; /* clear column k */ } fl = lnz + 1 ; /* create a n-by-1 sparse matrix to hold the single column */ C = &Cmatrix ; C->nrow = n ; C->ncol = 1 ; C->nzmax = lnz ; C->sorted = TRUE ; C->packed = TRUE ; C->p = Cp ; C->i = Ci ; C->x = Cx ; C->nz = NULL ; C->itype = L->itype ; C->xtype = L->xtype ; C->dtype = L->dtype ; C->z = NULL ; C->stype = 0 ; Cp [0] = 0 ; Cp [1] = lnz ; /* numeric update if dk > 0, and with Lx=b change */ /* workspace: Flag (nrow), Head (nrow+1), W (nrow), Iwork (2*nrow) */ ok = CHOLMOD(updown_mark) (do_update ? (1) : (0), C, colmark, L, X, DeltaB, Common) ; /* clear workspace */ for (kk = 0 ; kk < lnz ; kk++) { Cx [kk] = 0 ; } } Common->modfl += fl ; if (do_solve) { /* kth equation becomes identity, so X(k) is now Y(k) */ Xx [k] = yk [0] ; } DEBUG (CHOLMOD(dump_factor) (L, "LDL factorization, L:", Common)) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 2*n, Common)) ; return (ok) ; } #endif #endif Matrix/src/CHOLMOD/Check/0000755000176200001440000000000014154165363014417 5ustar liggesusersMatrix/src/CHOLMOD/Check/cholmod_read.c0000644000176200001440000011703713652535054017214 0ustar liggesusers/* ========================================================================== */ /* === Check/cholmod_read =================================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Check Module. Copyright (C) 2005-2006, Timothy A. Davis. * -------------------------------------------------------------------------- */ /* Read a sparse matrix in triplet or dense form. A triplet matrix can be * returned as compressed-column sparse matrix. The file format is compatible * with all variations of the Matrix Market "coordinate" and "array" format * (http://www.nist.gov/MatrixMarket). The format supported by these routines * also allow other formats, where the Matrix Market header is optional. * * Although the Matrix Market header is optional, I recommend that users stick * with the strict Matrix Market format. The optional format appears here to * support the reading of symmetric matrices stored with just their upper * triangular parts present, for testing and development of the A->stype > 0 * format in CHOLMOD. That format is not included in the Matrix Market format. * * If the first line of the file starts with %%MatrixMarket, then it is * interpretted as a file in Matrix Market format. This line must have * the following format: * * %%MatrixMarket matrix * * is one of: coordinate or array. The former is a sparse matrix in * triplet form. The latter is a dense matrix in column-major form. * * is one of: real, complex, pattern, or integer. * The functions here convert the "integer" and "pattern" types to real. * * is one of: general, hermitian, symmetric, or skew-symmetric * * The strings are case-insensitive. Only the first character is * significant (or the first two for skew-symmetric). * * is ignored for all matrices; the actual type (real, complex, * or pattern) is inferred from the number of tokens in each line of the * file. For a "coordinate" matrix: 2: pattern, 3: real, 4: complex; for * a dense "array" matrix: 1: real, 2: complex. This is compatible with * the Matrix Market format, since pattern matrices must have two tokens * per line, real matrices must have 3, and complex matrices must have 4. * A storage of "general" implies an stype of zero (see below). * "symmetric" and "hermitian" imply an stype of -1. Skew-symmetric and * complex symmetric matrices are always returned with both upper and lower * triangular parts present, with an stype of zero, since CHOLMOD does not * have a method for representing skew-symmetric and complex symmetric * matrices. Real symmetric and complex Hermitian matrices may optionally * be returned with both parts present. * * Any other lines starting with "%" are treated as comments, and are ignored. * Blank lines are ignored. The Matrix Market header is optional in this * routine (it is not optional in the Matrix Market format). * * Note that complex matrices are always returned in CHOLMOD_COMPLEX format, * not CHOLMOD_ZOMPLEX. * * ----------------------------------------------------------------------------- * Triplet matrices: * ----------------------------------------------------------------------------- * * The first data line of a triplet matrix contains 3 or 4 integers: * * nrow ncol nnz stype * * where stype is optional (stype does not appear in the Matrix Market format). * The matrix is nrow-by-ncol. The following nnz lines (excluding comments * and blank lines) each contain a single entry. Duplicates are permitted, * and are summed in the output matrix. * * The stype is first derived from the Matrix Market header. If the stype * appears as the fourth integer in the first data line, it is determined from * that line. * * If stype is present, it denotes the storage format for the matrix. * stype = 0 denotes an unsymmetric matrix (same as Matrix Market "general"). * stype = -1 denotes a real symmetric or complex Hermitian matrix whose lower * triangular entries are stored. Entries may be present in the upper * triangular part, but these are ignored (same as Matrix Market * "real symmetric" and "complex Hermitian"). * stype = 1 denotes a real symmetric or complex Hermitian matrix whose upper * triangular entries are stored. Entries may be present in the lower * triangular part, but these are ignored. This option is not present * in the Matrix Market format. * * If stype is not present (no Matrix Market header and not in the first data * line) it is inferred from the rest of the data. If the matrix is * rectangular, or has entries in both the upper and lower triangular parts, * then it is assumed to be unsymmetric (stype=0). If only entries in the * lower triangular part are present, the matrix is assumed to have stype = -1. * If only entries in the upper triangular part are present, the matrix is * assumed to have stype = 1. * * After the first data line (with nrow, ncol, nnz, and optionally stype), * each nonzero consists of one line with 2, 3, or 4 entries. All lines must * have the same number of entries. The first two entries are the row and * column indices of the nonzero. If 3 entries are present, the 3rd entry is * the numerical value, and the matrix is real. If 4 entries are present, * the 3rd and 4th entries in the line are the real and imaginary parts of * a complex value. * * The matrix can be either 0-based or 1-based. It is first assumed to be * one-based (all matrices in the Matrix Market are one-based), with row indices * in the range 1 to ncol and column indices in the range 1 to nrow. If a row * or column index of zero is found, the matrix is assumed to be zero-based * (with row indices in the range 0 to ncol-1 and column indices in the range 0 * to nrow-1). * * If Common->prefer_binary is set to its default value of FALSE, then * for symmetric pattern-only matrices, the kth diagonal (if present) is set to * one plus the degree of the row/column k, and the off-diagonal entries are set * to -1. A symmetric pattern-only matrix with a zero-free diagonal is thus * converted into a symmetric positive definite matrix. All entries are set to * one for an unsymmetric pattern-only matrix. This differs from the * Matrix Market format (A = mmread ('file') returns a binary pattern for A for * symmetric pattern-only matrices). If Common->prefer_binary is TRUE, then * this function returns a binary matrix (just like mmread('file')). * * ----------------------------------------------------------------------------- * Dense matrices: * ----------------------------------------------------------------------------- * * A dense matrix is specified by the Matrix Market "array" format. The * Matrix Market header is optional; if not present, the matrix is assumed to * be in the Matrix Market "general" format. The first data line contains just * two integers: * * nrow ncol * * The can be real, integer, or complex (not pattern). These functions * convert an integer type to real. The entries in the matrix are stored in * column-major format, with one line per entry. Two entries are present in * each line for complex matrices, one for real and integer matrices. In * rectangular and unsymmetric matrices, all entries are present. For real * symmetric or complex Hermitian matrices, only entries in the lower triangular * part appear. For skew-symmetric matrices, only entries in the strictly * lower triangular part appear. * * Since CHOLMOD does not have a data structure for presenting dense symmetric/ * Hermitian matrices, these functions always return a dense matrix in its * general form, with both upper and lower parts present. */ #ifndef NCHECK #include "cholmod_internal.h" #include "cholmod_check.h" #include #include /* The MatrixMarket format specificies a maximum line length of 1024 */ #define MAXLINE 1030 /* ========================================================================== */ /* === get_line ============================================================= */ /* ========================================================================== */ /* Read one line of the file, return TRUE if successful, FALSE if EOF. */ static int get_line (FILE *f, char *buf) { buf [0] = '\0' ; buf [1] = '\0' ; buf [MAXLINE] = '\0' ; return (fgets (buf, MAXLINE, f) != NULL) ; } /* ========================================================================== */ /* === fix_inf ============================================================== */ /* ========================================================================== */ /* Replace huge values with +/- Inf's, since scanf and printf don't deal * with Inf's properly. */ static double fix_inf (double x) { if ((x >= HUGE_DOUBLE) || (x <= -HUGE_DOUBLE)) { /* treat this as +/- Inf (assume 2*x leads to overflow) */ x = 2*x ; } return (x) ; } /* ========================================================================== */ /* === is_blank_line ======================================================== */ /* ========================================================================== */ /* TRUE if s is a blank line or comment, FALSE otherwise */ static int is_blank_line ( char *s ) { int c, k ; if (s [0] == '%') { /* a comment line */ return (TRUE) ; } for (k = 0 ; k <= MAXLINE ; k++) { c = s [k] ; if (c == '\0') { /* end of line */ break ; } if (!isspace (c)) { /* non-space character */ return (FALSE) ; } } return (TRUE) ; } /* ========================================================================== */ /* === read_header ========================================================== */ /* ========================================================================== */ /* Read the header. This consists of zero or more comment lines (blank, or * starting with a "%" in the first column), followed by a single data line * containing up to four numerical values. * * The first line may optionally be a Matrix Market header line, of the form * * %%MatrixMarket matrix * * The first data line of a sparse matrix in triplet form consists of 3 or 4 * numerical values: * * nrow ncol nnz stype * * where stype is optional (it does not appear in the Matrix Market file * format). The first line of a dense matrix in column-major form consists of * two numerical values: * * nrow ncol * * The stype of the matrix is determine either from the Matrix Market header, * or (optionally) from the first data line. stypes of 0 to -3 directly * correlate with the Matrix Market format; stype = 1 is an extension to that * format. * * 999: unknown (will be inferred from the data) * 1: real symmetric or complex Hermitian with upper part stored * (not in the Matrix Market format) * 0: unsymmetric (same as Matrix Market "general") * -1: real symmetric or complex Hermitian, with lower part stored * (Matrix Market "real symmetric" or "complex hermitian") * -2: real or complex skew symmetric (lower part stored, can only be * specified by Matrix Market header) * -3: complex symmetric (lower part stored) * specified by Matrix Market header) * * The Matrix Market header is optional. If stype appears in the first data * line, it is determine by that data line. Otherwise, if the Matrix Market * header appears, stype is determined from that header. If stype does not * appear, it is set to "unknown" (999). */ #define STYPE_UNKNOWN 999 #define STYPE_SYMMETRIC_UPPER 1 #define STYPE_UNSYMMETRIC 0 #define STYPE_SYMMETRIC_LOWER -1 #define STYPE_SKEW_SYMMETRIC -2 #define STYPE_COMPLEX_SYMMETRIC_LOWER -3 static int read_header /* returns TRUE if successful, FALSE on error */ ( /* ---- input ---- */ FILE *f, /* file to read from */ /* ---- output --- */ char *buf, /* a character array of size MAXLINE+1 */ int *mtype, /* CHOLMOD_TRIPLET or CHOLMOD_DENSE */ size_t *nrow, /* number of rows in the matrix */ size_t *ncol, /* number of columns in the matrix */ size_t *nnz, /* number of entries in a triplet matrix (0 for dense)*/ int *stype /* stype (see above) */ ) { char *p ; int first = TRUE, got_mm_header = FALSE, c, c2, is_complex, nitems ; double l1, l2, l3, l4 ; *mtype = CHOLMOD_TRIPLET ; *nrow = 0 ; *ncol = 0 ; *nnz = 0 ; *stype = STYPE_UNKNOWN ; for ( ; ; ) { /* ------------------------------------------------------------------ */ /* get the next line */ /* ------------------------------------------------------------------ */ if (!get_line (f, buf)) { /* premature end of file */ return (FALSE) ; } if (first && (strncmp (buf, "%%MatrixMarket", 14) == 0)) { /* -------------------------------------------------------------- */ /* read a Matrix Market header */ /* -------------------------------------------------------------- */ got_mm_header = TRUE ; p = buf ; /* -------------------------------------------------------------- */ /* get "matrix" token */ /* -------------------------------------------------------------- */ while (*p && !isspace (*p)) p++ ; while (*p && isspace (*p)) p++ ; c = tolower (*p) ; if (c != 'm') { /* bad format */ return (FALSE) ; } /* -------------------------------------------------------------- */ /* get the fmt token ("coord" or "array") */ /* -------------------------------------------------------------- */ while (*p && !isspace (*p)) p++ ; while (*p && isspace (*p)) p++ ; c = tolower (*p) ; if (c == 'c') { *mtype = CHOLMOD_TRIPLET ; } else if (c == 'a') { *mtype = CHOLMOD_DENSE ; } else { /* bad format, neither "coordinate" nor "array" */ return (FALSE) ; } /* -------------------------------------------------------------- */ /* get type token (real, pattern, complex, integer) */ /* -------------------------------------------------------------- */ while (*p && !isspace (*p)) p++ ; while (*p && isspace (*p)) p++ ; c = tolower (*p) ; if (!(c == 'r' || c == 'p' || c == 'c' || c == 'i')) { /* bad format */ return (FALSE) ; } is_complex = (c == 'c') ; /* -------------------------------------------------------------- */ /* get storage token (general, hermitian, symmetric, skew) */ /* -------------------------------------------------------------- */ while (*p && !isspace (*p)) p++ ; while (*p && isspace (*p)) p++ ; c = tolower (*p) ; c2 = tolower (*(p+1)) ; if (c == 'g') { /* "general" storage (unsymmetric matrix), both parts present */ *stype = STYPE_UNSYMMETRIC ; } else if (c == 's' && c2 == 'y') { /* "symmetric" */ if (is_complex) { /* complex symmetric, lower triangular part present */ *stype = STYPE_COMPLEX_SYMMETRIC_LOWER ; } else { /* real symmetric, lower triangular part present */ *stype = STYPE_SYMMETRIC_LOWER ; } } else if (c == 'h') { /* "hermitian" matrix, lower triangular part present */ *stype = STYPE_SYMMETRIC_LOWER ; } else if (c == 's' && c2 == 'k') { /* "skew-symmetric" (real or complex), lower part present */ *stype = STYPE_SKEW_SYMMETRIC ; } else { /* bad format */ return (FALSE) ; } } else if (is_blank_line (buf)) { /* -------------------------------------------------------------- */ /* blank line or comment line */ /* -------------------------------------------------------------- */ continue ; } else { /* -------------------------------------------------------------- */ /* read the first data line and return */ /* -------------------------------------------------------------- */ /* format: nrow ncol nnz stype */ l1 = EMPTY ; l2 = EMPTY ; l3 = 0 ; l4 = 0 ; nitems = sscanf (buf, "%lg %lg %lg %lg\n", &l1, &l2, &l3, &l4) ; if (nitems < 2 || nitems > 4 || l1 > Int_max || l2 > Int_max) { /* invalid matrix */ return (FALSE) ; } *nrow = l1 ; *ncol = l2 ; if (nitems == 2) { /* a dense matrix */ if (!got_mm_header) { *mtype = CHOLMOD_DENSE ; *stype = STYPE_UNSYMMETRIC ; } } if (nitems == 3 || nitems == 4) { /* a sparse triplet matrix */ *nnz = l3 ; if (!got_mm_header) { *mtype = CHOLMOD_TRIPLET ; } } if (nitems == 4) { /* an stype specified here can only be 1, 0, or -1 */ if (l4 < 0) { *stype = STYPE_SYMMETRIC_LOWER ; } else if (l4 > 0) { *stype = STYPE_SYMMETRIC_UPPER ; } else { *stype = STYPE_UNSYMMETRIC ; } } if (*nrow != *ncol) { /* a rectangular matrix must be unsymmetric */ *stype = STYPE_UNSYMMETRIC ; } return (TRUE) ; } first = FALSE ; } } /* ========================================================================== */ /* === read_triplet ========================================================= */ /* ========================================================================== */ /* Header has already been read in, including first line (nrow ncol nnz stype). * Read the triplets. */ static cholmod_triplet *read_triplet ( /* ---- input ---- */ FILE *f, /* file to read from, must already be open */ size_t nrow, /* number of rows */ size_t ncol, /* number of columns */ size_t nnz, /* number of triplets in file to read */ int stype, /* stype from header, or "unknown" */ int prefer_unsym, /* if TRUE, always return T->stype of zero */ /* ---- workspace */ char *buf, /* of size MAXLINE+1 */ /* --------------- */ cholmod_common *Common ) { double x, z ; double *Tx ; Int *Ti, *Tj, *Rdeg, *Cdeg ; cholmod_triplet *T ; double l1, l2 ; Int nitems, xtype, unknown, k, nshould, is_lower, is_upper, one_based, i, j, imax, jmax, skew_symmetric, p, complex_symmetric ; size_t s, nnz2, extra ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* quick return for empty matrix */ /* ---------------------------------------------------------------------- */ if (nrow == 0 || ncol == 0 || nnz == 0) { /* return an empty matrix */ return (CHOLMOD(allocate_triplet) (nrow, ncol, 0, 0, CHOLMOD_REAL, Common)) ; } /* ---------------------------------------------------------------------- */ /* special stype cases: unknown, skew symmetric, and complex symmetric */ /* ---------------------------------------------------------------------- */ unknown = (stype == STYPE_UNKNOWN) ; skew_symmetric = (stype == STYPE_SKEW_SYMMETRIC) ; complex_symmetric = (stype == STYPE_COMPLEX_SYMMETRIC_LOWER) ; extra = 0 ; if (stype < STYPE_SYMMETRIC_LOWER || (prefer_unsym && stype != STYPE_UNSYMMETRIC)) { /* 999: unknown might be converted to unsymmetric */ /* 1: symmetric upper converted to unsym. if prefer_unsym is TRUE */ /* -1: symmetric lower converted to unsym. if prefer_unsym is TRUE */ /* -2: real or complex skew symmetric converted to unsymmetric */ /* -3: complex symmetric converted to unsymmetric */ stype = STYPE_UNSYMMETRIC ; extra = nnz ; } nnz2 = CHOLMOD(add_size_t) (nnz, extra, &ok) ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* s = nrow + ncol */ s = CHOLMOD(add_size_t) (nrow, ncol, &ok) ; if (!ok || nrow > Int_max || ncol > Int_max || nnz > Int_max) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (NULL) ; } CHOLMOD(allocate_work) (0, s, 0, Common) ; Rdeg = Common->Iwork ; /* size nrow */ Cdeg = Rdeg + nrow ; /* size ncol */ /* ---------------------------------------------------------------------- */ /* read the triplets */ /* ---------------------------------------------------------------------- */ is_lower = TRUE ; is_upper = TRUE ; one_based = TRUE ; imax = 0 ; jmax = 0 ; Tx = NULL ; Ti = NULL ; Tj = NULL ; xtype = 999 ; nshould = 0 ; for (k = 0 ; k < (Int) nnz ; k++) { /* ------------------------------------------------------------------ */ /* get the next triplet, skipping blank lines and comment lines */ /* ------------------------------------------------------------------ */ l1 = EMPTY ; l2 = EMPTY ; x = 0 ; z = 0 ; for ( ; ; ) { if (!get_line (f, buf)) { /* premature end of file - not enough triplets read in */ ERROR (CHOLMOD_INVALID, "premature EOF") ; return (NULL) ; } if (is_blank_line (buf)) { /* blank line or comment */ continue ; } nitems = sscanf (buf, "%lg %lg %lg %lg\n", &l1, &l2, &x, &z) ; x = fix_inf (x) ; z = fix_inf (z) ; break ; } nitems = (nitems == EOF) ? 0 : nitems ; i = l1 ; j = l2 ; /* ------------------------------------------------------------------ */ /* for first triplet: determine type and allocate triplet matrix */ /* ------------------------------------------------------------------ */ if (k == 0) { if (nitems < 2 || nitems > 4) { /* invalid matrix */ ERROR (CHOLMOD_INVALID, "invalid format") ; return (NULL) ; } else if (nitems == 2) { /* this will be converted into a real matrix later */ xtype = CHOLMOD_PATTERN ; } else if (nitems == 3) { xtype = CHOLMOD_REAL ; } else if (nitems == 4) { xtype = CHOLMOD_COMPLEX ; } /* the rest of the lines should have the same number of entries */ nshould = nitems ; /* allocate triplet matrix */ T = CHOLMOD(allocate_triplet) (nrow, ncol, nnz2, stype, (xtype == CHOLMOD_PATTERN ? CHOLMOD_REAL : xtype), Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (NULL) ; } Ti = T->i ; Tj = T->j ; Tx = T->x ; T->nnz = nnz ; } /* ------------------------------------------------------------------ */ /* save the entry in the triplet matrix */ /* ------------------------------------------------------------------ */ if (nitems != nshould || i < 0 || j < 0) { /* wrong format, premature end-of-file, or negative indices */ CHOLMOD(free_triplet) (&T, Common) ; ERROR (CHOLMOD_INVALID, "invalid matrix file") ; return (NULL) ; } Ti [k] = i ; Tj [k] = j ; if (i < j) { /* this entry is in the upper triangular part */ is_lower = FALSE ; } if (i > j) { /* this entry is in the lower triangular part */ is_upper = FALSE ; } if (xtype == CHOLMOD_REAL) { Tx [k] = x ; } else if (xtype == CHOLMOD_COMPLEX) { Tx [2*k ] = x ; /* real part */ Tx [2*k+1] = z ; /* imaginary part */ } if (i == 0 || j == 0) { one_based = FALSE ; } imax = MAX (i, imax) ; jmax = MAX (j, jmax) ; } /* ---------------------------------------------------------------------- */ /* convert to zero-based */ /* ---------------------------------------------------------------------- */ if (one_based) { /* input matrix is one-based; convert matrix to zero-based */ for (k = 0 ; k < (Int) nnz ; k++) { Ti [k]-- ; Tj [k]-- ; } } if (one_based ? (imax > (Int) nrow || jmax > (Int) ncol) : (imax >= (Int) nrow || jmax >= (Int) ncol)) { /* indices out of range */ CHOLMOD(free_triplet) (&T, Common) ; ERROR (CHOLMOD_INVALID, "indices out of range") ; return (NULL) ; } /* ---------------------------------------------------------------------- */ /* determine the stype, if not yet known */ /* ---------------------------------------------------------------------- */ if (unknown) { if (is_lower && is_upper) { /* diagonal matrix, symmetric with upper part present */ stype = STYPE_SYMMETRIC_UPPER ; } else if (is_lower && !is_upper) { /* symmetric, lower triangular part present */ stype = STYPE_SYMMETRIC_LOWER ; } else if (!is_lower && is_upper) { /* symmetric, upper triangular part present */ stype = STYPE_SYMMETRIC_UPPER ; } else { /* unsymmetric */ stype = STYPE_UNSYMMETRIC ; extra = 0 ; } } /* ---------------------------------------------------------------------- */ /* add the remainder of symmetric, skew-symmetric or Hermitian matrices */ /* ---------------------------------------------------------------------- */ /* note that this step is not done for real symmetric or complex Hermitian * matrices, unless prefer_unsym is TRUE */ if (extra > 0) { p = nnz ; for (k = 0 ; k < (Int) nnz ; k++) { i = Ti [k] ; j = Tj [k] ; if (i != j) { Ti [p] = j ; Tj [p] = i ; if (xtype == CHOLMOD_REAL) { if (skew_symmetric) { Tx [p] = -Tx [k] ; } else { Tx [p] = Tx [k] ; } } else if (xtype == CHOLMOD_COMPLEX) { if (skew_symmetric) { Tx [2*p ] = -Tx [2*k ] ; Tx [2*p+1] = -Tx [2*k+1] ; } else if (complex_symmetric) { Tx [2*p ] = Tx [2*k ] ; Tx [2*p+1] = Tx [2*k+1] ; } else /* Hermitian */ { Tx [2*p ] = Tx [2*k ] ; Tx [2*p+1] = -Tx [2*k+1] ; } } p++ ; } } T->nnz = p ; nnz = p ; } T->stype = stype ; /* ---------------------------------------------------------------------- */ /* create values for a pattern-only matrix */ /* ---------------------------------------------------------------------- */ if (xtype == CHOLMOD_PATTERN) { if (stype == STYPE_UNSYMMETRIC || Common->prefer_binary) { /* unsymmetric case, or binary case */ for (k = 0 ; k < (Int) nnz ; k++) { Tx [k] = 1 ; } } else { /* compute the row and columm degrees (excluding the diagonal) */ for (i = 0 ; i < (Int) nrow ; i++) { Rdeg [i] = 0 ; } for (j = 0 ; j < (Int) ncol ; j++) { Cdeg [j] = 0 ; } for (k = 0 ; k < (Int) nnz ; k++) { i = Ti [k] ; j = Tj [k] ; if ((stype < 0 && i > j) || (stype > 0 && i < j)) { /* both a(i,j) and a(j,i) appear in the matrix */ Rdeg [i]++ ; Cdeg [j]++ ; Rdeg [j]++ ; Cdeg [i]++ ; } } /* assign the numerical values */ for (k = 0 ; k < (Int) nnz ; k++) { i = Ti [k] ; j = Tj [k] ; Tx [k] = (i == j) ? (1 + MAX (Rdeg [i], Cdeg [j])) : (-1) ; } } } /* ---------------------------------------------------------------------- */ /* return the new triplet matrix */ /* ---------------------------------------------------------------------- */ return (T) ; } /* ========================================================================== */ /* === read_dense =========================================================== */ /* ========================================================================== */ /* Header has already been read in, including first line (nrow ncol). * Read a dense matrix. */ static cholmod_dense *read_dense ( /* ---- input ---- */ FILE *f, /* file to read from, must already be open */ size_t nrow, /* number of rows */ size_t ncol, /* number of columns */ int stype, /* stype from header */ /* ---- workspace */ char *buf, /* of size MAXLINE+1 */ /* --------------- */ cholmod_common *Common ) { double x, z ; double *Xx = NULL ; cholmod_dense *X ; Int nitems, xtype = -1, nshould = 0, i, j, k, kup, first ; /* ---------------------------------------------------------------------- */ /* quick return for empty matrix */ /* ---------------------------------------------------------------------- */ if (nrow == 0 || ncol == 0) { /* return an empty dense matrix */ return (CHOLMOD(zeros) (nrow, ncol, CHOLMOD_REAL, Common)) ; } /* ---------------------------------------------------------------------- */ /* read the entries */ /* ---------------------------------------------------------------------- */ first = TRUE ; for (j = 0 ; j < (Int) ncol ; j++) { /* ------------------------------------------------------------------ */ /* get the row index of the first entry in the file for column j */ /* ------------------------------------------------------------------ */ if (stype == STYPE_UNSYMMETRIC) { i = 0 ; } else if (stype == STYPE_SKEW_SYMMETRIC) { i = j+1 ; } else /* real symmetric or complex Hermitian lower */ { i = j ; } /* ------------------------------------------------------------------ */ /* get column j */ /* ------------------------------------------------------------------ */ for ( ; i < (Int) nrow ; i++) { /* -------------------------------------------------------------- */ /* get the next entry, skipping blank lines and comment lines */ /* -------------------------------------------------------------- */ x = 0 ; z = 0 ; for ( ; ; ) { if (!get_line (f, buf)) { /* premature end of file - not enough entries read in */ ERROR (CHOLMOD_INVALID, "premature EOF") ; return (NULL) ; } if (is_blank_line (buf)) { /* blank line or comment */ continue ; } nitems = sscanf (buf, "%lg %lg\n", &x, &z) ; x = fix_inf (x) ; z = fix_inf (z) ; break ; } nitems = (nitems == EOF) ? 0 : nitems ; /* -------------------------------------------------------------- */ /* for first entry: determine type and allocate dense matrix */ /* -------------------------------------------------------------- */ if (first) { first = FALSE ; if (nitems < 1 || nitems > 2) { /* invalid matrix */ ERROR (CHOLMOD_INVALID, "invalid format") ; return (NULL) ; } else if (nitems == 1) { /* a real matrix */ xtype = CHOLMOD_REAL ; } else if (nitems == 2) { /* a complex matrix */ xtype = CHOLMOD_COMPLEX ; } /* the rest of the lines should have same number of entries */ nshould = nitems ; /* allocate the result */ X = CHOLMOD(zeros) (nrow, ncol, xtype, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (NULL) ; } Xx = X->x ; } /* -------------------------------------------------------------- */ /* save the entry in the dense matrix */ /* -------------------------------------------------------------- */ if (nitems != nshould) { /* wrong format or premature end-of-file */ CHOLMOD(free_dense) (&X, Common) ; ERROR (CHOLMOD_INVALID, "invalid matrix file") ; return (NULL) ; } k = i + j*nrow ; kup = j + i*nrow ; if (xtype == CHOLMOD_REAL) { /* real matrix */ Xx [k] = x ; if (k != kup) { if (stype == STYPE_SYMMETRIC_LOWER) { /* real symmetric matrix */ Xx [kup] = x ; } else if (stype == STYPE_SKEW_SYMMETRIC) { /* real skew symmetric matrix */ Xx [kup] = -x ; } } } else if (xtype == CHOLMOD_COMPLEX) { Xx [2*k ] = x ; /* real part */ Xx [2*k+1] = z ; /* imaginary part */ if (k != kup) { if (stype == STYPE_SYMMETRIC_LOWER) { /* complex Hermitian */ Xx [2*kup ] = x ; /* real part */ Xx [2*kup+1] = -z ; /* imaginary part */ } else if (stype == STYPE_SKEW_SYMMETRIC) { /* complex skew symmetric */ Xx [2*kup ] = -x ; /* real part */ Xx [2*kup+1] = -z ; /* imaginary part */ } if (stype == STYPE_COMPLEX_SYMMETRIC_LOWER) { /* complex symmetric */ Xx [2*kup ] = x ; /* real part */ Xx [2*kup+1] = z ; /* imaginary part */ } } } } } /* ---------------------------------------------------------------------- */ /* return the new dense matrix */ /* ---------------------------------------------------------------------- */ return (X) ; } /* ========================================================================== */ /* === cholmod_read_triplet ================================================= */ /* ========================================================================== */ /* Read in a triplet matrix from a file. */ cholmod_triplet *CHOLMOD(read_triplet) ( /* ---- input ---- */ FILE *f, /* file to read from, must already be open */ /* --------------- */ cholmod_common *Common ) { char buf [MAXLINE+1] ; size_t nrow, ncol, nnz ; int stype, mtype ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (f, NULL) ; Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* read the header and first data line */ /* ---------------------------------------------------------------------- */ if (!read_header (f, buf, &mtype, &nrow, &ncol, &nnz, &stype) || mtype != CHOLMOD_TRIPLET) { /* invalid matrix - this function can only read in a triplet matrix */ ERROR (CHOLMOD_INVALID, "invalid format") ; return (NULL) ; } /* ---------------------------------------------------------------------- */ /* read the triplet matrix */ /* ---------------------------------------------------------------------- */ return (read_triplet (f, nrow, ncol, nnz, stype, FALSE, buf, Common)) ; } /* ========================================================================== */ /* === cholmod_read_sparse ================================================== */ /* ========================================================================== */ /* Read a sparse matrix from a file. See cholmod_read_triplet for a discussion * of the file format. * * If Common->prefer_upper is TRUE (the default case), a symmetric matrix is * returned stored in upper-triangular form (A->stype == 1). */ cholmod_sparse *CHOLMOD(read_sparse) ( /* ---- input ---- */ FILE *f, /* file to read from, must already be open */ /* --------------- */ cholmod_common *Common ) { cholmod_sparse *A, *A2 ; cholmod_triplet *T ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (f, NULL) ; Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* convert to a sparse matrix in compressed-column form */ /* ---------------------------------------------------------------------- */ T = CHOLMOD(read_triplet) (f, Common) ; A = CHOLMOD(triplet_to_sparse) (T, 0, Common) ; CHOLMOD(free_triplet) (&T, Common) ; if (Common->prefer_upper && A != NULL && A->stype == -1) { /* A=A' */ A2 = CHOLMOD(transpose) (A, 2, Common) ; CHOLMOD(free_sparse) (&A, Common) ; A = A2 ; } return (A) ; } /* ========================================================================== */ /* === cholmod_read_dense =================================================== */ /* ========================================================================== */ /* Read a dense matrix from a file. */ cholmod_dense *CHOLMOD(read_dense) ( /* ---- input ---- */ FILE *f, /* file to read from, must already be open */ /* --------------- */ cholmod_common *Common ) { char buf [MAXLINE+1] ; size_t nrow, ncol, nnz ; int stype, mtype ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (f, NULL) ; Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* read the header and first data line */ /* ---------------------------------------------------------------------- */ if (!read_header (f, buf, &mtype, &nrow, &ncol, &nnz, &stype) || mtype != CHOLMOD_DENSE) { /* invalid matrix - this function can only read in a dense matrix */ ERROR (CHOLMOD_INVALID, "invalid format") ; return (NULL) ; } /* ---------------------------------------------------------------------- */ /* read the dense matrix */ /* ---------------------------------------------------------------------- */ return (read_dense (f, nrow, ncol, stype, buf, Common)) ; } /* ========================================================================== */ /* === cholmod_read_matrix ================================================== */ /* ========================================================================== */ /* Read a triplet matrix, sparse matrix or a dense matrix from a file. Returns * a void pointer to either a cholmod_triplet, cholmod_sparse, or cholmod_dense * object. The type of object is passed back to the caller as the mtype * argument. */ void *CHOLMOD(read_matrix) ( /* ---- input ---- */ FILE *f, /* file to read from, must already be open */ int prefer, /* If 0, a sparse matrix is always return as a * cholmod_triplet form. It can have any stype * (symmetric-lower, unsymmetric, or * symmetric-upper). * If 1, a sparse matrix is returned as an unsymmetric * cholmod_sparse form (A->stype == 0), with both * upper and lower triangular parts present. * This is what the MATLAB mread mexFunction does, * since MATLAB does not have an stype. * If 2, a sparse matrix is returned with an stype of 0 * or 1 (unsymmetric, or symmetric with upper part * stored). * This argument has no effect for dense matrices. */ /* ---- output---- */ int *mtype, /* CHOLMOD_TRIPLET, CHOLMOD_SPARSE or CHOLMOD_DENSE */ /* --------------- */ cholmod_common *Common ) { void *G = NULL ; cholmod_sparse *A, *A2 ; cholmod_triplet *T ; char buf [MAXLINE+1] ; size_t nrow, ncol, nnz ; int stype ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (f, NULL) ; RETURN_IF_NULL (mtype, NULL) ; Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* read the header to determine the mtype */ /* ---------------------------------------------------------------------- */ if (!read_header (f, buf, mtype, &nrow, &ncol, &nnz, &stype)) { /* invalid matrix */ ERROR (CHOLMOD_INVALID, "invalid format") ; return (NULL) ; } /* ---------------------------------------------------------------------- */ /* read a matrix */ /* ---------------------------------------------------------------------- */ if (*mtype == CHOLMOD_TRIPLET) { /* read in the triplet matrix, converting to unsymmetric format if * prefer == 1 */ T = read_triplet (f, nrow, ncol, nnz, stype, prefer == 1, buf, Common) ; if (prefer == 0) { /* return matrix in its original triplet form */ G = T ; } else { /* return matrix in a compressed-column form */ A = CHOLMOD(triplet_to_sparse) (T, 0, Common) ; CHOLMOD(free_triplet) (&T, Common) ; if (A != NULL && prefer == 2 && A->stype == -1) { /* convert A from symmetric-lower to symmetric-upper */ A2 = CHOLMOD(transpose) (A, 2, Common) ; CHOLMOD(free_sparse) (&A, Common) ; A = A2 ; } *mtype = CHOLMOD_SPARSE ; G = A ; } } else if (*mtype == CHOLMOD_DENSE) { /* return a dense matrix */ G = read_dense (f, nrow, ncol, stype, buf, Common) ; } return (G) ; } #endif Matrix/src/CHOLMOD/Check/cholmod_write.c0000644000176200001440000005127613652535054017435 0ustar liggesusers/* ========================================================================== */ /* === Check/cholmod_write ================================================== */ /* ========================================================================== */ /* Write a matrix to a file in Matrix Market form. * * A can be sparse or full. * * If present and non-empty, A and Z must have the same dimension. Z contains * the explicit zero entries in the matrix (which MATLAB drops). The entries * of Z appear as explicit zeros in the output file. Z is optional. If it is * an empty matrix it is ignored. Z must be sparse or empty, if present. * It is ignored if A is full. * * filename is the name of the output file. comments is file whose * contents are include after the Matrix Market header and before the first * data line. Ignored if an empty string or not present. * * Except for the workspace used by cholmod_symmetry (ncol integers) for * the sparse case, these routines use no workspace at all. */ #ifndef NCHECK #include "cholmod_config.h" #include "cholmod_internal.h" #include "cholmod_check.h" #include "cholmod_matrixops.h" #include #include #define MMLEN 1024 #define MAXLINE MMLEN+6 /* ========================================================================== */ /* === include_comments ===================================================== */ /* ========================================================================== */ /* Read in the comments file, if it exists, and copy it to the Matrix Market * file. A "%" is prepended to each line. Returns TRUE if successful, FALSE * otherwise. */ static int include_comments (FILE *f, const char *comments) { FILE *cf = NULL ; char buffer [MAXLINE] ; int ok = TRUE ; if (comments != NULL && comments [0] != '\0') { cf = fopen (comments, "r") ; if (cf == NULL) { return (FALSE) ; } while (ok && fgets (buffer, MAXLINE, cf) != NULL) { /* ensure the line is not too long */ buffer [MMLEN-1] = '\0' ; buffer [MMLEN-2] = '\n' ; ok = ok && (fprintf (f, "%%%s", buffer) > 0) ; } fclose (cf) ; } return (ok) ; } /* ========================================================================== */ /* === get_value ============================================================ */ /* ========================================================================== */ /* Get the pth value in the matrix. */ static void get_value ( double *Ax, /* real values, or real/imag. for CHOLMOD_COMPLEX type */ double *Az, /* imaginary values for CHOLMOD_ZOMPLEX type */ Int p, /* get the pth entry */ Int xtype, /* A->xtype: pattern, real, complex, or zomplex */ double *x, /* the real part */ double *z /* the imaginary part */ ) { switch (xtype) { case CHOLMOD_PATTERN: *x = 1 ; *z = 0 ; break ; case CHOLMOD_REAL: *x = Ax [p] ; *z = 0 ; break ; case CHOLMOD_COMPLEX: *x = Ax [2*p] ; *z = Ax [2*p+1] ; break ; case CHOLMOD_ZOMPLEX: *x = Ax [p] ; *z = Az [p] ; break ; } } /* ========================================================================== */ /* === print_value ========================================================== */ /* ========================================================================== */ /* Print a numeric value to the file, using the shortest format that ensures * the value is written precisely. Returns TRUE if successful, FALSE otherwise. */ static int print_value ( FILE *f, /* file to print to */ double x, /* value to print */ Int is_integer /* TRUE if printing as an integer */ ) { double y ; char s [MAXLINE], *p ; Int i, dest = 0, src = 0 ; int width, ok ; if (is_integer) { i = (Int) x ; ok = (fprintf (f, ID, i) > 0) ; return (ok) ; } /* ---------------------------------------------------------------------- */ /* handle Inf and NaN */ /* ---------------------------------------------------------------------- */ /* change -inf to -HUGE_DOUBLE, and change +inf and nan to +HUGE_DOUBLE */ if (CHOLMOD_IS_NAN (x) || x >= HUGE_DOUBLE) { x = HUGE_DOUBLE ; } else if (x <= -HUGE_DOUBLE) { x = -HUGE_DOUBLE ; } /* ---------------------------------------------------------------------- */ /* find the smallest acceptable precision */ /* ---------------------------------------------------------------------- */ for (width = 6 ; width < 20 ; width++) { sprintf (s, "%.*g", width, x) ; sscanf (s, "%lg", &y) ; if (x == y) break ; } /* ---------------------------------------------------------------------- */ /* shorten the string */ /* ---------------------------------------------------------------------- */ /* change "e+0" to "e", change "e+" to "e", and change "e-0" to "e-" */ for (i = 0 ; i < MAXLINE && s [i] != '\0' ; i++) { if (s [i] == 'e') { if (s [i+1] == '+') { dest = i+1 ; if (s [i+2] == '0') { /* delete characters s[i+1] and s[i+2] */ src = i+3 ; } else { /* delete characters s[i+1] */ src = i+2 ; } } else if (s [i+1] == '-') { dest = i+2 ; if (s [i+2] == '0') { /* delete character s[i+2] */ src = i+3 ; } else { /* no change */ break ; } } while (s [src] != '\0') { s [dest++] = s [src++] ; } s [dest] = '\0' ; break ; } } /* delete the leading "0" if present and not necessary */ p = s ; s [MAXLINE-1] = '\0' ; i = strlen (s) ; if (i > 2 && s [0] == '0' && s [1] == '.') { /* change "0.x" to ".x" */ p = s + 1 ; } else if (i > 3 && s [0] == '-' && s [1] == '0' && s [2] == '.') { /* change "-0.x" to "-.x" */ s [1] = '-' ; p = s + 1 ; } #if 0 /* double-check */ i = sscanf (p, "%lg", &z) ; if (i != 1 || y != z) { /* oops! something went wrong in the "e+0" edit, above. */ /* this "cannot" happen */ sprintf (s, "%.*g", width, x) ; p = s ; } #endif /* ---------------------------------------------------------------------- */ /* print the value to the file */ /* ---------------------------------------------------------------------- */ ok = (fprintf (f, "%s", p) > 0) ; return (ok) ; } /* ========================================================================== */ /* === print_triplet ======================================================== */ /* ========================================================================== */ /* Print a triplet, converting it to one-based. Returns TRUE if successful, * FALSE otherwise. */ static int print_triplet ( FILE *f, /* file to print to */ Int is_binary, /* TRUE if file is "pattern" */ Int is_complex, /* TRUE if file is "complex" */ Int is_integer, /* TRUE if file is "integer" */ Int i, /* row index (zero-based) */ Int j, /* column index (zero-based) */ double x, /* real part */ double z /* imaginary part */ ) { int ok ; ok = (fprintf (f, ID " " ID, 1+i, 1+j) > 0) ; if (!is_binary) { fprintf (f, " ") ; ok = ok && print_value (f, x, is_integer) ; if (is_complex) { fprintf (f, " ") ; ok = ok && print_value (f, z, is_integer) ; } } ok = ok && (fprintf (f, "\n") > 0) ; return (ok) ; } /* ========================================================================== */ /* === ntriplets ============================================================ */ /* ========================================================================== */ /* Compute the number of triplets that will be printed to the file * from the matrix A. */ static Int ntriplets ( cholmod_sparse *A, /* matrix that will be printed */ Int is_sym /* TRUE if the file is symmetric (lower part only)*/ ) { Int *Ap, *Ai, *Anz, packed, i, j, p, pend, ncol, stype, nz = 0 ; if (A == NULL) { /* the Z matrix is NULL */ return (0) ; } stype = A->stype ; Ap = A->p ; Ai = A->i ; Anz = A->nz ; packed = A->packed ; ncol = A->ncol ; for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = (packed) ? Ap [j+1] : p + Anz [j] ; for ( ; p < pend ; p++) { i = Ai [p] ; if ((stype < 0 && i >= j) || (stype == 0 && (i >= j || !is_sym))) { /* CHOLMOD matrix is symmetric-lower (and so is the file); * or CHOLMOD matrix is unsymmetric and either A(i,j) is in * the lower part or the file is unsymmetric. */ nz++ ; } else if (stype > 0 && i <= j) { /* CHOLMOD matrix is symmetric-upper, but the file is * symmetric-lower. Need to transpose the entry. */ nz++ ; } } } return (nz) ; } /* ========================================================================== */ /* === cholmod_write_sparse ================================================= */ /* ========================================================================== */ /* Write a sparse matrix to a file in Matrix Market format. Optionally include * comments, and print explicit zero entries given by the pattern of the Z * matrix. If not NULL, the Z matrix must have the same dimensions and stype * as A. * * Returns the symmetry in which the matrix was printed (1 to 7, see the * CHOLMOD_MM_* codes in CHOLMOD/Include/cholmod_core.h), or -1 on failure. * * If A and Z are sorted on input, and either unsymmetric (stype = 0) or * symmetric-lower (stype < 0), and if A and Z do not overlap, then the triplets * are sorted, first by column and then by row index within each column, with * no duplicate entries. If all the above holds except stype > 0, then the * triplets are sorted by row first and then column. */ int CHOLMOD(write_sparse) ( /* ---- input ---- */ FILE *f, /* file to write to, must already be open */ cholmod_sparse *A, /* matrix to print */ cholmod_sparse *Z, /* optional matrix with pattern of explicit zeros */ const char *comments, /* optional filename of comments to include */ /* --------------- */ cholmod_common *Common ) { double x = 0, z = 0 ; double *Ax, *Az ; Int *Ap, *Ai, *Anz, *Zp, *Zi, *Znz ; Int nrow, ncol, is_complex, symmetry, i, j, q, iz, p, nz, is_binary, stype, is_integer, asym, is_sym, xtype, apacked, zpacked, pend, qend, zsym ; int ok ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (EMPTY) ; RETURN_IF_NULL (f, EMPTY) ; RETURN_IF_NULL (A, EMPTY) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, EMPTY) ; if (Z != NULL && (Z->nrow == 0 || Z->ncol == 0)) { /* Z is non-NULL but empty, so treat it as a NULL matrix */ Z = NULL ; } if (Z != NULL) { RETURN_IF_XTYPE_INVALID (Z, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, EMPTY) ; if (Z->nrow != A->nrow || Z->ncol != A->ncol || Z->stype != A->stype) { ERROR (CHOLMOD_INVALID, "dimension or type of A and Z mismatch") ; return (EMPTY) ; } } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* get the A matrix */ /* ---------------------------------------------------------------------- */ Ap = A->p ; Ai = A->i ; Ax = A->x ; Az = A->z ; Anz = A->nz ; nrow = A->nrow ; ncol = A->ncol ; xtype = A->xtype ; apacked = A->packed ; if (xtype == CHOLMOD_PATTERN) { /* a CHOLMOD pattern matrix is printed as "pattern" in the file */ is_binary = TRUE ; is_integer = FALSE ; is_complex = FALSE ; } else if (xtype == CHOLMOD_REAL) { /* determine if a real matrix is in fact binary or integer */ is_binary = TRUE ; is_integer = TRUE ; is_complex = FALSE ; for (j = 0 ; (is_binary || is_integer) && j < ncol ; j++) { p = Ap [j] ; pend = (apacked) ? Ap [j+1] : p + Anz [j] ; for ( ; (is_binary || is_integer) && p < pend ; p++) { x = Ax [p] ; if (x != 1) { is_binary = FALSE ; } /* convert to Int and then back to double */ i = (Int) x ; z = (double) i ; if (z != x) { is_integer = FALSE ; } } } } else { /* a CHOLMOD complex matrix is printed as "complex" in the file */ is_binary = FALSE ; is_integer = FALSE ; is_complex = TRUE ; } /* ---------------------------------------------------------------------- */ /* get the Z matrix (only consider the pattern) */ /* ---------------------------------------------------------------------- */ Zp = NULL ; Zi = NULL ; Znz = NULL ; zpacked = TRUE ; if (Z != NULL) { Zp = Z->p ; Zi = Z->i ; Znz = Z->nz ; zpacked = Z->packed ; } /* ---------------------------------------------------------------------- */ /* determine the symmetry of A and Z */ /* ---------------------------------------------------------------------- */ stype = A->stype ; if (A->nrow != A->ncol) { asym = CHOLMOD_MM_RECTANGULAR ; } else if (stype != 0) { /* CHOLMOD's A and Z matrices have a symmetric (and matching) stype. * Note that the diagonal is not checked. */ asym = is_complex ? CHOLMOD_MM_HERMITIAN : CHOLMOD_MM_SYMMETRIC ; } else if (!A->sorted) { /* A is in unsymmetric storage, but unsorted */ asym = CHOLMOD_MM_UNSYMMETRIC ; } else { /* CHOLMOD's stype is zero (stored in unsymmetric form) */ asym = EMPTY ; zsym = EMPTY ; #ifndef NMATRIXOPS /* determine if the matrices are in fact symmetric or Hermitian */ asym = CHOLMOD(symmetry) (A, 1, NULL, NULL, NULL, NULL, Common) ; zsym = (Z == NULL) ? 999 : CHOLMOD(symmetry) (Z, 1, NULL, NULL, NULL, NULL, Common) ; #endif if (asym == EMPTY || zsym <= CHOLMOD_MM_UNSYMMETRIC) { /* not computed, out of memory, or Z is unsymmetric */ asym = CHOLMOD_MM_UNSYMMETRIC ; } } /* ---------------------------------------------------------------------- */ /* write the Matrix Market header */ /* ---------------------------------------------------------------------- */ ok = fprintf (f, "%%%%MatrixMarket matrix coordinate") > 0 ; if (is_complex) { ok = ok && (fprintf (f, " complex") > 0) ; } else if (is_binary) { ok = ok && (fprintf (f, " pattern") > 0) ; } else if (is_integer) { ok = ok && (fprintf (f, " integer") > 0) ; } else { ok = ok && (fprintf (f, " real") > 0) ; } is_sym = FALSE ; switch (asym) { case CHOLMOD_MM_RECTANGULAR: case CHOLMOD_MM_UNSYMMETRIC: /* A is rectangular or unsymmetric */ ok = ok && (fprintf (f, " general\n") > 0) ; is_sym = FALSE ; symmetry = CHOLMOD_MM_UNSYMMETRIC ; break ; case CHOLMOD_MM_SYMMETRIC: case CHOLMOD_MM_SYMMETRIC_POSDIAG: /* A is symmetric */ ok = ok && (fprintf (f, " symmetric\n") > 0) ; is_sym = TRUE ; symmetry = CHOLMOD_MM_SYMMETRIC ; break ; case CHOLMOD_MM_HERMITIAN: case CHOLMOD_MM_HERMITIAN_POSDIAG: /* A is Hermitian */ ok = ok && (fprintf (f, " Hermitian\n") > 0) ; is_sym = TRUE ; symmetry = CHOLMOD_MM_HERMITIAN ; break ; case CHOLMOD_MM_SKEW_SYMMETRIC: /* A is skew symmetric */ ok = ok && (fprintf (f, " skew-symmetric\n") > 0) ; is_sym = TRUE ; symmetry = CHOLMOD_MM_SKEW_SYMMETRIC ; break ; } /* ---------------------------------------------------------------------- */ /* include the comments if present */ /* ---------------------------------------------------------------------- */ ok = ok && include_comments (f, comments) ; /* ---------------------------------------------------------------------- */ /* write a sparse matrix (A and Z) */ /* ---------------------------------------------------------------------- */ nz = ntriplets (A, is_sym) + ntriplets (Z, is_sym) ; /* write the first data line, with nrow, ncol, and # of triplets */ ok = ok && (fprintf (f, ID " " ID " " ID "\n", nrow, ncol, nz) > 0) ; for (j = 0 ; ok && j < ncol ; j++) { /* merge column of A and Z */ p = Ap [j] ; pend = (apacked) ? Ap [j+1] : p + Anz [j] ; q = (Z == NULL) ? 0 : Zp [j] ; qend = (Z == NULL) ? 0 : ((zpacked) ? Zp [j+1] : q + Znz [j]) ; while (ok) { /* get the next row index from A and Z */ i = (p < pend) ? Ai [p] : (nrow+1) ; iz = (q < qend) ? Zi [q] : (nrow+2) ; if (i <= iz) { /* get A(i,j), or quit if both A and Z are exhausted */ if (i == nrow+1) break ; get_value (Ax, Az, p, xtype, &x, &z) ; p++ ; } else { /* get Z(i,j) */ i = iz ; x = 0 ; z = 0 ; q++ ; } if ((stype < 0 && i >= j) || (stype == 0 && (i >= j || !is_sym))) { /* CHOLMOD matrix is symmetric-lower (and so is the file); * or CHOLMOD matrix is unsymmetric and either A(i,j) is in * the lower part or the file is unsymmetric. */ ok = ok && print_triplet (f, is_binary, is_complex, is_integer, i,j, x,z) ; } else if (stype > 0 && i <= j) { /* CHOLMOD matrix is symmetric-upper, but the file is * symmetric-lower. Need to transpose the entry. If the * matrix is real, the complex part is ignored. If the matrix * is complex, it Hermitian. */ ASSERT (IMPLIES (is_complex, asym == CHOLMOD_MM_HERMITIAN)) ; if (z != 0) { z = -z ; } ok = ok && print_triplet (f, is_binary, is_complex, is_integer, j,i, x,z) ; } } } if (!ok) { ERROR (CHOLMOD_INVALID, "error reading/writing file") ; return (EMPTY) ; } return (asym) ; } /* ========================================================================== */ /* === cholmod_write_dense ================================================== */ /* ========================================================================== */ /* Write a dense matrix to a file in Matrix Market format. Optionally include * comments. Returns > 0 if successful, -1 otherwise (1 if rectangular, 2 if * square). Future versions may return 1 to 7 on success (a CHOLMOD_MM_* code, * just as cholmod_write_sparse does). * * A dense matrix is written in "general" format; symmetric formats in the * Matrix Market standard are not exploited. */ int CHOLMOD(write_dense) ( /* ---- input ---- */ FILE *f, /* file to write to, must already be open */ cholmod_dense *X, /* matrix to print */ const char *comments, /* optional filename of comments to include */ /* --------------- */ cholmod_common *Common ) { double x = 0, z = 0 ; double *Xx, *Xz ; Int nrow, ncol, is_complex, i, j, xtype, p ; int ok ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (EMPTY) ; RETURN_IF_NULL (f, EMPTY) ; RETURN_IF_NULL (X, EMPTY) ; RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, EMPTY) ; Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* get the X matrix */ /* ---------------------------------------------------------------------- */ Xx = X->x ; Xz = X->z ; nrow = X->nrow ; ncol = X->ncol ; xtype = X->xtype ; is_complex = (xtype == CHOLMOD_COMPLEX) || (xtype == CHOLMOD_ZOMPLEX) ; /* ---------------------------------------------------------------------- */ /* write the Matrix Market header */ /* ---------------------------------------------------------------------- */ ok = (fprintf (f, "%%%%MatrixMarket matrix array") > 0) ; if (is_complex) { ok = ok && (fprintf (f, " complex general\n") > 0) ; } else { ok = ok && (fprintf (f, " real general\n") > 0) ; } /* ---------------------------------------------------------------------- */ /* include the comments if present */ /* ---------------------------------------------------------------------- */ ok = ok && include_comments (f, comments) ; /* ---------------------------------------------------------------------- */ /* write a dense matrix */ /* ---------------------------------------------------------------------- */ /* write the first data line, with nrow and ncol */ ok = ok && (fprintf (f, ID " " ID "\n", nrow, ncol) > 0) ; Xx = X->x ; Xz = X->z ; for (j = 0 ; ok && j < ncol ; j++) { for (i = 0 ; ok && i < nrow ; i++) { p = i + j*nrow ; get_value (Xx, Xz, p, xtype, &x, &z) ; ok = ok && print_value (f, x, FALSE) ; if (is_complex) { ok = ok && (fprintf (f, " ") > 0) ; ok = ok && print_value (f, z, FALSE) ; } ok = ok && (fprintf (f, "\n") > 0) ; } } if (!ok) { ERROR (CHOLMOD_INVALID, "error reading/writing file") ; return (EMPTY) ; } return ((nrow == ncol) ? CHOLMOD_MM_UNSYMMETRIC : CHOLMOD_MM_RECTANGULAR) ; } #endif Matrix/src/CHOLMOD/Check/License.txt0000644000176200001440000000204211770402705016533 0ustar liggesusersCHOLMOD/Check Module. Copyright (C) 2005-2006, Timothy A. Davis CHOLMOD is also available under other licenses; contact authors for details. http://www.suitesparse.com Note that this license is for the CHOLMOD/Check module only. All CHOLMOD modules are licensed separately. -------------------------------------------------------------------------------- This Module is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This Module 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this Module; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Matrix/src/CHOLMOD/Check/cholmod_check.c0000644000176200001440000020227413652535054017354 0ustar liggesusers/* ========================================================================== */ /* === Check/cholmod_check ================================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Check Module. Copyright (C) 2005-2013, Timothy A. Davis * -------------------------------------------------------------------------- */ /* Routines to check and print the contents of the 5 CHOLMOD objects: * * No CHOLMOD routine calls the check or print routines. If a user wants to * check CHOLMOD's input parameters, a separate call to the appropriate check * routine should be used before calling other CHOLMOD routines. * * cholmod_check_common check statistics and workspace in Common * cholmod_check_sparse check sparse matrix in compressed column form * cholmod_check_dense check dense matrix * cholmod_check_factor check factorization * cholmod_check_triplet check sparse matrix in triplet form * * cholmod_print_common print statistics in Common * cholmod_print_sparse print sparse matrix in compressed column form * cholmod_print_dense print dense matrix * cholmod_print_factor print factorization * cholmod_print_triplet print sparse matrix in triplet form * * In addition, this file contains routines to check and print three types of * integer vectors: * * cholmod_check_perm check a permutation of 0:n-1 (no duplicates) * cholmod_check_subset check a subset of 0:n-1 (duplicates OK) * cholmod_check_parent check an elimination tree * * cholmod_print_perm print a permutation * cholmod_print_subset print a subset * cholmod_print_parent print an elimination tree * * Each Common->print level prints the items at or below the given level: * * 0: print nothing; just check the data structures and return TRUE/FALSE * 1: error messages * 2: warning messages * 3: one-line summary of each object printed * 4: short summary of each object (first and last few entries) * 5: entire contents of the object * * No CHOLMOD routine calls these routines, so no printing occurs unless * the user specifically calls a cholmod_print_* routine. Thus, the default * print level is 3. * * Common->precise controls the # of digits printed for numerical entries * (5 if FALSE, 15 if TRUE). * * If SuiteSparse_config.printf_func is NULL, then no printing occurs. The * cholmod_check_* and cholmod_print_* routines still check their inputs and * return TRUE/FALSE if the object is valid or not. * * This file also includes debugging routines that are enabled only when * NDEBUG is defined in cholmod_internal.h (cholmod_dump_*). */ #ifndef NCHECK #include "cholmod_internal.h" #include "cholmod_check.h" /* ========================================================================== */ /* === printing definitions ================================================= */ /* ========================================================================== */ #ifdef LONG #define I8 "%8ld" #define I_8 "%-8ld" #else #define I8 "%8d" #define I_8 "%-8d" #endif #define PR(i,format,arg) \ { \ if (print >= i && SuiteSparse_config.printf_func != NULL) \ { \ SuiteSparse_config.printf_func (format, arg) ; \ } \ } #define P1(format,arg) PR(1,format,arg) #define P2(format,arg) PR(2,format,arg) #define P3(format,arg) PR(3,format,arg) #define P4(format,arg) PR(4,format,arg) #define ERR(msg) \ { \ P1 ("\nCHOLMOD ERROR: %s: ", type) ; \ if (name != NULL) \ { \ P1 ("%s", name) ; \ } \ P1 (": %s\n", msg) ; \ ERROR (CHOLMOD_INVALID, "invalid") ; \ return (FALSE) ; \ } /* print a numerical value */ #define PRINTVALUE(value) \ { \ if (Common->precise) \ { \ P4 (" %23.15e", value) ; \ } \ else \ { \ P4 (" %.5g", value) ; \ } \ } /* start printing */ #define ETC_START(count,limit) \ { \ count = (init_print == 4) ? (limit) : (-1) ; \ } /* re-enable printing if condition is met */ #define ETC_ENABLE(condition,count,limit) \ { \ if ((condition) && init_print == 4) \ { \ count = limit ; \ print = 4 ; \ } \ } /* turn off printing if limit is reached */ #define ETC_DISABLE(count) \ { \ if ((count >= 0) && (count-- == 0) && print == 4) \ { \ P4 ("%s", " ...\n") ; \ print = 3 ; \ } \ } /* re-enable printing, or turn if off after limit is reached */ #define ETC(condition,count,limit) \ { \ ETC_ENABLE (condition, count, limit) ; \ ETC_DISABLE (count) ; \ } #define BOOLSTR(x) ((x) ? "true " : "false") /* ========================================================================== */ /* === print_value ========================================================== */ /* ========================================================================== */ static void print_value ( Int print, Int xtype, double *Xx, double *Xz, Int p, cholmod_common *Common) { if (xtype == CHOLMOD_REAL) { PRINTVALUE (Xx [p]) ; } else if (xtype == CHOLMOD_COMPLEX) { P4 ("%s", "(") ; PRINTVALUE (Xx [2*p ]) ; P4 ("%s", " , ") ; PRINTVALUE (Xx [2*p+1]) ; P4 ("%s", ")") ; } else if (xtype == CHOLMOD_ZOMPLEX) { P4 ("%s", "(") ; PRINTVALUE (Xx [p]) ; P4 ("%s", " , ") ; PRINTVALUE (Xz [p]) ; P4 ("%s", ")") ; } } /* ========================================================================== */ /* === cholmod_check_common ================================================= */ /* ========================================================================== */ /* Print and verify the contents of Common */ static int check_common ( Int print, const char *name, cholmod_common *Common ) { double fl, lnz ; double *Xwork ; Int *Flag, *Head ; SuiteSparse_long mark ; Int i, nrow, nmethods, ordering, xworksize, amd_backup, init_print ; const char *type = "common" ; /* ---------------------------------------------------------------------- */ /* print control parameters and statistics */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; init_print = print ; P2 ("%s", "\n") ; P1 ("CHOLMOD version %d", CHOLMOD_MAIN_VERSION) ; P1 (".%d", CHOLMOD_SUB_VERSION) ; P1 (".%d", CHOLMOD_SUBSUB_VERSION) ; P1 (", %s: ", CHOLMOD_DATE) ; if (name != NULL) { P1 ("%s: ", name) ; } switch (Common->status) { case CHOLMOD_OK: P1 ("%s", "status: OK\n") ; break ; case CHOLMOD_OUT_OF_MEMORY: P1 ("%s", "status: ERROR, out of memory\n") ; break ; case CHOLMOD_INVALID: P1 ("%s", "status: ERROR, invalid parameter\n") ; break ; case CHOLMOD_TOO_LARGE: P1 ("%s", "status: ERROR, problem too large\n") ; break ; case CHOLMOD_NOT_INSTALLED: P1 ("%s", "status: ERROR, method not installed\n") ; break ; case CHOLMOD_GPU_PROBLEM: P1 ("%s", "status: ERROR, GPU had a fatal error\n") ; break ; case CHOLMOD_NOT_POSDEF: P1 ("%s", "status: warning, matrix not positive definite\n") ; break ; case CHOLMOD_DSMALL: P1 ("%s", "status: warning, diagonal entry has tiny abs. value\n") ; break ; default: ERR ("unknown status") ; } P2 (" Architecture: %s\n", CHOLMOD_ARCHITECTURE) ; P3 (" sizeof(int): %d\n", (int) sizeof (int)) ; P3 (" sizeof(SuiteSparse_long): %d\n", (int) sizeof (SuiteSparse_long)); P3 (" sizeof(void *): %d\n", (int) sizeof (void *)) ; P3 (" sizeof(double): %d\n", (int) sizeof (double)) ; P3 (" sizeof(Int): %d (CHOLMOD's basic integer)\n", (int) sizeof (Int)) ; P3 (" sizeof(BLAS_INT): %d (integer used in the BLAS)\n", (int) sizeof (BLAS_INT)) ; if (Common->fl != EMPTY) { P2 ("%s", " Results from most recent analysis:\n") ; P2 (" Cholesky flop count: %.5g\n", Common->fl) ; P2 (" Nonzeros in L: %.5g\n", Common->lnz) ; } if (Common->modfl != EMPTY) { P2 (" Update/downdate flop count: %.5g\n", Common->modfl) ; } P2 (" memory blocks in use: %8.0f\n", (double) (Common->malloc_count)) ; P2 (" memory in use (MB): %8.1f\n", (double) (Common->memory_inuse) / 1048576.) ; P2 (" peak memory usage (MB): %8.1f\n", (double) (Common->memory_usage) / 1048576.) ; /* ---------------------------------------------------------------------- */ /* primary control parameters and related ordering statistics */ /* ---------------------------------------------------------------------- */ P3 (" maxrank: update/downdate rank: "ID"\n", (Int) CHOLMOD(maxrank) (0, Common)) ; P3 (" supernodal control: %d", Common->supernodal) ; P3 (" %g ", Common->supernodal_switch) ; if (Common->supernodal <= CHOLMOD_SIMPLICIAL) { P3 ("%s", "(always do simplicial)\n") ; } else if (Common->supernodal == CHOLMOD_AUTO) { P3 ("(supernodal if flops/lnz >= %g)\n", Common->supernodal_switch) ; } else { P3 ("%s", "(always do supernodal)\n") ; } nmethods = MIN (Common->nmethods, CHOLMOD_MAXMETHODS) ; nmethods = MAX (0, nmethods) ; if (nmethods > 0) { P3 ("%s", " nmethods: number of ordering methods to try: ") ; P3 (""ID"\n", nmethods) ; amd_backup = (nmethods > 1) || (nmethods == 1 && (Common->method [0].ordering == CHOLMOD_METIS || Common->method [0].ordering == CHOLMOD_NESDIS)) ; } else { P3 ("%s", " nmethods=0: default strategy: Try user permutation if " "given. Try AMD.\n") ; #ifndef NPARTITION if (Common->default_nesdis) { P3 ("%s", " Try NESDIS if AMD reports flops/nnz(L) >= 500 and " "nnz(L)/nnz(A) >= 5.\n") ; } else { P3 ("%s", " Try METIS if AMD reports flops/nnz(L) >= 500 and " "nnz(L)/nnz(A) >= 5.\n") ; } #endif P3 ("%s", " Select best ordering tried.\n") ; Common->method [0].ordering = CHOLMOD_GIVEN ; Common->method [1].ordering = CHOLMOD_AMD ; Common->method [2].ordering = (Common->default_nesdis ? CHOLMOD_NESDIS : CHOLMOD_METIS) ; amd_backup = FALSE ; #ifndef NPARTITION nmethods = 3 ; #else nmethods = 2 ; #endif } for (i = 0 ; i < nmethods ; i++) { P3 (" method "ID": ", i) ; ordering = Common->method [i].ordering ; fl = Common->method [i].fl ; lnz = Common->method [i].lnz ; switch (ordering) { case CHOLMOD_NATURAL: P3 ("%s", "natural\n") ; break ; case CHOLMOD_GIVEN: P3 ("%s", "user permutation (if given)\n") ; break ; case CHOLMOD_AMD: P3 ("%s", "AMD (or COLAMD if factorizing AA')\n") ; amd_backup = FALSE ; break ; case CHOLMOD_COLAMD: P3 ("%s", "AMD if factorizing A, COLAMD if factorizing AA')\n"); amd_backup = FALSE ; break ; case CHOLMOD_METIS: P3 ("%s", "METIS_NodeND nested dissection\n") ; break ; case CHOLMOD_NESDIS: P3 ("%s", "CHOLMOD nested dissection\n") ; P3 (" nd_small: # nodes in uncut subgraph: "ID"\n", (Int) (Common->method [i].nd_small)) ; P3 (" nd_compress: compress the graph: %s\n", BOOLSTR (Common->method [i].nd_compress)) ; P3 (" nd_camd: use constrained min degree: %s\n", BOOLSTR (Common->method [i].nd_camd)) ; break ; default: P3 (ID, ordering) ; ERR ("unknown ordering method") ; break ; } if (!(ordering == CHOLMOD_NATURAL || ordering == CHOLMOD_GIVEN)) { if (Common->method [i].prune_dense < 0) { P3 (" prune_dense: for pruning dense nodes: %s\n", " none pruned") ; } else { P3 (" prune_dense: for pruning dense nodes: " "%.5g\n", Common->method [i].prune_dense) ; P3 (" a dense node has degree " ">= max(16,(%.5g)*sqrt(n))\n", Common->method [i].prune_dense) ; } } if (ordering == CHOLMOD_COLAMD || ordering == CHOLMOD_NESDIS) { if (Common->method [i].prune_dense2 < 0) { P3 (" prune_dense2: for pruning dense rows for AA':" " %s\n", " none pruned") ; } else { P3 (" prune_dense2: for pruning dense rows for AA':" " %.5g\n", Common->method [i].prune_dense2) ; P3 (" a dense row has degree " ">= max(16,(%.5g)*sqrt(ncol))\n", Common->method [i].prune_dense2) ; } } if (fl != EMPTY) P3 (" flop count: %.5g\n", fl) ; if (lnz != EMPTY) P3 (" nnz(L): %.5g\n", lnz) ; } /* backup AMD results, if any */ if (amd_backup) { P3 ("%s", " backup method: ") ; P3 ("%s", "AMD (or COLAMD if factorizing AA')\n") ; fl = Common->method [nmethods].fl ; lnz = Common->method [nmethods].lnz ; if (fl != EMPTY) P3 (" AMD flop count: %.5g\n", fl) ; if (lnz != EMPTY) P3 (" AMD nnz(L): %.5g\n", lnz) ; } /* ---------------------------------------------------------------------- */ /* arcane control parameters */ /* ---------------------------------------------------------------------- */ if (Common->final_asis) { P4 ("%s", " final_asis: TRUE, leave as is\n") ; } else { P4 ("%s", " final_asis: FALSE, convert when done\n") ; if (Common->final_super) { P4 ("%s", " final_super: TRUE, leave in supernodal form\n") ; } else { P4 ("%s", " final_super: FALSE, convert to simplicial form\n") ; } if (Common->final_ll) { P4 ("%s", " final_ll: TRUE, convert to LL' form\n") ; } else { P4 ("%s", " final_ll: FALSE, convert to LDL' form\n") ; } if (Common->final_pack) { P4 ("%s", " final_pack: TRUE, pack when done\n") ; } else { P4 ("%s", " final_pack: FALSE, do not pack when done\n") ; } if (Common->final_monotonic) { P4 ("%s", " final_monotonic: TRUE, ensure L is monotonic\n") ; } else { P4 ("%s", " final_monotonic: FALSE, do not ensure L is monotonic\n") ; } P4 (" final_resymbol: remove zeros from amalgamation: %s\n", BOOLSTR (Common->final_resymbol)) ; } P4 (" dbound: LDL' diagonal threshold: % .5g\n Entries with abs. value" " less than dbound are replaced with +/- dbound.\n", Common->dbound) ; P4 (" grow0: memory reallocation: % .5g\n", Common->grow0) ; P4 (" grow1: memory reallocation: % .5g\n", Common->grow1) ; P4 (" grow2: memory reallocation: %g\n", (double) (Common->grow2)) ; P4 ("%s", " nrelax, zrelax: supernodal amalgamation rule:\n") ; P4 ("%s", " s = # columns in two adjacent supernodes\n") ; P4 ("%s", " z = % of zeros in new supernode if they are merged.\n") ; P4 ("%s", " Two supernodes are merged if") ; P4 (" (s <= %g) or (no new zero entries) or\n", (double) (Common->nrelax [0])) ; P4 (" (s <= %g and ", (double) (Common->nrelax [1])) ; P4 ("z < %.5g%%) or", Common->zrelax [0] * 100) ; P4 (" (s <= %g and ", (double) (Common->nrelax [2])) ; P4 ("z < %.5g%%) or", Common->zrelax [1] * 100) ; P4 (" (z < %.5g%%)\n", Common->zrelax [2] * 100) ; /* ---------------------------------------------------------------------- */ /* check workspace */ /* ---------------------------------------------------------------------- */ mark = Common->mark ; nrow = Common->nrow ; Flag = Common->Flag ; Head = Common->Head ; if (nrow > 0) { if (mark < 0 || Flag == NULL || Head == NULL) { ERR ("workspace corrupted (Flag and/or Head missing)") ; } for (i = 0 ; i < nrow ; i++) { if (Flag [i] >= mark) { PRINT0 (("Flag ["ID"]="ID", mark = %ld\n", i, Flag [i], mark)) ; ERR ("workspace corrupted (Flag)") ; } } for (i = 0 ; i <= nrow ; i++) { if (Head [i] != EMPTY) { PRINT0 (("Head ["ID"] = "ID",\n", i, Head [i])) ; ERR ("workspace corrupted (Head)") ; } } } xworksize = Common->xworksize ; Xwork = Common->Xwork ; if (xworksize > 0) { if (Xwork == NULL) { ERR ("workspace corrupted (Xwork missing)") ; } for (i = 0 ; i < xworksize ; i++) { if (Xwork [i] != 0.) { PRINT0 (("Xwork ["ID"] = %g\n", i, Xwork [i])) ; ERR ("workspace corrupted (Xwork)") ; } } } /* workspace and parameters are valid */ P3 ("%s", " OK\n") ; P4 ("%s", "\n") ; return (TRUE) ; } int CHOLMOD(check_common) ( cholmod_common *Common ) { return (check_common (0, NULL, Common)) ; } int CHOLMOD(print_common) ( /* ---- input ---- */ const char *name, /* printed name of Common object */ /* --------------- */ cholmod_common *Common ) { Int print = (Common == NULL) ? 3 : (Common->print) ; return (check_common (print, name, Common)) ; } /* ========================================================================== */ /* === cholmod_gpu_stats ==================================================== */ /* ========================================================================== */ /* Print CPU / GPU statistics. If the timer is not installed, the times are reported as zero, but this function still works. Likewise, the function still works if the GPU BLAS is not installed. */ int CHOLMOD(gpu_stats) ( cholmod_common *Common /* input */ ) { double cpu_time, gpu_time ; int print ; RETURN_IF_NULL_COMMON (FALSE) ; print = Common->print ; P2 ("%s", "\nCHOLMOD GPU/CPU statistics:\n") ; P2 ("SYRK CPU calls %12.0f", (double) Common->CHOLMOD_CPU_SYRK_CALLS) ; P2 (" time %12.4e\n", Common->CHOLMOD_CPU_SYRK_TIME) ; P2 (" GPU calls %12.0f", (double) Common->CHOLMOD_GPU_SYRK_CALLS) ; P2 (" time %12.4e\n", Common->CHOLMOD_GPU_SYRK_TIME) ; P2 ("GEMM CPU calls %12.0f", (double) Common->CHOLMOD_CPU_GEMM_CALLS) ; P2 (" time %12.4e\n", Common->CHOLMOD_CPU_GEMM_TIME) ; P2 (" GPU calls %12.0f", (double) Common->CHOLMOD_GPU_GEMM_CALLS) ; P2 (" time %12.4e\n", Common->CHOLMOD_GPU_GEMM_TIME) ; P2 ("POTRF CPU calls %12.0f", (double) Common->CHOLMOD_CPU_POTRF_CALLS) ; P2 (" time %12.4e\n", Common->CHOLMOD_CPU_POTRF_TIME) ; P2 (" GPU calls %12.0f", (double) Common->CHOLMOD_GPU_POTRF_CALLS) ; P2 (" time %12.4e\n", Common->CHOLMOD_GPU_POTRF_TIME) ; P2 ("TRSM CPU calls %12.0f", (double) Common->CHOLMOD_CPU_TRSM_CALLS) ; P2 (" time %12.4e\n", Common->CHOLMOD_CPU_TRSM_TIME) ; P2 (" GPU calls %12.0f", (double) Common->CHOLMOD_GPU_TRSM_CALLS) ; P2 (" time %12.4e\n", Common->CHOLMOD_GPU_TRSM_TIME) ; cpu_time = Common->CHOLMOD_CPU_SYRK_TIME + Common->CHOLMOD_CPU_TRSM_TIME + Common->CHOLMOD_CPU_GEMM_TIME + Common->CHOLMOD_CPU_POTRF_TIME ; gpu_time = Common->CHOLMOD_GPU_SYRK_TIME + Common->CHOLMOD_GPU_TRSM_TIME + Common->CHOLMOD_GPU_GEMM_TIME + Common->CHOLMOD_GPU_POTRF_TIME ; P2 ("time in the BLAS: CPU %12.4e", cpu_time) ; P2 (" GPU %12.4e", gpu_time) ; P2 (" total: %12.4e\n", cpu_time + gpu_time) ; P2 ("assembly time %12.4e", Common->CHOLMOD_ASSEMBLE_TIME) ; P2 (" %12.4e\n", Common->CHOLMOD_ASSEMBLE_TIME2) ; return (TRUE) ; } /* ========================================================================== */ /* === cholmod_check_sparse ================================================= */ /* ========================================================================== */ /* Ensure that a sparse matrix in column-oriented form is valid, and optionally * print it. Returns the number of entries on the diagonal or -1 if error. * * workspace: Iwork (nrow) */ static SuiteSparse_long check_sparse ( Int *Wi, Int print, const char *name, cholmod_sparse *A, SuiteSparse_long *nnzdiag, cholmod_common *Common ) { double *Ax, *Az ; Int *Ap, *Ai, *Anz ; Int nrow, ncol, nzmax, sorted, packed, j, p, pend, i, nz, ilast, init_print, dnz, count, xtype ; const char *type = "sparse" ; /* ---------------------------------------------------------------------- */ /* print header information */ /* ---------------------------------------------------------------------- */ P4 ("%s", "\n") ; P3 ("%s", "CHOLMOD sparse: ") ; if (name != NULL) { P3 ("%s: ", name) ; } if (A == NULL) { ERR ("null") ; } nrow = A->nrow ; ncol = A->ncol ; nzmax = A->nzmax ; sorted = A->sorted ; packed = A->packed ; xtype = A->xtype ; Ap = A->p ; Ai = A->i ; Ax = A->x ; Az = A->z ; Anz = A->nz ; nz = CHOLMOD(nnz) (A, Common) ; P3 (" "ID"", nrow) ; P3 ("-by-"ID", ", ncol) ; P3 ("nz "ID",", nz) ; if (A->stype > 0) { P3 ("%s", " upper.") ; } else if (A->stype < 0) { P3 ("%s", " lower.") ; } else { P3 ("%s", " up/lo.") ; } P4 ("\n nzmax "ID", ", nzmax) ; if (nz > nzmax) { ERR ("nzmax too small") ; } if (!sorted) { P4 ("%s", "un") ; } P4 ("%s", "sorted, ") ; if (!packed) { P4 ("%s", "un") ; } P4 ("%s", "packed, ") ; switch (A->itype) { case CHOLMOD_INT: P4 ("%s", "\n scalar types: int, ") ; break ; case CHOLMOD_INTLONG: ERR ("mixed int/long type unsupported") ; case CHOLMOD_LONG: P4 ("%s", "\n scalar types: SuiteSparse_long, "); break ; default: ERR ("unknown itype") ; } switch (A->xtype) { case CHOLMOD_PATTERN: P4 ("%s", "pattern") ; break ; case CHOLMOD_REAL: P4 ("%s", "real") ; break ; case CHOLMOD_COMPLEX: P4 ("%s", "complex") ; break ; case CHOLMOD_ZOMPLEX: P4 ("%s", "zomplex") ; break ; default: ERR ("unknown xtype") ; } switch (A->dtype) { case CHOLMOD_DOUBLE: P4 ("%s", ", double\n") ; break ; case CHOLMOD_SINGLE: ERR ("float unsupported") ; default: ERR ("unknown dtype") ; } if (A->itype != ITYPE || A->dtype != DTYPE) { ERR ("integer and real type must match routine") ; } if (A->stype && nrow != ncol) { ERR ("symmetric but not square") ; } /* check for existence of Ap, Ai, Anz, Ax, and Az arrays */ if (Ap == NULL) { ERR ("p array not present") ; } if (Ai == NULL) { ERR ("i array not present") ; } if (!packed && Anz == NULL) { ERR ("nz array not present") ; } if (xtype != CHOLMOD_PATTERN && Ax == NULL) { ERR ("x array not present") ; } if (xtype == CHOLMOD_ZOMPLEX && Az == NULL) { ERR ("z array not present") ; } /* packed matrices must start at Ap [0] = 0 */ if (packed && Ap [0] != 0) { ERR ("p [0] must be zero") ; } if (packed && (Ap [ncol] < Ap [0] || Ap [ncol] > nzmax)) { ERR ("p [ncol] invalid") ; } /* ---------------------------------------------------------------------- */ /* allocate workspace if needed */ /* ---------------------------------------------------------------------- */ if (!sorted) { if (Wi == NULL) { CHOLMOD(allocate_work) (0, nrow, 0, Common) ; Wi = Common->Iwork ; /* size nrow, (i/i/l) */ } if (Common->status < CHOLMOD_OK) { return (FALSE) ; /* out of memory */ } for (i = 0 ; i < nrow ; i++) { Wi [i] = EMPTY ; } } /* ---------------------------------------------------------------------- */ /* check and print each column */ /* ---------------------------------------------------------------------- */ init_print = print ; dnz = 0 ; ETC_START (count, 8) ; for (j = 0 ; j < ncol ; j++) { ETC (j == ncol-1, count, 4) ; p = Ap [j] ; if (packed) { pend = Ap [j+1] ; nz = pend - p ; } else { /* Note that Anz [j] < 0 is treated as zero */ nz = MAX (0, Anz [j]) ; pend = p + nz ; } P4 (" col "ID":", j) ; P4 (" nz "ID"", nz) ; P4 (" start "ID"", p) ; P4 (" end "ID"", pend) ; P4 ("%s", ":\n") ; if (p < 0 || pend > nzmax) { ERR ("pointer invalid") ; } if (nz < 0 || nz > nrow) { ERR ("nz invalid") ; } ilast = EMPTY ; for ( ; p < pend ; p++) { ETC (j == ncol-1 && p >= pend-4, count, -1) ; i = Ai [p] ; P4 (" "I8":", i) ; print_value (print, xtype, Ax, Az, p, Common) ; if (i == j) { dnz++ ; } if (i < 0 || i >= nrow) { ERR ("row index out of range") ; } if (sorted && i <= ilast) { ERR ("row indices out of order") ; } if (!sorted && Wi [i] == j) { ERR ("duplicate row index") ; } P4 ("%s", "\n") ; ilast = i ; if (!sorted) { Wi [i] = j ; } } } /* matrix is valid */ P4 (" nnz on diagonal: "ID"\n", dnz) ; P3 ("%s", " OK\n") ; P4 ("%s", "\n") ; *nnzdiag = dnz ; return (TRUE) ; } int CHOLMOD(check_sparse) ( /* ---- input ---- */ cholmod_sparse *A, /* sparse matrix to check */ /* --------------- */ cholmod_common *Common ) { SuiteSparse_long nnzdiag ; RETURN_IF_NULL_COMMON (FALSE) ; Common->status = CHOLMOD_OK ; return (check_sparse (NULL, 0, NULL, A, &nnzdiag, Common)) ; } int CHOLMOD(print_sparse) ( /* ---- input ---- */ cholmod_sparse *A, /* sparse matrix to print */ const char *name, /* printed name of sparse matrix */ /* --------------- */ cholmod_common *Common ) { SuiteSparse_long nnzdiag ; RETURN_IF_NULL_COMMON (FALSE) ; Common->status = CHOLMOD_OK ; return (check_sparse (NULL, Common->print, name, A, &nnzdiag, Common)) ; } /* ========================================================================== */ /* === cholmod_check_dense ================================================== */ /* ========================================================================== */ /* Ensure a dense matrix is valid, and optionally print it. */ static int check_dense ( Int print, const char *name, cholmod_dense *X, cholmod_common *Common ) { double *Xx, *Xz ; Int i, j, d, nrow, ncol, nzmax, nz, init_print, count, xtype ; const char *type = "dense" ; /* ---------------------------------------------------------------------- */ /* print header information */ /* ---------------------------------------------------------------------- */ P4 ("%s", "\n") ; P3 ("%s", "CHOLMOD dense: ") ; if (name != NULL) { P3 ("%s: ", name) ; } if (X == NULL) { ERR ("null") ; } nrow = X->nrow ; ncol = X->ncol ; nzmax = X->nzmax ; d = X->d ; Xx = X->x ; Xz = X->z ; xtype = X->xtype ; P3 (" "ID"", nrow) ; P3 ("-by-"ID", ", ncol) ; P4 ("\n leading dimension "ID", ", d) ; P4 ("nzmax "ID", ", nzmax) ; if (d * ncol > nzmax) { ERR ("nzmax too small") ; } if (d < nrow) { ERR ("leading dimension must be >= # of rows") ; } if (Xx == NULL) { ERR ("null") ; } switch (X->xtype) { case CHOLMOD_PATTERN: ERR ("pattern unsupported") ; break ; case CHOLMOD_REAL: P4 ("%s", "real") ; break ; case CHOLMOD_COMPLEX: P4 ("%s", "complex") ; break ; case CHOLMOD_ZOMPLEX: P4 ("%s", "zomplex") ; break ; default: ERR ("unknown xtype") ; } switch (X->dtype) { case CHOLMOD_DOUBLE: P4 ("%s", ", double\n") ; break ; case CHOLMOD_SINGLE: ERR ("single unsupported") ; default: ERR ("unknown dtype") ; } /* ---------------------------------------------------------------------- */ /* check and print each entry */ /* ---------------------------------------------------------------------- */ if (print >= 4) { init_print = print ; ETC_START (count, 9) ; nz = nrow * ncol ; for (j = 0 ; j < ncol ; j++) { ETC (j == ncol-1, count, 5) ; P4 (" col "ID":\n", j) ; for (i = 0 ; i < nrow ; i++) { ETC (j == ncol-1 && i >= nrow-4, count, -1) ; P4 (" "I8":", i) ; print_value (print, xtype, Xx, Xz, i+j*d, Common) ; P4 ("%s", "\n") ; } } } /* dense is valid */ P3 ("%s", " OK\n") ; P4 ("%s", "\n") ; return (TRUE) ; } int CHOLMOD(check_dense) ( /* ---- input ---- */ cholmod_dense *X, /* dense matrix to check */ /* --------------- */ cholmod_common *Common ) { RETURN_IF_NULL_COMMON (FALSE) ; Common->status = CHOLMOD_OK ; return (check_dense (0, NULL, X, Common)) ; } int CHOLMOD(print_dense) ( /* ---- input ---- */ cholmod_dense *X, /* dense matrix to print */ const char *name, /* printed name of dense matrix */ /* --------------- */ cholmod_common *Common ) { RETURN_IF_NULL_COMMON (FALSE) ; Common->status = CHOLMOD_OK ; return (check_dense (Common->print, name, X, Common)) ; } /* ========================================================================== */ /* === cholmod_check_subset ================================================= */ /* ========================================================================== */ /* Ensure S (0:len-1) is a subset of 0:n-1. Duplicates are allowed. S may be * NULL. A negative len denotes the set 0:n-1. * * To check the rset and cset for A(rset,cset), where nc and nr are the length * of cset and rset respectively: * * cholmod_check_subset (cset, nc, A->ncol, Common) ; * cholmod_check_subset (rset, nr, A->nrow, Common) ; * * workspace: none */ static int check_subset ( Int *S, SuiteSparse_long len, size_t n, Int print, const char *name, cholmod_common *Common ) { Int i, k, init_print, count ; const char *type = "subset" ; init_print = print ; if (S == NULL) { /* zero len denotes S = [ ], negative len denotes S = 0:n-1 */ len = (len < 0) ? (-1) : 0 ; } P4 ("%s", "\n") ; P3 ("%s", "CHOLMOD subset: ") ; if (name != NULL) { P3 ("%s: ", name) ; } P3 (" len: %ld ", len) ; if (len < 0) { P3 ("%s", "(denotes 0:n-1) ") ; } P3 ("n: "ID"", (Int) n) ; P4 ("%s", "\n") ; if (len <= 0 || S == NULL) { P3 ("%s", " OK\n") ; P4 ("%s", "\n") ; return (TRUE) ; } if (print >= 4) { ETC_START (count, 8) ; for (k = 0 ; k < ((Int) len) ; k++) { ETC (k == ((Int) len) - 4, count, -1) ; i = S [k] ; P4 (" "I8":", k) ; P4 (" "ID"\n", i) ; if (i < 0 || i >= ((Int) n)) { ERR ("entry out range") ; } } } else { for (k = 0 ; k < ((Int) len) ; k++) { i = S [k] ; if (i < 0 || i >= ((Int) n)) { ERR ("entry out range") ; } } } P3 ("%s", " OK\n") ; P4 ("%s", "\n") ; return (TRUE) ; } int CHOLMOD(check_subset) ( /* ---- input ---- */ Int *Set, /* Set [0:len-1] is a subset of 0:n-1. Duplicates OK */ SuiteSparse_long len, /* size of Set (an integer array), or < 0 if 0:n-1 */ size_t n, /* 0:n-1 is valid range */ /* --------------- */ cholmod_common *Common ) { RETURN_IF_NULL_COMMON (FALSE) ; Common->status = CHOLMOD_OK ; return (check_subset (Set, len, n, 0, NULL, Common)) ; } int CHOLMOD(print_subset) ( /* ---- input ---- */ Int *Set, /* Set [0:len-1] is a subset of 0:n-1. Duplicates OK */ SuiteSparse_long len, /* size of Set (an integer array), or < 0 if 0:n-1 */ size_t n, /* 0:n-1 is valid range */ const char *name, /* printed name of Set */ /* --------------- */ cholmod_common *Common ) { RETURN_IF_NULL_COMMON (FALSE) ; Common->status = CHOLMOD_OK ; return (check_subset (Set, len, n, Common->print, name, Common)) ; } /* ========================================================================== */ /* === cholmod_check_perm =================================================== */ /* ========================================================================== */ /* Ensure that Perm [0..len-1] is a permutation of a subset of 0:n-1. Perm * may be NULL, which is interpreted as the identity permutation. There can * be no duplicate entries (len must be <= n). * * If n <= Common->nrow, then this routine takes O(len) time and does not * allocate any memory, by using Common->Flag. Otherwise, it takes O(n) time * and ensures that Common->Iwork is at least n*sizeof(Int) in size. * * To check the fset: cholmod_check_perm (fset, fsize, ncol, Common) ; * To check a permutation: cholmod_check_perm (Perm, n, n, Common) ; * * workspace: Flag (n) if n <= Common->nrow, Iwork (n) otherwise. */ static int check_perm ( Int *Wi, Int print, const char *name, Int *Perm, size_t len, size_t n, cholmod_common *Common ) { Int *Flag ; Int i, k, mark, init_print, count ; const char *type = "perm" ; /* ---------------------------------------------------------------------- */ /* checks that take O(1) time */ /* ---------------------------------------------------------------------- */ if (Perm == NULL || n == 0) { /* Perm is valid implicit identity, or empty */ return (TRUE) ; } /* ---------------------------------------------------------------------- */ /* checks that take O(n) time or require memory allocation */ /* ---------------------------------------------------------------------- */ init_print = print ; ETC_START (count, 8) ; if (Wi == NULL && n <= Common->nrow) { /* use the Common->Flag array if it's big enough */ mark = CHOLMOD(clear_flag) (Common) ; Flag = Common->Flag ; ASSERT (CHOLMOD(dump_work) (TRUE, FALSE, 0, Common)) ; if (print >= 4) { for (k = 0 ; k < ((Int) len) ; k++) { ETC (k >= ((Int) len) - 4, count, -1) ; i = Perm [k] ; P4 (" "I8":", k) ; P4 (""ID"\n", i) ; if (i < 0 || i >= ((Int) n) || Flag [i] == mark) { CHOLMOD(clear_flag) (Common) ; ERR ("invalid permutation") ; } Flag [i] = mark ; } } else { for (k = 0 ; k < ((Int) len) ; k++) { i = Perm [k] ; if (i < 0 || i >= ((Int) n) || Flag [i] == mark) { CHOLMOD(clear_flag) (Common) ; ERR ("invalid permutation") ; } Flag [i] = mark ; } } CHOLMOD(clear_flag) (Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, FALSE, 0, Common)) ; } else { if (Wi == NULL) { /* use Common->Iwork instead, but initialize it first */ CHOLMOD(allocate_work) (0, n, 0, Common) ; Wi = Common->Iwork ; /* size n, (i/i/i) is OK */ } if (Common->status < CHOLMOD_OK) { return (FALSE) ; /* out of memory */ } for (i = 0 ; i < ((Int) n) ; i++) { Wi [i] = FALSE ; } if (print >= 4) { for (k = 0 ; k < ((Int) len) ; k++) { ETC (k >= ((Int) len) - 4, count, -1) ; i = Perm [k] ; P4 (" "I8":", k) ; P4 (""ID"\n", i) ; if (i < 0 || i >= ((Int) n) || Wi [i]) { ERR ("invalid permutation") ; } Wi [i] = TRUE ; } } else { for (k = 0 ; k < ((Int) len) ; k++) { i = Perm [k] ; if (i < 0 || i >= ((Int) n) || Wi [i]) { ERR ("invalid permutation") ; } Wi [i] = TRUE ; } } } /* perm is valid */ return (TRUE) ; } int CHOLMOD(check_perm) ( /* ---- input ---- */ Int *Perm, /* Perm [0:len-1] is a permutation of subset of 0:n-1 */ size_t len, /* size of Perm (an integer array) */ size_t n, /* 0:n-1 is valid range */ /* --------------- */ cholmod_common *Common ) { RETURN_IF_NULL_COMMON (FALSE) ; Common->status = CHOLMOD_OK ; return (check_perm (NULL, 0, NULL, Perm, len, n, Common)) ; } int CHOLMOD(print_perm) ( /* ---- input ---- */ Int *Perm, /* Perm [0:len-1] is a permutation of subset of 0:n-1 */ size_t len, /* size of Perm (an integer array) */ size_t n, /* 0:n-1 is valid range */ const char *name, /* printed name of Perm */ /* --------------- */ cholmod_common *Common ) { Int ok, print ; RETURN_IF_NULL_COMMON (FALSE) ; Common->status = CHOLMOD_OK ; print = Common->print ; P4 ("%s", "\n") ; P3 ("%s", "CHOLMOD perm: ") ; if (name != NULL) { P3 ("%s: ", name) ; } P3 (" len: "ID"", (Int) len) ; P3 (" n: "ID"", (Int) n) ; P4 ("%s", "\n") ; ok = check_perm (NULL, print, name, Perm, len, n, Common) ; if (ok) { P3 ("%s", " OK\n") ; P4 ("%s", "\n") ; } return (ok) ; } /* ========================================================================== */ /* === cholmod_check_parent ================================================= */ /* ========================================================================== */ /* Ensure that Parent is a valid elimination tree of nodes 0 to n-1. * If j is a root of the tree then Parent [j] is EMPTY (-1). * * NOTE: this check will fail if applied to the component tree (CParent) in * cholmod_nested_dissection, unless it has been postordered and renumbered. * * workspace: none */ static int check_parent ( Int *Parent, size_t n, Int print, const char *name, cholmod_common *Common ) { Int j, p, init_print, count ; const char *type = "parent" ; init_print = print ; P4 ("%s", "\n") ; P3 ("%s", "CHOLMOD parent: ") ; if (name != NULL) { P3 ("%s: ", name) ; } P3 (" n: "ID"", (Int) n) ; P4 ("%s", "\n") ; if (Parent == NULL) { ERR ("null") ; } /* ---------------------------------------------------------------------- */ /* checks that take O(n) time */ /* ---------------------------------------------------------------------- */ ETC_START (count, 8) ; for (j = 0 ; j < ((Int) n) ; j++) { ETC (j == ((Int) n) - 4, count, -1) ; p = Parent [j] ; P4 (" "I8":", j) ; P4 (" "ID"\n", p) ; if (!(p == EMPTY || p > j)) { ERR ("invalid") ; } } P3 ("%s", " OK\n") ; P4 ("%s", "\n") ; return (TRUE) ; } int CHOLMOD(check_parent) ( /* ---- input ---- */ Int *Parent, /* Parent [0:n-1] is an elimination tree */ size_t n, /* size of Parent */ /* --------------- */ cholmod_common *Common ) { RETURN_IF_NULL_COMMON (FALSE) ; Common->status = CHOLMOD_OK ; return (check_parent (Parent, n, 0, NULL, Common)) ; } int CHOLMOD(print_parent) ( /* ---- input ---- */ Int *Parent, /* Parent [0:n-1] is an elimination tree */ size_t n, /* size of Parent */ const char *name, /* printed name of Parent */ /* --------------- */ cholmod_common *Common ) { RETURN_IF_NULL_COMMON (FALSE) ; Common->status = CHOLMOD_OK ; return (check_parent (Parent, n, Common->print, name, Common)) ; } /* ========================================================================== */ /* === cholmod_check_factor ================================================= */ /* ========================================================================== */ static int check_factor ( Int *Wi, Int print, const char *name, cholmod_factor *L, cholmod_common *Common ) { double *Lx, *Lz ; Int *Lp, *Li, *Lnz, *Lnext, *Lprev, *Perm, *ColCount, *Lpi, *Lpx, *Super, *Ls ; Int n, nzmax, j, p, pend, i, nz, ordering, space, is_monotonic, minor, count, precise, init_print, ilast, lnz, head, tail, jprev, plast, jnext, examine_super, nsuper, s, k1, k2, psi, psend, psx, nsrow, nscol, ps2, psxend, ssize, xsize, maxcsize, maxesize, nsrow2, jj, ii, xtype ; Int check_Lpx ; const char *type = "factor" ; /* ---------------------------------------------------------------------- */ /* print header information */ /* ---------------------------------------------------------------------- */ P4 ("%s", "\n") ; P3 ("%s", "CHOLMOD factor: ") ; if (name != NULL) { P3 ("%s: ", name) ; } if (L == NULL) { ERR ("null") ; } n = L->n ; minor = L->minor ; ordering = L->ordering ; xtype = L->xtype ; Perm = L->Perm ; ColCount = L->ColCount ; lnz = 0 ; precise = Common->precise ; P3 (" "ID"", n) ; P3 ("-by-"ID"", n) ; if (minor < n) { P3 (" not positive definite (column "ID")", minor) ; } switch (L->itype) { case CHOLMOD_INT: P4 ("%s", "\n scalar types: int, ") ; break ; case CHOLMOD_INTLONG: ERR ("mixed int/long type unsupported") ; case CHOLMOD_LONG: P4 ("%s", "\n scalar types: SuiteSparse_long, "); break ; default: ERR ("unknown itype") ; } switch (L->xtype) { case CHOLMOD_PATTERN: P4 ("%s", "pattern") ; break ; case CHOLMOD_REAL: P4 ("%s", "real") ; break ; case CHOLMOD_COMPLEX: P4 ("%s", "complex") ; break ; case CHOLMOD_ZOMPLEX: P4 ("%s", "zomplex") ; break ; default: ERR ("unknown xtype") ; } switch (L->dtype) { case CHOLMOD_DOUBLE: P4 ("%s", ", double\n") ; break ; case CHOLMOD_SINGLE: ERR ("single unsupported") ; default: ERR ("unknown dtype") ; } if (L->itype != ITYPE || L->dtype != DTYPE) { ERR ("integer and real type must match routine") ; } if (L->is_super) { P3 ("%s", " supernodal") ; } else { P3 ("%s", " simplicial") ; } if (L->is_ll) { P3 ("%s", ", LL'.") ; } else { P3 ("%s", ", LDL'.") ; } P4 ("%s", "\n ordering method used: ") ; switch (L->ordering) { case CHOLMOD_POSTORDERED:P4 ("%s", "natural (postordered)") ; break ; case CHOLMOD_NATURAL: P4 ("%s", "natural") ; break ; case CHOLMOD_GIVEN: P4 ("%s", "user-provided") ; break ; case CHOLMOD_AMD: P4 ("%s", "AMD") ; break ; case CHOLMOD_COLAMD: P4 ("%s", "AMD for A, COLAMD for A*A'") ;break ; #ifndef NPARTITION case CHOLMOD_METIS: P4 ("%s", "METIS NodeND") ; break ; case CHOLMOD_NESDIS: P4 ("%s", "CHOLMOD nested dissection") ; break ; #endif default: ERR ("unknown ordering") ; } P4 ("%s", "\n") ; init_print = print ; if (L->is_super && L->xtype == CHOLMOD_ZOMPLEX) { ERR ("Supernodal zomplex L not supported") ; } /* ---------------------------------------------------------------------- */ /* check L->Perm */ /* ---------------------------------------------------------------------- */ if (!check_perm (Wi, print, name, Perm, n, n, Common)) { return (FALSE) ; } /* ---------------------------------------------------------------------- */ /* check L->ColCount */ /* ---------------------------------------------------------------------- */ if (ColCount == NULL) { ERR ("ColCount vector invalid") ; } ETC_START (count, 8) ; for (j = 0 ; j < n ; j++) { ETC (j >= n-4, count, -1) ; P4 (" col: "ID" ", j) ; nz = ColCount [j] ; P4 ("colcount: "ID"\n", nz) ; if (nz < 0 || nz > n-j) { ERR ("ColCount out of range") ; } } /* ---------------------------------------------------------------------- */ /* check factor */ /* ---------------------------------------------------------------------- */ if (L->xtype == CHOLMOD_PATTERN && !(L->is_super)) { /* ------------------------------------------------------------------ */ /* check simplicial symbolic factor */ /* ------------------------------------------------------------------ */ /* nothing else to do */ ; } else if (L->xtype != CHOLMOD_PATTERN && !(L->is_super)) { /* ------------------------------------------------------------------ */ /* check simplicial numerical factor */ /* ------------------------------------------------------------------ */ P4 ("monotonic: %d\n", L->is_monotonic) ; nzmax = L->nzmax ; P3 (" nzmax "ID".", nzmax) ; P4 ("%s", "\n") ; Lp = L->p ; Li = L->i ; Lx = L->x ; Lz = L->z ; Lnz = L->nz ; Lnext = L->next ; Lprev = L->prev ; /* check for existence of Lp, Li, Lnz, Lnext, Lprev, and Lx arrays */ if (Lp == NULL) { ERR ("p array not present") ; } if (Li == NULL) { ERR ("i array not present") ; } if (Lnz == NULL) { ERR ("nz array not present") ; } if (Lx == NULL) { ERR ("x array not present") ; } if (xtype == CHOLMOD_ZOMPLEX && Lz == NULL) { ERR ("z array not present") ; } if (Lnext == NULL) { ERR ("next array not present") ; } if (Lprev == NULL) { ERR ("prev array not present") ; } ETC_START (count, 8) ; /* check each column of L */ plast = 0 ; is_monotonic = TRUE ; for (j = 0 ; j < n ; j++) { ETC (j >= n-3, count, -1) ; p = Lp [j] ; nz = Lnz [j] ; pend = p + nz ; lnz += nz ; P4 (" col "ID":", j) ; P4 (" nz "ID"", nz) ; P4 (" start "ID"", p) ; P4 (" end "ID"", pend) ; if (Lnext [j] < 0 || Lnext [j] > n) { ERR ("invalid link list") ; } space = Lp [Lnext [j]] - p ; P4 (" space "ID"", space) ; P4 (" free "ID":\n", space - nz) ; if (p < 0 || pend > nzmax || space < 1) { ERR ("pointer invalid") ; } if (nz < 1 || nz > (n-j) || nz > space) { ERR ("nz invalid") ; } ilast = j-1 ; if (p < plast) { is_monotonic = FALSE ; } plast = p ; i = Li [p] ; P4 (" "I8":", i) ; if (i != j) { ERR ("diagonal missing") ; } print_value (print, xtype, Lx, Lz, p, Common) ; P4 ("%s", "\n") ; ilast = j ; for (p++ ; p < pend ; p++) { ETC_DISABLE (count) ; i = Li [p] ; P4 (" "I8":", i) ; if (i < j || i >= n) { ERR ("row index out of range") ; } if (i <= ilast) { ERR ("row indices out of order") ; } print_value (print, xtype, Lx, Lz, p, Common) ; P4 ("%s", "\n") ; ilast = i ; } } if (L->is_monotonic && !is_monotonic) { ERR ("columns not monotonic") ; } /* check the link list */ head = n+1 ; tail = n ; j = head ; jprev = EMPTY ; count = 0 ; for ( ; ; ) { if (j < 0 || j > n+1 || count > n+2) { ERR ("invalid link list") ; } jnext = Lnext [j] ; if (j >= 0 && j < n) { if (jprev != Lprev [j]) { ERR ("invalid link list") ; } } count++ ; if (j == tail) { break ; } jprev = j ; j = jnext ; } if (Lnext [tail] != EMPTY || count != n+2) { ERR ("invalid link list") ; } } else { /* ------------------------------------------------------------------ */ /* check supernodal numeric or symbolic factor */ /* ------------------------------------------------------------------ */ nsuper = L->nsuper ; ssize = L->ssize ; xsize = L->xsize ; maxcsize = L->maxcsize ; maxesize = L->maxesize ; Ls = L->s ; Lpi = L->pi ; Lpx = L->px ; Super = L->super ; Lx = L->x ; ETC_START (count, 8) ; P4 (" ssize "ID" ", ssize) ; P4 ("xsize "ID" ", xsize) ; P4 ("maxcsize "ID" ", maxcsize) ; P4 ("maxesize "ID"\n", maxesize) ; if (Ls == NULL) { ERR ("invalid: L->s missing") ; } if (Lpi == NULL) { ERR ("invalid: L->pi missing") ; } if (Lpx == NULL) { ERR ("invalid: L->px missing") ; } if (Super == NULL) { ERR ("invalid: L->super missing") ; } if (L->xtype != CHOLMOD_PATTERN) { /* numerical supernodal factor */ if (Lx == NULL) { ERR ("invalid: L->x missing") ; } if (Ls [0] == EMPTY) { ERR ("invalid: L->s not defined") ; } examine_super = TRUE ; } else { /* symbolic supernodal factor, but only if it has been computed */ examine_super = (Ls [0] != EMPTY) ; } if (examine_super) { if (Lpi [0] != 0 || MAX (1, Lpi [nsuper]) != ssize) { PRINT0 (("Lpi [0] "ID", Lpi [nsuper = "ID"] = "ID"\n", Lpi [0], nsuper, Lpi [nsuper])) ; ERR ("invalid: L->pi invalid") ; } /* If Lpx [0] is 123456, then supernodes are present but Lpx [0...nsuper] is not defined, so don't check it. This is used in the non-GPU accelerated SPQR */ check_Lpx = (Lpx [0] != 123456) ; if (check_Lpx && (Lpx [0] != 0 || MAX (1, Lpx[nsuper]) != xsize)) { ERR ("invalid: L->px invalid") ; } /* check and print each supernode */ for (s = 0 ; s < nsuper ; s++) { k1 = Super [s] ; k2 = Super [s+1] ; psi = Lpi [s] ; psend = Lpi [s+1] ; nsrow = psend - psi ; nscol = k2 - k1 ; nsrow2 = nsrow - nscol ; ps2 = psi + nscol ; if (check_Lpx) { psx = Lpx [s] ; psxend = Lpx [s+1] ; } ETC (s == nsuper-1, count, 4) ; P4 (" supernode "ID", ", s) ; P4 ("col "ID" ", k1) ; P4 ("to "ID". ", k2-1) ; P4 ("nz in first col: "ID".\n", nsrow) ; if (check_Lpx) { P4 (" values start "ID", ", psx) ; P4 ("end "ID"\n", psxend) ; } if (k1 > k2 || k1 < 0 || k2 > n || nsrow < nscol || nsrow2 < 0 || (check_Lpx && psxend - psx != nsrow * nscol)) { ERR ("invalid supernode") ; } lnz += nscol * nsrow - (nscol*nscol - nscol)/2 ; if (L->xtype != CHOLMOD_PATTERN) { /* print each column of the supernode */ for (jj = 0 ; jj < nscol ; jj++) { ETC_ENABLE (s == nsuper-1 && jj >= nscol-3, count, -1) ; j = k1 + jj ; P4 (" col "ID"\n", j) ; ilast = j ; i = Ls [psi + jj] ; P4 (" "I8":", i) ; if (i != j) { ERR ("row index invalid") ; } /* PRINTVALUE (Lx [psx + jj + jj*nsrow]) ; */ print_value (print, xtype, Lx, NULL, psx + jj + jj*nsrow, Common) ; P4 ("%s", "\n") ; for (ii = jj + 1 ; ii < nsrow ; ii++) { ETC_DISABLE (count) ; i = Ls [psi + ii] ; P4 (" "I8":", i) ; if (i <= ilast || i > n) { ERR ("row index out of range") ; } /* PRINTVALUE (Lx [psx + ii + jj*nsrow]) ; */ print_value (print, xtype, Lx, NULL, psx + ii + jj*nsrow, Common) ; P4 ("%s", "\n") ; ilast = i ; } } } else { /* just print the leading column of the supernode */ P4 (" col "ID"\n", k1) ; for (jj = 0 ; jj < nscol ; jj++) { ETC (s == nsuper-1 && jj >= nscol-3, count, -1) ; j = k1 + jj ; i = Ls [psi + jj] ; P4 (" "I8"", i) ; if (i != j) { ERR ("row index invalid") ; } P4 ("%s", "\n") ; } ilast = j ; for (ii = nscol ; ii < nsrow ; ii++) { ETC_DISABLE (count) ; i = Ls [psi + ii] ; P4 (" "I8"", i) ; if (i <= ilast || i > n) { ERR ("row index out of range") ; } P4 ("%s", "\n") ; ilast = i ; } } } } } /* factor is valid */ P3 (" nz "ID"", lnz) ; P3 ("%s", " OK\n") ; P4 ("%s", "\n") ; return (TRUE) ; } int CHOLMOD(check_factor) ( /* ---- input ---- */ cholmod_factor *L, /* factor to check */ /* --------------- */ cholmod_common *Common ) { RETURN_IF_NULL_COMMON (FALSE) ; Common->status = CHOLMOD_OK ; return (check_factor (NULL, 0, NULL, L, Common)) ; } int CHOLMOD(print_factor) ( /* ---- input ---- */ cholmod_factor *L, /* factor to print */ const char *name, /* printed name of factor */ /* --------------- */ cholmod_common *Common ) { RETURN_IF_NULL_COMMON (FALSE) ; Common->status = CHOLMOD_OK ; return (check_factor (NULL, Common->print, name, L, Common)) ; } /* ========================================================================== */ /* === cholmod_check_triplet ================================================ */ /* ========================================================================== */ /* Ensure a triplet matrix is valid, and optionally print it. */ static int check_triplet ( Int print, const char *name, cholmod_triplet *T, cholmod_common *Common ) { double *Tx, *Tz ; Int *Ti, *Tj ; Int i, j, p, nrow, ncol, nzmax, nz, xtype, init_print, count ; const char *type = "triplet" ; /* ---------------------------------------------------------------------- */ /* print header information */ /* ---------------------------------------------------------------------- */ P4 ("%s", "\n") ; P3 ("%s", "CHOLMOD triplet: ") ; if (name != NULL) { P3 ("%s: ", name) ; } if (T == NULL) { ERR ("null") ; } nrow = T->nrow ; ncol = T->ncol ; nzmax = T->nzmax ; nz = T->nnz ; Ti = T->i ; Tj = T->j ; Tx = T->x ; Tz = T->z ; xtype = T->xtype ; P3 (" "ID"", nrow) ; P3 ("-by-"ID", ", ncol) ; P3 ("nz "ID",", nz) ; if (T->stype > 0) { P3 ("%s", " upper.") ; } else if (T->stype < 0) { P3 ("%s", " lower.") ; } else { P3 ("%s", " up/lo.") ; } P4 ("\n nzmax "ID", ", nzmax) ; if (nz > nzmax) { ERR ("nzmax too small") ; } switch (T->itype) { case CHOLMOD_INT: P4 ("%s", "\n scalar types: int, ") ; break ; case CHOLMOD_INTLONG: ERR ("mixed int/long type unsupported") ; case CHOLMOD_LONG: P4 ("%s", "\n scalar types: SuiteSparse_long, "); break ; default: ERR ("unknown itype") ; } switch (T->xtype) { case CHOLMOD_PATTERN: P4 ("%s", "pattern") ; break ; case CHOLMOD_REAL: P4 ("%s", "real") ; break ; case CHOLMOD_COMPLEX: P4 ("%s", "complex") ; break ; case CHOLMOD_ZOMPLEX: P4 ("%s", "zomplex") ; break ; default: ERR ("unknown xtype") ; } switch (T->dtype) { case CHOLMOD_DOUBLE: P4 ("%s", ", double\n") ; break ; case CHOLMOD_SINGLE: ERR ("single unsupported") ; default: ERR ("unknown dtype") ; } if (T->itype != ITYPE || T->dtype != DTYPE) { ERR ("integer and real type must match routine") ; } if (T->stype && nrow != ncol) { ERR ("symmetric but not square") ; } /* check for existence of Ti, Tj, Tx arrays */ if (Tj == NULL) { ERR ("j array not present") ; } if (Ti == NULL) { ERR ("i array not present") ; } if (xtype != CHOLMOD_PATTERN && Tx == NULL) { ERR ("x array not present") ; } if (xtype == CHOLMOD_ZOMPLEX && Tz == NULL) { ERR ("z array not present") ; } /* ---------------------------------------------------------------------- */ /* check and print each entry */ /* ---------------------------------------------------------------------- */ init_print = print ; ETC_START (count, 8) ; for (p = 0 ; p < nz ; p++) { ETC (p >= nz-4, count, -1) ; i = Ti [p] ; P4 (" "I8":", p) ; P4 (" "I_8"", i) ; if (i < 0 || i >= nrow) { ERR ("row index out of range") ; } j = Tj [p] ; P4 (" "I_8"", j) ; if (j < 0 || j >= ncol) { ERR ("column index out of range") ; } print_value (print, xtype, Tx, Tz, p, Common) ; P4 ("%s", "\n") ; } /* triplet matrix is valid */ P3 ("%s", " OK\n") ; P4 ("%s", "\n") ; return (TRUE) ; } int CHOLMOD(check_triplet) ( /* ---- input ---- */ cholmod_triplet *T, /* triplet matrix to check */ /* --------------- */ cholmod_common *Common ) { RETURN_IF_NULL_COMMON (FALSE) ; Common->status = CHOLMOD_OK ; return (check_triplet (0, NULL, T, Common)) ; } int CHOLMOD(print_triplet) ( /* ---- input ---- */ cholmod_triplet *T, /* triplet matrix to print */ const char *name, /* printed name of triplet matrix */ /* --------------- */ cholmod_common *Common ) { RETURN_IF_NULL_COMMON (FALSE) ; Common->status = CHOLMOD_OK ; return (check_triplet (Common->print, name, T, Common)) ; } /* ========================================================================== */ /* === CHOLMOD debugging routines =========================================== */ /* ========================================================================== */ #ifndef NDEBUG /* The global variables present only when debugging enabled. */ int CHOLMOD(dump) = 0 ; int CHOLMOD(dump_malloc) = -1 ; /* workspace: no debug routines use workspace in Common */ /* ========================================================================== */ /* === cholmod_dump_init ==================================================== */ /* ========================================================================== */ void CHOLMOD(dump_init) (const char *s, cholmod_common *Common) { int i = 0 ; FILE *f ; f = fopen ("debug", "r") ; CHOLMOD(dump) = 0 ; if (f != NULL) { i = fscanf (f, "%d", &CHOLMOD(dump)) ; fclose (f) ; } PRINT1 (("%s: cholmod_dump_init, D = %d\n", s, CHOLMOD(dump))) ; } /* ========================================================================== */ /* === cholmod_dump_sparse ================================================== */ /* ========================================================================== */ /* returns nnz (diag (A)) or EMPTY if error */ SuiteSparse_long CHOLMOD(dump_sparse) ( cholmod_sparse *A, const char *name, cholmod_common *Common ) { Int *Wi ; SuiteSparse_long nnzdiag ; Int ok ; if (CHOLMOD(dump) < -1) { /* no checks if debug level is -2 or less */ return (0) ; } RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; Wi = malloc (MAX (1, A->nrow) * sizeof (Int)) ; ok = check_sparse (Wi, CHOLMOD(dump), name, A, &nnzdiag, Common) ; if (Wi != NULL) free (Wi) ; return (ok ? nnzdiag : EMPTY) ; } /* ========================================================================== */ /* === cholmod_dump_factor ================================================== */ /* ========================================================================== */ int CHOLMOD(dump_factor) ( cholmod_factor *L, const char *name, cholmod_common *Common ) { Int *Wi ; int ok ; if (CHOLMOD(dump) < -1) { /* no checks if debug level is -2 or less */ return (TRUE) ; } RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (L, FALSE) ; Wi = malloc (MAX (1, L->n) * sizeof (Int)) ; ok = check_factor (Wi, CHOLMOD(dump), name, L, Common) ; if (Wi != NULL) free (Wi) ; return (ok) ; } /* ========================================================================== */ /* === cholmod_dump_perm ==================================================== */ /* ========================================================================== */ int CHOLMOD(dump_perm) ( Int *Perm, size_t len, size_t n, const char *name, cholmod_common *Common ) { Int *Wi ; int ok ; if (CHOLMOD(dump) < -1) { /* no checks if debug level is -2 or less */ return (TRUE) ; } RETURN_IF_NULL_COMMON (FALSE) ; Wi = malloc (MAX (1, n) * sizeof (Int)) ; ok = check_perm (Wi, CHOLMOD(dump), name, Perm, len, n,Common) ; if (Wi != NULL) free (Wi) ; return (ok) ; } /* ========================================================================== */ /* === cholmod_dump_dense =================================================== */ /* ========================================================================== */ int CHOLMOD(dump_dense) ( cholmod_dense *X, const char *name, cholmod_common *Common ) { if (CHOLMOD(dump) < -1) { /* no checks if debug level is -2 or less */ return (TRUE) ; } RETURN_IF_NULL_COMMON (FALSE) ; return (check_dense (CHOLMOD(dump), name, X, Common)) ; } /* ========================================================================== */ /* === cholmod_dump_triplet ================================================= */ /* ========================================================================== */ int CHOLMOD(dump_triplet) ( cholmod_triplet *T, const char *name, cholmod_common *Common ) { if (CHOLMOD(dump) < -1) { /* no checks if debug level is -2 or less */ return (TRUE) ; } RETURN_IF_NULL_COMMON (FALSE) ; return (check_triplet (CHOLMOD(dump), name, T, Common)) ; } /* ========================================================================== */ /* === cholmod_dump_subset ================================================== */ /* ========================================================================== */ int CHOLMOD(dump_subset) ( Int *S, size_t len, size_t n, const char *name, cholmod_common *Common ) { if (CHOLMOD(dump) < -1) { /* no checks if debug level is -2 or less */ return (TRUE) ; } RETURN_IF_NULL_COMMON (FALSE) ; return (check_subset (S, len, n, CHOLMOD(dump), name, Common)) ; } /* ========================================================================== */ /* === cholmod_dump_parent ================================================== */ /* ========================================================================== */ int CHOLMOD(dump_parent) ( Int *Parent, size_t n, const char *name, cholmod_common *Common ) { if (CHOLMOD(dump) < -1) { /* no checks if debug level is -2 or less */ return (TRUE) ; } RETURN_IF_NULL_COMMON (FALSE) ; return (check_parent (Parent, n, CHOLMOD(dump), name, Common)) ; } /* ========================================================================== */ /* === cholmod_dump_real ==================================================== */ /* ========================================================================== */ void CHOLMOD(dump_real) ( const char *name, Real *X, SuiteSparse_long nrow, SuiteSparse_long ncol, int lower, int xentry, cholmod_common *Common ) { /* dump an nrow-by-ncol real dense matrix */ SuiteSparse_long i, j ; double x, z ; if (CHOLMOD(dump) < -1) { /* no checks if debug level is -2 or less */ return ; } PRINT1 (("%s: dump_real, nrow: %ld ncol: %ld lower: %d\n", name, nrow, ncol, lower)) ; for (j = 0 ; j < ncol ; j++) { PRINT2 ((" col %ld\n", j)) ; for (i = 0 ; i < nrow ; i++) { /* X is stored in column-major form */ if (lower && i < j) { PRINT2 ((" %5ld: -", i)) ; } else { x = *X ; PRINT2 ((" %5ld: %e", i, x)) ; if (xentry == 2) { z = *(X+1) ; PRINT2 ((", %e", z)) ; } } PRINT2 (("\n")) ; X += xentry ; } } } /* ========================================================================== */ /* === cholmod_dump_super =================================================== */ /* ========================================================================== */ void CHOLMOD(dump_super) ( SuiteSparse_long s, Int *Super, Int *Lpi, Int *Ls, Int *Lpx, double *Lx, int xentry, cholmod_common *Common ) { Int k1, k2, do_values, psi, psx, nsrow, nscol, psend, ilast, p, i ; if (CHOLMOD(dump) < -1) { /* no checks if debug level is -2 or less */ return ; } k1 = Super [s] ; k2 = Super [s+1] ; nscol = k2 - k1 ; do_values = (Lpx != NULL) && (Lx != NULL) ; psi = Lpi [s] ; psend = Lpi [s+1] ; nsrow = psend - psi ; PRINT1 (("\nSuper %ld, columns "ID" to "ID", "ID" rows "ID" cols\n", s, k1, k2-1, nsrow, nscol)) ; ilast = -1 ; for (p = psi ; p < psend ; p++) { i = Ls [p] ; PRINT2 ((" "ID" : p-psi "ID"\n", i, p-psi)) ; ASSERT (IMPLIES (p-psi < nscol, i == k1 + (p-psi))) ; if (p-psi == nscol-1) PRINT2 (("------\n")) ; ASSERT (i > ilast) ; ilast = i ; } if (do_values) { psx = Lpx [s] ; CHOLMOD(dump_real) ("Supernode", Lx + xentry*psx, nsrow, nscol, TRUE, xentry, Common) ; } } /* ========================================================================== */ /* === cholmod_dump_mem ===================================================== */ /* ========================================================================== */ int CHOLMOD(dump_mem) ( const char *where, SuiteSparse_long should, cholmod_common *Common ) { SuiteSparse_long diff = should - Common->memory_inuse ; if (diff != 0) { PRINT0 (("mem: %-15s peak %10g inuse %10g should %10g\n", where, (double) Common->memory_usage, (double) Common->memory_inuse, (double) should)) ; PRINT0 (("mem: %s diff %ld !\n", where, diff)) ; } return (diff == 0) ; } /* ========================================================================== */ /* === cholmod_dump_partition =============================================== */ /* ========================================================================== */ /* make sure we have a proper separator (for debugging only) * * workspace: none */ int CHOLMOD(dump_partition) ( SuiteSparse_long n, Int *Cp, Int *Ci, Int *Cnw, /* can be NULL */ Int *Part, SuiteSparse_long sepsize, cholmod_common *Common ) { Int chek [3], which, ok, i, j, p ; PRINT1 (("bisect sepsize %ld\n", sepsize)) ; ok = TRUE ; chek [0] = 0 ; chek [1] = 0 ; chek [2] = 0 ; for (j = 0 ; j < n ; j++) { PRINT2 (("--------j "ID" in part "ID" nw "ID"\n", j, Part [j], Cnw ? (Cnw[j]):1)); which = Part [j] ; for (p = Cp [j] ; p < Cp [j+1] ; p++) { i = Ci [p] ; PRINT3 (("i "ID", part "ID"\n", i, Part [i])) ; if (which == 0) { if (Part [i] == 1) { PRINT0 (("Error! "ID" "ID"\n", i, j)) ; ok = FALSE ; } } else if (which == 1) { if (Part [i] == 0) { PRINT0 (("Error! "ID" "ID"\n", i, j)) ; ok = FALSE ; } } } if (which < 0 || which > 2) { PRINT0 (("Part out of range\n")) ; ok = FALSE ; } chek [which] += (Cnw ? (Cnw [j]) : 1) ; } PRINT1 (("sepsize %ld check "ID" "ID" "ID"\n", sepsize, chek[0], chek[1],chek[2])); if (sepsize != chek[2]) { PRINT0 (("mismatch!\n")) ; ok = FALSE ; } return (ok) ; } /* ========================================================================== */ /* === cholmod_dump_work ==================================================== */ /* ========================================================================== */ int CHOLMOD(dump_work) (int flag, int head, SuiteSparse_long wsize, cholmod_common *Common) { double *W ; Int *Flag, *Head ; Int k, nrow, mark ; if (CHOLMOD(dump) < -1) { /* no checks if debug level is -2 or less */ return (TRUE) ; } RETURN_IF_NULL_COMMON (FALSE) ; nrow = Common->nrow ; Flag = Common->Flag ; Head = Common->Head ; W = Common->Xwork ; mark = Common->mark ; if (wsize < 0) { /* check all of Xwork */ wsize = Common->xworksize ; } else { /* check on the first wsize doubles in Xwork */ wsize = MIN (wsize, (Int) (Common->xworksize)) ; } if (flag) { for (k = 0 ; k < nrow ; k++) { if (Flag [k] >= mark) { PRINT0 (("Flag invalid, Flag ["ID"] = "ID", mark = "ID"\n", k, Flag [k], mark)) ; ASSERT (0) ; return (FALSE) ; } } } if (head) { for (k = 0 ; k < nrow ; k++) { if (Head [k] != EMPTY) { PRINT0 (("Head invalid, Head ["ID"] = "ID"\n", k, Head [k])) ; ASSERT (0) ; return (FALSE) ; } } } for (k = 0 ; k < wsize ; k++) { if (W [k] != 0.) { PRINT0 (("W invalid, W ["ID"] = %g\n", k, W [k])) ; ASSERT (0) ; return (FALSE) ; } } return (TRUE) ; } #endif #endif Matrix/src/CHOLMOD/Supernodal/0000755000176200001440000000000014154165363015516 5ustar liggesusersMatrix/src/CHOLMOD/Supernodal/cholmod_super_symbolic.c0000644000176200001440000010233213652535054022427 0ustar liggesusers/* ========================================================================== */ /* === Supernodal/cholmod_super_symbolic ==================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Supernodal Module. Copyright (C) 2005-2006, Timothy A. Davis * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* Supernodal symbolic analysis of the LL' factorization of A, A*A', * A(:,f)*A(:,f)'. * * This routine must be preceded by a simplicial symbolic analysis * (cholmod_rowcolcounts). See cholmod_analyze.c for an example of how to use * this routine. * * The user need not call this directly; cholmod_analyze is a "simple" wrapper * for this routine. * * Symmetric case: * * A is stored in column form, with entries stored in the upper triangular * part. Entries in the lower triangular part are ignored. * * Unsymmetric case: * * A is stored in column form. If F is equal to the transpose of A, then * A*A' is analyzed. F can include a subset of the columns of A * (F=A(:,f)'), in which case F*F' is analyzed. * * Requires Parent and L->ColCount to be defined on input; these are the * simplicial Parent and ColCount arrays as computed by cholmod_rowcolcounts. * Does not use L->Perm; the input matrices A and F must already be properly * permuted. Allocates and computes the supernodal pattern of L (L->super, * L->pi, L->px, and L->s). Does not allocate the real part (L->x). * * Supports any xtype (pattern, real, complex, or zomplex). */ #ifndef NGPL #ifndef NSUPERNODAL #include "cholmod_internal.h" #include "cholmod_supernodal.h" #ifdef GPU_BLAS #include "cholmod_gpu.h" #endif /* ========================================================================== */ /* === subtree ============================================================== */ /* ========================================================================== */ /* In the symmetric case, traverse the kth row subtree from the nonzeros in * A (0:k1-1,k) and add the new entries found to the pattern of the kth row * of L. The current supernode s contains the diagonal block k1:k2-1, so it * can be skipped. * * In the unsymmetric case, the nonzero pattern of A*F is computed one column * at a time (thus, the total time spent in this function is bounded below by * the time taken to multiply A*F, which can be high if A is tall and thin). * The kth column is A*F(:,k), or the set union of all columns A(:,j) for which * F(j,k) is nonzero. This routine is called once for each entry j. Only the * upper triangular part is needed, so only A (0:k1-1,j) is accessed, where * k1:k2-1 are the columns of the current supernode s (k is in the range k1 to * k2-1). * * If A is sorted, then the total time taken by this function is proportional * to the number of nonzeros in the strictly block upper triangular part of A, * plus the number of entries in the strictly block lower triangular part of * the supernodal part of L. This excludes entries in the diagonal blocks * corresponding to the columns in each supernode. That is, if k1:k2-1 are * in a single supernode, then only A (0:k1-1,k1:k2-1) are accessed. * * For the unsymmetric case, only the strictly block upper triangular part * of A*F is constructed. * * Only adds column indices corresponding to the leading columns of each * relaxed supernode. */ static void subtree ( /* inputs, not modified: */ Int j, /* j = k for symmetric case */ Int k, Int Ap [ ], Int Ai [ ], Int Anz [ ], Int SuperMap [ ], Int Sparent [ ], Int mark, Int sorted, /* true if the columns of A are sorted */ Int k1, /* only consider A (0:k1-1,k) */ /* input/output: */ Int Flag [ ], Int Ls [ ], Int Lpi2 [ ] ) { Int p, pend, i, si ; p = Ap [j] ; pend = (Anz == NULL) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i < k1) { /* (i,k) is an entry in the upper triangular part of A or A*F'. * symmetric case: A(i,k) is nonzero (j=k). * unsymmetric case: A(i,j) and F(j,k) are both nonzero. * * Column i is in supernode si = SuperMap [i]. Follow path from si * to root of supernodal etree, stopping at the first flagged * supernode. The root of the row subtree is supernode SuperMap[k], * which is flagged already. This traversal will stop there, or it * might stop earlier if supernodes have been flagged by previous * calls to this routine for the same k. */ for (si = SuperMap [i] ; Flag [si] < mark ; si = Sparent [si]) { ASSERT (si <= SuperMap [k]) ; Ls [Lpi2 [si]++] = k ; Flag [si] = mark ; } } else if (sorted) { break ; } } } /* clear workspace used by cholmod_super_symbolic */ #define FREE_WORKSPACE \ { \ /* CHOLMOD(clear_flag) (Common) ; */ \ CHOLMOD_CLEAR_FLAG (Common) ; \ for (k = 0 ; k <= nfsuper ; k++) \ { \ Head [k] = EMPTY ; \ } \ ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; \ } \ /* ========================================================================== */ /* === cholmod_super_symbolic2 ============================================== */ /* ========================================================================== */ /* Analyze for supernodal Cholesky or multifrontal QR. */ int CHOLMOD(super_symbolic2) ( /* ---- input ---- */ int for_whom, /* FOR_SPQR (0): for SPQR but not GPU-accelerated FOR_CHOLESKY (1): for Cholesky (GPU or not) FOR_SPQRGPU (2): for SPQR with GPU acceleration */ cholmod_sparse *A, /* matrix to analyze */ cholmod_sparse *F, /* F = A' or A(:,f)' */ Int *Parent, /* elimination tree */ /* ---- in/out --- */ cholmod_factor *L, /* simplicial symbolic on input, * supernodal symbolic on output */ /* --------------- */ cholmod_common *Common ) { double zrelax0, zrelax1, zrelax2, xxsize ; Int *Wi, *Wj, *Super, *Snz, *Ap, *Ai, *Flag, *Head, *Ls, *Lpi, *Lpx, *Fnz, *Sparent, *Anz, *SuperMap, *Merged, *Nscol, *Zeros, *Fp, *Fj, *ColCount, *Lpi2, *Lsuper, *Iwork ; Int nsuper, d, n, j, k, s, mark, parent, p, pend, k1, k2, packed, nscol, nsrow, ndrow1, ndrow2, stype, ssize, xsize, sparent, plast, slast, csize, maxcsize, ss, nscol0, nscol1, ns, nfsuper, newzeros, totzeros, merge, snext, esize, maxesize, nrelax0, nrelax1, nrelax2, Asorted ; size_t w ; int ok = TRUE, find_xsize ; const char* env_use_gpu; const char* env_max_bytes; size_t max_bytes; const char* env_max_fraction; double max_fraction; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_NULL (Parent, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_PATTERN, FALSE) ; stype = A->stype ; if (stype < 0) { /* invalid symmetry; symmetric lower form not supported */ ERROR (CHOLMOD_INVALID, "symmetric lower not supported") ; return (FALSE) ; } if (stype == 0) { /* F must be present in the unsymmetric case */ RETURN_IF_NULL (F, FALSE) ; } if (L->is_super) { /* L must be a simplicial symbolic factor */ ERROR (CHOLMOD_INVALID, "L must be symbolic on input") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ n = A->nrow ; /* w = 5*n */ w = CHOLMOD(mult_size_t) (n, 5, &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (FALSE) ; } CHOLMOD(allocate_work) (n, w, 0, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (FALSE) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; /* ---------------------------------------------------------------------- */ /* allocate GPU workspace */ /* ---------------------------------------------------------------------- */ L->useGPU = 0 ; /* only used for Cholesky factorization, not QR */ #ifdef GPU_BLAS /* GPU module is installed */ if ( for_whom == CHOLMOD_ANALYZE_FOR_CHOLESKY ) { /* only allocate GPU workspace for supernodal Cholesky, and only when the GPU is requested and available. */ max_bytes = 0; max_fraction = 0; #ifdef DLONG if ( Common->useGPU == EMPTY ) { /* useGPU not explicity requested by the user, but not explicitly * prohibited either. Query OS environment variables for request.*/ env_use_gpu = getenv("CHOLMOD_USE_GPU"); if ( env_use_gpu ) { /* CHOLMOD_USE_GPU environment variable is set to something */ if ( atoi ( env_use_gpu ) == 0 ) { Common->useGPU = 0; /* don't use the gpu */ } else { Common->useGPU = 1; /* use the gpu */ env_max_bytes = getenv("CHOLMOD_GPU_MEM_BYTES"); env_max_fraction = getenv("CHOLMOD_GPU_MEM_FRACTION"); if ( env_max_bytes ) { max_bytes = atol(env_max_bytes); Common->maxGpuMemBytes = max_bytes; } if ( env_max_fraction ) { max_fraction = atof (env_max_fraction); if ( max_fraction < 0 ) max_fraction = 0; if ( max_fraction > 1 ) max_fraction = 1; Common->maxGpuMemFraction = max_fraction; } } } else { /* CHOLMOD_USE_GPU environment variable not set, so no GPU * acceleration will be used */ Common->useGPU = 0; } /* fprintf (stderr, "useGPU queried: %d\n", Common->useGPU) ; */ } /* Ensure that a GPU is present */ if ( Common->useGPU == 1 ) { /* fprintf (stderr, "\nprobe GPU:\n") ; */ Common->useGPU = CHOLMOD(gpu_probe) (Common); // Cholesky only, not SPQR /* fprintf (stderr, "\nprobe GPU: result %d\n", Common->useGPU) ; */ } if ( Common->useGPU == 1 ) { /* Cholesky + GPU, so allocate space */ /* fprintf (stderr, "allocate GPU:\n") ; */ CHOLMOD(gpu_allocate) ( Common ); // Cholesky only, not SPQR /* fprintf (stderr, "allocate GPU done\n") ; */ } #else /* GPU acceleration is only supported for long int version */ Common->useGPU = 0; #endif /* Cache the fact that the symbolic factorization supports * GPU acceleration */ L->useGPU = Common->useGPU; } #else /* GPU module is not installed */ Common->useGPU = 0 ; #endif /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ /* A is now either A or triu(A(p,p)) for the symmetric case. It is either * A or A(p,f) for the unsymmetric case (both in column form). It can be * either packed or unpacked, and either sorted or unsorted. Entries in * the lower triangular part may be present if A is symmetric, but these * are ignored. */ Ap = A->p ; Ai = A->i ; Anz = A->nz ; if (stype != 0) { /* F not accessed */ Fp = NULL ; Fj = NULL ; Fnz = NULL ; packed = TRUE ; } else { /* F = A(:,f) or A(p,f) in packed row form, either sorted or unsorted */ Fp = F->p ; Fj = F->i ; Fnz = F->nz ; packed = F->packed ; } ColCount = L->ColCount ; nrelax0 = Common->nrelax [0] ; nrelax1 = Common->nrelax [1] ; nrelax2 = Common->nrelax [2] ; zrelax0 = Common->zrelax [0] ; zrelax1 = Common->zrelax [1] ; zrelax2 = Common->zrelax [2] ; zrelax0 = IS_NAN (zrelax0) ? 0 : zrelax0 ; zrelax1 = IS_NAN (zrelax1) ? 0 : zrelax1 ; zrelax2 = IS_NAN (zrelax2) ? 0 : zrelax2 ; ASSERT (CHOLMOD(dump_parent) (Parent, n, "Parent", Common)) ; /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ /* Sparent, Snz, and Merged could be allocated later, of size nfsuper */ Iwork = Common->Iwork ; Wi = Iwork ; /* size n (i/l/l). Lpi2 is i/l/l */ Wj = Iwork + n ; /* size n (i/l/l). Zeros is i/l/l */ Sparent = Iwork + 2*((size_t) n) ; /* size nfsuper <= n [ */ Snz = Iwork + 3*((size_t) n) ; /* size nfsuper <= n [ */ Merged = Iwork + 4*((size_t) n) ; /* size nfsuper <= n [ */ Flag = Common->Flag ; /* size n */ Head = Common->Head ; /* size n+1 */ /* ---------------------------------------------------------------------- */ /* find the fundamental supernodes */ /* ---------------------------------------------------------------------- */ /* count the number of children of each node, using Wi [ */ for (j = 0 ; j < n ; j++) { Wi [j] = 0 ; } for (j = 0 ; j < n ; j++) { parent = Parent [j] ; if (parent != EMPTY) { Wi [parent]++ ; } } Super = Head ; /* use Head [0..nfsuper] as workspace for Super list ( */ /* column 0 always starts a new supernode */ nfsuper = (n == 0) ? 0 : 1 ; /* number of fundamental supernodes */ Super [0] = 0 ; for (j = 1 ; j < n ; j++) { /* check if j starts new supernode, or in the same supernode as j-1 */ if (Parent [j-1] != j /* parent of j-1 is not j */ || (ColCount [j-1] != ColCount [j] + 1) /* j-1 not subset of j*/ || Wi [j] > 1 /* j has more than one child */ #ifdef GPU_BLAS /* Ensure that the supernode will fit in the GPU buffers */ /* Data size of 16 bytes must be assumed for case of PATTERN */ || (for_whom == CHOLMOD_ANALYZE_FOR_CHOLESKY && L->useGPU && (j-Super[nfsuper-1]+1) * ColCount[Super[nfsuper-1]] * sizeof(double) * 2 >= Common->devBuffSize) #endif ) { /* j is the leading node of a supernode */ Super [nfsuper++] = j ; } } Super [nfsuper] = n ; /* contents of Wi no longer needed for child count ] */ Nscol = Wi ; /* use Wi as size-nfsuper workspace for Nscol [ */ /* ---------------------------------------------------------------------- */ /* find the mapping of fundamental nodes to supernodes */ /* ---------------------------------------------------------------------- */ SuperMap = Wj ; /* use Wj as workspace for SuperMap [ */ /* SuperMap [k] = s if column k is contained in supernode s */ for (s = 0 ; s < nfsuper ; s++) { for (k = Super [s] ; k < Super [s+1] ; k++) { SuperMap [k] = s ; } } /* ---------------------------------------------------------------------- */ /* construct the fundamental supernodal etree */ /* ---------------------------------------------------------------------- */ for (s = 0 ; s < nfsuper ; s++) { j = Super [s+1] - 1 ; /* last node in supernode s */ parent = Parent [j] ; /* parent of last node */ Sparent [s] = (parent == EMPTY) ? EMPTY : SuperMap [parent] ; PRINT1 (("Sparent ["ID"] = "ID"\n", s, Sparent [s])) ; } /* contents of Wj no longer needed as workspace for SuperMap ] * SuperMap will be recomputed below, for the relaxed supernodes. */ Zeros = Wj ; /* use Wj for Zeros, workspace of size nfsuper [ */ /* ---------------------------------------------------------------------- */ /* relaxed amalgamation */ /* ---------------------------------------------------------------------- */ for (s = 0 ; s < nfsuper ; s++) { Merged [s] = EMPTY ; /* s not merged into another */ Nscol [s] = Super [s+1] - Super [s] ; /* # of columns in s */ Zeros [s] = 0 ; /* # of zero entries in s */ ASSERT (s <= Super [s]) ; Snz [s] = ColCount [Super [s]] ; /* # of entries in leading col of s */ PRINT2 (("lnz ["ID"] "ID"\n", s, Snz [s])) ; } for (s = nfsuper-2 ; s >= 0 ; s--) { double lnz1 ; /* should supernodes s and s+1 merge into a new node s? */ PRINT1 (("\n========= Check relax of s "ID" and s+1 "ID"\n", s, s+1)) ; ss = Sparent [s] ; if (ss == EMPTY) { PRINT1 (("s "ID" is a root, no merge with s+1 = "ID"\n", s, s+1)) ; continue ; } /* find the current parent of s (perform path compression as needed) */ for (ss = Sparent [s] ; Merged [ss] != EMPTY ; ss = Merged [ss]) ; sparent = ss ; PRINT2 (("Current sparent of s "ID" is "ID"\n", s, sparent)) ; /* ss is the current parent of s */ for (ss = Sparent [s] ; Merged [ss] != EMPTY ; ss = snext) { snext = Merged [ss] ; PRINT2 (("ss "ID" is dead, merged into snext "ID"\n", ss, snext)) ; Merged [ss] = sparent ; } /* if s+1 is not the current parent of s, do not merge */ if (sparent != s+1) { continue ; } nscol0 = Nscol [s] ; /* # of columns in s */ nscol1 = Nscol [s+1] ; /* # of columns in s+1 */ ns = nscol0 + nscol1 ; PRINT2 (("ns "ID" nscol0 "ID" nscol1 "ID"\n", ns, nscol0, nscol1)) ; totzeros = Zeros [s+1] ; /* current # of zeros in s+1 */ lnz1 = (double) (Snz [s+1]) ; /* # entries in leading column of s+1 */ /* determine if supernodes s and s+1 should merge */ if (ns <= nrelax0) { PRINT2 (("ns is tiny ("ID"), so go ahead and merge\n", ns)) ; merge = TRUE ; } else { /* use double to avoid integer overflow */ double lnz0 = Snz [s] ; /* # entries in leading column of s */ double xnewzeros = nscol0 * (lnz1 + nscol0 - lnz0) ; /* use Int for the final update of Zeros [s] below */ newzeros = nscol0 * (Snz [s+1] + nscol0 - Snz [s]) ; ASSERT (newzeros == xnewzeros) ; PRINT2 (("lnz0 %g lnz1 %g xnewzeros %g\n", lnz0, lnz1, xnewzeros)) ; if (xnewzeros == 0) { /* no new zeros, so go ahead and merge */ PRINT2 (("no new fillin, so go ahead and merge\n")) ; merge = TRUE ; } else { /* # of zeros if merged */ double xtotzeros = ((double) totzeros) + xnewzeros ; /* xtotsize: total size of merged supernode, if merged: */ double xns = (double) ns ; double xtotsize = (xns * (xns+1) / 2) + xns * (lnz1 - nscol1) ; double z = xtotzeros / xtotsize ; Int totsize ; totsize = (ns * (ns+1) / 2) + ns * (Snz [s+1] - nscol1) ; PRINT2 (("oldzeros "ID" newzeros "ID" xtotsize %g z %g\n", Zeros [s+1], newzeros, xtotsize, z)) ; /* use Int for the final update of Zeros [s] below */ totzeros += newzeros ; /* do not merge if supernode would become too big * (Int overflow). Continue computing; not (yet) an error. */ /* fl.pt. compare, but no NaN's can occur here */ merge = ((ns <= nrelax1 && z < zrelax0) || (ns <= nrelax2 && z < zrelax1) || (z < zrelax2)) && (xtotsize < Int_max / sizeof (double)) ; } } #ifdef GPU_BLAS if ( for_whom == CHOLMOD_ANALYZE_FOR_CHOLESKY && L->useGPU ) { /* Ensure that the aggregated supernode fits in the device supernode buffers */ double xns = (double) ns; if ( ((xns * xns) + xns * (lnz1 - nscol1))*sizeof(double)*2 >= Common->devBuffSize ) { merge = FALSE; } } #endif if (merge) { PRINT1 (("Merge node s ("ID") and s+1 ("ID")\n", s, s+1)) ; Zeros [s] = totzeros ; Merged [s+1] = s ; Snz [s] = nscol0 + Snz [s+1] ; Nscol [s] += Nscol [s+1] ; } } /* contents of Wj no longer needed for Zeros ] */ /* contents of Wi no longer needed for Nscol ] */ /* contents of Sparent no longer needed (recomputed below) */ /* ---------------------------------------------------------------------- */ /* construct the relaxed supernode list */ /* ---------------------------------------------------------------------- */ nsuper = 0 ; for (s = 0 ; s < nfsuper ; s++) { if (Merged [s] == EMPTY) { PRINT1 (("live supernode: "ID" snz "ID"\n", s, Snz [s])) ; Super [nsuper] = Super [s] ; Snz [nsuper] = Snz [s] ; nsuper++ ; } } Super [nsuper] = n ; PRINT1 (("Fundamental supernodes: "ID" relaxed "ID"\n", nfsuper, nsuper)) ; /* Merged no longer needed ] */ /* ---------------------------------------------------------------------- */ /* find the mapping of relaxed nodes to supernodes */ /* ---------------------------------------------------------------------- */ /* use Wj as workspace for SuperMap { */ /* SuperMap [k] = s if column k is contained in supernode s */ for (s = 0 ; s < nsuper ; s++) { for (k = Super [s] ; k < Super [s+1] ; k++) { SuperMap [k] = s ; } } /* ---------------------------------------------------------------------- */ /* construct the relaxed supernodal etree */ /* ---------------------------------------------------------------------- */ for (s = 0 ; s < nsuper ; s++) { j = Super [s+1] - 1 ; /* last node in supernode s */ parent = Parent [j] ; /* parent of last node */ Sparent [s] = (parent == EMPTY) ? EMPTY : SuperMap [parent] ; PRINT1 (("new Sparent ["ID"] = "ID"\n", s, Sparent [s])) ; } /* ---------------------------------------------------------------------- */ /* determine the size of L->s and L->x */ /* ---------------------------------------------------------------------- */ ssize = 0 ; xsize = 0 ; xxsize = 0 ; find_xsize = for_whom == CHOLMOD_ANALYZE_FOR_CHOLESKY || for_whom == CHOLMOD_ANALYZE_FOR_SPQRGPU ; for (s = 0 ; s < nsuper ; s++) { nscol = Super [s+1] - Super [s] ; nsrow = Snz [s] ; ASSERT (nscol > 0) ; ssize += nsrow ; if (find_xsize) { xsize += nscol * nsrow ; /* also compute xsize in double to guard against Int overflow */ xxsize += ((double) nscol) * ((double) nsrow) ; } if (ssize < 0 ||(find_xsize && xxsize > Int_max)) { /* Int overflow, clear workspace and return. QR factorization will not use xxsize, so that error is ignored. For Cholesky factorization, however, memory of space xxsize will be allocated, so this is a failure. Both QR and Cholesky fail if ssize overflows. */ ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; FREE_WORKSPACE ; return (FALSE) ; } ASSERT (ssize > 0) ; ASSERT (IMPLIES (find_xsize, xsize > 0)) ; } xsize = MAX (1, xsize) ; ssize = MAX (1, ssize) ; PRINT1 (("ix sizes: "ID" "ID" nsuper "ID"\n", ssize, xsize, nsuper)) ; /* ---------------------------------------------------------------------- */ /* allocate L (all except real part L->x) */ /* ---------------------------------------------------------------------- */ L->ssize = ssize ; L->xsize = xsize ; L->nsuper = nsuper ; CHOLMOD(change_factor) (CHOLMOD_PATTERN, TRUE, TRUE, TRUE, TRUE, L, Common); if (Common->status < CHOLMOD_OK) { /* out of memory; L is still a valid simplicial symbolic factor */ FREE_WORKSPACE ; return (FALSE) ; } DEBUG (CHOLMOD(dump_factor) (L, "L to symbolic super", Common)) ; ASSERT (L->is_ll && L->xtype == CHOLMOD_PATTERN && L->is_super) ; Lpi = L->pi ; Lpx = L->px ; Ls = L->s ; Ls [0] = 0 ; /* flag for cholmod_check_factor; supernodes are defined */ Lsuper = L->super ; /* copy the list of relaxed supernodes into the final list in L */ for (s = 0 ; s <= nsuper ; s++) { Lsuper [s] = Super [s] ; } /* Head no longer needed as workspace for fundamental Super list ) */ Super = Lsuper ; /* Super is now the list of relaxed supernodes */ /* ---------------------------------------------------------------------- */ /* construct column pointers of relaxed supernodal pattern (L->pi) */ /* ---------------------------------------------------------------------- */ p = 0 ; for (s = 0 ; s < nsuper ; s++) { Lpi [s] = p ; p += Snz [s] ; PRINT1 (("Snz ["ID"] = "ID", Super ["ID"] = "ID"\n", s, Snz [s], s, Super[s])) ; } Lpi [nsuper] = p ; ASSERT ((Int) (L->ssize) == MAX (1,p)) ; /* ---------------------------------------------------------------------- */ /* construct pointers for supernodal values (L->px) */ /* ---------------------------------------------------------------------- */ if (for_whom == CHOLMOD_ANALYZE_FOR_CHOLESKY || for_whom == CHOLMOD_ANALYZE_FOR_SPQRGPU) { Lpx [0] = 0 ; p = 0 ; for (s = 0 ; s < nsuper ; s++) { nscol = Super [s+1] - Super [s] ; /* number of columns in s */ nsrow = Snz [s] ; /* # of rows, incl triangular part*/ Lpx [s] = p ; /* pointer to numerical part of s */ p += nscol * nsrow ; } Lpx [s] = p ; ASSERT ((Int) (L->xsize) == MAX (1,p)) ; } else { /* L->px is not needed for non-GPU accelerated QR factorization (it may * lead to Int overflow, anyway, if xsize caused Int overflow above). * Use a magic number to tell cholmod_check_factor to ignore Lpx. */ Lpx [0] = 123456 ; } /* Snz no longer needed ] */ /* ---------------------------------------------------------------------- */ /* symbolic analysis to construct the relaxed supernodal pattern (L->s) */ /* ---------------------------------------------------------------------- */ Lpi2 = Wi ; /* copy Lpi into Lpi2, using Wi as workspace for Lpi2 [ */ for (s = 0 ; s < nsuper ; s++) { Lpi2 [s] = Lpi [s] ; } Asorted = A->sorted ; for (s = 0 ; s < nsuper ; s++) { /* sth supernode is in columns k1 to k2-1. * compute nonzero pattern of L (k1:k2-1,:). */ /* place rows k1 to k2-1 in leading column of supernode s */ k1 = Super [s] ; k2 = Super [s+1] ; PRINT1 (("=========>>> Supernode "ID" k1 "ID" k2-1 "ID"\n", s, k1, k2-1)) ; for (k = k1 ; k < k2 ; k++) { Ls [Lpi2 [s]++] = k ; } /* compute nonzero pattern each row k1 to k2-1 */ for (k = k1 ; k < k2 ; k++) { /* compute row k of L. In the symmetric case, the pattern of L(k,:) * is the set of nodes reachable in the supernodal etree from any * row i in the nonzero pattern of A(0:k,k). In the unsymmetric * case, the pattern of the kth column of A*A' is the set union * of all columns A(0:k,j) for each nonzero F(j,k). */ /* clear the Flag array and mark the current supernode */ /* mark = CHOLMOD(clear_flag) (Common) ; */ CHOLMOD_CLEAR_FLAG (Common) ; mark = Common->mark ; Flag [s] = mark ; ASSERT (s == SuperMap [k]) ; /* traverse the row subtree for each nonzero in A or AA' */ if (stype != 0) { subtree (k, k, Ap, Ai, Anz, SuperMap, Sparent, mark, Asorted, k1, Flag, Ls, Lpi2) ; } else { /* for each j nonzero in F (:,k) do */ p = Fp [k] ; pend = (packed) ? (Fp [k+1]) : (p + Fnz [k]) ; for ( ; p < pend ; p++) { subtree (Fj [p], k, Ap, Ai, Anz, SuperMap, Sparent, mark, Asorted, k1, Flag, Ls, Lpi2) ; } } } } #ifndef NDEBUG for (s = 0 ; s < nsuper ; s++) { PRINT1 (("Lpi2[s] "ID" Lpi[s+1] "ID"\n", Lpi2 [s], Lpi [s+1])) ; ASSERT (Lpi2 [s] == Lpi [s+1]) ; CHOLMOD(dump_super) (s, Super, Lpi, Ls, NULL, NULL, 0, Common) ; } #endif /* contents of Wi no longer needed for Lpi2 ] */ /* Sparent no longer needed ] */ /* ---------------------------------------------------------------------- */ /* determine the largest update matrix (L->maxcsize) */ /* ---------------------------------------------------------------------- */ /* maxcsize could be determined before L->s is allocated and defined, which * would mean that all memory requirements for both the symbolic and numeric * factorizations could be computed using O(nnz(A)+O(n)) space. However, it * would require a lot of extra work. The analysis phase, above, would need * to be duplicated, but with Ls not kept; instead, the algorithm would keep * track of the current s and slast for each supernode d, and update them * when a new row index appears in supernode d. An alternative would be to * do this computation only if the allocation of L->s failed, in which case * the following code would be skipped. * * The csize for a supernode is the size of its largest contribution to * a subsequent ancestor supernode. For example, suppose the rows of #'s * in the figure below correspond to the columns of a subsequent supernode, * and the dots are the entries in that ancestore. * * c * c c * c c c * x x x * x x x * # # # . * # # # . . * * * * . . * * * * . . * * * * . . * . . * * Then for this update, the csize is 3-by-2, or 6, because there are 3 * rows of *'s which is the number of rows in the update, and there are * 2 rows of #'s, which is the number columns in the update. The csize * of a supernode is the largest such contribution for any ancestor * supernode. maxcsize, for the whole matrix, has a rough upper bound of * the maximum size of any supernode. This bound is loose, because the * the contribution must be less than the size of the ancestor supernodal * that it's updating. maxcsize of a completely dense matrix, with one * supernode, is zero. * * maxesize is the column dimension for the workspace E needed for the * solve. E is of size nrhs-by-maxesize, where the nrhs is the number of * columns in the right-hand-side. The maxesize is the largest esize of * any supernode. The esize of a supernode is the number of row indices * it contains, excluding the column indices of the supernode itself. * For the following example, esize is 4: * * c * c c * c c c * x x x * x x x * x x x * x x x * * maxesize can be no bigger than n. */ maxcsize = 1 ; maxesize = 1 ; /* Do not need to guard csize against Int overflow since xsize is OK. */ if (for_whom == CHOLMOD_ANALYZE_FOR_CHOLESKY || for_whom == CHOLMOD_ANALYZE_FOR_SPQRGPU) { /* this is not needed for non-GPU accelerated QR factorization */ for (d = 0 ; d < nsuper ; d++) { nscol = Super [d+1] - Super [d] ; p = Lpi [d] + nscol ; plast = p ; pend = Lpi [d+1] ; esize = pend - p ; maxesize = MAX (maxesize, esize) ; slast = (p == pend) ? (EMPTY) : (SuperMap [Ls [p]]) ; for ( ; p <= pend ; p++) { s = (p == pend) ? (EMPTY) : (SuperMap [Ls [p]]) ; if (s != slast) { /* row i is the start of a new supernode */ ndrow1 = p - plast ; ndrow2 = pend - plast ; csize = ndrow2 * ndrow1 ; PRINT1 (("Supernode "ID" ancestor "ID" C: "ID"-by-"ID " csize "ID"\n", d, slast, ndrow1, ndrow2, csize)) ; maxcsize = MAX (maxcsize, csize) ; plast = p ; slast = s ; } } } PRINT1 (("max csize "ID"\n", maxcsize)) ; } /* Wj no longer needed for SuperMap } */ L->maxcsize = maxcsize ; L->maxesize = maxesize ; L->is_super = TRUE ; ASSERT (L->xtype == CHOLMOD_PATTERN && L->is_ll) ; /* ---------------------------------------------------------------------- */ /* supernodal symbolic factorization is complete */ /* ---------------------------------------------------------------------- */ FREE_WORKSPACE ; return (TRUE) ; } /* ========================================================================== */ /* === cholmod_super_symbolic =============================================== */ /* ========================================================================== */ /* Analyzes A, AA', or A(:,f)*A(:,f)' in preparation for a supernodal numeric * factorization. The user need not call this directly; cholmod_analyze is * a "simple" wrapper for this routine. * * This function does all the analysis for a supernodal Cholesky factorization. * * workspace: Flag (nrow), Head (nrow), Iwork (2*nrow), * and temporary space of size 3*nfsuper*sizeof(Int), where nfsuper <= n * is the number of fundamental supernodes. */ int CHOLMOD(super_symbolic) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to analyze */ cholmod_sparse *F, /* F = A' or A(:,f)' */ Int *Parent, /* elimination tree */ /* ---- in/out --- */ cholmod_factor *L, /* simplicial symbolic on input, * supernodal symbolic on output */ /* --------------- */ cholmod_common *Common ) { return (CHOLMOD(super_symbolic2) (CHOLMOD_ANALYZE_FOR_CHOLESKY, A, F, Parent, L, Common)) ; } #endif #endif Matrix/src/CHOLMOD/Supernodal/t_cholmod_super_numeric.c0000644000176200001440000012276613652535054022610 0ustar liggesusers/* ========================================================================== */ /* === Supernodal/t_cholmod_super_numeric =================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Supernodal Module. Copyright (C) 2005-2012, Timothy A. Davis * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* Template routine for cholmod_super_numeric. All xtypes supported, except * that a zomplex A and F result in a complex L (there is no supernodal * zomplex L). */ /* ========================================================================== */ /* === complex arithmetic =================================================== */ /* ========================================================================== */ #include "cholmod_template.h" #undef L_ENTRY #undef L_CLEAR #undef L_ASSIGN #undef L_MULTADD #undef L_ASSEMBLE #undef L_ASSEMBLESUB #ifdef REAL /* -------------------------------------------------------------------------- */ /* A, F, and L are all real */ /* -------------------------------------------------------------------------- */ #define L_ENTRY 1 #define L_CLEAR(Lx,p) Lx [p] = 0 #define L_ASSIGN(Lx,q, Ax,Az,p) Lx [q] = Ax [p] #define L_MULTADD(Lx,q, Ax,Az,p, f) Lx [q] += Ax [p] * f [0] #define L_ASSEMBLE(Lx,q,b) Lx [q] += b [0] #define L_ASSEMBLESUB(Lx,q,C,p) Lx [q] -= C [p] #else /* -------------------------------------------------------------------------- */ /* A and F are complex or zomplex, L and C are complex */ /* -------------------------------------------------------------------------- */ #define L_ENTRY 2 #define L_CLEAR(Lx,p) Lx [2*(p)] = 0 ; Lx [2*(p)+1] = 0 #define L_ASSEMBLE(Lx,q,b) Lx [2*(q)] += b [0] ; #define L_ASSEMBLESUB(Lx,q,C,p) \ Lx [2*(q) ] -= C [2*(p) ] ; \ Lx [2*(q)+1] -= C [2*(p)+1] ; #ifdef COMPLEX /* -------------------------------------------------------------------------- */ /* A, F, L, and C are all complex */ /* -------------------------------------------------------------------------- */ #define L_ASSIGN(Lx,q, Ax,Az,p) \ Lx [2*(q) ] = Ax [2*(p) ] ; \ Lx [2*(q)+1] = Ax [2*(p)+1] #define L_MULTADD(Lx,q, Ax,Az,p, f) \ Lx [2*(q) ] += Ax [2*(p) ] * f [0] - Ax [2*(p)+1] * f [1] ; \ Lx [2*(q)+1] += Ax [2*(p)+1] * f [0] + Ax [2*(p) ] * f [1] #else /* -------------------------------------------------------------------------- */ /* A and F are zomplex, L and C is complex */ /* -------------------------------------------------------------------------- */ #define L_ASSIGN(Lx,q, Ax,Az,p) \ Lx [2*(q) ] = Ax [p] ; \ Lx [2*(q)+1] = Az [p] ; #define L_MULTADD(Lx,q, Ax,Az,p, f) \ Lx [2*(q) ] += Ax [p] * f [0] - Az [p] * f [1] ; \ Lx [2*(q)+1] += Az [p] * f [0] + Ax [p] * f [1] #endif #endif /* ========================================================================== */ /* === t_cholmod_super_numeric ============================================== */ /* ========================================================================== */ /* This function returns FALSE only if integer overflow occurs in the BLAS. * It returns TRUE otherwise whether or not the matrix is positive definite. */ static int TEMPLATE (cholmod_super_numeric) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to factorize */ cholmod_sparse *F, /* F = A' or A(:,f)' */ double beta [2], /* beta*I is added to diagonal of matrix to factorize */ /* ---- in/out --- */ cholmod_factor *L, /* factorization */ /* -- workspace -- */ cholmod_dense *Cwork, /* size (L->maxcsize)-by-1 */ /* --------------- */ cholmod_common *Common ) { double one [2], zero [2], tstart ; double *Lx, *Ax, *Fx, *Az, *Fz, *C ; Int *Super, *Head, *Ls, *Lpi, *Lpx, *Map, *SuperMap, *RelativeMap, *Next, *Lpos, *Fp, *Fi, *Fnz, *Ap, *Ai, *Anz, *Iwork, *Next_save, *Lpos_save, *Previous; Int nsuper, n, j, i, k, s, p, pend, k1, k2, nscol, psi, psx, psend, nsrow, pj, d, kd1, kd2, info, ndcol, ndrow, pdi, pdx, pdend, pdi1, pdi2, pdx1, ndrow1, ndrow2, px, dancestor, sparent, dnext, nsrow2, ndrow3, pk, pf, pfend, stype, Apacked, Fpacked, q, imap, repeat_supernode, nscol2, ss, tail, nscol_new = 0; /* ---------------------------------------------------------------------- */ /* declarations for the GPU */ /* ---------------------------------------------------------------------- */ /* these variables are not used if the GPU module is not installed */ #ifdef GPU_BLAS Int ndescendants, mapCreatedOnGpu, supernodeUsedGPU, idescendant, dlarge, dsmall, skips ; int iHostBuff, iDevBuff, useGPU, GPUavailable ; cholmod_gpu_pointers *gpu_p, gpu_pointer_struct ; gpu_p = &gpu_pointer_struct ; #endif /* ---------------------------------------------------------------------- */ /* guard against integer overflow in the BLAS */ /* ---------------------------------------------------------------------- */ /* If integer overflow occurs in the BLAS, Common->status is set to * CHOLMOD_TOO_LARGE, and the contents of Lx are undefined. */ Common->blas_ok = TRUE ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ nsuper = L->nsuper ; n = L->n ; C = Cwork->x ; /* workspace of size L->maxcsize */ one [0] = 1.0 ; /* ALPHA for *syrk, *herk, *gemm, and *trsm */ one [1] = 0. ; zero [0] = 0. ; /* BETA for *syrk, *herk, and *gemm */ zero [1] = 0. ; /* Iwork must be of size 2n + 5*nsuper, allocated in the caller, * cholmod_super_numeric. The memory cannot be allocated here because the * cholmod_super_numeric initializes SuperMap, and cholmod_allocate_work * does not preserve existing workspace if the space needs to be increase * in size. */ /* allocate integer workspace */ Iwork = Common->Iwork ; SuperMap = Iwork ; /* size n (i/i/l) */ RelativeMap = Iwork + n ; /* size n (i/i/l) */ Next = Iwork + 2*((size_t) n) ; /* size nsuper*/ Lpos = Iwork + 2*((size_t) n) + nsuper ; /* size nsuper*/ Next_save = Iwork + 2*((size_t) n) + 2*((size_t) nsuper) ;/* size nsuper*/ Lpos_save = Iwork + 2*((size_t) n) + 3*((size_t) nsuper) ;/* size nsuper*/ Previous = Iwork + 2*((size_t) n) + 4*((size_t) nsuper) ;/* size nsuper*/ Map = Common->Flag ; /* size n, use Flag as workspace for Map array */ Head = Common->Head ; /* size n+1, only Head [0..nsuper-1] used */ Ls = L->s ; Lpi = L->pi ; Lpx = L->px ; Super = L->super ; Lx = L->x ; #ifdef GPU_BLAS /* local copy of useGPU */ if ( (Common->useGPU == 1) && L->useGPU) { /* Initialize the GPU. If not found, don't use it. */ useGPU = TEMPLATE2 (CHOLMOD (gpu_init)) (C, L, Common, nsuper, n, Lpi[nsuper]-Lpi[0], gpu_p) ; } else { useGPU = 0; } /* fprintf (stderr, "local useGPU %d\n", useGPU) ; */ #endif #ifndef NTIMER /* clear GPU / CPU statistics */ Common->CHOLMOD_CPU_GEMM_CALLS = 0 ; Common->CHOLMOD_CPU_SYRK_CALLS = 0 ; Common->CHOLMOD_CPU_TRSM_CALLS = 0 ; Common->CHOLMOD_CPU_POTRF_CALLS = 0 ; Common->CHOLMOD_GPU_GEMM_CALLS = 0 ; Common->CHOLMOD_GPU_SYRK_CALLS = 0 ; Common->CHOLMOD_GPU_TRSM_CALLS = 0 ; Common->CHOLMOD_GPU_POTRF_CALLS = 0 ; Common->CHOLMOD_CPU_GEMM_TIME = 0 ; Common->CHOLMOD_CPU_SYRK_TIME = 0 ; Common->CHOLMOD_CPU_TRSM_TIME = 0 ; Common->CHOLMOD_CPU_POTRF_TIME = 0 ; Common->CHOLMOD_GPU_GEMM_TIME = 0 ; Common->CHOLMOD_GPU_SYRK_TIME = 0 ; Common->CHOLMOD_GPU_TRSM_TIME = 0 ; Common->CHOLMOD_GPU_POTRF_TIME = 0 ; Common->CHOLMOD_ASSEMBLE_TIME = 0 ; Common->CHOLMOD_ASSEMBLE_TIME2 = 0 ; #endif stype = A->stype ; if (stype != 0) { /* F not accessed */ Fp = NULL ; Fi = NULL ; Fx = NULL ; Fz = NULL ; Fnz = NULL ; Fpacked = TRUE ; } else { Fp = F->p ; Fi = F->i ; Fx = F->x ; Fz = F->z ; Fnz = F->nz ; Fpacked = F->packed ; } Ap = A->p ; Ai = A->i ; Ax = A->x ; Az = A->z ; Anz = A->nz ; Apacked = A->packed ; /* clear the Map so that changes in the pattern of A can be detected */ #pragma omp parallel for num_threads(CHOLMOD_OMP_NUM_THREADS) \ if ( n > 128 ) schedule (static) for (i = 0 ; i < n ; i++) { Map [i] = EMPTY ; } /* If the matrix is not positive definite, the supernode s containing the * first zero or negative diagonal entry of L is repeated (but factorized * only up to just before the problematic diagonal entry). The purpose is * to provide MATLAB with [R,p]=chol(A); columns 1 to p-1 of L=R' are * required, where L(p,p) is the problematic diagonal entry. The * repeat_supernode flag tells us whether this is the repeated supernode. * Once supernode s is repeated, the factorization is terminated. */ repeat_supernode = FALSE ; #ifdef GPU_BLAS if ( useGPU ) { /* Case of GPU, zero all supernodes at one time for better performance*/ TEMPLATE2 (CHOLMOD (gpu_clear_memory))(Lx, L->xsize, CHOLMOD_OMP_NUM_THREADS); } #endif /* ---------------------------------------------------------------------- */ /* supernodal numerical factorization */ /* ---------------------------------------------------------------------- */ for (s = 0 ; s < nsuper ; s++) { /* ------------------------------------------------------------------ */ /* get the size of supernode s */ /* ------------------------------------------------------------------ */ k1 = Super [s] ; /* s contains columns k1 to k2-1 of L */ k2 = Super [s+1] ; nscol = k2 - k1 ; /* # of columns in all of s */ psi = Lpi [s] ; /* pointer to first row of s in Ls */ psx = Lpx [s] ; /* pointer to first row of s in Lx */ psend = Lpi [s+1] ; /* pointer just past last row of s in Ls */ nsrow = psend - psi ; /* # of rows in all of s */ PRINT1 (("====================================================\n" "S "ID" k1 "ID" k2 "ID" nsrow "ID" nscol "ID" psi "ID" psend " ""ID" psx "ID"\n", s, k1, k2, nsrow, nscol, psi, psend, psx)) ; /* ------------------------------------------------------------------ */ /* zero the supernode s */ /* ------------------------------------------------------------------ */ ASSERT ((size_t) (psx + nsrow*nscol) <= L->xsize) ; pend = psx + nsrow * nscol ; /* s is nsrow-by-nscol */ #ifdef GPU_BLAS if ( !useGPU ) #endif { /* Case of no GPU, zero individual supernodes */ #pragma omp parallel for num_threads(CHOLMOD_OMP_NUM_THREADS) \ schedule (static) if ( pend - psx > 1024 ) for (p = psx ; p < pend ; p++) { L_CLEAR (Lx,p); } } /* ------------------------------------------------------------------ */ /* construct the scattered Map for supernode s */ /* ------------------------------------------------------------------ */ /* If row i is the kth row in s, then Map [i] = k. Similarly, if * column j is the kth column in s, then Map [j] = k. */ #pragma omp parallel for num_threads(CHOLMOD_OMP_NUM_THREADS) \ if ( nsrow > 128 ) for (k = 0 ; k < nsrow ; k++) { PRINT1 ((" "ID" map "ID"\n", Ls [psi+k], k)) ; Map [Ls [psi + k]] = k ; } /* ------------------------------------------------------------------ */ /* when using GPU, reorder supernodes by levels.*/ /* (all supernodes in a level are independent) */ /* ------------------------------------------------------------------ */ #ifdef GPU_BLAS if ( useGPU ) { TEMPLATE2 (CHOLMOD (gpu_reorder_descendants)) ( Common, Super, &s, Lpi, Lpos, Head, Next, Previous, &ndescendants, &tail, &mapCreatedOnGpu, gpu_p ) ; } #endif /* ------------------------------------------------------------------ */ /* copy matrix into supernode s (lower triangular part only) */ /* ------------------------------------------------------------------ */ pk = psx ; #pragma omp parallel for private ( p, pend, pfend, pf, i, j, imap, q ) \ num_threads(CHOLMOD_OMP_NUM_THREADS) if ( k2-k1 > 64 ) for (k = k1 ; k < k2 ; k++) { if (stype != 0) { /* copy the kth column of A into the supernode */ p = Ap [k] ; pend = (Apacked) ? (Ap [k+1]) : (p + Anz [k]) ; for ( ; p < pend ; p++) { /* row i of L is located in row Map [i] of s */ i = Ai [p] ; if (i >= k) { /* This test is here simply to avoid a segfault. If * the test is false, the numeric factorization of A * is undefined. It does not detect all invalid * entries, only some of them (when debugging is * enabled, and Map is cleared after each step, then * all entries not in the pattern of L are detected). */ imap = Map [i] ; if (imap >= 0 && imap < nsrow) { /* Lx [Map [i] + pk] = Ax [p] ; */ L_ASSIGN (Lx,(imap+(psx+(k-k1)*nsrow)), Ax,Az,p) ; } } } } else { double fjk[2]; /* copy the kth column of A*F into the supernode */ pf = Fp [k] ; pfend = (Fpacked) ? (Fp [k+1]) : (p + Fnz [k]) ; for ( ; pf < pfend ; pf++) { j = Fi [pf] ; /* fjk = Fx [pf] ; */ L_ASSIGN (fjk,0, Fx,Fz,pf) ; p = Ap [j] ; pend = (Apacked) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i >= k) { /* See the discussion of imap above. */ imap = Map [i] ; if (imap >= 0 && imap < nsrow) { /* Lx [Map [i] + pk] += Ax [p] * fjk ; */ L_MULTADD (Lx,(imap+(psx+(k-k1)*nsrow)), Ax,Az,p, fjk) ; } } } } } } /* add beta to the diagonal of the supernode, if nonzero */ if (beta [0] != 0.0) { /* note that only the real part of beta is used */ pk = psx ; for (k = k1 ; k < k2 ; k++) { /* Lx [pk] += beta [0] ; */ L_ASSEMBLE (Lx,pk, beta) ; pk += nsrow + 1 ; /* advance to the next diagonal entry */ } } PRINT1 (("Supernode with just A: repeat: "ID"\n", repeat_supernode)) ; DEBUG (CHOLMOD(dump_super) (s, Super, Lpi, Ls, Lpx, Lx, L_ENTRY, Common)) ; PRINT1 (("\n\n")) ; /* ------------------------------------------------------------------ */ /* save/restore the list of supernodes */ /* ------------------------------------------------------------------ */ if (!repeat_supernode) { /* Save the list of pending descendants in case s is not positive * definite. Also save Lpos for each descendant d, so that we can * find which part of d is used to update s. */ for (d = Head [s] ; d != EMPTY ; d = Next [d]) { Lpos_save [d] = Lpos [d] ; Next_save [d] = Next [d] ; } } else { for (d = Head [s] ; d != EMPTY ; d = Next [d]) { Lpos [d] = Lpos_save [d] ; Next [d] = Next_save [d] ; } } /* ------------------------------------------------------------------ */ /* update supernode s with each pending descendant d */ /* ------------------------------------------------------------------ */ #ifndef NDEBUG for (d = Head [s] ; d != EMPTY ; d = Next [d]) { PRINT1 (("\nWill update "ID" with Child: "ID"\n", s, d)) ; DEBUG (CHOLMOD(dump_super) (d, Super, Lpi, Ls, Lpx, Lx, L_ENTRY, Common)) ; } PRINT1 (("\nNow factorizing supernode "ID":\n", s)) ; #endif #ifdef GPU_BLAS /* initialize the buffer counter */ if ( useGPU ) { Common->ibuffer = 0; supernodeUsedGPU = 0; idescendant = 0; d = Head[s]; dnext = d; dlarge = Next[d]; dsmall = tail; GPUavailable = 1; skips = 0; } else { dnext = Head[s]; } #else /* GPU module not installed */ dnext = Head[s]; #endif while #ifdef GPU_BLAS ( (!useGPU && (dnext != EMPTY)) || (useGPU && (idescendant < ndescendants))) #else ( dnext != EMPTY ) #endif { #ifdef GPU_BLAS if ( useGPU ) { /* Conditionally select the next descendant supernode to * assemble. * + first, select the largest descendant * + subsequently, if gpu host buffers are available, select * the largest remaining descendant for assembly on the GPU * + otherwise select the smallest remaining descendant for * assembly on the CPU * * The objective is to keep the GPU busy assembling the largest * descendants, and simultaneously keep the CPU busy assembling * the smallest descendants. * * As this is called for every descendent supernode, moving * this code to t_cholmod_gpu incurs substantial overhead - * ~20 GF/s on audikw_1 - so it is being left here. */ iHostBuff = (Common->ibuffer) % CHOLMOD_HOST_SUPERNODE_BUFFERS; cudaError_t cuErr; if ( idescendant > 0 ) { if ( GPUavailable == -1 || skips > 0) { d = dsmall; dsmall = Previous[dsmall]; skips--; } else { cuErr = cudaEventQuery ( Common->updateCBuffersFree[iHostBuff] ); if ( cuErr == cudaSuccess ) { /* buffers are available, so assemble a large * descendant (anticipating that this will be * assembled on the GPU) */ d = dlarge; dlarge = Next[dlarge]; GPUavailable = 1; skips = 0; } else { /* buffers are not available, so the GPU is busy, * so assemble a small descendant (anticipating * that it will be assembled on the host) */ d = dsmall; dsmall = Previous[dsmall]; GPUavailable = 0; /* if the GPUs are busy, then do this many * supernodes on the CPU before querying GPUs * again. */ skips = CHOLMOD_GPU_SKIP; } } } idescendant++; } else { d = dnext; } #else /* GPU module not installed at compile time */ d = dnext ; #endif /* -------------------------------------------------------------- */ /* get the size of supernode d */ /* -------------------------------------------------------------- */ kd1 = Super [d] ; /* d contains cols kd1 to kd2-1 of L */ kd2 = Super [d+1] ; ndcol = kd2 - kd1 ; /* # of columns in all of d */ pdi = Lpi [d] ; /* pointer to first row of d in Ls */ pdx = Lpx [d] ; /* pointer to first row of d in Lx */ pdend = Lpi [d+1] ; /* pointer just past last row of d in Ls */ ndrow = pdend - pdi ; /* # rows in all of d */ PRINT1 (("Child: ")) ; DEBUG (CHOLMOD(dump_super) (d, Super, Lpi, Ls, Lpx, Lx, L_ENTRY, Common)) ; /* -------------------------------------------------------------- */ /* find the range of rows of d that affect rows k1 to k2-1 of s */ /* -------------------------------------------------------------- */ p = Lpos [d] ; /* offset of 1st row of d affecting s */ pdi1 = pdi + p ; /* ptr to 1st row of d affecting s in Ls */ pdx1 = pdx + p ; /* ptr to 1st row of d affecting s in Lx */ /* there must be at least one row remaining in d to update s */ ASSERT (pdi1 < pdend) ; PRINT1 (("Lpos[d] "ID" pdi1 "ID" Ls[pdi1] "ID"\n", Lpos[d], pdi1, Ls [pdi1])) ; ASSERT (Ls [pdi1] >= k1 && Ls [pdi1] < k2) ; for (pdi2 = pdi1 ; pdi2 < pdend && Ls [pdi2] < k2 ; pdi2++) ; ndrow1 = pdi2 - pdi1 ; /* # rows in first part of d */ ndrow2 = pdend - pdi1 ; /* # rows in remaining d */ /* rows Ls [pdi1 ... pdi2-1] are in the range k1 to k2-1. Since d * affects s, this set cannot be empty. */ ASSERT (pdi1 < pdi2 && pdi2 <= pdend) ; PRINT1 (("ndrow1 "ID" ndrow2 "ID"\n", ndrow1, ndrow2)) ; DEBUG (for (p = pdi1 ; p < pdi2 ; p++) PRINT1 (("Ls["ID"] "ID"\n", p, Ls[p]))) ; /* -------------------------------------------------------------- */ /* construct the update matrix C for this supernode d */ /* -------------------------------------------------------------- */ /* C = L (k1:n-1, kd1:kd2-1) * L (k1:k2-1, kd1:kd2-1)', except * that k1:n-1 refers to all of the rows in L, but many of the * rows are all zero. Supernode d holds columns kd1 to kd2-1 of L. * Nonzero rows in the range k1:k2-1 are in the list * Ls [pdi1 ... pdi2-1], of size ndrow1. Nonzero rows in the range * k2:n-1 are in the list Ls [pdi2 ... pdend], of size ndrow2. Let * L1 = L (Ls [pdi1 ... pdi2-1], kd1:kd2-1), and let * L2 = L (Ls [pdi2 ... pdend], kd1:kd2-1). C is ndrow2-by-ndrow1. * Let C1 be the first ndrow1 rows of C and let C2 be the last * ndrow2-ndrow1 rows of C. Only the lower triangular part of C1 * needs to be computed since C1 is symmetric. */ /* maxcsize is the largest size of C for all pairs (d,s) */ ASSERT (ndrow2 * ndrow1 <= ((Int) L->maxcsize)) ; /* compute leading ndrow1-by-ndrow1 lower triangular block of C, * C1 = L1*L1' */ ndrow3 = ndrow2 - ndrow1 ; /* number of rows of C2 */ ASSERT (ndrow3 >= 0) ; #ifdef GPU_BLAS if ( useGPU ) { /* set up GPU to assemble new supernode */ if ( GPUavailable == 1) { if ( ndrow2 * L_ENTRY >= CHOLMOD_ND_ROW_LIMIT && ndcol * L_ENTRY >= CHOLMOD_ND_COL_LIMIT ) { if ( ! mapCreatedOnGpu ) { TEMPLATE2 ( CHOLMOD (gpu_initialize_supernode)) ( Common, nscol, nsrow, psi, gpu_p ); mapCreatedOnGpu = 1; } } else { /* we've reached the limit of GPU-eligible descendants * flag to stop stop performing cudaEventQueries */ GPUavailable = -1; } } } #endif #ifdef GPU_BLAS if ( !useGPU || GPUavailable!=1 || !TEMPLATE2 (CHOLMOD (gpu_updateC)) (ndrow1, ndrow2, ndrow, ndcol, nsrow, pdx1, pdi1, Lx, C, Common, gpu_p)) #endif { /* GPU not installed, or not used */ #ifndef NTIMER Common->CHOLMOD_CPU_SYRK_CALLS++ ; tstart = SuiteSparse_time () ; #endif #ifdef REAL BLAS_dsyrk ("L", "N", ndrow1, ndcol, /* N, K: L1 is ndrow1-by-ndcol*/ one, /* ALPHA: 1 */ Lx + L_ENTRY*pdx1, ndrow, /* A, LDA: L1, ndrow */ zero, /* BETA: 0 */ C, ndrow2) ; /* C, LDC: C1 */ #else BLAS_zherk ("L", "N", ndrow1, ndcol, /* N, K: L1 is ndrow1-by-ndcol*/ one, /* ALPHA: 1 */ Lx + L_ENTRY*pdx1, ndrow, /* A, LDA: L1, ndrow */ zero, /* BETA: 0 */ C, ndrow2) ; /* C, LDC: C1 */ #endif #ifndef NTIMER Common->CHOLMOD_CPU_SYRK_TIME += SuiteSparse_time () - tstart ; #endif /* compute remaining (ndrow2-ndrow1)-by-ndrow1 block of C, * C2 = L2*L1' */ if (ndrow3 > 0) { #ifndef NTIMER Common->CHOLMOD_CPU_GEMM_CALLS++ ; tstart = SuiteSparse_time () ; #endif #ifdef REAL BLAS_dgemm ("N", "C", ndrow3, ndrow1, ndcol, /* M, N, K */ one, /* ALPHA: 1 */ Lx + L_ENTRY*(pdx1 + ndrow1), /* A, LDA: L2 */ ndrow, /* ndrow */ Lx + L_ENTRY*pdx1, /* B, LDB: L1 */ ndrow, /* ndrow */ zero, /* BETA: 0 */ C + L_ENTRY*ndrow1, /* C, LDC: C2 */ ndrow2) ; #else BLAS_zgemm ("N", "C", ndrow3, ndrow1, ndcol, /* M, N, K */ one, /* ALPHA: 1 */ Lx + L_ENTRY*(pdx1 + ndrow1), /* A, LDA: L2 */ ndrow, /* ndrow */ Lx + L_ENTRY*pdx1, /* B, LDB: L1, ndrow */ ndrow, zero, /* BETA: 0 */ C + L_ENTRY*ndrow1, /* C, LDC: C2 */ ndrow2) ; #endif #ifndef NTIMER Common->CHOLMOD_CPU_GEMM_TIME += SuiteSparse_time () - tstart ; #endif } /* ---------------------------------------------------------- */ /* construct relative map to assemble d into s */ /* ---------------------------------------------------------- */ DEBUG (CHOLMOD(dump_real) ("C", C, ndrow2, ndrow1, TRUE, L_ENTRY, Common)) ; #pragma omp parallel for num_threads(CHOLMOD_OMP_NUM_THREADS) \ if ( ndrow2 > 64 ) for (i = 0 ; i < ndrow2 ; i++) { RelativeMap [i] = Map [Ls [pdi1 + i]] ; ASSERT (RelativeMap [i] >= 0 && RelativeMap [i] < nsrow) ; } /* ---------------------------------------------------------- */ /* assemble C into supernode s using the relative map */ /* ---------------------------------------------------------- */ #pragma omp parallel for private ( j, i, px, q ) \ num_threads(CHOLMOD_OMP_NUM_THREADS) if (ndrow1 > 64 ) for (j = 0 ; j < ndrow1 ; j++) /* cols k1:k2-1 */ { ASSERT (RelativeMap [j] == Map [Ls [pdi1 + j]]) ; ASSERT (RelativeMap [j] >= 0 && RelativeMap [j] < nscol) ; px = psx + RelativeMap [j] * nsrow ; for (i = j ; i < ndrow2 ; i++) /* rows k1:n-1 */ { ASSERT (RelativeMap [i] == Map [Ls [pdi1 + i]]) ; ASSERT (RelativeMap [i] >= j && RelativeMap[i] < nsrow); /* Lx [px + RelativeMap [i]] -= C [i + pj] ; */ q = px + RelativeMap [i] ; L_ASSEMBLESUB (Lx,q, C, i+ndrow2*j) ; } } } #ifdef GPU_BLAS else { supernodeUsedGPU = 1; /* GPU was used for this supernode*/ Common->ibuffer++; /* gpu_updateC is asynchronous, so use * the next host buffer for the next * supernode */ Common->ibuffer = Common->ibuffer% (CHOLMOD_HOST_SUPERNODE_BUFFERS*CHOLMOD_DEVICE_STREAMS); } #endif /* -------------------------------------------------------------- */ /* prepare this supernode d for its next ancestor */ /* -------------------------------------------------------------- */ dnext = Next [d] ; if (!repeat_supernode) { /* If node s is being repeated, Head [dancestor] has already * been cleared (set to EMPTY). It must remain EMPTY. The * dancestor will not be factorized since the factorization * terminates at node s. */ Lpos [d] = pdi2 - pdi ; if (Lpos [d] < ndrow) { dancestor = SuperMap [Ls [pdi2]] ; ASSERT (dancestor > s && dancestor < nsuper) ; /* place d in the link list of its next ancestor */ Next [d] = Head [dancestor] ; Head [dancestor] = d ; } } } /* end of descendant supernode loop */ #ifdef GPU_BLAS if ( useGPU ) { iHostBuff = (Common->ibuffer)%CHOLMOD_HOST_SUPERNODE_BUFFERS; iDevBuff = (Common->ibuffer)%CHOLMOD_DEVICE_STREAMS; /* combine updates assembled on the GPU with updates * assembled on the CPU */ TEMPLATE2 ( CHOLMOD (gpu_final_assembly )) ( Common, Lx, psx, nscol, nsrow, supernodeUsedGPU, &iHostBuff, &iDevBuff, gpu_p ); } #endif PRINT1 (("\nSupernode with contributions A: repeat: "ID"\n", repeat_supernode)) ; DEBUG (CHOLMOD(dump_super) (s, Super, Lpi, Ls, Lpx, Lx, L_ENTRY, Common)) ; PRINT1 (("\n\n")) ; /* ------------------------------------------------------------------ */ /* factorize diagonal block of supernode s in LL' */ /* ------------------------------------------------------------------ */ /* The current supernode s is ready to factorize. It has been updated * by all descendant supernodes. Let S = the current supernode, which * holds rows k1:n-1 and columns k1:k2-1 of the updated matrix. It * splits into two parts: the square diagonal block S1, and the * rectangular part S2. Here, S1 is factorized into L1*L1' and * overwritten by L1. * * If supernode s is being repeated, only factorize it up to but not * including the column containing the problematic entry. */ nscol2 = (repeat_supernode) ? (nscol_new) : (nscol) ; #ifdef GPU_BLAS if ( !useGPU || !supernodeUsedGPU || !TEMPLATE2 (CHOLMOD (gpu_lower_potrf))(nscol2, nsrow, psx, Lx, &info, Common, gpu_p)) #endif { /* Note that the GPU will not be used for the triangular solve */ #ifdef GPU_BLAS supernodeUsedGPU = 0; #endif #ifndef NTIMER Common->CHOLMOD_CPU_POTRF_CALLS++ ; tstart = SuiteSparse_time () ; #endif #ifdef REAL LAPACK_dpotrf ("L", nscol2, /* N: nscol2 */ Lx + L_ENTRY*psx, nsrow, /* A, LDA: S1, nsrow */ info) ; /* INFO */ #else LAPACK_zpotrf ("L", nscol2, /* N: nscol2 */ Lx + L_ENTRY*psx, nsrow, /* A, LDA: S1, nsrow */ info) ; /* INFO */ #endif #ifndef NTIMER Common->CHOLMOD_CPU_POTRF_TIME += SuiteSparse_time ()- tstart ; #endif } /* ------------------------------------------------------------------ */ /* check if the matrix is not positive definite */ /* ------------------------------------------------------------------ */ if (repeat_supernode) { /* the leading part has been refactorized; it must have succeeded */ info = 0 ; /* zero out the rest of this supernode */ p = psx + nsrow * nscol_new ; pend = psx + nsrow * nscol ; /* s is nsrow-by-nscol */ for ( ; p < pend ; p++) { /* Lx [p] = 0 ; */ L_CLEAR (Lx,p) ; } } /* info is set to one in LAPACK_*potrf if blas_ok is FALSE. It is * set to zero in dpotrf/zpotrf if the factorization was successful. */ if (CHECK_BLAS_INT && !Common->blas_ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large for the BLAS") ; } if (info != 0) { /* Matrix is not positive definite. dpotrf/zpotrf do NOT report an * error if the diagonal of L has NaN's, only if it has a zero. */ if (Common->status == CHOLMOD_OK) { ERROR (CHOLMOD_NOT_POSDEF, "matrix not positive definite") ; } /* L->minor is the column of L that contains a zero or negative * diagonal term. */ L->minor = k1 + info - 1 ; /* clear the link lists of all subsequent supernodes */ for (ss = s+1 ; ss < nsuper ; ss++) { Head [ss] = EMPTY ; } /* zero this supernode, and all remaining supernodes */ pend = L->xsize ; for (p = psx ; p < pend ; p++) { /* Lx [p] = 0. ; */ L_CLEAR (Lx,p) ; } /* If L is indefinite, it still contains useful information. * Supernodes 0 to s-1 are valid, similar to MATLAB [R,p]=chol(A), * where the 1-based p is identical to the 0-based L->minor. Since * L->minor is in the current supernode s, it and any columns to the * left of it in supernode s are also all zero. This differs from * [R,p]=chol(A), which contains nonzero rows 1 to p-1. Fix this * by setting repeat_supernode to TRUE, and repeating supernode s. * * If Common->quick_return_if_not_posdef is true, then the entire * supernode s is not factorized; it is left as all zero. */ if (info == 1 || Common->quick_return_if_not_posdef) { /* If the first column of supernode s contains a zero or * negative diagonal entry, then it is already properly set to * zero. Also, info will be 1 if integer overflow occured in * the BLAS. */ Head [s] = EMPTY ; #ifdef GPU_BLAS if ( useGPU ) { CHOLMOD (gpu_end) (Common) ; } #endif return (Common->status >= CHOLMOD_OK) ; } else { /* Repeat supernode s, but only factorize it up to but not * including the column containing the problematic diagonal * entry. */ repeat_supernode = TRUE ; s-- ; nscol_new = info - 1 ; continue ; } } /* ------------------------------------------------------------------ */ /* compute the subdiagonal block and prepare supernode for its parent */ /* ------------------------------------------------------------------ */ nsrow2 = nsrow - nscol2 ; if (nsrow2 > 0) { /* The current supernode is columns k1 to k2-1 of L. Let L1 be the * diagonal block (factorized by dpotrf/zpotrf above; rows/cols * k1:k2-1), and L2 be rows k2:n-1 and columns k1:k2-1 of L. The * triangular system to solve is L2*L1' = S2, where S2 is * overwritten with L2. More precisely, L2 = S2 / L1' in MATLAB * notation. */ #ifdef GPU_BLAS if ( !useGPU || !supernodeUsedGPU || !TEMPLATE2 (CHOLMOD(gpu_triangular_solve)) (nsrow2, nscol2, nsrow, psx, Lx, Common, gpu_p)) #endif { #ifndef NTIMER Common->CHOLMOD_CPU_TRSM_CALLS++ ; tstart = SuiteSparse_time () ; #endif #ifdef REAL BLAS_dtrsm ("R", "L", "C", "N", nsrow2, nscol2, /* M, N */ one, /* ALPHA: 1 */ Lx + L_ENTRY*psx, nsrow, /* A, LDA: L1, nsrow */ Lx + L_ENTRY*(psx + nscol2), /* B, LDB, L2, nsrow */ nsrow) ; #else BLAS_ztrsm ("R", "L", "C", "N", nsrow2, nscol2, /* M, N */ one, /* ALPHA: 1 */ Lx + L_ENTRY*psx, nsrow, /* A, LDA: L1, nsrow */ Lx + L_ENTRY*(psx + nscol2), /* B, LDB, L2, nsrow */ nsrow) ; #endif #ifndef NTIMER Common->CHOLMOD_CPU_TRSM_TIME += SuiteSparse_time () - tstart ; #endif } if (CHECK_BLAS_INT && !Common->blas_ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large for the BLAS") ; } if (!repeat_supernode) { /* Lpos [s] is offset of first row of s affecting its parent */ Lpos [s] = nscol ; sparent = SuperMap [Ls [psi + nscol]] ; ASSERT (sparent != EMPTY) ; ASSERT (Ls [psi + nscol] >= Super [sparent]) ; ASSERT (Ls [psi + nscol] < Super [sparent+1]) ; ASSERT (SuperMap [Ls [psi + nscol]] == sparent) ; ASSERT (sparent > s && sparent < nsuper) ; /* place s in link list of its parent */ Next [s] = Head [sparent] ; Head [sparent] = s ; } } else { #ifdef GPU_BLAS TEMPLATE2 ( CHOLMOD (gpu_copy_supernode) ) ( Common, Lx, psx, nscol, nscol2, nsrow, supernodeUsedGPU, iHostBuff, gpu_p); #endif } Head [s] = EMPTY ; /* link list for supernode s no longer needed */ /* clear the Map (debugging only, to detect changes in pattern of A) */ DEBUG (for (k = 0 ; k < nsrow ; k++) Map [Ls [psi + k]] = EMPTY) ; DEBUG (CHOLMOD(dump_super) (s, Super, Lpi, Ls, Lpx, Lx, L_ENTRY, Common)) ; if (repeat_supernode) { /* matrix is not positive definite; finished clean-up for supernode * containing negative diagonal */ #ifdef GPU_BLAS if ( useGPU ) { CHOLMOD (gpu_end) (Common) ; } #endif return (Common->status >= CHOLMOD_OK) ; } } /* success; matrix is positive definite */ L->minor = n ; #ifdef GPU_BLAS if ( useGPU ) { CHOLMOD (gpu_end) (Common) ; } #endif return (Common->status >= CHOLMOD_OK) ; } #undef PATTERN #undef REAL #undef COMPLEX #undef ZOMPLEX Matrix/src/CHOLMOD/Supernodal/License.txt0000644000176200001440000000203111770402705017630 0ustar liggesusersCHOLMOD/Supernodal Module. Copyright (C) 2005-2006, Timothy A. Davis CHOLMOD is also available under other licenses; contact authors for details. http://www.suitesparse.com Note that this license is for the CHOLMOD/Supernodal module only. All CHOLMOD modules are licensed separately. -------------------------------------------------------------------------------- This Module 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 of the License, or (at your option) any later version. This Module 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 Module; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. Matrix/src/CHOLMOD/Supernodal/cholmod_super_solve.c0000644000176200001440000001537113652535054021744 0ustar liggesusers/* ========================================================================== */ /* === Supernodal/cholmod_super_solve ======================================= */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Supernodal Module. Copyright (C) 2005-2006, Timothy A. Davis * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* Solve Lx=b or L'x=b for a supernodal factorization. These routines do not * apply the permutation L->Perm. See cholmod_solve for a more general * interface that performs that operation. */ #ifndef NGPL #ifndef NSUPERNODAL #include "cholmod_internal.h" #include "cholmod_supernodal.h" /* ========================================================================== */ /* === TEMPLATE ============================================================= */ /* ========================================================================== */ #define REAL #include "t_cholmod_super_solve.c" #define COMPLEX #include "t_cholmod_super_solve.c" /* ========================================================================== */ /* === cholmod_super_lsolve ================================================= */ /* ========================================================================== */ /* Solve Lx=b where x and b are of size n-by-nrhs. b is overwritten by the * solution x. On input, b is stored in col-major order with leading dimension * of d, and on output x is stored in the same manner. * * The contents of the workspace E are undefined on both input and output. * * workspace: none */ int CHOLMOD(super_lsolve) /* TRUE if OK, FALSE if BLAS overflow occured */ ( /* ---- input ---- */ cholmod_factor *L, /* factor to use for the forward solve */ /* ---- output ---- */ cholmod_dense *X, /* b on input, solution to Lx=b on output */ /* ---- workspace ---- */ cholmod_dense *E, /* workspace of size nrhs*(L->maxesize) */ /* --------------- */ cholmod_common *Common ) { /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_NULL (X, FALSE) ; RETURN_IF_NULL (E, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_REAL, CHOLMOD_COMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_COMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (E, CHOLMOD_REAL, CHOLMOD_COMPLEX, FALSE) ; if (L->xtype != X->xtype) { ERROR (CHOLMOD_INVALID, "L and X must have the same xtype") ; return (FALSE) ; } if (L->xtype != E->xtype) { ERROR (CHOLMOD_INVALID, "L and E must have the same xtype") ; return (FALSE) ; } if (X->d < X->nrow || L->n != X->nrow) { ERROR (CHOLMOD_INVALID, "X and L dimensions must match") ; return (FALSE) ; } if (E->nzmax < X->ncol * (L->maxesize)) { ERROR (CHOLMOD_INVALID, "workspace E not large enough") ; return (FALSE) ; } if (!(L->is_ll) || !(L->is_super)) { ERROR (CHOLMOD_INVALID, "L not supernodal") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; ASSERT (IMPLIES (L->n == 0, L->nsuper == 0)) ; if (L->n == 0 || X->ncol == 0) { /* nothing to do */ return (TRUE) ; } /* ---------------------------------------------------------------------- */ /* solve Lx=b using template routine */ /* ---------------------------------------------------------------------- */ switch (L->xtype) { case CHOLMOD_REAL: r_cholmod_super_lsolve (L, X, E, Common) ; break ; case CHOLMOD_COMPLEX: c_cholmod_super_lsolve (L, X, E, Common) ; break ; } if (CHECK_BLAS_INT && !Common->blas_ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large for the BLAS") ; } return (Common->blas_ok) ; } /* ========================================================================== */ /* === cholmod_super_ltsolve ================================================ */ /* ========================================================================== */ /* Solve L'x=b where x and b are of size n-by-nrhs. b is overwritten by the * solution x. On input, b is stored in col-major order with leading dimension * of d, and on output x is stored in the same manner. * * The contents of the workspace E are undefined on both input and output. * * workspace: none */ int CHOLMOD(super_ltsolve) /* TRUE if OK, FALSE if BLAS overflow occured */ ( /* ---- input ---- */ cholmod_factor *L, /* factor to use for the backsolve */ /* ---- output ---- */ cholmod_dense *X, /* b on input, solution to L'x=b on output */ /* ---- workspace ---- */ cholmod_dense *E, /* workspace of size nrhs*(L->maxesize) */ /* --------------- */ cholmod_common *Common ) { /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_NULL (X, FALSE) ; RETURN_IF_NULL (E, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_REAL, CHOLMOD_COMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_COMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (E, CHOLMOD_REAL, CHOLMOD_COMPLEX, FALSE) ; if (L->xtype != X->xtype) { ERROR (CHOLMOD_INVALID, "L and X must have the same xtype") ; return (FALSE) ; } if (L->xtype != E->xtype) { ERROR (CHOLMOD_INVALID, "L and E must have the same xtype") ; return (FALSE) ; } if (X->d < X->nrow || L->n != X->nrow) { ERROR (CHOLMOD_INVALID, "X and L dimensions must match") ; return (FALSE) ; } if (E->nzmax < X->ncol * (L->maxesize)) { ERROR (CHOLMOD_INVALID, "workspace E not large enough") ; return (FALSE) ; } if (!(L->is_ll) || !(L->is_super)) { ERROR (CHOLMOD_INVALID, "L not supernodal") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; ASSERT (IMPLIES (L->n == 0, L->nsuper == 0)) ; if (L->n == 0 || X->ncol == 0) { /* nothing to do */ return (TRUE) ; } /* ---------------------------------------------------------------------- */ /* solve Lx=b using template routine */ /* ---------------------------------------------------------------------- */ switch (L->xtype) { case CHOLMOD_REAL: r_cholmod_super_ltsolve (L, X, E, Common) ; break ; case CHOLMOD_COMPLEX: c_cholmod_super_ltsolve (L, X, E, Common) ; break ; } if (CHECK_BLAS_INT && !Common->blas_ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large for the BLAS") ; } return (Common->blas_ok) ; } #endif #endif Matrix/src/CHOLMOD/Supernodal/t_cholmod_gpu.c0000644000176200001440000010374612215610421020502 0ustar liggesusers/* ========================================================================== */ /* === Supernodal/t_cholmod_gpu ============================================= */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Supernodal Module. Copyright (C) 2005-2012, Timothy A. Davis * The CHOLMOD/Supernodal Module is licensed under Version 2.0 of the GNU * General Public License. See gpl.txt for a text of the license. * CHOLMOD is also available under other licenses; contact authors for details. * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* GPU BLAS template routine for cholmod_super_numeric. */ /* ========================================================================== */ /* === include files and definitions ======================================== */ /* ========================================================================== */ #include "cholmod_template.h" #undef L_ENTRY #ifdef REAL #define L_ENTRY 1 #else #define L_ENTRY 2 #endif /* #define GPU_Printf printf */ #define GPU_Printf #define PAGE_SIZE (4*1024) #define OK(cuda_operation) ((cuda_operation) == cudaSuccess) /* ========================================================================== */ /* === gpu_init ============================================================= */ /* ========================================================================== */ void TEMPLATE (CHOLMOD (gpu_init)) ( void *Cwork, Int maxSize, cholmod_common *Common ) { Int i ; cublasStatus_t cublasError ; cudaError_t cudaErr ; size_t maxBytesSize, HostPinnedSize ; Common->GemmUsed = 0 ; GPU_Printf ("gpu_init : %p\n", (void *) ((size_t) Cwork & ~(PAGE_SIZE-1))) ; if (!(Common->cublasHandle)) { /* ------------------------------------------------------------------ */ /* create the CUDA BLAS handle */ /* ------------------------------------------------------------------ */ cublasError = cublasCreate (&(Common->cublasHandle)) ; if (cublasError != CUBLAS_STATUS_SUCCESS) { ERROR (CHOLMOD_GPU_PROBLEM, "CUBLAS initialization") ; return ; } /* ------------------------------------------------------------------ */ /* create each CUDA stream */ /* ------------------------------------------------------------------ */ cudaErr = cudaStreamCreate (&(Common->cudaStreamSyrk)) ; if (cudaErr != cudaSuccess) { ERROR (CHOLMOD_GPU_PROBLEM, "CUDA stream initialization") ; return ; } cudaErr = cudaStreamCreate (&(Common->cudaStreamGemm)) ; if (cudaErr != cudaSuccess) { ERROR (CHOLMOD_GPU_PROBLEM, "CUDA stream initialization") ; return ; } cudaErr = cudaStreamCreate (&(Common->cudaStreamTrsm)) ; if (cudaErr != cudaSuccess) { ERROR (CHOLMOD_GPU_PROBLEM, "CUDA stream initialization") ; return ; } for (i = 0 ; i < 3 ; i++) { cudaErr = cudaStreamCreate (&(Common->cudaStreamPotrf [i])) ; if (cudaErr != cudaSuccess) { ERROR (CHOLMOD_GPU_PROBLEM, "CUDA stream initialization") ; return ; } } /* ------------------------------------------------------------------ */ /* create each CUDA event */ /* ------------------------------------------------------------------ */ for (i = 0 ; i < 2 ; i++) { cudaErr = cudaEventCreateWithFlags (&(Common->cublasEventPotrf [i]), cudaEventDisableTiming) ; if (cudaErr != cudaSuccess) { ERROR (CHOLMOD_GPU_PROBLEM, "CUDA event") ; return ; } } } /* ---------------------------------------------------------------------- */ /* pin the Host memory */ /* ---------------------------------------------------------------------- */ Common->HostPinnedMemory = (void *) ((size_t) Cwork & ~(PAGE_SIZE-1)) ; maxBytesSize = sizeof (double)*L_ENTRY*maxSize ; /* Align on a 4K page boundary (it is no more necessary in 4.1 */ HostPinnedSize = (((size_t) Cwork + maxBytesSize + PAGE_SIZE-1) & ~(PAGE_SIZE-1)) - (size_t) (Common->HostPinnedMemory) ; GPU_Printf ("gpu HostPinnedSize: %g %p\n", (double) HostPinnedSize, Common->HostPinnedMemory) ; cudaErr = cudaHostRegister (Common->HostPinnedMemory, HostPinnedSize, 0) ; if (cudaErr != cudaSuccess) { ERROR (CHOLMOD_GPU_PROBLEM, "CUDA Pinning Memory") ; Common->HostPinnedMemory = NULL ; } } /* ========================================================================== */ /* === gpu_end ============================================================== */ /* ========================================================================== */ void TEMPLATE (CHOLMOD (gpu_end)) ( cholmod_common *Common ) { int i; /* unpin the Host memory */ GPU_Printf ("gpu_end %p\n", Common->HostPinnedMemory) ; cudaError_t cudaErr = cudaHostUnregister (Common->HostPinnedMemory) ; if (cudaErr != cudaSuccess) { ERROR (CHOLMOD_GPU_PROBLEM, "CUDA Unpinning Memory") ; Common->HostPinnedMemory = NULL ; } /* ------------------------------------------------------------------ */ /* destroy Cublas Handle */ /* ------------------------------------------------------------------ */ if (Common->cublasHandle) { cublasDestroy(Common->cublasHandle); Common->cublasHandle = NULL ; } /* ------------------------------------------------------------------ */ /* destroy each CUDA stream */ /* ------------------------------------------------------------------ */ if (Common->cudaStreamSyrk) { cudaStreamDestroy (Common->cudaStreamSyrk) ; Common->cudaStreamSyrk = NULL ; } if (Common->cudaStreamGemm) { cudaStreamDestroy (Common->cudaStreamGemm) ; } if (Common->cudaStreamTrsm) { cudaStreamDestroy (Common->cudaStreamTrsm) ; Common->cudaStreamTrsm = NULL ; } for (i = 0 ; i < 3 ; i++) { if (Common->cudaStreamPotrf [i]) { cudaStreamDestroy(Common->cudaStreamPotrf [i]) ; Common->cudaStreamPotrf [i] = NULL ; } } /* ------------------------------------------------------------------ */ /* destroy each CUDA event */ /* ------------------------------------------------------------------ */ for (i = 0 ; i < 2 ; i++) { if (Common->cublasEventPotrf [i]) { cudaEventDestroy( Common->cublasEventPotrf [i] ) ; Common->cublasEventPotrf [i] = NULL ; } } } /* ========================================================================== */ /* === gpu_updateC ========================================================== */ /* ========================================================================== */ /* C = L (k1:n-1, kd1:kd2-1) * L (k1:k2-1, kd1:kd2-1)', except that k1:n-1 * refers to all of the rows in L, but many of the rows are all zero. * Supernode d holds columns kd1 to kd2-1 of L. Nonzero rows in the range * k1:k2-1 are in the list Ls [pdi1 ... pdi2-1], of size ndrow1. Nonzero rows * in the range k2:n-1 are in the list Ls [pdi2 ... pdend], of size ndrow2. * Let L1 = L (Ls [pdi1 ... pdi2-1], kd1:kd2-1), and let L2 = L (Ls [pdi2 ... * pdend], kd1:kd2-1). C is ndrow2-by-ndrow1. Let C1 be the first ndrow1 * rows of C and let C2 be the last ndrow2-ndrow1 rows of C. Only the lower * triangular part of C1 needs to be computed since C1 is symmetric. */ int TEMPLATE (CHOLMOD (gpu_updateC)) ( Int ndrow1, /* C is ndrow2-by-ndrow2 */ Int ndrow2, Int ndrow, /* leading dimension of Lx */ Int ndcol, /* L1 is ndrow1-by-ndcol */ Int pdx1, /* L1 starts at Lx + L_ENTRY*pdx1 */ /* L2 starts at Lx + L_ENTRY*(pdx1 + ndrow1) */ double *Lx, double *C, cholmod_common *Common ) { double *devPtrLx, *devPtrC ; double alpha, beta ; cublasStatus_t cublasStatus ; cudaError_t cudaStat [2] ; Int ndrow3 ; Common->SyrkUsed = 0 ; Common->GemmUsed = 0 ; if ((ndrow2 < 512) || (ndcol < 128)) { /* too small for the CUDA BLAS; use the CPU instead */ return (0) ; } ndrow3 = ndrow2 - ndrow1 ; #ifndef NTIMER Common->syrkStart = SuiteSparse_time ( ) ; #endif /* ---------------------------------------------------------------------- */ /* allocate workspace on the GPU */ /* ---------------------------------------------------------------------- */ cudaStat [0] = cudaMalloc ((void **) &devPtrLx, ndrow2 * ndcol * L_ENTRY * sizeof (devPtrLx [0])) ; cudaStat [1] = cudaMalloc ((void **) &devPtrC, ndrow2 * ndrow1 * L_ENTRY * sizeof (devPtrC [0])) ; Common->devSyrkGemmPtrLx = devPtrLx ; Common->devSyrkGemmPtrC = devPtrC ; if (cudaStat [0] || cudaStat [1]) { /* one or both cudaMalloc's failed */ if (devPtrLx) cudaFree (devPtrLx) ; if (devPtrC) cudaFree (devPtrC) ; GPU_Printf ("gpu malloc failed =%d,%d ndrow1=%d ndrow2=%d ndcol=%d\n", cudaStat [0], cudaStat [1], (int) ndrow1, (int) ndrow2, (int) ndcol) ; /* cudaMalloc failure is not an error, just bypass the GPU */ return (0) ; } Common->SyrkUsed = 1 ; #ifndef NTIMER Common->CHOLMOD_GPU_SYRK_CALLS++ ; #endif /* ---------------------------------------------------------------------- */ /* copy Lx to the GPU */ /* ---------------------------------------------------------------------- */ /* copy Lx in two steps on different streams. * (ldLx is shortened from ndrow to ndrow2) */ cudaStat [0] = cudaMemcpy2DAsync (devPtrLx, ndrow2 * L_ENTRY * sizeof (devPtrLx [0]), Lx + L_ENTRY * pdx1, ndrow * L_ENTRY * sizeof (Lx [0]), ndrow1 * L_ENTRY * sizeof (devPtrLx [0]), ndcol, cudaMemcpyHostToDevice, Common->cudaStreamSyrk) ; if (cudaStat [0]) { ERROR (CHOLMOD_GPU_PROBLEM, "GPU memcopy to device") ; } if (ndrow3 > 0) { Common->GemmUsed = 1 ; cudaStat [1] = cudaMemcpy2DAsync (devPtrLx + L_ENTRY*ndrow1, ndrow2 * L_ENTRY * sizeof (devPtrLx [0]), Lx + L_ENTRY * (pdx1 + ndrow1), ndrow * L_ENTRY * sizeof (Lx [0]), ndrow3 * L_ENTRY * sizeof (devPtrLx [0]), ndcol, cudaMemcpyHostToDevice, Common->cudaStreamGemm) ; if (cudaStat [1]) { ERROR (CHOLMOD_GPU_PROBLEM, "GPU memcopy to device") ; } } /* ---------------------------------------------------------------------- */ /* do the CUDA SYRK */ /* ---------------------------------------------------------------------- */ cublasStatus = cublasSetStream (Common->cublasHandle, Common->cudaStreamSyrk) ; if (cublasStatus != CUBLAS_STATUS_SUCCESS) { ERROR (CHOLMOD_GPU_PROBLEM, "GPU CUBLAS stream") ; } alpha = 1.0 ; beta = 0.0 ; #ifdef REAL cublasStatus = cublasDsyrk (Common->cublasHandle, CUBLAS_FILL_MODE_LOWER, CUBLAS_OP_N, (int) ndrow1, (int) ndcol, /* N, K: L1 is ndrow1-by-ndcol */ &alpha, /* ALPHA: 1 */ devPtrLx, ndrow2, /* A, LDA: L1, ndrow2 */ &beta, /* BETA: 0 */ devPtrC, ndrow2) ; /* C, LDC: C1 */ #else cublasStatus = cublasZherk (Common->cublasHandle, CUBLAS_FILL_MODE_LOWER, CUBLAS_OP_N, (int) ndrow1, (int) ndcol, /* N, K: L1 is ndrow1-by-ndcol*/ &alpha, /* ALPHA: 1 */ (const cuDoubleComplex *) devPtrLx, ndrow2, /* A, LDA: L1, ndrow2 */ &beta, /* BETA: 0 */ (cuDoubleComplex *) devPtrC, ndrow2) ; /* C, LDC: C1 */ #endif if (cublasStatus != CUBLAS_STATUS_SUCCESS) { ERROR (CHOLMOD_GPU_PROBLEM, "GPU CUBLAS routine failure") ; } /* ---------------------------------------------------------------------- */ /* partial copy of C to the GPU */ /* ---------------------------------------------------------------------- */ cudaStat [0] = cudaMemcpy2DAsync (C, ndrow2 * L_ENTRY * sizeof (C [0]), devPtrC, ndrow2 * L_ENTRY * sizeof (devPtrC [0]), ndrow1 * L_ENTRY * sizeof (devPtrC [0]), ndrow1, cudaMemcpyDeviceToHost, Common->cudaStreamSyrk) ; if (cudaStat [0]) { ERROR (CHOLMOD_GPU_PROBLEM, "GPU memcopy from device") ; } /* ---------------------------------------------------------------------- */ /* compute remaining (ndrow2-ndrow1)-by-ndrow1 block of C, C2 = L2*L1' */ /* ---------------------------------------------------------------------- */ if (ndrow3 > 0) { #ifndef REAL cuDoubleComplex calpha = {1.0,0.0} ; cuDoubleComplex cbeta = {0.0,0.0} ; #endif #ifndef NTIMER Common->CHOLMOD_GPU_GEMM_CALLS++ ; #endif cublasStatus = cublasSetStream (Common->cublasHandle, Common->cudaStreamGemm) ; if (cublasStatus != CUBLAS_STATUS_SUCCESS) { ERROR (CHOLMOD_GPU_PROBLEM, "GPU CUBLAS stream") ; } /* ------------------------------------------------------------------ */ /* do the CUDA BLAS dgemm */ /* ------------------------------------------------------------------ */ #ifdef REAL alpha = 1.0 ; beta = 0.0 ; cublasStatus = cublasDgemm (Common->cublasHandle, CUBLAS_OP_N, CUBLAS_OP_T, ndrow3, ndrow1, ndcol, /* M, N, K */ &alpha, /* ALPHA: 1 */ devPtrLx + L_ENTRY*(ndrow1), /* A, LDA: L2, ndrow */ ndrow2, devPtrLx, /* B, LDB: L1, ndrow */ ndrow2, &beta, /* BETA: 0 */ devPtrC + L_ENTRY*ndrow1, /* C, LDC: C2 */ ndrow2) ; #else cublasStatus = cublasZgemm (Common->cublasHandle, CUBLAS_OP_N, CUBLAS_OP_C, ndrow3, ndrow1, ndcol, /* M, N, K */ &calpha, /* ALPHA: 1 */ (const cuDoubleComplex *) devPtrLx + ndrow1, /* A, LDA: L2, ndrow */ ndrow2, (const cuDoubleComplex *) devPtrLx, /* B, LDB: L1, ndrow */ ndrow2, &cbeta, /* BETA: 0 */ (cuDoubleComplex *)devPtrC + ndrow1, /* C, LDC: C2 */ ndrow2) ; #endif if (cublasStatus != CUBLAS_STATUS_SUCCESS) { ERROR (CHOLMOD_GPU_PROBLEM, "GPU CUBLAS routine failure") ; } /* ------------------------------------------------------------------ */ /* finish copy of C */ /* ------------------------------------------------------------------ */ cudaStat [0] = cudaMemcpy2DAsync (C + L_ENTRY*ndrow1, ndrow2 * L_ENTRY * sizeof (C [0]), devPtrC+ L_ENTRY*ndrow1, ndrow2 * L_ENTRY * sizeof (devPtrC [0]), ndrow3 * L_ENTRY * sizeof (devPtrC [0]), ndrow1, cudaMemcpyDeviceToHost, Common->cudaStreamGemm) ; if (cudaStat [0]) { ERROR (CHOLMOD_GPU_PROBLEM, "GPU memcopy from device") ; } } return (1) ; } /* ========================================================================== */ /* === gpu_syncSyrk ========================================================= */ /* ========================================================================== */ /* synchronize with the CUDA BLAS dsyrk stream */ void TEMPLATE (CHOLMOD (gpu_syncSyrk)) ( cholmod_common *Common ) { if (Common->SyrkUsed) { cudaStreamSynchronize (Common->cudaStreamSyrk) ; if (!Common->GemmUsed) { cudaFree (Common->devSyrkGemmPtrLx) ; cudaFree (Common->devSyrkGemmPtrC) ; Common->devSyrkGemmPtrLx = NULL ; Common->devSyrkGemmPtrC = NULL ; #ifndef NTIMER /* this actually sums time spend on Syrk and Gemm */ Common->CHOLMOD_GPU_SYRK_TIME += SuiteSparse_time ( ) - Common->syrkStart ; #endif } } } /* ========================================================================== */ /* === gpu_syncGemm ========================================================= */ /* ========================================================================== */ /* synchronize with the CUDA BLAS dgemm stream */ void TEMPLATE (CHOLMOD (gpu_syncGemm)) ( cholmod_common *Common ) { if (Common->GemmUsed) { cudaStreamSynchronize (Common->cudaStreamGemm) ; cudaFree (Common->devSyrkGemmPtrLx) ; cudaFree (Common->devSyrkGemmPtrC) ; Common->devSyrkGemmPtrLx = NULL ; Common->devSyrkGemmPtrC = NULL ; #ifndef NTIMER /* this actually sums time spend on Syrk and Gemm */ Common->CHOLMOD_GPU_SYRK_TIME += SuiteSparse_time ( ) - Common->syrkStart ; #endif } } /* ========================================================================== */ /* === gpu_lower_potrf ====================================================== */ /* ========================================================================== */ /* Cholesky factorzation (dpotrf) of a matrix S, operating on the lower * triangular part only. S is nscol2-by-nscol2 with leading dimension nsrow. * * S is the top part of the supernode (the lower triangular matrx). * This function also copies the bottom rectangular part of the supernode (B) * onto the GPU, in preparation for gpu_triangular_solve. */ int TEMPLATE (CHOLMOD (gpu_lower_potrf)) ( Int nscol2, /* S is nscol2-by-nscol2 */ Int nsrow, /* leading dimension of S */ Int psx, /* S is located at Lx + L_Entry*psx */ double *Lx, /* contains S; overwritten with Cholesky factor */ Int *info, /* BLAS info return value */ cholmod_common *Common ) { double *devPtrA, *devPtrB, *A ; double alpha, beta ; cudaError_t cudaStat ; cublasStatus_t cublasStatus ; Int j, nsrow2, nb, n, gpu_lda, lda, gpu_ldb ; int ilda, ijb, iinfo ; #ifndef NTIMER double tstart = SuiteSparse_time ( ) ; #endif if (nscol2 < 256) { /* too small for the CUDA BLAS; use the CPU instead */ return (0) ; } nsrow2 = nsrow - nscol2 ; /* ---------------------------------------------------------------------- */ /* heuristic to get the block size depending of the problem size */ /* ---------------------------------------------------------------------- */ nb = 128 ; if (nscol2 > 4096) nb = 256 ; if (nscol2 > 8192) nb = 384 ; n = nscol2 ; gpu_lda = ((nscol2+31)/32)*32 ; lda = nsrow ; A = Lx + L_ENTRY*psx ; /* ---------------------------------------------------------------------- */ /* free the dpotrf workspace, if allocated */ /* ---------------------------------------------------------------------- */ if (Common->devPotrfWork) { cudaFree (Common->devPotrfWork) ; Common->devPotrfWork = NULL ; } /* ---------------------------------------------------------------------- */ /* determine the GPU leading dimension of B */ /* ---------------------------------------------------------------------- */ gpu_ldb = 0 ; if (nsrow2 > 0) { gpu_ldb = ((nsrow2+31)/32)*32 ; } /* ---------------------------------------------------------------------- */ /* allocate device memory for the factorization and for potential solve */ /* ---------------------------------------------------------------------- */ cudaStat = cudaMalloc ((void **) &devPtrA, gpu_lda * (gpu_lda + gpu_ldb) * L_ENTRY * sizeof (devPtrA [0])) ; if (cudaStat) { GPU_Printf ("@@gpu_lower_potrf cudaMalloc failed =%d gpu_lda=%d\n", cudaStat, (int) (gpu_lda)) ; /* cudaMalloc failure not fatal, GPU bypassed */ return (0) ; } #ifndef NTIMER Common->CHOLMOD_GPU_POTRF_CALLS++ ; #endif /* ---------------------------------------------------------------------- */ /* remember where device memory is, to be used by triangular solve later */ /* ---------------------------------------------------------------------- */ Common->devPotrfWork = devPtrA ; devPtrB = devPtrA + gpu_lda * gpu_lda * L_ENTRY ; /* ---------------------------------------------------------------------- */ /* copy B in advance, for gpu_triangular_solve */ /* ---------------------------------------------------------------------- */ if (nsrow2 > 0) { cudaStat = cudaMemcpy2DAsync (devPtrB, gpu_ldb * L_ENTRY * sizeof (devPtrB [0]), Lx + L_ENTRY * (psx + nscol2), nsrow * L_ENTRY * sizeof (Lx [0]), nsrow2 * L_ENTRY * sizeof (devPtrB [0]), nscol2, cudaMemcpyHostToDevice, Common->cudaStreamTrsm) ; if (cudaStat) { ERROR (CHOLMOD_GPU_PROBLEM, "GPU memcopy to device") ; } } /* ---------------------------------------------------------------------- */ /* block Cholesky factorization of S */ /* ---------------------------------------------------------------------- */ for (j = 0 ; j < n ; j += nb) { Int jb = nb < (n-j) ? nb : (n-j) ; /* ------------------------------------------------------------------ */ /* copy jb columns starting at the diagonal to the GPU */ /* ------------------------------------------------------------------ */ cudaStat = cudaMemcpy2DAsync (devPtrA + (j + j*gpu_lda)*L_ENTRY, gpu_lda * L_ENTRY * sizeof (devPtrA [0]), A + L_ENTRY*(j + j*lda), lda * L_ENTRY * sizeof (A [0]), (n-j) * L_ENTRY * sizeof (devPtrA [0]), jb, cudaMemcpyHostToDevice, Common->cudaStreamPotrf [0]) ; if (cudaStat) { ERROR (CHOLMOD_GPU_PROBLEM, "GPU memcopy to device") ; } /* ------------------------------------------------------------------ */ /* define the dpotrf stream */ /* ------------------------------------------------------------------ */ cublasStatus = cublasSetStream (Common->cublasHandle, Common->cudaStreamPotrf [0]) ; if (cublasStatus != CUBLAS_STATUS_SUCCESS) { ERROR (CHOLMOD_GPU_PROBLEM, "GPU CUBLAS stream") ; } /* ------------------------------------------------------------------ */ /* record the end of the copy of block L22 | L32 */ /* ------------------------------------------------------------------ */ cudaStat = cudaEventRecord (Common->cublasEventPotrf [0], Common->cudaStreamPotrf [0]) ; if (cudaStat) { ERROR (CHOLMOD_GPU_PROBLEM, "CUDA event failure") ; } /* ------------------------------------------------------------------ */ /* do the CUDA BLAS dsyrk */ /* ------------------------------------------------------------------ */ alpha = -1.0 ; beta = 1.0 ; #ifdef REAL cublasStatus = cublasDsyrk (Common->cublasHandle, CUBLAS_FILL_MODE_LOWER, CUBLAS_OP_N, jb, j, &alpha, devPtrA + j, gpu_lda, &beta, devPtrA + j + j*gpu_lda, gpu_lda) ; #else cublasStatus = cublasZherk (Common->cublasHandle, CUBLAS_FILL_MODE_LOWER, CUBLAS_OP_N, jb, j, &alpha, (cuDoubleComplex*)devPtrA + j, gpu_lda, &beta, (cuDoubleComplex*)devPtrA + j + j*gpu_lda, gpu_lda) ; #endif if (cublasStatus != CUBLAS_STATUS_SUCCESS) { ERROR (CHOLMOD_GPU_PROBLEM, "GPU CUBLAS routine failure") ; } /* ------------------------------------------------------------------ */ cudaStat = cudaEventRecord (Common->cublasEventPotrf [1], Common->cudaStreamPotrf [0]) ; if (cudaStat) { ERROR (CHOLMOD_GPU_PROBLEM, "CUDA event failure") ; } cudaStat = cudaStreamWaitEvent (Common->cudaStreamPotrf [1], Common->cublasEventPotrf [1], 0) ; if (cudaStat) { ERROR (CHOLMOD_GPU_PROBLEM, "CUDA event failure") ; } /* ------------------------------------------------------------------ */ /* copy back the jb columns on two different streams */ /* ------------------------------------------------------------------ */ cudaStat = cudaMemcpy2DAsync (A + L_ENTRY*(j + j*lda), lda * L_ENTRY * sizeof (double), devPtrA + L_ENTRY*(j + j*gpu_lda), gpu_lda * L_ENTRY * sizeof (double), L_ENTRY * sizeof (double)*jb, jb, cudaMemcpyDeviceToHost, Common->cudaStreamPotrf [1]) ; if (cudaStat) { ERROR (CHOLMOD_GPU_PROBLEM, "GPU memcopy from device") ; } cudaStat = cudaMemcpy2DAsync (A + L_ENTRY*j, lda * L_ENTRY * sizeof (double), devPtrA + L_ENTRY*j, gpu_lda * L_ENTRY * sizeof (double), L_ENTRY * sizeof (double)*jb, j, cudaMemcpyDeviceToHost, Common->cudaStreamPotrf [0]) ; if (cudaStat) { ERROR (CHOLMOD_GPU_PROBLEM, "GPU memcopy to device") ; } /* ------------------------------------------------------------------ */ /* do the CUDA BLAS dgemm */ /* ------------------------------------------------------------------ */ if ((j+jb) < n) { #ifdef REAL alpha = -1.0 ; beta = 1.0 ; cublasStatus = cublasDgemm (Common->cublasHandle, CUBLAS_OP_N, CUBLAS_OP_T, (n-j-jb), jb, j, &alpha, devPtrA + (j+jb), gpu_lda, devPtrA + (j) , gpu_lda, &beta, devPtrA + (j+jb + j*gpu_lda), gpu_lda) ; #else cuDoubleComplex calpha = {-1.0,0.0} ; cuDoubleComplex cbeta = { 1.0,0.0} ; cublasStatus = cublasZgemm (Common->cublasHandle, CUBLAS_OP_N, CUBLAS_OP_C, (n-j-jb), jb, j, &calpha, (cuDoubleComplex*)devPtrA + (j+jb), gpu_lda, (cuDoubleComplex*)devPtrA + (j) , gpu_lda, &cbeta, (cuDoubleComplex*)devPtrA + (j+jb + j*gpu_lda), gpu_lda) ; #endif if (cublasStatus != CUBLAS_STATUS_SUCCESS) { ERROR (CHOLMOD_GPU_PROBLEM, "GPU CUBLAS routine failure") ; } } cudaStat = cudaStreamSynchronize (Common->cudaStreamPotrf [1]) ; if (cudaStat) { ERROR (CHOLMOD_GPU_PROBLEM, "GPU memcopy to device") ; } /* ------------------------------------------------------------------ */ /* compute the Cholesky factorization of the jbxjb block on the CPU */ /* ------------------------------------------------------------------ */ ilda = (int) lda ; ijb = jb ; #ifdef REAL LAPACK_DPOTRF ("L", &ijb, A + L_ENTRY * (j + j*lda), &ilda, &iinfo) ; #else LAPACK_ZPOTRF ("L", &ijb, A + L_ENTRY * (j + j*lda), &ilda, &iinfo) ; #endif *info = iinfo ; if (*info != 0) { *info = *info + j ; break ; } /* ------------------------------------------------------------------ */ /* copy the result back to the GPU */ /* ------------------------------------------------------------------ */ cudaStat = cudaMemcpy2DAsync (devPtrA + L_ENTRY*(j + j*gpu_lda), gpu_lda * L_ENTRY * sizeof (double), A + L_ENTRY * (j + j*lda), lda * L_ENTRY * sizeof (double), L_ENTRY * sizeof (double) * jb, jb, cudaMemcpyHostToDevice, Common->cudaStreamPotrf [0]) ; if (cudaStat) { ERROR (CHOLMOD_GPU_PROBLEM, "GPU memcopy to device") ; } /* ------------------------------------------------------------------ */ /* do the CUDA BLAS dtrsm */ /* ------------------------------------------------------------------ */ if ((j+jb) < n) { #ifdef REAL alpha = 1.0 ; cublasStatus = cublasDtrsm (Common->cublasHandle, CUBLAS_SIDE_RIGHT, CUBLAS_FILL_MODE_LOWER, CUBLAS_OP_T, CUBLAS_DIAG_NON_UNIT, (n-j-jb), jb, &alpha, devPtrA + (j + j*gpu_lda), gpu_lda, devPtrA + (j+jb + j*gpu_lda), gpu_lda) ; #else cuDoubleComplex calpha = {1.0,0.0}; cublasStatus = cublasZtrsm (Common->cublasHandle, CUBLAS_SIDE_RIGHT, CUBLAS_FILL_MODE_LOWER, CUBLAS_OP_C, CUBLAS_DIAG_NON_UNIT, (n-j-jb), jb, &calpha, (cuDoubleComplex *)devPtrA + (j + j*gpu_lda), gpu_lda, (cuDoubleComplex *)devPtrA + (j+jb + j*gpu_lda), gpu_lda) ; #endif if (cublasStatus != CUBLAS_STATUS_SUCCESS) { ERROR (CHOLMOD_GPU_PROBLEM, "GPU CUBLAS routine failure") ; } } } if (nsrow2 <= 0) { /* No TRSM necessary */ cudaFree (Common->devPotrfWork) ; Common->devPotrfWork = NULL ; } #ifndef NTIMER Common->CHOLMOD_GPU_POTRF_TIME += SuiteSparse_time ( ) - tstart ; #endif return (1) ; } /* ========================================================================== */ /* === gpu_triangular_solve ================================================= */ /* ========================================================================== */ /* The current supernode is columns k1 to k2-1 of L. Let L1 be the diagonal * block (factorized by dpotrf/zpotrf above; rows/cols k1:k2-1), and L2 be rows * k2:n-1 and columns k1:k2-1 of L. The triangular system to solve is L2*L1' = * S2, where S2 is overwritten with L2. More precisely, L2 = S2 / L1' in * MATLAB notation. */ /* Version with pre-allocation in POTRF */ int TEMPLATE (CHOLMOD (gpu_triangular_solve)) ( Int nsrow2, /* L1 and S2 are nsrow2-by-nscol2 */ Int nscol2, /* L1 is nscol2-by-nscol2 */ Int nsrow, /* leading dimension of L1, L2, and S2 */ Int psx, /* L1 is at Lx+L_ENTRY*psx; L2 at Lx+L_ENTRY*(psx+nscol2)*/ double *Lx, /* holds L1, L2, and S2 */ cholmod_common *Common ) { double *devPtrA, *devPtrB ; cudaError_t cudaStat ; cublasStatus_t cublasStatus ; Int gpu_lda, gpu_ldb ; #ifdef REAL double alpha = 1.0 ; #else cuDoubleComplex calpha = {1.0,0.0} ; #endif if (!Common->devPotrfWork) { /* no workspace for triangular solve */ return (0) ; } #ifndef NTIMER double tstart = SuiteSparse_time ( ) ; Common->CHOLMOD_GPU_TRSM_CALLS++ ; #endif gpu_lda = ((nscol2+31)/32)*32 ; gpu_ldb = ((nsrow2+31)/32)*32 ; devPtrA = Common->devPotrfWork ; devPtrB = devPtrA + gpu_lda * gpu_lda * L_ENTRY ; /* ---------------------------------------------------------------------- */ /* start the trsm stream */ /* ---------------------------------------------------------------------- */ cublasStatus = cublasSetStream (Common->cublasHandle, Common->cudaStreamTrsm) ; if (cublasStatus != CUBLAS_STATUS_SUCCESS) { ERROR (CHOLMOD_GPU_PROBLEM, "GPU CUBLAS stream") ; } /* ---------------------------------------------------------------------- */ /* do the CUDA BLAS dtrsm */ /* ---------------------------------------------------------------------- */ #ifdef REAL cublasStatus = cublasDtrsm (Common->cublasHandle, CUBLAS_SIDE_RIGHT, CUBLAS_FILL_MODE_LOWER, CUBLAS_OP_T, CUBLAS_DIAG_NON_UNIT, nsrow2, nscol2, /* M, N */ &alpha, /* ALPHA: 1 */ devPtrA, gpu_lda, /* A, LDA */ devPtrB, gpu_ldb) ; /* B, LDB */ #else cublasStatus = cublasZtrsm (Common->cublasHandle, CUBLAS_SIDE_RIGHT, CUBLAS_FILL_MODE_LOWER, CUBLAS_OP_C, CUBLAS_DIAG_NON_UNIT, nsrow2, nscol2, /* M, N */ &calpha, /* ALPHA: 1 */ (const cuDoubleComplex *) devPtrA, gpu_lda, /* A, LDA */ (cuDoubleComplex *) devPtrB, gpu_ldb) ; /* B, LDB: nsrow2 */ #endif if (cublasStatus != CUBLAS_STATUS_SUCCESS) { ERROR (CHOLMOD_GPU_PROBLEM, "GPU CUBLAS routine failure") ; } /* ---------------------------------------------------------------------- */ /* copy result back to the CPU */ /* ---------------------------------------------------------------------- */ cudaStat = cudaMemcpy2DAsync (Lx + L_ENTRY*(psx + nscol2), nsrow * L_ENTRY * sizeof (Lx [0]), devPtrB, gpu_ldb * L_ENTRY * sizeof (devPtrB [0]), nsrow2 * L_ENTRY * sizeof (devPtrB [0]), nscol2, cudaMemcpyDeviceToHost, Common->cudaStreamTrsm) ; if (cudaStat) { ERROR (CHOLMOD_GPU_PROBLEM, "GPU memcopy from device") ; } /* ---------------------------------------------------------------------- */ /* synchronize with the GPU */ /* ---------------------------------------------------------------------- */ cudaStat = cudaThreadSynchronize ( ) ; if (cudaStat) { ERROR (CHOLMOD_GPU_PROBLEM, "GPU synchronization failure") ; } /* ---------------------------------------------------------------------- */ /* free workspace and return */ /* ---------------------------------------------------------------------- */ cudaFree (Common->devPotrfWork) ; Common->devPotrfWork = NULL ; #ifndef NTIMER Common->CHOLMOD_GPU_TRSM_TIME += SuiteSparse_time ( ) - tstart ; #endif return (1) ; } #undef REAL #undef COMPLEX #undef ZOMPLEX Matrix/src/CHOLMOD/Supernodal/cholmod_super_numeric.c0000644000176200001440000002527513652535054022262 0ustar liggesusers/* ========================================================================== */ /* === Supernodal/cholmod_super_numeric ===================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Supernodal Module. Copyright (C) 2005-2006, Timothy A. Davis * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* Computes the Cholesky factorization of A+beta*I or A*F+beta*I. Only the * the lower triangular part of A+beta*I or A*F+beta*I is accessed. The * matrices A and F must already be permuted according to the fill-reduction * permutation L->Perm. cholmod_factorize is an "easy" wrapper for this code * which applies that permutation. beta is real. * * Symmetric case: A is a symmetric (lower) matrix. F is not accessed. * With a fill-reducing permutation, A(p,p) should be passed instead, where is * p is L->Perm. * * Unsymmetric case: A is unsymmetric, and F must be present. Normally, F=A'. * With a fill-reducing permutation, A(p,f) and A(p,f)' should be passed as A * and F, respectively, where f is a list of the subset of the columns of A. * * The input factorization L must be supernodal (L->is_super is TRUE). It can * either be symbolic or numeric. In the first case, L has been analyzed by * cholmod_analyze or cholmod_super_symbolic, but the matrix has not yet been * numerically factorized. The numerical values are allocated here and the * factorization is computed. In the second case, a prior matrix has been * analyzed and numerically factorized, and a new matrix is being factorized. * The numerical values of L are replaced with the new numerical factorization. * * L->is_ll is ignored, and set to TRUE. This routine always computes an LL' * factorization. Supernodal LDL' factorization is not (yet) supported. * FUTURE WORK: perform a supernodal LDL' factorization if L->is_ll is FALSE. * * Uses BLAS routines dsyrk, dgemm, dtrsm, and the LAPACK routine dpotrf. * The supernodal solver uses BLAS routines dtrsv, dgemv, dtrsm, and dgemm. * * If the matrix is not positive definite the routine returns TRUE, but sets * Common->status to CHOLMOD_NOT_POSDEF and L->minor is set to the column at * which the failure occurred. The supernode containing the non-positive * diagonal entry is set to zero (this includes columns to the left of L->minor * in the same supernode), as are all subsequent supernodes. * * workspace: Flag (nrow), Head (nrow+1), Iwork (2*nrow + 5*nsuper). * Allocates temporary space of size L->maxcsize * sizeof(double) * (twice that for the complex/zomplex case). * * If L is supernodal symbolic on input, it is converted to a supernodal numeric * factor on output, with an xtype of real if A is real, or complex if A is * complex or zomplex. If L is supernodal numeric on input, its xtype must * match A (except that L can be complex and A zomplex). The xtype of A and F * must match. */ #ifndef NGPL #ifndef NSUPERNODAL #include "cholmod_internal.h" #include "cholmod_supernodal.h" #ifdef GPU_BLAS #include "cholmod_gpu.h" #endif /* ========================================================================== */ /* === TEMPLATE codes for GPU and regular numeric factorization ============= */ /* ========================================================================== */ #ifdef DLONG #ifdef GPU_BLAS #define REAL #include "../GPU/t_cholmod_gpu.c" #define COMPLEX #include "../GPU/t_cholmod_gpu.c" #define ZOMPLEX /* no #include of "../GPU/t_cholmod_gpu.c". Zomplex case relies on complex */ #endif #endif #define REAL #include "t_cholmod_super_numeric.c" #define COMPLEX #include "t_cholmod_super_numeric.c" #define ZOMPLEX #include "t_cholmod_super_numeric.c" /* ========================================================================== */ /* === cholmod_super_numeric ================================================ */ /* ========================================================================== */ /* Returns TRUE if successful, or if the matrix is not positive definite. * Returns FALSE if out of memory, inputs are invalid, or other fatal error * occurs. */ int CHOLMOD(super_numeric) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to factorize */ cholmod_sparse *F, /* F = A' or A(:,f)' */ double beta [2], /* beta*I is added to diagonal of matrix to factorize */ /* ---- in/out --- */ cholmod_factor *L, /* factorization */ /* --------------- */ cholmod_common *Common ) { cholmod_dense *C ; Int *Super, *Map, *SuperMap ; size_t maxcsize ; Int nsuper, n, i, k, s, stype, nrow ; int ok = TRUE, symbolic ; size_t t, w ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_COMPLEX, FALSE) ; stype = A->stype ; if (stype < 0) { if (A->nrow != A->ncol || A->nrow != L->n) { ERROR (CHOLMOD_INVALID, "invalid dimensions") ; return (FALSE) ; } } else if (stype == 0) { if (A->nrow != L->n) { ERROR (CHOLMOD_INVALID, "invalid dimensions") ; return (FALSE) ; } RETURN_IF_NULL (F, FALSE) ; RETURN_IF_XTYPE_INVALID (F, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ; if (A->nrow != F->ncol || A->ncol != F->nrow || F->stype != 0) { ERROR (CHOLMOD_INVALID, "F invalid") ; return (FALSE) ; } if (A->xtype != F->xtype) { ERROR (CHOLMOD_INVALID, "A and F must have same xtype") ; return (FALSE) ; } } else { /* symmetric upper case not suppored */ ERROR (CHOLMOD_INVALID, "symmetric upper case not supported") ; return (FALSE) ; } if (!(L->is_super)) { ERROR (CHOLMOD_INVALID, "L not supernodal") ; return (FALSE) ; } if (L->xtype != CHOLMOD_PATTERN) { if (! ((A->xtype == CHOLMOD_REAL && L->xtype == CHOLMOD_REAL) || (A->xtype == CHOLMOD_COMPLEX && L->xtype == CHOLMOD_COMPLEX) || (A->xtype == CHOLMOD_ZOMPLEX && L->xtype == CHOLMOD_COMPLEX))) { ERROR (CHOLMOD_INVALID, "complex type mismatch") ; return (FALSE) ; } } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace in Common */ /* ---------------------------------------------------------------------- */ nsuper = L->nsuper ; maxcsize = L->maxcsize ; nrow = A->nrow ; n = nrow ; PRINT1 (("nsuper "ID" maxcsize %g\n", nsuper, (double) maxcsize)) ; ASSERT (nsuper >= 0 && maxcsize > 0) ; /* w = 2*n + 5*nsuper */ w = CHOLMOD(mult_size_t) (n, 2, &ok) ; t = CHOLMOD(mult_size_t) (nsuper, 5, &ok) ; w = CHOLMOD(add_size_t) (w, t, &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (FALSE) ; } CHOLMOD(allocate_work) (n, w, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; /* ---------------------------------------------------------------------- */ /* get the current factor L and allocate numerical part, if needed */ /* ---------------------------------------------------------------------- */ Super = L->super ; symbolic = (L->xtype == CHOLMOD_PATTERN) ; if (symbolic) { /* convert to supernodal numeric by allocating L->x */ CHOLMOD(change_factor) ( (A->xtype == CHOLMOD_REAL) ? CHOLMOD_REAL : CHOLMOD_COMPLEX, TRUE, TRUE, TRUE, TRUE, L, Common) ; if (Common->status < CHOLMOD_OK) { /* the factor L remains in symbolic supernodal form */ return (FALSE) ; } } ASSERT (L->dtype == DTYPE) ; ASSERT (L->xtype == CHOLMOD_REAL || L->xtype == CHOLMOD_COMPLEX) ; /* supernodal LDL' is not supported */ L->is_ll = TRUE ; /* ---------------------------------------------------------------------- */ /* get more workspace */ /* ---------------------------------------------------------------------- */ C = CHOLMOD(allocate_dense) (maxcsize, 1, maxcsize, L->xtype, Common) ; if (Common->status < CHOLMOD_OK) { int status = Common->status ; if (symbolic) { /* Change L back to symbolic, since the numeric values are not * initialized. This cannot fail. */ CHOLMOD(change_factor) (CHOLMOD_PATTERN, TRUE, TRUE, TRUE, TRUE, L, Common) ; } /* the factor L is now back to the form it had on input */ Common->status = status ; return (FALSE) ; } /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ SuperMap = Common->Iwork ; /* size n (i/i/l) */ Map = Common->Flag ; /* size n, use Flag as workspace for Map array */ for (i = 0 ; i < n ; i++) { Map [i] = EMPTY ; } /* ---------------------------------------------------------------------- */ /* find the mapping of nodes to relaxed supernodes */ /* ---------------------------------------------------------------------- */ /* SuperMap [k] = s if column k is contained in supernode s */ for (s = 0 ; s < nsuper ; s++) { PRINT1 (("Super ["ID"] "ID" ncols "ID"\n", s, Super[s], Super[s+1]-Super[s])); for (k = Super [s] ; k < Super [s+1] ; k++) { SuperMap [k] = s ; PRINT2 (("relaxed SuperMap ["ID"] = "ID"\n", k, SuperMap [k])) ; } } /* ---------------------------------------------------------------------- */ /* supernodal numerical factorization, using template routine */ /* ---------------------------------------------------------------------- */ switch (A->xtype) { case CHOLMOD_REAL: ok = r_cholmod_super_numeric (A, F, beta, L, C, Common) ; break ; case CHOLMOD_COMPLEX: ok = c_cholmod_super_numeric (A, F, beta, L, C, Common) ; break ; case CHOLMOD_ZOMPLEX: /* This operates on complex L, not zomplex */ ok = z_cholmod_super_numeric (A, F, beta, L, C, Common) ; break ; } /* ---------------------------------------------------------------------- */ /* clear Common workspace, free temp workspace C, and return */ /* ---------------------------------------------------------------------- */ /* Flag array was used as workspace, clear it */ Common->mark = EMPTY ; /* CHOLMOD(clear_flag) (Common) ; */ CHOLMOD_CLEAR_FLAG (Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; CHOLMOD(free_dense) (&C, Common) ; return (ok) ; } #endif #endif Matrix/src/CHOLMOD/Supernodal/t_cholmod_super_solve.c0000644000176200001440000002523013652535054022262 0ustar liggesusers/* ========================================================================== */ /* === Supernodal/t_cholmod_super_solve ===================================== */ /* ========================================================================== */ /* ----------------------------------------------------------------------------- * CHOLMOD/Supernodal Module. Copyright (C) 2005-2006, Timothy A. Davis * http://www.suitesparse.com * -------------------------------------------------------------------------- */ /* Template routine for cholmod_super_solve. Supports real or complex L. */ #include "cholmod_template.h" static void TEMPLATE (cholmod_super_lsolve) ( /* ---- input ---- */ cholmod_factor *L, /* factor to use for the forward solve */ /* ---- output ---- */ cholmod_dense *X, /* b on input, solution to Lx=b on output */ /* ---- workspace ---- */ cholmod_dense *E, /* workspace of size nrhs*(L->maxesize) */ /* --------------- */ cholmod_common *Common ) { double *Lx, *Xx, *Ex ; double minus_one [2], one [2] ; Int *Lpi, *Lpx, *Ls, *Super ; Int nsuper, k1, k2, psi, psend, psx, nsrow, nscol, ii, s, nsrow2, n, ps2, j, i, d, nrhs ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ nrhs = X->ncol ; Ex = E->x ; Xx = X->x ; n = L->n ; d = X->d ; nsuper = L->nsuper ; Lpi = L->pi ; Lpx = L->px ; Ls = L->s ; Super = L->super ; Lx = L->x ; minus_one [0] = -1.0 ; minus_one [1] = 0 ; one [0] = 1.0 ; one [1] = 0 ; /* ---------------------------------------------------------------------- */ /* solve Lx=b */ /* ---------------------------------------------------------------------- */ if (nrhs == 1) { for (s = 0 ; s < nsuper ; s++) { k1 = Super [s] ; k2 = Super [s+1] ; psi = Lpi [s] ; psend = Lpi [s+1] ; psx = Lpx [s] ; nsrow = psend - psi ; nscol = k2 - k1 ; nsrow2 = nsrow - nscol ; ps2 = psi + nscol ; ASSERT ((size_t) nsrow2 <= L->maxesize) ; /* L1 is nscol-by-nscol, lower triangular with non-unit diagonal. * L2 is nsrow2-by-nscol. L1 and L2 have leading dimension of * nsrow. x1 is nscol-by-nsrow, with leading dimension n. * E is nsrow2-by-1, with leading dimension nsrow2. */ /* gather X into E */ for (ii = 0 ; ii < nsrow2 ; ii++) { /* Ex [ii] = Xx [Ls [ps2 + ii]] ; */ ASSIGN (Ex,-,ii, Xx,-,Ls [ps2 + ii]) ; } #ifdef REAL /* solve L1*x1 (that is, x1 = L1\x1) */ BLAS_dtrsv ("L", "N", "N", nscol, /* N: L1 is nscol-by-nscol */ Lx + ENTRY_SIZE*psx, nsrow, /* A, LDA: L1 */ Xx + ENTRY_SIZE*k1, 1) ; /* X, INCX: x1 */ /* E = E - L2*x1 */ BLAS_dgemv ("N", nsrow2, nscol, /* M, N: L2 is nsrow2-by-nscol */ minus_one, /* ALPHA: -1 */ Lx + ENTRY_SIZE*(psx + nscol), /* A, LDA: L2 */ nsrow, Xx + ENTRY_SIZE*k1, 1, /* X, INCX: x1 */ one, /* BETA: 1 */ Ex, 1) ; /* Y, INCY: E */ #else /* solve L1*x1 (that is, x1 = L1\x1) */ BLAS_ztrsv ("L", "N", "N", nscol, /* N: L1 is nscol-by-nscol */ Lx + ENTRY_SIZE*psx, nsrow, /* A, LDA: L1 */ Xx + ENTRY_SIZE*k1, 1) ; /* X, INCX: x1 */ /* E = E - L2*x1 */ BLAS_zgemv ("N", nsrow2, nscol, /* M, N: L2 is nsrow2-by-nscol */ minus_one, /* ALPHA: -1 */ Lx + ENTRY_SIZE*(psx + nscol), /* A, LDA: L2 */ nsrow, Xx + ENTRY_SIZE*k1, 1, /* X, INCX: x1 */ one, /* BETA: 1 */ Ex, 1) ; /* Y, INCY: E */ #endif /* scatter E back into X */ for (ii = 0 ; ii < nsrow2 ; ii++) { /* Xx [Ls [ps2 + ii]] = Ex [ii] ; */ ASSIGN (Xx,-,Ls [ps2 + ii], Ex,-,ii) ; } } } else { for (s = 0 ; s < nsuper ; s++) { k1 = Super [s] ; k2 = Super [s+1] ; psi = Lpi [s] ; psend = Lpi [s+1] ; psx = Lpx [s] ; nsrow = psend - psi ; nscol = k2 - k1 ; nsrow2 = nsrow - nscol ; ps2 = psi + nscol ; ASSERT ((size_t) nsrow2 <= L->maxesize) ; /* E is nsrow2-by-nrhs, with leading dimension nsrow2. */ /* gather X into E */ for (ii = 0 ; ii < nsrow2 ; ii++) { i = Ls [ps2 + ii] ; for (j = 0 ; j < nrhs ; j++) { /* Ex [ii + j*nsrow2] = Xx [i + j*d] ; */ ASSIGN (Ex,-,ii+j*nsrow2, Xx,-,i+j*d) ; } } #ifdef REAL /* solve L1*x1 */ BLAS_dtrsm ("L", "L", "N", "N", nscol, nrhs, /* M, N: x1 is nscol-by-nrhs */ one, /* ALPHA: 1 */ Lx + ENTRY_SIZE*psx, nsrow, /* A, LDA: L1 */ Xx + ENTRY_SIZE*k1, d) ; /* B, LDB: x1 */ /* E = E - L2*x1 */ if (nsrow2 > 0) { BLAS_dgemm ("N", "N", nsrow2, nrhs, nscol, /* M, N, K */ minus_one, /* ALPHA: -1 */ Lx + ENTRY_SIZE*(psx + nscol), /* A, LDA: L2 */ nsrow, Xx + ENTRY_SIZE*k1, d, /* B, LDB: X1 */ one, /* BETA: 1 */ Ex, nsrow2) ; /* C, LDC: E */ } #else /* solve L1*x1 */ BLAS_ztrsm ("L", "L", "N", "N", nscol, nrhs, /* M, N: x1 is nscol-by-nrhs */ one, /* ALPHA: 1 */ Lx + ENTRY_SIZE*psx, nsrow, /* A, LDA: L1 */ Xx + ENTRY_SIZE*k1, d) ; /* B, LDB: x1 */ /* E = E - L2*x1 */ if (nsrow2 > 0) { BLAS_zgemm ("N", "N", nsrow2, nrhs, nscol, /* M, N, K */ minus_one, /* ALPHA: -1 */ Lx + ENTRY_SIZE*(psx + nscol), /* A, LDA: L2 */ nsrow, Xx + ENTRY_SIZE*k1, d, /* B, LDB: X1 */ one, /* BETA: 1 */ Ex, nsrow2) ; /* C, LDC: E */ } #endif /* scatter E back into X */ for (ii = 0 ; ii < nsrow2 ; ii++) { i = Ls [ps2 + ii] ; for (j = 0 ; j < nrhs ; j++) { /* Xx [i + j*d] = Ex [ii + j*nsrow2] ; */ ASSIGN (Xx,-,i+j*d, Ex,-,ii+j*nsrow2) ; } } } } } static void TEMPLATE (cholmod_super_ltsolve) ( /* ---- input ---- */ cholmod_factor *L, /* factor to use for the forward solve */ /* ---- output ---- */ cholmod_dense *X, /* b on input, solution to Lx=b on output */ /* ---- workspace ---- */ cholmod_dense *E, /* workspace of size nrhs*(L->maxesize) */ /* --------------- */ cholmod_common *Common ) { double *Lx, *Xx, *Ex ; double minus_one [2], one [2] ; Int *Lpi, *Lpx, *Ls, *Super ; Int nsuper, k1, k2, psi, psend, psx, nsrow, nscol, ii, s, nsrow2, n, ps2, j, i, d, nrhs ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ nrhs = X->ncol ; Ex = E->x ; Xx = X->x ; n = L->n ; d = X->d ; nsuper = L->nsuper ; Lpi = L->pi ; Lpx = L->px ; Ls = L->s ; Super = L->super ; Lx = L->x ; minus_one [0] = -1.0 ; minus_one [1] = 0 ; one [0] = 1.0 ; one [1] = 0 ; /* ---------------------------------------------------------------------- */ /* solve L'x=b */ /* ---------------------------------------------------------------------- */ if (nrhs == 1) { for (s = nsuper-1 ; s >= 0 ; s--) { k1 = Super [s] ; k2 = Super [s+1] ; psi = Lpi [s] ; psend = Lpi [s+1] ; psx = Lpx [s] ; nsrow = psend - psi ; nscol = k2 - k1 ; nsrow2 = nsrow - nscol ; ps2 = psi + nscol ; ASSERT ((size_t) nsrow2 <= L->maxesize) ; /* L1 is nscol-by-nscol, lower triangular with non-unit diagonal. * L2 is nsrow2-by-nscol. L1 and L2 have leading dimension of * nsrow. x1 is nscol-by-nsrow, with leading dimension n. * E is nsrow2-by-1, with leading dimension nsrow2. */ /* gather X into E */ for (ii = 0 ; ii < nsrow2 ; ii++) { /* Ex [ii] = Xx [Ls [ps2 + ii]] ; */ ASSIGN (Ex,-,ii, Xx,-,Ls [ps2 + ii]) ; } #ifdef REAL /* x1 = x1 - L2'*E */ BLAS_dgemv ("C", nsrow2, nscol, /* M, N: L2 is nsrow2-by-nscol */ minus_one, /* ALPHA: -1 */ Lx + ENTRY_SIZE*(psx + nscol), /* A, LDA: L2 */ nsrow, Ex, 1, /* X, INCX: Ex */ one, /* BETA: 1 */ Xx + ENTRY_SIZE*k1, 1) ; /* Y, INCY: x1 */ /* solve L1'*x1 */ BLAS_dtrsv ("L", "C", "N", nscol, /* N: L1 is nscol-by-nscol */ Lx + ENTRY_SIZE*psx, nsrow, /* A, LDA: L1 */ Xx + ENTRY_SIZE*k1, 1) ; /* X, INCX: x1 */ #else /* x1 = x1 - L2'*E */ BLAS_zgemv ("C", nsrow2, nscol, /* M, N: L2 is nsrow2-by-nscol */ minus_one, /* ALPHA: -1 */ Lx + ENTRY_SIZE*(psx + nscol), /* A, LDA: L2 */ nsrow, Ex, 1, /* X, INCX: Ex */ one, /* BETA: 1 */ Xx + ENTRY_SIZE*k1, 1) ; /* Y, INCY: x1 */ /* solve L1'*x1 */ BLAS_ztrsv ("L", "C", "N", nscol, /* N: L1 is nscol-by-nscol */ Lx + ENTRY_SIZE*psx, nsrow, /* A, LDA: L1 */ Xx + ENTRY_SIZE*k1, 1) ; /* X, INCX: x1 */ #endif } } else { for (s = nsuper-1 ; s >= 0 ; s--) { k1 = Super [s] ; k2 = Super [s+1] ; psi = Lpi [s] ; psend = Lpi [s+1] ; psx = Lpx [s] ; nsrow = psend - psi ; nscol = k2 - k1 ; nsrow2 = nsrow - nscol ; ps2 = psi + nscol ; ASSERT ((size_t) nsrow2 <= L->maxesize) ; /* E is nsrow2-by-nrhs, with leading dimension nsrow2. */ /* gather X into E */ for (ii = 0 ; ii < nsrow2 ; ii++) { i = Ls [ps2 + ii] ; for (j = 0 ; j < nrhs ; j++) { /* Ex [ii + j*nsrow2] = Xx [i + j*d] ; */ ASSIGN (Ex,-,ii+j*nsrow2, Xx,-,i+j*d) ; } } #ifdef REAL /* x1 = x1 - L2'*E */ if (nsrow2 > 0) { BLAS_dgemm ("C", "N", nscol, nrhs, nsrow2, /* M, N, K */ minus_one, /* ALPHA: -1 */ Lx + ENTRY_SIZE*(psx + nscol), /* A, LDA: L2 */ nsrow, Ex, nsrow2, /* B, LDB: E */ one, /* BETA: 1 */ Xx + ENTRY_SIZE*k1, d) ; /* C, LDC: x1 */ } /* solve L1'*x1 */ BLAS_dtrsm ("L", "L", "C", "N", nscol, nrhs, /* M, N: x1 is nscol-by-nrhs */ one, /* ALPHA: 1 */ Lx + ENTRY_SIZE*psx, nsrow, /* A, LDA: L1 */ Xx + ENTRY_SIZE*k1, d) ; /* B, LDB: x1 */ #else /* x1 = x1 - L2'*E */ if (nsrow2 > 0) { BLAS_zgemm ("C", "N", nscol, nrhs, nsrow2, /* M, N, K */ minus_one, /* ALPHA: -1 */ Lx + ENTRY_SIZE*(psx + nscol), /* A, LDA: L2 */ nsrow, Ex, nsrow2, /* B, LDB: E */ one, /* BETA: 1 */ Xx + ENTRY_SIZE*k1, d) ; /* C, LDC: x1 */ } /* solve L1'*x1 */ BLAS_ztrsm ("L", "L", "C", "N", nscol, nrhs, /* M, N: x1 is nscol-by-nrhs */ one, /* ALPHA: 1 */ Lx + ENTRY_SIZE*psx, nsrow, /* A, LDA: L1 */ Xx + ENTRY_SIZE*k1, d) ; /* B, LDB: x1 */ #endif } } } #undef PATTERN #undef REAL #undef COMPLEX #undef ZOMPLEX Matrix/src/SuiteSparse_config/0000755000176200001440000000000014154165627016114 5ustar liggesusersMatrix/src/SuiteSparse_config/SuiteSparse_config.h0000644000176200001440000001701313652535054022060 0ustar liggesusers/* ========================================================================== */ /* === SuiteSparse_config =================================================== */ /* ========================================================================== */ /* Configuration file for SuiteSparse: a Suite of Sparse matrix packages * (AMD, COLAMD, CCOLAMD, CAMD, CHOLMOD, UMFPACK, CXSparse, and others). * * SuiteSparse_config.h provides the definition of the long integer. On most * systems, a C program can be compiled in LP64 mode, in which long's and * pointers are both 64-bits, and int's are 32-bits. Windows 64, however, uses * the LLP64 model, in which int's and long's are 32-bits, and long long's and * pointers are 64-bits. * * SuiteSparse packages that include long integer versions are * intended for the LP64 mode. However, as a workaround for Windows 64 * (and perhaps other systems), the long integer can be redefined. * * If _WIN64 is defined, then the __int64 type is used instead of long. * * The long integer can also be defined at compile time. For example, this * could be added to SuiteSparse_config.mk: * * CFLAGS = -O -D'SuiteSparse_long=long long' \ * -D'SuiteSparse_long_max=9223372036854775801' -D'SuiteSparse_long_idd="lld"' * * This file defines SuiteSparse_long as either long (on all but _WIN64) or * __int64 on Windows 64. The intent is that a SuiteSparse_long is always a * 64-bit integer in a 64-bit code. ptrdiff_t might be a better choice than * long; it is always the same size as a pointer. * * This file also defines the SUITESPARSE_VERSION and related definitions. * * Copyright (c) 2012, Timothy A. Davis. No licensing restrictions apply * to this file or to the SuiteSparse_config directory. * Author: Timothy A. Davis. */ #ifndef SUITESPARSE_CONFIG_H #define SUITESPARSE_CONFIG_H #ifdef __cplusplus extern "C" { #endif #include #include /* ========================================================================== */ /* === SuiteSparse_long ===================================================== */ /* ========================================================================== */ #ifndef SuiteSparse_long #ifdef _WIN64 #define SuiteSparse_long __int64 #define SuiteSparse_long_max _I64_MAX #define SuiteSparse_long_idd "I64d" #else #define SuiteSparse_long long #define SuiteSparse_long_max LONG_MAX #define SuiteSparse_long_idd "ld" #endif #define SuiteSparse_long_id "%" SuiteSparse_long_idd #endif /* ========================================================================== */ /* === SuiteSparse_config parameters and functions ========================== */ /* ========================================================================== */ /* SuiteSparse-wide parameters are placed in this struct. It is meant to be an extern, globally-accessible struct. It is not meant to be updated frequently by multiple threads. Rather, if an application needs to modify SuiteSparse_config, it should do it once at the beginning of the application, before multiple threads are launched. The intent of these function pointers is that they not be used in your application directly, except to assign them to the desired user-provided functions. Rather, you should use the */ struct SuiteSparse_config_struct { void *(*malloc_func) (size_t) ; /* pointer to malloc */ void *(*calloc_func) (size_t, size_t) ; /* pointer to calloc */ void *(*realloc_func) (void *, size_t) ; /* pointer to realloc */ void (*free_func) (void *) ; /* pointer to free */ int (*printf_func) (const char *, ...) ; /* pointer to printf */ double (*hypot_func) (double, double) ; /* pointer to hypot */ int (*divcomplex_func) (double, double, double, double, double *, double *); } ; extern struct SuiteSparse_config_struct SuiteSparse_config ; void SuiteSparse_start ( void ) ; /* called to start SuiteSparse */ void SuiteSparse_finish ( void ) ; /* called to finish SuiteSparse */ void *SuiteSparse_malloc /* pointer to allocated block of memory */ ( size_t nitems, /* number of items to malloc (>=1 is enforced) */ size_t size_of_item /* sizeof each item */ ) ; void *SuiteSparse_calloc /* pointer to allocated block of memory */ ( size_t nitems, /* number of items to calloc (>=1 is enforced) */ size_t size_of_item /* sizeof each item */ ) ; void *SuiteSparse_realloc /* pointer to reallocated block of memory, or to original block if the realloc failed. */ ( size_t nitems_new, /* new number of items in the object */ size_t nitems_old, /* old number of items in the object */ size_t size_of_item, /* sizeof each item */ void *p, /* old object to reallocate */ int *ok /* 1 if successful, 0 otherwise */ ) ; void *SuiteSparse_free /* always returns NULL */ ( void *p /* block to free */ ) ; void SuiteSparse_tic /* start the timer */ ( double tic [2] /* output, contents undefined on input */ ) ; double SuiteSparse_toc /* return time in seconds since last tic */ ( double tic [2] /* input: from last call to SuiteSparse_tic */ ) ; double SuiteSparse_time /* returns current wall clock time in seconds */ ( void ) ; /* returns sqrt (x^2 + y^2), computed reliably */ double SuiteSparse_hypot (double x, double y) ; /* complex division of c = a/b */ int SuiteSparse_divcomplex ( double ar, double ai, /* real and imaginary parts of a */ double br, double bi, /* real and imaginary parts of b */ double *cr, double *ci /* real and imaginary parts of c */ ) ; /* determine which timer to use, if any */ #ifndef NTIMER #ifdef _POSIX_C_SOURCE #if _POSIX_C_SOURCE >= 199309L #define SUITESPARSE_TIMER_ENABLED #endif #endif #endif /* SuiteSparse printf macro */ #define SUITESPARSE_PRINTF(params) \ { \ if (SuiteSparse_config.printf_func != NULL) \ { \ (void) (SuiteSparse_config.printf_func) params ; \ } \ } /* ========================================================================== */ /* === SuiteSparse version ================================================== */ /* ========================================================================== */ /* SuiteSparse is not a package itself, but a collection of packages, some of * which must be used together (UMFPACK requires AMD, CHOLMOD requires AMD, * COLAMD, CAMD, and CCOLAMD, etc). A version number is provided here for the * collection itself, which is also the version number of SuiteSparse_config. */ int SuiteSparse_version /* returns SUITESPARSE_VERSION */ ( /* output, not defined on input. Not used if NULL. Returns the three version codes in version [0..2]: version [0] is SUITESPARSE_MAIN_VERSION version [1] is SUITESPARSE_SUB_VERSION version [2] is SUITESPARSE_SUBSUB_VERSION */ int version [3] ) ; /* Versions prior to 4.2.0 do not have the above function. The following code fragment will work with any version of SuiteSparse: #ifdef SUITESPARSE_HAS_VERSION_FUNCTION v = SuiteSparse_version (NULL) ; #else v = SUITESPARSE_VERSION ; #endif */ #define SUITESPARSE_HAS_VERSION_FUNCTION #define SUITESPARSE_DATE "Feb 20, 2020" #define SUITESPARSE_VER_CODE(main,sub) ((main) * 1000 + (sub)) #define SUITESPARSE_MAIN_VERSION 5 #define SUITESPARSE_SUB_VERSION 7 #define SUITESPARSE_SUBSUB_VERSION 1 #define SUITESPARSE_VERSION \ SUITESPARSE_VER_CODE(SUITESPARSE_MAIN_VERSION,SUITESPARSE_SUB_VERSION) #ifdef __cplusplus } #endif #endif Matrix/src/SuiteSparse_config/Makefile0000644000176200001440000000065014154165630017547 0ustar liggesusers#------------------------------------------------------------------------------- # SuiteSparse_config Makefile #------------------------------------------------------------------------------- VERSION = 4.2.1 PKG_CPPFLAGS = -DNTIMER LIB = ../SuiteSparse_config.a library: $(LIB) $(LIB): SuiteSparse_config.o $(AR) -rucs $(LIB) SuiteSparse_config.o mostlyclean: clean clean: @-rm -rf .libs _libs $(LIB) @-rm -f *.o Matrix/src/SuiteSparse_config/SuiteSparse_config.mk0000644000176200001440000000000011770402705022217 0ustar liggesusersMatrix/src/SuiteSparse_config/SuiteSparse_config.c0000644000176200001440000004033313652535054022054 0ustar liggesusers/* ========================================================================== */ /* === SuiteSparse_config =================================================== */ /* ========================================================================== */ /* SuiteSparse configuration : memory manager and printf functions. */ /* Copyright (c) 2013-2018, Timothy A. Davis. No licensing restrictions * apply to this file or to the SuiteSparse_config directory. * Author: Timothy A. Davis. */ #include #include // For use with R package 'Matrix': #define NPRINT #ifndef NPRINT #include #endif #ifdef MATLAB_MEX_FILE #include "mex.h" #include "matrix.h" #endif #ifndef NULL #define NULL ((void *) 0) #endif #include "SuiteSparse_config.h" /* -------------------------------------------------------------------------- */ /* SuiteSparse_config : a global extern struct */ /* -------------------------------------------------------------------------- */ /* The SuiteSparse_config struct is available to all SuiteSparse functions and to all applications that use those functions. It must be modified with care, particularly in a multithreaded context. Normally, the application will initialize this object once, via SuiteSparse_start, possibily followed by application-specific modifications if the applications wants to use alternative memory manager functions. The user can redefine these global pointers at run-time to change the memory manager and printf function used by SuiteSparse. If -DNMALLOC is defined at compile-time, then no memory-manager is specified. You must define them at run-time, after calling SuiteSparse_start. If -DPRINT is defined a compile time, then printf is disabled, and SuiteSparse will not use printf. */ struct SuiteSparse_config_struct SuiteSparse_config = { /* memory management functions */ #ifndef NMALLOC #ifdef MATLAB_MEX_FILE /* MATLAB mexFunction: */ mxMalloc, mxCalloc, mxRealloc, mxFree, #else /* standard ANSI C: */ malloc, calloc, realloc, free, #endif #else /* no memory manager defined; you must define one at run-time: */ NULL, NULL, NULL, NULL, #endif /* printf function */ #ifndef NPRINT #ifdef MATLAB_MEX_FILE /* MATLAB mexFunction: */ mexPrintf, #else // /* standard ANSI C: */ // printf, // For use with R package 'Matrix': #include Rprintf, #endif #else /* printf is disabled */ NULL, #endif SuiteSparse_hypot, SuiteSparse_divcomplex } ; /* -------------------------------------------------------------------------- */ /* SuiteSparse_start */ /* -------------------------------------------------------------------------- */ /* All applications that use SuiteSparse should call SuiteSparse_start prior to using any SuiteSparse function. Only a single thread should call this function, in a multithreaded application. Currently, this function is optional, since all this function currently does is to set the four memory function pointers to NULL (which tells SuiteSparse to use the default functions). In a multi- threaded application, only a single thread should call this function. Future releases of SuiteSparse might enforce a requirement that SuiteSparse_start be called prior to calling any SuiteSparse function. */ void SuiteSparse_start ( void ) { /* memory management functions */ #ifndef NMALLOC #ifdef MATLAB_MEX_FILE /* MATLAB mexFunction: */ SuiteSparse_config.malloc_func = mxMalloc ; SuiteSparse_config.calloc_func = mxCalloc ; SuiteSparse_config.realloc_func = mxRealloc ; SuiteSparse_config.free_func = mxFree ; #else /* standard ANSI C: */ SuiteSparse_config.malloc_func = malloc ; SuiteSparse_config.calloc_func = calloc ; SuiteSparse_config.realloc_func = realloc ; SuiteSparse_config.free_func = free ; #endif #else /* no memory manager defined; you must define one after calling SuiteSparse_start */ SuiteSparse_config.malloc_func = NULL ; SuiteSparse_config.calloc_func = NULL ; SuiteSparse_config.realloc_func = NULL ; SuiteSparse_config.free_func = NULL ; #endif /* printf function */ #ifndef NPRINT #ifdef MATLAB_MEX_FILE /* MATLAB mexFunction: */ SuiteSparse_config.printf_func = mexPrintf ; #else /* standard ANSI C: */ SuiteSparse_config.printf_func = printf ; #endif #else /* printf is disabled */ SuiteSparse_config.printf_func = NULL ; #endif /* math functions */ SuiteSparse_config.hypot_func = SuiteSparse_hypot ; SuiteSparse_config.divcomplex_func = SuiteSparse_divcomplex ; } /* -------------------------------------------------------------------------- */ /* SuiteSparse_finish */ /* -------------------------------------------------------------------------- */ /* This currently does nothing, but in the future, applications should call SuiteSparse_start before calling any SuiteSparse function, and then SuiteSparse_finish after calling the last SuiteSparse function, just before exiting. In a multithreaded application, only a single thread should call this function. Future releases of SuiteSparse might use this function for any SuiteSparse-wide cleanup operations or finalization of statistics. */ void SuiteSparse_finish ( void ) { /* do nothing */ ; } /* -------------------------------------------------------------------------- */ /* SuiteSparse_malloc: malloc wrapper */ /* -------------------------------------------------------------------------- */ void *SuiteSparse_malloc /* pointer to allocated block of memory */ ( size_t nitems, /* number of items to malloc */ size_t size_of_item /* sizeof each item */ ) { void *p ; size_t size ; if (nitems < 1) nitems = 1 ; if (size_of_item < 1) size_of_item = 1 ; size = nitems * size_of_item ; if (size != ((double) nitems) * size_of_item) { /* size_t overflow */ p = NULL ; } else { p = (void *) (SuiteSparse_config.malloc_func) (size) ; } return (p) ; } /* -------------------------------------------------------------------------- */ /* SuiteSparse_calloc: calloc wrapper */ /* -------------------------------------------------------------------------- */ void *SuiteSparse_calloc /* pointer to allocated block of memory */ ( size_t nitems, /* number of items to calloc */ size_t size_of_item /* sizeof each item */ ) { void *p ; size_t size ; if (nitems < 1) nitems = 1 ; if (size_of_item < 1) size_of_item = 1 ; size = nitems * size_of_item ; if (size != ((double) nitems) * size_of_item) { /* size_t overflow */ p = NULL ; } else { p = (void *) (SuiteSparse_config.calloc_func) (nitems, size_of_item) ; } return (p) ; } /* -------------------------------------------------------------------------- */ /* SuiteSparse_realloc: realloc wrapper */ /* -------------------------------------------------------------------------- */ /* If p is non-NULL on input, it points to a previously allocated object of size nitems_old * size_of_item. The object is reallocated to be of size nitems_new * size_of_item. If p is NULL on input, then a new object of that size is allocated. On success, a pointer to the new object is returned, and ok is returned as 1. If the allocation fails, ok is set to 0 and a pointer to the old (unmodified) object is returned. */ void *SuiteSparse_realloc /* pointer to reallocated block of memory, or to original block if the realloc failed. */ ( size_t nitems_new, /* new number of items in the object */ size_t nitems_old, /* old number of items in the object */ size_t size_of_item, /* sizeof each item */ void *p, /* old object to reallocate */ int *ok /* 1 if successful, 0 otherwise */ ) { size_t size ; if (nitems_old < 1) nitems_old = 1 ; if (nitems_new < 1) nitems_new = 1 ; if (size_of_item < 1) size_of_item = 1 ; size = nitems_new * size_of_item ; if (size != ((double) nitems_new) * size_of_item) { /* size_t overflow */ (*ok) = 0 ; } else if (p == NULL) { /* a fresh object is being allocated */ p = SuiteSparse_malloc (nitems_new, size_of_item) ; (*ok) = (p != NULL) ; } else if (nitems_old == nitems_new) { /* the object does not change; do nothing */ (*ok) = 1 ; } else { /* change the size of the object from nitems_old to nitems_new */ void *pnew ; pnew = (void *) (SuiteSparse_config.realloc_func) (p, size) ; if (pnew == NULL) { if (nitems_new < nitems_old) { /* the attempt to reduce the size of the block failed, but the old block is unchanged. So pretend to succeed. */ (*ok) = 1 ; } else { /* out of memory */ (*ok) = 0 ; } } else { /* success */ p = pnew ; (*ok) = 1 ; } } return (p) ; } /* -------------------------------------------------------------------------- */ /* SuiteSparse_free: free wrapper */ /* -------------------------------------------------------------------------- */ void *SuiteSparse_free /* always returns NULL */ ( void *p /* block to free */ ) { if (p) { (SuiteSparse_config.free_func) (p) ; } return (NULL) ; } /* -------------------------------------------------------------------------- */ /* SuiteSparse_tic: return current wall clock time */ /* -------------------------------------------------------------------------- */ /* Returns the number of seconds (tic [0]) and nanoseconds (tic [1]) since some * unspecified but fixed time in the past. If no timer is installed, zero is * returned. A scalar double precision value for 'tic' could be used, but this * might cause loss of precision because clock_getttime returns the time from * some distant time in the past. Thus, an array of size 2 is used. * * The timer is enabled by default. To disable the timer, compile with * -DNTIMER. If enabled on a POSIX C 1993 system, the timer requires linking * with the -lrt library. * * example: * * double tic [2], r, s, t ; * SuiteSparse_tic (tic) ; // start the timer * // do some work A * t = SuiteSparse_toc (tic) ; // t is time for work A, in seconds * // do some work B * s = SuiteSparse_toc (tic) ; // s is time for work A and B, in seconds * SuiteSparse_tic (tic) ; // restart the timer * // do some work C * r = SuiteSparse_toc (tic) ; // s is time for work C, in seconds * * A double array of size 2 is used so that this routine can be more easily * ported to non-POSIX systems. The caller does not rely on the POSIX * include file. */ #ifdef SUITESPARSE_TIMER_ENABLED #include void SuiteSparse_tic ( double tic [2] /* output, contents undefined on input */ ) { /* POSIX C 1993 timer, requires -librt */ struct timespec t ; clock_gettime (CLOCK_MONOTONIC, &t) ; tic [0] = (double) (t.tv_sec) ; tic [1] = (double) (t.tv_nsec) ; } #else void SuiteSparse_tic ( double tic [2] /* output, contents undefined on input */ ) { /* no timer installed */ tic [0] = 0 ; tic [1] = 0 ; } #endif /* -------------------------------------------------------------------------- */ /* SuiteSparse_toc: return time since last tic */ /* -------------------------------------------------------------------------- */ /* Assuming SuiteSparse_tic is accurate to the nanosecond, this function is * accurate down to the nanosecond for 2^53 nanoseconds since the last call to * SuiteSparse_tic, which is sufficient for SuiteSparse (about 104 days). If * additional accuracy is required, the caller can use two calls to * SuiteSparse_tic and do the calculations differently. */ double SuiteSparse_toc /* returns time in seconds since last tic */ ( double tic [2] /* input, not modified from last call to SuiteSparse_tic */ ) { double toc [2] ; SuiteSparse_tic (toc) ; return ((toc [0] - tic [0]) + 1e-9 * (toc [1] - tic [1])) ; } /* -------------------------------------------------------------------------- */ /* SuiteSparse_time: return current wallclock time in seconds */ /* -------------------------------------------------------------------------- */ /* This function might not be accurate down to the nanosecond. */ double SuiteSparse_time /* returns current wall clock time in seconds */ ( void ) { double toc [2] ; SuiteSparse_tic (toc) ; return (toc [0] + 1e-9 * toc [1]) ; } /* -------------------------------------------------------------------------- */ /* SuiteSparse_version: return the current version of SuiteSparse */ /* -------------------------------------------------------------------------- */ int SuiteSparse_version ( int version [3] ) { if (version != NULL) { version [0] = SUITESPARSE_MAIN_VERSION ; version [1] = SUITESPARSE_SUB_VERSION ; version [2] = SUITESPARSE_SUBSUB_VERSION ; } return (SUITESPARSE_VERSION) ; } /* -------------------------------------------------------------------------- */ /* SuiteSparse_hypot */ /* -------------------------------------------------------------------------- */ /* There is an equivalent routine called hypot in , which conforms * to ANSI C99. However, SuiteSparse does not assume that ANSI C99 is * available. You can use the ANSI C99 hypot routine with: * * #include *i SuiteSparse_config.hypot_func = hypot ; * * Default value of the SuiteSparse_config.hypot_func pointer is * SuiteSparse_hypot, defined below. * * s = hypot (x,y) computes s = sqrt (x*x + y*y) but does so more accurately. * The NaN cases for the double relops x >= y and x+y == x are safely ignored. * * Source: Algorithm 312, "Absolute value and square root of a complex number," * P. Friedland, Comm. ACM, vol 10, no 10, October 1967, page 665. */ double SuiteSparse_hypot (double x, double y) { double s, r ; x = fabs (x) ; y = fabs (y) ; if (x >= y) { if (x + y == x) { s = x ; } else { r = y / x ; s = x * sqrt (1.0 + r*r) ; } } else { if (y + x == y) { s = y ; } else { r = x / y ; s = y * sqrt (1.0 + r*r) ; } } return (s) ; } /* -------------------------------------------------------------------------- */ /* SuiteSparse_divcomplex */ /* -------------------------------------------------------------------------- */ /* c = a/b where c, a, and b are complex. The real and imaginary parts are * passed as separate arguments to this routine. The NaN case is ignored * for the double relop br >= bi. Returns 1 if the denominator is zero, * 0 otherwise. * * This uses ACM Algo 116, by R. L. Smith, 1962, which tries to avoid * underflow and overflow. * * c can be the same variable as a or b. * * Default value of the SuiteSparse_config.divcomplex_func pointer is * SuiteSparse_divcomplex. */ int SuiteSparse_divcomplex ( double ar, double ai, /* real and imaginary parts of a */ double br, double bi, /* real and imaginary parts of b */ double *cr, double *ci /* real and imaginary parts of c */ ) { double tr, ti, r, den ; if (fabs (br) >= fabs (bi)) { r = bi / br ; den = br + r * bi ; tr = (ar + ai * r) / den ; ti = (ai - ar * r) / den ; } else { r = br / bi ; den = r * br + bi ; tr = (ar * r + ai) / den ; ti = (ai * r - ar) / den ; } *cr = tr ; *ci = ti ; return (den == 0.) ; } Matrix/src/TMatrix_as.c0000644000176200001440000001216614060416534014535 0ustar liggesusers /* Sparse symmetric matrices in triplet format */ #include "TMatrix_as.h" #define MAYBE_DECLARE_AND_GET_X_SLOT(__T__, __S__) \ DECLARE_AND_GET_X_SLOT(__T__, __S__) #define Matrix_T_as_DENSE(_C_TYPE_, _SEXP_, _SEXPTYPE_, _SYMM_) \ SEXP dimP = GET_SLOT(x, Matrix_DimSym), \ xiP = GET_SLOT(x, Matrix_iSym); \ int k, n = INTEGER(dimP)[0]; R_xlen_t nnz = xlength(xiP); \ int *xi = INTEGER(xiP), *xj = INTEGER(GET_SLOT(x, Matrix_jSym)); \ R_xlen_t n_ = n, sz = n * n_; \ _C_TYPE_ *tx = _SEXP_(ALLOC_SLOT(val, Matrix_xSym, _SEXPTYPE_, sz)); \ MAYBE_DECLARE_AND_GET_X_SLOT(_C_TYPE_, _SEXP_); \ \ SET_SLOT(val, Matrix_DimSym, duplicate(dimP)); \ if(_SYMM_) \ SET_DimNames_symm(val, x); \ else \ SET_DimNames(val, x); \ slot_dup(val, x, Matrix_uploSym) #define Matrix_T_as_DENSE_FINISH(_X_k_) \ AZERO(tx, sz); \ for (k = 0; k < nnz; k++) \ tx[xi[k] + xj[k] * n_] = _X_k_; \ UNPROTECT(1); \ return val SEXP dsTMatrix_as_dsyMatrix(SEXP x) { SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("dsyMatrix")); Matrix_T_as_DENSE(double, REAL, REALSXP, FALSE); Matrix_T_as_DENSE_FINISH(xx[k]); } SEXP lsTMatrix_as_lsyMatrix(SEXP x) { SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("lsyMatrix")); Matrix_T_as_DENSE(int, LOGICAL, LGLSXP, FALSE); Matrix_T_as_DENSE_FINISH(xx[k]); } /* ---- Now the triangular ones -- have an extra 'diag' slot : ------ */ SEXP dtTMatrix_as_dtrMatrix(SEXP x) { SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("dtrMatrix")); Matrix_T_as_DENSE(double, REAL, REALSXP, FALSE); slot_dup(val, x, Matrix_diagSym); Matrix_T_as_DENSE_FINISH(xx[k]); } SEXP ltTMatrix_as_ltrMatrix(SEXP x) { SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("ltrMatrix")); Matrix_T_as_DENSE(int, LOGICAL, LGLSXP, FALSE); slot_dup(val, x, Matrix_diagSym); Matrix_T_as_DENSE_FINISH(xx[k]); } /*===================== Coercion to gTMatrix ================================*/ #undef MAYBE_DECLARE_AND_GET_X_SLOT #define MAYBE_DECLARE_AND_GET_X_SLOT(__T__, __S__) \ DECLARE_AND_GET_X_SLOT(__T__, __S__), *vx #define ALLOC_val_x_SLOT(__SEXP__, __S_TYPE__) \ vx = __SEXP__(ALLOC_SLOT(val, Matrix_xSym,__S_TYPE__, nv)) #define MAYBE_ALLOC_val_x_SLOT(_S1_, _S2_) \ ALLOC_val_x_SLOT(_S1_, _S2_) #define MEMCPY_x_SLOT Memcpy(&vx[nv], xx, nnz) #define MAYBE_MEMCPY_x_SLOT MEMCPY_x_SLOT #define SET_x_SLOT vx[nv] = xx[i] #define MAYBE_SET_x_SLOT SET_x_SLOT #define Matrix_sT_as_GENERAL(_C_TYPE_, _SEXP_, _SEXPTYPE_) \ SEXP xiP = GET_SLOT(x, Matrix_iSym); \ /* , uplo = GET_SLOT(x, Matrix_uploSym); */ \ int i, nnz = length(xiP), n0d, nv, \ *xi = INTEGER(xiP), \ *xj = INTEGER(GET_SLOT(x, Matrix_jSym)), \ *vi, *vj; \ MAYBE_DECLARE_AND_GET_X_SLOT(_C_TYPE_, _SEXP_); \ \ /* Find *length* of result slots: */ \ /* = 2 * nnz - n0d; n0d := #{non-0 diagonals} :*/ \ for(i = 0, n0d = 0; i < nnz; i++) \ if(xi[i] == xj[i]) n0d++ ; \ nv = 2 * nnz - n0d; \ \ vi = INTEGER(ALLOC_SLOT(val, Matrix_iSym, INTSXP, nv)); \ vj = INTEGER(ALLOC_SLOT(val, Matrix_jSym, INTSXP, nv)); \ MAYBE_ALLOC_val_x_SLOT(_SEXP_, _SEXPTYPE_); \ \ slot_dup(val, x, Matrix_DimSym); \ SET_DimNames_symm(val, x); \ /* copy the upper/lower triangle (including the diagonal)*/ \ /* "at end" ([nv]): */ \ nv = nnz - n0d; \ Memcpy(&vi[nv], xi, nnz); \ Memcpy(&vj[nv], xj, nnz); \ MAYBE_MEMCPY_x_SLOT; \ \ for(i = 0, nv = 0; i < nnz; i++) { /* copy the other triangle */ \ if(xi[i] != xj[i]) { /* but not the diagonal */ \ vi[nv] = xj[i]; \ vj[nv] = xi[i]; \ MAYBE_SET_x_SLOT; \ nv++; \ } \ } \ \ UNPROTECT(1); \ return val /* this corresponds to changing 'stype' of a cholmod_triplet; * seems not available there */ SEXP dsTMatrix_as_dgTMatrix(SEXP x) { SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("dgTMatrix")); Matrix_sT_as_GENERAL(double, REAL, REALSXP); } SEXP lsTMatrix_as_lgTMatrix(SEXP x) { SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("lgTMatrix")); Matrix_sT_as_GENERAL(int, LOGICAL, LGLSXP); } /* Now the 'nsparseMatrix' ones where input has no 'x' slot : ---------------*/ #undef MAYBE_DECLARE_AND_GET_X_SLOT #define MAYBE_DECLARE_AND_GET_X_SLOT(__T__, __S__) #undef MAYBE_ALLOC_val_x_SLOT #define MAYBE_ALLOC_val_x_SLOT(_S1_, _S2_) #undef MAYBE_MEMCPY_x_SLOT #define MAYBE_MEMCPY_x_SLOT #undef MAYBE_SET_x_SLOT #define MAYBE_SET_x_SLOT SEXP nsTMatrix_as_nsyMatrix(SEXP x) { SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("nsyMatrix")); Matrix_T_as_DENSE(int, LOGICAL, LGLSXP, FALSE); Matrix_T_as_DENSE_FINISH(1); } SEXP ntTMatrix_as_ntrMatrix(SEXP x) { SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("ntrMatrix")); Matrix_T_as_DENSE(int, LOGICAL, LGLSXP, FALSE); slot_dup(val, x, Matrix_diagSym); Matrix_T_as_DENSE_FINISH(1); } SEXP nsTMatrix_as_ngTMatrix(SEXP x) { SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("ngTMatrix")); Matrix_sT_as_GENERAL(int, LOGICAL, LGLSXP); } Matrix/vignettes/0000755000176200001440000000000014154165627013541 5ustar liggesusersMatrix/vignettes/Comparisons.Rnw0000644000176200001440000002150212070262574016520 0ustar liggesusers\documentclass{article} \usepackage{myVignette} \usepackage[authoryear,round]{natbib} \bibliographystyle{plainnat} %%\VignetteIndexEntry{Comparisons of Least Squares calculation speeds} %%\VignetteDepends{Matrix} \begin{document} \SweaveOpts{engine=R,eps=FALSE,pdf=TRUE,width=5,height=3,strip.white=true,keep.source=TRUE} \setkeys{Gin}{width=\textwidth} \title{Comparing Least Squares Calculations} \author{Douglas Bates\\R Development Core Team\\\email{Douglas.Bates@R-project.org}} \date{\today} \maketitle \begin{abstract} Many statistics methods require one or more least squares problems to be solved. There are several ways to perform this calculation, using objects from the base R system and using objects in the classes defined in the \code{Matrix} package. We compare the speed of some of these methods on a very small example and on a example for which the model matrix is large and sparse. \end{abstract} <>= options(width=75) @ \section{Linear least squares calculations} \label{sec:LeastSquares} Many statistical techniques require least squares solutions \begin{equation} \label{eq:LeastSquares} \widehat{\bm{\beta}}= \arg\min_{\bm{\beta}}\left\|\bm{y}-\bX\bm{\beta}\right\|^2 \end{equation} where $\bX$ is an $n\times p$ model matrix ($p\leq n$), $\bm{y}$ is $n$-dimensional and $\bm{\beta}$ is $p$ dimensional. Most statistics texts state that the solution to (\ref{eq:LeastSquares}) is \begin{equation} \label{eq:XPX} \widehat{\bm{\beta}}=\left(\bX\trans\bX\right)^{-1}\bX\trans\bm{y} \end{equation} when $\bX$ has full column rank (i.e. the columns of $\bX$ are linearly independent) and all too frequently it is calculated in exactly this way. \subsection{A small example} \label{sec:smallLSQ} As an example, let's create a model matrix, \code{mm}, and corresponding response vector, \code{y}, for a simple linear regression model using the \code{Formaldehyde} data. <>= data(Formaldehyde) str(Formaldehyde) (m <- cbind(1, Formaldehyde$carb)) (yo <- Formaldehyde$optden) @ Using \code{t} to evaluate the transpose, \code{solve} to take an inverse, and the \code{\%*\%} operator for matrix multiplication, we can translate \ref{eq:XPX} into the \Slang{} as <>= solve(t(m) %*% m) %*% t(m) %*% yo @ On modern computers this calculation is performed so quickly that it cannot be timed accurately in \RR{} \footnote{From R version 2.2.0, \code{system.time()} has default argument \code{gcFirst = TRUE} which is assumed and relevant for all subsequent timings} <>= system.time(solve(t(m) %*% m) %*% t(m) %*% yo) @ and it provides essentially the same results as the standard \code{lm.fit} function that is called by \code{lm}. <>= dput(c(solve(t(m) %*% m) %*% t(m) %*% yo)) dput(unname(lm.fit(m, yo)$coefficients)) @ %$ \subsection{A large example} \label{sec:largeLSQ} For a large, ill-conditioned least squares problem, such as that described in \citet{koen:ng:2003}, the literal translation of (\ref{eq:XPX}) does not perform well. <>= library(Matrix) data(KNex, package = "Matrix") y <- KNex$y mm <- as(KNex$mm, "matrix") # full traditional matrix dim(mm) system.time(naive.sol <- solve(t(mm) %*% mm) %*% t(mm) %*% y) @ Because the calculation of a ``cross-product'' matrix, such as $\bX\trans\bX$ or $\bX\trans\bm{y}$, is a common operation in statistics, the \code{crossprod} function has been provided to do this efficiently. In the single argument form \code{crossprod(mm)} calculates $\bX\trans\bX$, taking advantage of the symmetry of the product. That is, instead of calculating the $712^2=506944$ elements of $\bX\trans\bX$ separately, it only calculates the $(712\cdot 713)/2=253828$ elements in the upper triangle and replicates them in the lower triangle. Furthermore, there is no need to calculate the inverse of a matrix explicitly when solving a linear system of equations. When the two argument form of the \code{solve} function is used the linear system \begin{equation} \label{eq:LSQsol} \left(\bX\trans\bX\right) \widehat{\bm{\beta}} = \bX\trans\by \end{equation} is solved directly. Combining these optimizations we obtain <>= system.time(cpod.sol <- solve(crossprod(mm), crossprod(mm,y))) all.equal(naive.sol, cpod.sol) @ On this computer (2.0 GHz Pentium-4, 1 GB Memory, Goto's BLAS, in Spring 2004) the crossprod form of the calculation is about four times as fast as the naive calculation. In fact, the entire crossprod solution is faster than simply calculating $\bX\trans\bX$ the naive way. <>= system.time(t(mm) %*% mm) @ Note that in newer versions of \RR{} and the BLAS library (as of summer 2007), \RR's \code{\%*\%} is able to detect the many zeros in \code{mm} and shortcut many operations, and is hence much faster for such a sparse matrix than \code{crossprod} which currently does not make use of such optimizations. This is not the case when \RR{} is linked against an optimized BLAS library such as GOTO or ATLAS. %% Also, for fully dense matrices, \code{crossprod()} indeed remains faster (by a factor of two, typically) independently of the BLAS library: <>= fm <- mm set.seed(11) fm[] <- rnorm(length(fm)) system.time(c1 <- t(fm) %*% fm) system.time(c2 <- crossprod(fm)) stopifnot(all.equal(c1, c2, tol = 1e-12)) @ % using stopifnot(.) to save output \subsection{Least squares calculations with Matrix classes} \label{sec:MatrixLSQ} The \code{crossprod} function applied to a single matrix takes advantage of symmetry when calculating the product but does not retain the information that the product is symmetric (and positive semidefinite). As a result the solution of (\ref{eq:LSQsol}) is performed using general linear system solver based on an LU decomposition when it would be faster, and more stable numerically, to use a Cholesky decomposition. The Cholesky decomposition could be used but it is rather awkward <>= system.time(ch <- chol(crossprod(mm))) system.time(chol.sol <- backsolve(ch, forwardsolve(ch, crossprod(mm, y), upper = TRUE, trans = TRUE))) stopifnot(all.equal(chol.sol, naive.sol)) @ The \code{Matrix} package uses the S4 class system \citep{R:Chambers:1998} to retain information on the structure of matrices from the intermediate calculations. A general matrix in dense storage, created by the \code{Matrix} function, has class \code{"dgeMatrix"} but its cross-product has class \code{"dpoMatrix"}. The \code{solve} methods for the \code{"dpoMatrix"} class use the Cholesky decomposition. <>= mm <- as(KNex$mm, "dgeMatrix") class(crossprod(mm)) system.time(Mat.sol <- solve(crossprod(mm), crossprod(mm, y))) stopifnot(all.equal(naive.sol, unname(as(Mat.sol,"matrix")))) @ Furthermore, any method that calculates a decomposition or factorization stores the resulting factorization with the original object so that it can be reused without recalculation. <>= xpx <- crossprod(mm) xpy <- crossprod(mm, y) system.time(solve(xpx, xpy)) system.time(solve(xpx, xpy)) # reusing factorization @ The model matrix \code{mm} is sparse; that is, most of the elements of \code{mm} are zero. The \code{Matrix} package incorporates special methods for sparse matrices, which produce the fastest results of all. <>= mm <- KNex$mm class(mm) system.time(sparse.sol <- solve(crossprod(mm), crossprod(mm, y))) stopifnot(all.equal(naive.sol, unname(as(sparse.sol, "matrix")))) @ As with other classes in the \code{Matrix} package, the \code{dsCMatrix} retains any factorization that has been calculated although, in this case, the decomposition is so fast that it is difficult to determine the difference in the solution times. <>= xpx <- crossprod(mm) xpy <- crossprod(mm, y) system.time(solve(xpx, xpy)) system.time(solve(xpx, xpy)) @ \subsection*{Session Info} <>= toLatex(sessionInfo()) @ <>= if(identical(1L, grep("linux", R.version[["os"]]))) { ##----- Linux - only ---- Sys.procinfo <- function(procfile) { l2 <- strsplit(readLines(procfile),"[ \t]*:[ \t]*") r <- sapply(l2[sapply(l2, length) == 2], function(c2)structure(c2[2], names= c2[1])) attr(r,"Name") <- procfile class(r) <- "simple.list" r } Scpu <- Sys.procinfo("/proc/cpuinfo") Smem <- Sys.procinfo("/proc/meminfo") } # Linux only @ <>= if(identical(1L, grep("linux", R.version[["os"]]))) { ## Linux - only --- Scpu <- sfsmisc::Sys.procinfo("/proc/cpuinfo") Smem <- sfsmisc::Sys.procinfo("/proc/meminfo") print(Scpu[c("model name", "cpu MHz", "cache size", "bogomips")]) print(Smem[c("MemTotal", "SwapTotal")]) } @ <>= if(identical(1L, grep("linux", R.version[["os"]]))) { ## Linux - only --- print(Scpu[c("model name", "cpu MHz", "cache size", "bogomips")]) print(Smem[c("MemTotal", "SwapTotal")]) } @ \bibliography{Matrix} \end{document} Matrix/vignettes/Matrix.bib0000644000176200001440000003410412764547531015470 0ustar liggesusers@BOOK{R:Venables+Ripley:2000, AUTHOR = {William N. Venables and Brian D. Ripley}, TITLE = {S Programming}, PUBLISHER = {Springer}, YEAR = 2000, NOTE = {ISBN 0-387-98966-8}, URL = {http://www.stats.ox.ac.uk/pub/MASS3/Sprog/}, ABSTRACT = {This provides an in-depth guide to writing software in the S language which forms the basis of both the commercial S-PLUS and the Open Source R data analysis software systems.} } @BOOK{R:Chambers+Hastie:1992, AUTHOR = {John M. Chambers and Trevor J. Hastie}, TITLE = {Statistical Models in {S}}, PUBLISHER = {Chapman \& Hall}, YEAR = 1992, ADDRESS = {London}, ISBN = {0-412-83040-X}, ABSTRACT = {This is also called the ``\emph{White Book}'', and introduced S version 3, which added structures to facilitate statistical modeling in S. } } @Article{Rnews:Gentleman+Carey:2002, author = {Robert Gentleman and Vincent Carey}, title = {Bioconductor}, journal = {R News}, year = 2002, volume = 2, number = 1, pages = {11--16}, month = {March}, url = {https://CRAN.R-project.org/doc/Rnews/} } @article{Ke:Wang:2001, author = {Ke, Chunlei and Wang, Yuedong}, title = {Semiparametric nonlinear mixed-effects models and their applications}, year = {2001}, journal = {Journal of the American Statistical Association}, volume = {96}, number = {456}, pages = {1272--1298}, keywords = {NONLINEAR MIXED EFFECTS MODEL; Penalized likelihood; Repeated measures; SELF-MODELING NONLINEAR REGRESSION; Smoothing spline} } @Article{Lind:Bate:1988, author = {Lindstrom, Mary J. and Bates, Douglas M.}, title = {Newton-{R}aphson and {EM} algorithms for linear mixed-effects models for repeated-measures data ({C}orr: 94{V}89 p1572)}, year = {1988}, journal = {Journal of the American Statistical Association}, volume = {83}, pages = {1014--1022}, keywords = {Growth curve; Longitudinal data} } @ARTICLE{Atlas, AUTHOR = "R. Clint Whaley and Antoine Petitet and Jack J. Dongarra", TITLE = "Automated Empirical Optimization of Software and the {ATLAS} Project", JOURNAL = "Parallel Computing", VOLUME = "27", NUMBER = "1--2", PAGES = "3--35", YEAR = 2001, NOTE = "Also available as University of Tennessee LAPACK Working Note \#147, UT-CS-00-448, 2000 ({\tt www.netlib.org/lapack/lawns/lawn147.ps})" } @TechReport{GotosBLAS, author = {Kazushige Goto and Robert van de Geijn}, title = {On Reducing TLB Misses in Matrix Multiplication}, institution = {Department of Computer Sciences, U. of Texas at Austin}, year = 2002, number = {TR02-55} } @Misc{Taucs, author = {Sivan Toledo}, title = {Taucs: A Library of Sparse Linear Solvers}, howpublished = {http://www.tau.ac.il/~stoledo/taucs/}, year = 2003 } @Misc{Umfpack, author = {Tim Davis}, title = {UMFPACK: Unified Multifrontal Package}, howpublished = {http://www.cise.ufl.edu/research/sparse/umfpack}, year = 2003 } @misc{Cholmod, author = {Tim Davis}, title = {{CHOLMOD}: sparse supernodal {Cholesky} factorization and update/downdate}, howpublished = {http://www.cise.ufl.edu/research/sparse/cholmod}, year = 2005 } @Misc{CSparse, author = {Tim Davis}, title = {{CSparse}: a concise sparse matrix package}, howpublished = {http://www.cise.ufl.edu/research/sparse/CSparse}, year = 2005 } @Book{davis06:csparse_book, author = {Timothy A. Davis }, title = {Direct Methods for Sparse Linear Systems}, publisher = {SIAM}, year = 2006, series = {Fundamentals of Algorithms} } @Misc{Metis, author = {George Karapis}, title = {Metis: Family of Multilevel Partioning Algorithms}, howpublished = {http://www-users.cs.umn.edu/~karypis/metis/}, year = 2003 } @Book{Linpack, author = {Jack Dongarra and Cleve Moler and Bunch and G.W. Stewart}, title = {Linpack Users' Guide}, publisher = {SIAM}, year = 1979 } @Book{Lapack, author = {E. Anderson and Z. Bai and C. Bischof and S. Blackford and J. Demmel and J. Dongarra and J. Du Croz and A. Greenbaum and S. Hammarling and A. McKenney and D. Sorensen}, title = {LAPACK Users' Guide}, chapter = {}, publisher = {SIAM}, year = 1999, address = {Philadelphia, PA}, edition = {3rd} } @Book{bryk00:_hlm, author = {A. S. Bryk and S. W. Raudenbush and R. Congdon}, title = {{HLM} version 5}, publisher = {Scientific Software International, Inc.}, year = 2000, address = {Chicago} } @Article{demp:lair:rubi:1977, Journal = JRSSB, Volume = 39, Pages = {1--22}, Keywords = {Posterior mode}, Author = {A. P. Dempster and N. M. Laird and D. B. Rubin}, Title = {Maximum Likelihood From Incomplete Data Via the {EM} Algorithm}, Year = 1977 } @Book{denn:schn:1983, author = {J. E. Dennis and R. B. Schnabel}, title = {Numerical Methods for Unconstrained Optimization and Nonlinear Equations}, publisher = {Prentice-Hall}, year = 1983, address = {Englewood Cliffs, NJ} } @Book{dong:bunc:mole:stew:1979, publisher = "SIAM", address = "Philadelphia", author = "J. J. Dongarra and J. R. Bunch and C. B. Moler and G. W. Stewart", title = "Linpack Users' Guide", year = 1979 } @Book{goldstein98:_mlwin, author = {H. Goldstein and J. Rasbash and I. Plewis and D. Draper and W. Browne and M. Wang}, title = {A user's guide to {MLwiN}}, publisher = {University of London, Institute of Education}, year = 1998, address = {London} } @Book{golu:vanl:1996, author = {Golub, Gene H. and van Loan, Charles F.}, title = {Matrix Computations}, publisher = {Johns Hopkins}, year = 1996, edition = {3rd} } @Article{ harv:1974, author = {Harville, David A.}, title = {Bayesian Inference for Variance Components Using Only Error Contrasts}, journal = {Biometrika}, year = 1974, volume = 61, pages = {383--385}, keywords = {Maximum likelihood} } @Article{ lair:ware:1982, author = {Laird, Nan M. and Ware, James H.}, title = {Random-effects Models for Longitudinal Data}, journal = {Biometrics}, year = 1982, volume = 38, pages = {963--974}, keywords = {Variance components; Repeated measurements; Empirical Bayes; EM algorithm} } @Book{lapack:1992, publisher = "SIAM", address = "Philadelphia", author = "E. Anderson and Z. Bai and C. Bischof and J. Demmel and J. Dongarra and J. Du Croz and A. Greenbaum and S. Hammaring and A. McKenney and S. Ostrouchov and D. Sorensen", title = "Lapack Users' Guide", year = 1992 } @Article{liu:rubi:1994, author = {Liu, Chuanhai and Rubin, Donald B.}, title = {The {ECME} algorithm: {A} simple extension of {EM} and {ECM} with faster monotone convergence}, year = {1994}, journal = {Biometrika}, volume = {81}, pages = {633--648}, keywords = {Markov chain monte carlo; Incomplete data} } @article{patt:thom:1971, Author = {Patterson, H. D. and Thompson, R.}, Title = {Recovery of Interblock Information When Block Sizes Are Unequal}, Year = 1971, Journal = {Biometrika}, Volume = 58, Pages = {545--554}, Keywords = {Incomplete block design; Components of variance; Maximum likelihood; Design of experiments} } @phdthesis{pinh:1994, author = {Jos\'{e} C. Pinheiro}, title = {Topics in Mixed-Effects Models}, school = {University of Wisconsin}, year = 1994, address = {Madison, WI} } @Article{pinh:bate:1995, author = "Jos\'{e} C. Pinheiro and Douglas M. Bates", title = "Approximations to the Log-Likelihood Function in the Nonlinear Mixed-Effects Model", year = 1995, journal = "Journal of Computational and Graphical Statistics", volume = 4, number = 1, pages = "12--35" } @Article{ pinh:bate:1996, author = {Jos\'{e} C. Pinheiro and Douglas M. Bates}, title = {Unconstrained Parameterizations for Variance-Covariance Matrices}, journal = {Statistics and Computing}, year = 1996, volume = 6, pages = {289--296} } @Book{pinh:bate:2000, author = {Jos\'{e} C. Pinheiro and Douglas M. Bates}, title = {Mixed-Effects Models in {S} and {S-PLUS}}, year = 2000, pages = {528}, ISBN = {0-387-98957-9}, publisher = {Springer} } @Article{schn:koon:1985, Journal = {ACM Trans. Math. Software}, Volume = 11, Pages = {419--440}, Author = {R. B. Schnabel and J. E. Koontz and B. E. Weiss}, Title = {A modular system of algorithms for unconstrained minimization}, Year = 1985 } @book{snijders99:_multil_analy, author = {Tom Snijders and Roel Bosker}, title = {Multilevel Analysis: An introduction to basic and advanced multilevel analysis}, publisher = {Sage}, year = 1999, address = {London} } @book{this:1988, Author = {Thisted, R. A.}, Title = {Elements of Statistical Computing}, Year = 1988, Publisher = {Chapman \& Hall}, address = {London} } @Article{van:2000, author = {van Dyk, David A.}, title = {Fitting mixed-effects models using efficient {EM}-type algorithms}, year = {2000}, journal = {Journal of Computational and Graphical Statistics}, volume = {9}, number = {1}, pages = {78--98}, keywords = {EM algorithm; ECME algorithm; Gaussian hierarchical models; Posterior inference; PXEM algorithm; random-effects models; Reml; variance-component models; working parameters} } @misc{jfox:2002, author = {Fox, John}, title = {Linear Mixed Models -- Appendix to {An R and S-PLUS Companion to Applied Regression}}, year = 2002, month= {May}, url = {http://www.socsci.mcmaster.ca/jfox/Books/companion/appendix-mixed-models.pdf} } @book{roge:1980, Author = {Rogers, Gerald S.}, Title = {Matrix Derivatives}, Year = 1980, Publisher = {Marcell Dekker, Inc.}, address = {New York and Basel} } @TechReport{DebRoy:Bates:2003a, author = {Saikat DebRoy and Douglas M. Bates}, title = {Computational Methods for Single Level Linear Mixed-effects Models}, institution = {Department of Statistics, University of Wisconsin-Madison}, number = {1073}, year = 2003 } @TechReport{DebRoy:Bates:2003b, author = {Saikat DebRoy and Douglas M. Bates}, title = {Computational Methods for Multiple Level Linear Mixed-effects Models}, institution = {Department of Statistics, University of Wisconsin-Madison}, number = {1076}, year = 2003 } @Article{RaudenbushYangYosef:2000, author = {Stephen W. Raudenbush and Meng-Li Yang and Matheos Yosef}, title = {Maximum Likelihood for Generalized Linear Models With Nested Random Effects via High-Order, Multivariate {L}aplace Approximation}, journal = {J. Comput. Graph. Statist.}, year = 2000, volume = 9, number = 1, pages = {141--157} } @Book{goldstein87:_multil, author = {Goldstein, Harvey}, title = {Multilevel models in education and social research}, publisher = {Oxford University Press}, year = 1987 } @Book{raudenbush02:_hierar_linear_model, author = {Stephen W. Raudenbush and Anthony S. Bryk}, title = {Hierarchical Linear Models: Applications and Data Analysis Methods}, publisher = {Sage}, year = 2002, edition = {second}, ISBN = {0-7619-1904-X} } @BOOK{R:Chambers:1998, AUTHOR = {John M. Chambers}, TITLE = {Programming with Data}, PUBLISHER = {Springer}, YEAR = 1998, ADDRESS = {New York}, ISBN = {0-387-98503-4}, ABSTRACT = {This ``\emph{Green Book}'' describes version 4 of S, a major revision of S designed by John Chambers to improve its usefulness at every stage of the programming process.} } @article{Rodriguez:Goldman:1995, author = {Germ\'an Rodriguez and Noreen Goldman}, title = {An assessment of estimation procedures for multilevel models with binary responses}, year = {1995}, journal = {Journal of the Royal Statistical Society, Series A, General}, volume = {158}, pages = {73--89}, keywords = {Logistic regression; Random effects model; Software; Variance component} } @Article{koen:ng:2003, author = {Roger Koenker and Pin Ng}, title = {{SparseM}: A Sparse Matrix Package for {R}}, journal = {J. of Statistical Software}, year = 2003, volume = 8, number = 6 } @Book{Eispack, author = {Smith, B. T. and Boyle, J. M. and Dongarra, J. J. and Garbow, B. S. and Ikebe, Y. and Klema, V. C. and Moler, C. B.}, title = {Matrix Eigensystem Routines. EISPACK Guide}, publisher = {Springer-Verlag}, year = 1976, volume = 6, series = {Lecture Notes in Computer Science}, address = {New York} } @Article{bate:debr:2004, author = {Douglas M. Bates and Saikat DebRoy}, title = {Linear Mixed Models and Penalized Least Squares}, journal = {J. of Multivariate Analysis}, year = 2004, note = {to appear} } @Article{Rnews:Lockwood+Doran+Mccaffrey:2003, author = {J.R. Lockwood and Harold Doran and Daniel F. McCaffrey}, title = {Using R for Estimating Longitudinal Student Achievement Models}, journal = {R News}, year = 2003, volume = 3, number = 3, pages = {17--23}, month = {December}, url = {https://CRAN.R-project.org/doc/Rnews/} } @Article{Paterson:1991, author = {L. Paterson}, title = {Socio economic status and educational attainment: a multidimensional and multilevel study}, journal = {Evaluation and Research in Education}, year = 1991, volume = 5, pages = {97--121} } Matrix/vignettes/Design-issues.Rnw0000644000176200001440000001377013253770612016756 0ustar liggesusers\documentclass{article} % \usepackage{myVignette} \usepackage[authoryear,round]{natbib} \bibliographystyle{plainnat} \newcommand{\noFootnote}[1]{{\small (\textit{#1})}} \newcommand{\myOp}[1]{{$\left\langle\ensuremath{#1}\right\rangle$}} %% vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv %%\VignetteIndexEntry{Design Issues in Matrix package Development} %%\VignetteDepends{Matrix} \SweaveOpts{engine=R,eps=FALSE,pdf=TRUE,width=5,height=3,strip.white=true,keep.source=TRUE} % ^^^^^^^^^^^^^^^^ \title{Design Issues in Matrix package Development} \author{Martin Maechler and Douglas Bates\\R Core Development Team \\\email{maechler@stat.math.ethz.ch}, \email{bates@r-project.org}} \date{Spring 2008 ({\tiny typeset on \tiny\today})} % \begin{document} \maketitle \begin{abstract} This is a (\textbf{currently very incomplete}) write-up of the many smaller and larger design decisions we have made in organizing functionalities in the Matrix package. Classes: There's a rich hierarchy of matrix classes, which you can visualize as a set of trees whose inner (and ``upper'') nodes are \emph{virtual} classes and only the leaves are non-virtual ``actual'' classes. Functions and Methods: - setAs() - others \end{abstract} %% Note: These are explained in '?RweaveLatex' : <>= options(width=75) @ \section{The Matrix class structures} \label{sec:classes} Take Martin's DSC 2007 talk to depict class hierarchy. \\ --- --- --- %% \hrule[1pt]{\textwidth} \subsection{Diagonal Matrices} \label{ssec:diagMat} The class of diagonal matrices is worth mentioning for several reasons. First, we have wanted such a class, because \emph{multiplication} methods are particularly simple with diagonal matrices. The typical constructor is \Rfun{Diagonal} whereas the accessor (as for traditional matrices), \Rfun{diag} simply returns the \emph{vector} of diagonal entries: <>= library(Matrix) (D4 <- Diagonal(4, 10*(1:4))) str(D4) diag(D4) @ We can \emph{modify} the diagonal in the traditional way (via method definition for \Rfun{diag<-}): <>= diag(D4) <- diag(D4) + 1:4 D4 @ Note that \textbf{unit-diagonal} matrices (the identity matrices of linear algebra) with slot \code{diag = "U"} can have an empty \code{x} slot, very analogously to the unit-diagonal triangular matrices: <>= str(I3 <- Diagonal(3)) ## empty 'x' slot getClass("diagonalMatrix") ## extending "sparseMatrix" @ Originally, we had implemented diagonal matrices as \emph{dense} rather than sparse matrices. After several years it became clear that this had not been helpful really both from a user and programmer point of view. So now, indeed the \code{"diagonalMatrix"} class does extend the \code{"sparseMatrix"} one. However, we do \emph{not} store explicitly where the non-zero entries are, and the class does \emph{not} extend any of the typical sparse matrix classes, \code{"CsparseMatrix"}, \code{"TsparseMatrix"}, or \code{"RsparseMatrix"}. Rather, the \code{diag()}onal (vector) is the basic part of such a matrix, and this is simply the \code{x} slot unless the \code{diag} slot is \code{"U"}, the unit-diagonal case, which is the identity matrix. Further note, e.g., from the \code{?$\,$Diagonal} help page, that we provide (low level) utility function \code{.sparseDiagonal()} with wrappers \code{.symDiagonal()} and \code{.trDiagonal()} which will provide diagonal matrices inheriting from \code{"CsparseMatrix"} which may be advantageous in \emph{some cases}, but less efficient in others, see the help page. \section{Matrix Transformations} \label{sec:trafos} \subsection{Coercions between Matrix classes} \label{ssec:coerce} You may need to transform Matrix objects into specific shape (triangular, symmetric), content type (double, logical, \dots) or storage structure (dense or sparse). Every useR should use \code{as(x, )} to this end, where \code{} is a \emph{virtual} Matrix super class, such as \code{"triangularMatrix"} \code{"dMatrix"}, or \code{"sparseMatrix"}. In other words, the user should \emph{not} coerce directly to a specific desired class such as \code{"dtCMatrix"}, even though that may occasionally work as well. Here is a set of rules to which the Matrix developers and the users should typically adhere: \begin{description} \item[Rule~1]: \code{as(M, "matrix")} should work for \textbf{all} Matrix objects \code{M}. \item[Rule~2]: \code{Matrix(x)} should also work for matrix like objects \code{x} and always return a ``classed'' Matrix. Applied to a \code{"matrix"} object \code{m}, \code{M. <- Matrix(m)} can be considered a kind of inverse of \code{m <- as(M, "matrix")}. For sparse matrices however, \code{M.} well be a \code{CsparseMatrix}, and it is often ``more structured'' than \code{M}, e.g., <>= (M <- spMatrix(4,4, i=1:4, j=c(3:1,4), x=c(4,1,4,8))) # dgTMatrix m <- as(M, "matrix") (M. <- Matrix(m)) # dsCMatrix (i.e. *symmetric*) @ \item[Rule~3]: All the following coercions to \emph{virtual} matrix classes should work:\\ \begin{enumerate} \item \code{as(m, "dMatrix")} \item \code{as(m, "lMatrix")} \item \code{as(m, "nMatrix")} \item \code{as(m, "denseMatrix")} \item \code{as(m, "sparseMatrix")} \item \code{as(m, "generalMatrix")} \end{enumerate} whereas the next ones should work under some assumptions: \begin{enumerate} \item \code{as(m1, "triangularMatrix")} \\ should work when \code{m1} is a triangular matrix, i.e. the upper or lower triangle of \code{m1} contains only zeros. \item \code{as(m2, "symmetricMatrix")} should work when \code{m2} is a symmetric matrix in the sense of \code{isSymmetric(m2)} returning \code{TRUE}. Note that this is typically equivalent to something like \code{isTRUE(all.equal(m2, t(m2)))}, i.e., the lower and upper triangle of the matrix have to be equal \emph{up to small numeric fuzz}. \end{enumerate} \end{description} \section{Session Info} <>= toLatex(sessionInfo()) @ %not yet %\bibliography{Matrix} \end{document} Matrix/vignettes/myVignette.sty0000644000176200001440000000666512070321331016427 0ustar liggesusers\RequirePackage{hyperref} \RequirePackage{url} \RequirePackage{amsmath} \RequirePackage{bm}%-> \bm (= bold math) \newcommand{\Slang}{\textsf{S} language} \newcommand{\RR}{\textsf{R}} \newcommand{\email}[1]{\href{mailto:#1}{\normalfont\texttt{#1}}} %- R programming markup \newcommand\code{\bgroup\@codex} \def\@codex#1{{\normalfont\ttfamily\hyphenchar\font=-1 #1}\egroup} \let\env=\code \let\command=\code \newcommand*{\Rfun}[1]{\code{#1()}\index{\RR~function #1}} \newcommand*{\class}[1]{\code{#1}\index{class #1}}% \newcommand*{\pkg}[1]{\code{#1}\index{\RR~package #1}} % \newcommand{\kbd}[1]{{\normalfont\texttt{#1}}} \newcommand{\key}[1]{{\normalfont\texttt{\uppercase{#1}}}} \newcommand\samp{`\bgroup\@noligs\@sampx} \def\@sampx#1{{\normalfont\texttt{#1}}\egroup'} \let\option=\samp \newcommand{\var}[1]{{\normalfont\textsl{#1}}} \newcommand{\file}[1]{{`\normalfont\textsf{#1}'}} \newcommand{\dfn}[1]{{\normalfont\textsl{#1}}} \newcommand{\acronym}[1]{{\normalfont\textsc{\lowercase{#1}}}} \newcommand{\strong}[1]{{\normalfont\fontseries{b}\selectfont #1}} \let\pkg=\strong % \RequirePackage{alltt} \newenvironment{example}{\begin{alltt}}{\end{alltt}} \newenvironment{smallexample}{\begin{alltt}\small}{\end{alltt}} \newenvironment{display}{\list{}{}\item\relax}{\endlist} \newenvironment{smallverbatim}{\small\verbatim}{\endverbatim} % This is already in ``Sweave'' -- but withOUT the fontsize=\small part !! %% \RequirePackage{fancyvrb} %% \DefineVerbatimEnvironment{Sinput}{Verbatim}{fontsize=\small,fontshape=sl} %% \DefineVerbatimEnvironment{Soutput}{Verbatim}{fontsize=\small} %% \DefineVerbatimEnvironment{Scode}{Verbatim}{fontsize=\small,fontshape=sl} % \newcommand{\FIXME}[1]{\marginpar{ \dots FIXME \emph{#1} \dots}} \newcommand{\TODO}[1]{\par\noindent\textsc{Todo:} \textit{#1}\par} % %% Matrix stuff : % \newcommand{\trans}{\ensuremath{^\mathsf{T}}} \newcommand{\bA}{\ensuremath{\bm{A}}} \newcommand{\bD}{\ensuremath{\bm{D}}} \newcommand{\bDelta}{\ensuremath{\bm{\Delta}}} \newcommand{\bI}{\ensuremath{\bm{I}}} \newcommand{\bL}{\ensuremath{\bm{L}}} \newcommand{\LXXi}[1]{\ensuremath{\bL_{\mathit{XX}({#1})}}} \newcommand{\LXX}{\ensuremath{\bL_\mathit{XX}}} \newcommand{\LXZi}[1]{\ensuremath{\bL_{\mathit{XZ}({#1})}}} \newcommand{\LXZ}{\ensuremath{\bL_\mathit{XZ}}} \newcommand{\LZZi}[1]{\ensuremath{\bL_{\mathit{ZZ}({#1})}}} \newcommand{\LZZ}{\ensuremath{\bL_\mathit{ZZ}}} \newcommand{\LZZoo}{\ensuremath{\bL_{\mathit{ZZ}11}}} \newcommand{\LZZot}{\ensuremath{\bL_{\mathit{ZZ}12}}} \newcommand{\LZZtt}{\ensuremath{\bL_{\mathit{ZZ}22}}} \newcommand{\bOmega}{\ensuremath{\bm{\Omega}}} \newcommand{\bPhi}{\ensuremath{\bm{\Phi}}} \newcommand{\bR}{\ensuremath{\bm{R}}} \newcommand{\bX}{\ensuremath{\bm{X}}} \newcommand{\bZ}{\ensuremath{\bm{Z}}} \newcommand{\bbeta}{\ensuremath{\bm{\beta}}} \newcommand{\bb}{\ensuremath{\bm{b}}} \newcommand{\beps}{\ensuremath{\bm{\epsilon}}} \newcommand{\dX}{\ensuremath{\bm{d}_{\mathit{X}}}} \newcommand{\dZ}{\ensuremath{\bm{d}_{\mathit{Z}}}} \newcommand{\dy}{\ensuremath{d_{\mathit{y}}}} \newcommand{\lyXi}[1]{\ensuremath{\bm{\ell}_{\mathit{yX}(#1)}}} \newcommand{\lyX}{\ensuremath{\bm{\ell}_\mathit{yX}}} \newcommand{\lyZi}[1]{\ensuremath{\bm{\ell}_{\mathit{yZ}(#1)}}} \newcommand{\lyZ}{\ensuremath{\bm{\ell}_\mathit{yZ}}} \newcommand{\lyyi}[1]{\ensuremath{\bm{\ell}_{\mathit{yy}(#1)}}} \newcommand{\lyy}{\ensuremath{\ell_\mathit{yy}}} \newcommand{\btheta}{\ensuremath{\bm{\theta}}} \newcommand{\by}{\ensuremath{\bm{y}}} \newcommand{\bzer}{\ensuremath{\bm{0}}} Matrix/vignettes/Intro2Matrix.Rnw0000644000176200001440000004450713775317466016615 0ustar liggesusers\documentclass{article} % \usepackage{myVignette} \usepackage{fullpage}% save trees ;-) \usepackage[authoryear,round]{natbib} \bibliographystyle{plainnat} \newcommand{\noFootnote}[1]{{\small (\textit{#1})}} \newcommand{\myOp}[1]{{$\left\langle\ensuremath{#1}\right\rangle$}} % %%\VignetteIndexEntry{2nd Introduction to the Matrix Package} %%\VignetteDepends{Matrix} \SweaveOpts{engine=R,eps=FALSE,pdf=TRUE,width=7,height=4,strip.white=true,keep.source=TRUE} % ^^^^^^^^^^^^^^^^ \title{2nd Introduction to the Matrix package} \author{Martin Maechler and Douglas Bates\\ R Core Development Team \\\email{maechler@stat.math.ethz.ch}, \email{bates@r-project.org}} \date{September 2006 ({\tiny typeset on \tiny\today})} % \begin{document} \maketitle \begin{abstract} % \emph{\Large Why should you want to work with this package and what % does it do for you?} Linear algebra is at the core of many areas of statistical computing and from its inception the \Slang{} has supported numerical linear algebra via a matrix data type and several functions and operators, such as \code{\%*\%}, \code{qr}, \code{chol}, and \code{solve}. However, these data types and functions do not provide direct access to all of the facilities for efficient manipulation of dense matrices, as provided by the Lapack subroutines, and they do not provide for manipulation of sparse matrices. The \pkg{Matrix} package provides a set of S4 classes for dense and sparse matrices that extend the basic matrix data type. Methods for a wide variety of functions and operators applied to objects from these classes provide efficient access to BLAS (Basic Linear Algebra Subroutines), Lapack (dense matrix), CHOLMOD including AMD and COLAMD and \code{Csparse} (sparse matrix) routines. One notable characteristic of the package is that whenever a matrix is factored, the factorization is stored as part of the original matrix so that further operations on the matrix can reuse this factorization. \end{abstract} %% Note: These are explained in '?RweaveLatex' : <>= options(width=75) @ \section{Introduction} \label{sec:Intro} The most automatic way to use the \pkg{Matrix} package is via the \Rfun{Matrix} function which is very similar to the standard \RR\ function \Rfun{matrix}, @ <>= library(Matrix) M <- Matrix(10 + 1:28, 4, 7) M tM <- t(M) @ %def Such a matrix can be appended to (using \Rfun{cbind} or \Rfun{rbind}) or indexed, <>= (M2 <- cbind(-1, M)) M[2, 1] M[4, ] @ where the last two statements show customary matrix indexing, returning a simple numeric vector each\footnote{because there's an additional default argument to indexing, \code{drop = TRUE}. If you add \hbox{``\code{\ ,\ drop = FALSE}\ ''} you will get submatrices instead of simple vectors.}. We assign 0 to some columns and rows to ``sparsify'' it, and some \code{NA}s (typically ``missing values'' in data analysis) in order to demonstrate how they are dealt with; note how we can \emph{``subassign''} as usual, for classical \RR{} matrices (i.e., single entries or whole slices at once), @ <>= M2[, c(2,4:6)] <- 0 M2[2, ] <- 0 M2 <- rbind(0, M2, 0) M2[1:2,2] <- M2[3,4:5] <- NA @ and then coerce it to a sparse matrix, @ <>= sM <- as(M2, "sparseMatrix") 10 * sM identical(sM * 2, sM + sM) is(sM / 10 + M2 %/% 2, "sparseMatrix") @ %def where the last three calls show that multiplication by a scalar keeps sparcity, as does other arithmetic, but addition to a ``dense'' object does not, as you might have expected after some thought about ``sensible'' behavior: @ <>= sM + 10 @ %def Operations on our classed matrices include (componentwise) arithmetic ($+$, $-$, $*$, $/$, etc) as partly seen above, comparison ($>$, $\le$, etc), e.g., <>= Mg2 <- (sM > 2) Mg2 @ returning a logical sparse matrix. When interested in the internal \textbf{str}ucture, \Rfun{str} comes handy, and we have been using it ourselves more regulary than \Rfun{print}ing (or \Rfun{show}ing as it happens) our matrices; alternatively, \Rfun{summary} gives output similar to Matlab's printing of sparse matrices. @ <>= str(Mg2) summary(Mg2) @ As you see from both of these, \code{Mg2} contains ``extra zero'' (here \code{FALSE}) entries; such sparse matrices may be created for different reasons, and you can use \Rfun{drop0} to remove (``drop'') these extra zeros. This should \emph{never} matter for functionality, and does not even show differently for logical sparse matrices, but the internal structure is more compact: <>= Mg2 <- drop0(Mg2) str(Mg2@x) # length 13, was 16 @ For large sparse matrices, visualization (of the sparsity pattern) is important, and we provide \Rfun{image} methods for that, e.g., <>= data(CAex) print(image(CAex, main = "image(CAex)")) # print(.) needed for Sweave @ \smallskip Further, i.e., in addition to the above implicitly mentioned \code{"Ops"} operators (\code{+}, \code{*},\dots, \code{<=},\code{>},\dots, \code{\&} which all work with our matrices, notably in conjunction with scalars and traditional matrices), the \code{"Math"}-operations (such as \Rfun{exp}, \Rfun{sin} or \Rfun{gamma}) and \code{"Math2"} (\Rfun{round} etc) and the \code{"Summary"} group of functions, \Rfun{min}, \Rfun{range}, \Rfun{sum}, all work on our matrices as they should. Note that all these are implemented via so called \emph{group methods}, see e.g., \code{?Arith} in \RR. The intention is that sparse matrices remain sparse whenever sensible, given the matrix \emph{classes} and operators involved, but not content specifically. E.g., + gives even for the rare cases where it would be advantageous to get a result. These classed matrices can be ``indexed'' (more technically ``subset'') as traditional \Slang{} (and hence \RR) matrices, as partly seen above. This also includes the idiom \code{M [ M \myOp{\mathit{op}} \myOp{\mathrm{num}}~]} which returns simple vectors, @ <>= sM[sM > 2] sml <- sM[sM <= 2] sml @ %def and \emph{``subassign''}ment similarly works in the same generality as for traditional \Slang{} matrices. %% We have seen that already above! %% This was the 2005 - Introduction vignette's first section: \subsection{\pkg{Matrix} package for numerical linear algebra} \label{ssec:intro-linalg} Linear algebra is at the core of many statistical computing techniques and, from its inception, the \Slang{} has supported numerical linear algebra via a matrix data type and several functions and operators, such as \code{\%*\%}, \code{qr}, \code{chol}, and \code{solve}. %% Initially the numerical linear algebra functions in \RR{} called underlying Fortran routines from the Linpack~\citep{Linpack} and Eispack~\citep{Eispack} libraries but over the years most of these functions have been switched to use routines from the Lapack~\citep{Lapack} library which is the state-of-the-art implementation of numerical dense linear algebra. %% Furthermore, \RR{} can be configured to use accelerated BLAS (Basic Linear Algebra Subroutines), such as those from the Atlas~\citep{Atlas} project or other ones, see the \RR~manual ``Installation and Administration''. Lapack provides routines for operating on several special forms of matrices, such as triangular matrices and symmetric matrices. Furthermore, matrix decompositions like the QR decompositions produce multiple output components that should be regarded as parts of a single object. There is some support in \RR{} for operations on special forms of matrices (e.g. the \code{backsolve}, \code{forwardsolve} and \code{chol2inv} functions) and for special structures (e.g. a QR structure is implicitly defined as a list by the \code{qr}, \code{qr.qy}, \code{qr.qty}, and related functions) but it is not as fully developed as it could be. Also there is no direct support for sparse matrices in \RR{} although \citet{koen:ng:2003} have developed the \pkg{SparseM} package for sparse matrices based on SparseKit. The \pkg{Matrix} package provides S4 classes and methods for dense and sparse matrices. The methods for dense matrices use Lapack and BLAS. The sparse matrix methods use CHOLMOD~\citep{Cholmod}, CSparse~\citep{Csparse} and other parts (AMD, COLAMD) of Tim Davis' ``SuiteSparse'' collection of sparse matrix libraries, many of which also use BLAS. \TODO{\Rfun{triu}, \Rfun{tril}, \Rfun{diag}, ... and \command{as(.,.)} , but of course only when they've seen a few different ones.} \TODO{matrix operators include \code{\%*\%}, \Rfun{crossprod}, \Rfun{tcrossprod}, \Rfun{solve}} \TODO{\Rfun{expm} is the matrix exponential ... ...} \TODO{\Rfun{symmpart} and \Rfun{skewpart} compute the symmetric part, \code{(x + t(x))/2} and the skew-symmetric part, \code{(x - t(x))/2} of a matrix \code{x}.} \TODO{factorizations include \Rfun{Cholesky} (or \Rfun{chol}), \Rfun{lu}, \Rfun{qr} (not yet for dense)} \TODO{Although generally the result of an operation on dense matrices is a dgeMatrix, certain operations return matrices of special types.} \TODO{E.g. show the distinction between \code{t(mm) \%*\% mm} and \code{crossprod(mm)}.} % \bigskip % ... ... ... The following is the old \file{Introduction.Rnw} ... FIXME ... ... \bigskip \section{Matrix Classes} The \pkg{Matrix} package provides classes for real (stored as double precision), logical and so-called ``pattern'' (binary) dense and sparse matrices. There are provisions to also provide integer and complex (stored as double precision complex) matrices. Note that in \RR, \code{logical} means entries \code{TRUE}, \code{FALSE}, or \code{NA}. To store just the non-zero pattern for typical sparse matrix algorithms, the pattern matrices are \emph{binary}, i.e., conceptually just \code{TRUE} or \code{FALSE}. In \pkg{Matrix}, the pattern matrices all have class names starting with \code{"n"} (patter\textbf{n}). \subsection{Classes for dense matrices} \label{ssec:DenseClasses} For the sake of brevity, we restrict ourselves to the \emph{real} (\textbf{d}ouble) classes, but they are paralleled by \textbf{l}ogical and patter\textbf{n} matrices for all but the positive definite ones. \begin{description} \item[dgeMatrix] Real matrices in general storage mode \item[dsyMatrix] Symmetric real matrices in non-packed storage \item[dspMatrix] Symmetric real matrices in packed storage (one triangle only) \item[dtrMatrix] Triangular real matrices in non-packed storage \item[dtpMatrix] Triangular real matrices in packed storage (triangle only) \item[dpoMatrix] Positive semi-definite symmetric real matrices in non-packed storage \item[dppMatrix] \ \ ditto \ \ in packed storage \end{description} Methods for these classes include coercion between these classes, when appropriate, and coercion to the \code{matrix} class; methods for matrix multiplication (\code{\%*\%}); cross products (\code{crossprod}), matrix norm (\code{norm}); reciprocal condition number (\code{rcond}); LU factorization (\code{lu}) or, for the \code{poMatrix} class, the Cholesky decomposition (\code{chol}); and solutions of linear systems of equations (\code{solve}). %-- mentioned above already: % Further, group methods have been defined for the \code{Arith} (basic % arithmetic, including with scalar numbers) and the \code{Math} (basic % mathematical functions) group.. Whenever a factorization or a decomposition is calculated it is preserved as a (list) element in the \code{factors} slot of the original object. In this way a sequence of operations, such as determining the condition number of a matrix then solving a linear system based on the matrix, do not require multiple factorizations of the same matrix nor do they require the user to store the intermediate results. \subsection{Classes for sparse matrices} \label{sec:SparseClasses} Used for large matrices in which most of the elements are known to be zero (or \code{FALSE} for logical and binary (``pattern'') matrices). Sparse matrices are automatically built from \Rfun{Matrix} whenever the majority of entries is zero (or \code{FALSE} respectively). Alternatively, \Rfun{sparseMatrix} builds sparse matrices from their non-zero entries and is typically recommended to construct large sparse matrices, rather than direct calls of \Rfun{new}. \TODO{E.g. model matrices created from factors with a large number of levels} \TODO{ or from spline basis functions (e.g. COBS, package \pkg{cobs}), etc.} \TODO{Other uses include representations of graphs. indeed; good you mentioned it! particularly since we still have the interface to the \pkg{graph} package. I think I'd like to draw one graph in that article --- maybe the undirected graph corresponding to a crossprod() result of dimension ca. $50^2$} \TODO{Specialized algorithms can give substantial savings in amount of storage used and execution time of operations.} \TODO{Our implementation is based on the CHOLMOD and CSparse libraries by Tim Davis.} \subsection{Representations of sparse matrices} \label{ssec:SparseReps} \subsubsection{Triplet representation (\class{TsparseMatrix})} Conceptually, the simplest representation of a sparse matrix is as a triplet of an integer vector \code{i} giving the row numbers, an integer vector \code{j} giving the column numbers, and a numeric vector \code{x} giving the non-zero values in the matrix.\footnote{For efficiency reasons, we use ``zero-based'' indexing in the \pkg{Matrix} package, i.e., the row indices \code{i} are in \code{0:(nrow(.)-1)} and the column indices \code{j} accordingly.} In \pkg{Matrix}, the \class{TsparseMatrix} class is the virtual class of all sparse matrices in triplet representation. Its main use is for easy input or transfer to other classes. As for the dense matrices, the class of the \code{x} slot may vary, and the subclasses may be triangular, symmetric or unspecified (``general''), such that the \class{TsparseMatrix} class has several\footnote{the $3 \times 3$ actual subclasses of \class{TsparseMatrix} are the three structural kinds, namely \textbf{t}riangular, \textbf{s}ymmetric and \textbf{g}eneral, times three entry classes, \textbf{d}ouble, \textbf{l}ogical, and patter\textbf{n}.} `actual'' subclasses, the most typical (numeric, general) is \class{dgTMatrix}: <>= getClass("TsparseMatrix") # (i,j, Dim, Dimnames) slots are common to all getClass("dgTMatrix") @ Note that the \emph{order} of the entries in the \code{(i,j,x)} vectors does not matter; consequently, such matrices are not unique in their representation. \footnote{ Furthermore, there can be \emph{repeated} \code{(i,j)} entries with the customary convention that the corresponding \code{x} entries are \emph{added} to form the matrix element $m_{ij}$. } %% The triplet representation is row-oriented if elements in the same row %% were adjacent and column-oriented if elements in the same column were %% adjacent. \subsubsection{Compressed representations: \class{CsparseMatrix} and \class{RsparseMatrix}} For most sparse operations we use the compressed column-oriented representation (virtual class \class{CsparseMatrix}) (also known as ``csc'', ``compressed sparse column''). Here, instead of storing all column indices \code{j}, only the \emph{start} index of every column is stored. Analogously, there is also a compressed sparse row (csr) representation, which e.g. is used in in the \pkg{SparseM} package, and we provide the \class{RsparseMatrix} for compatibility and completeness purposes, in addition to basic coercion (\code({as(., \textit{})} between the classes. %% (column-oriented triplet) except that \code{i} (\code{j}) just stores %% the index of the first element in the row (column). (There are a %% couple of other details but that is the gist of it.) These compressed representations remove the redundant row (column) indices and provide faster access to a given location in the matrix because you only need to check one row (column). There are certain advantages \footnote{routines can make use of high-level (``level-3'') BLAS in certain sparse matrix computations} to csc in systems like \RR{}, Octave and Matlab where dense matrices are stored in column-major order, therefore it is used in sparse matrix libraries such as CHOLMOD or CSparse of which we make use. For this reason, the \class{CsparseMatrix} class and subclasses are the principal classes for sparse matrices in the \pkg{Matrix} package. The Matrix package provides the following classes for sparse matrices \FIXME{many more --- maybe explain naming scheme?} \begin{description} \item[dgTMatrix] general, numeric, sparse matrices in (a possibly redundant) triplet form. This can be a convenient form in which to construct sparse matrices. \item[dgCMatrix] general, numeric, sparse matrices in the (sorted) compressed sparse column format. \item[dsCMatrix] symmetric, real, sparse matrices in the (sorted) compressed sparse column format. Only the upper or the lower triangle is stored. Although there is provision for both forms, the lower triangle form works best with TAUCS. \item[dtCMatrix] triangular, real, sparse matrices in the (sorted) compressed sparse column format. \end{description} \TODO{Can also read and write the Matrix Market and read the Harwell-Boeing representations.} \TODO{Can convert from a dense matrix to a sparse matrix (or use the Matrix function) but going through an intermediate dense matrix may cause problems with the amount of memory required.} \TODO{similar range of operations as for the dense matrix classes.} \section{More detailed examples of ``Matrix'' operations} Have seen \texttt{drop0()} above, %(p.3); only with logical showe a nice double example (where you see ``.'' and ``0''). Show the use of \code{dim<-} for \emph{resizing} a (sparse) matrix. Maybe mention \Rfun{nearPD}. \TODO{Solve a sparse least squares problem and demonstrate memory / speed gain} \TODO{mention \code{lme4} and \Rfun{lmer}, maybe use one example to show the matrix sizes.} \section{Notes about S4 classes and methods implementation} Maybe we could % even here (for R News, not only for JSS) give some glimpses of implementations at least on the \RR{} level ones? \TODO{The class hierarchy: a non-trivial tree where only the leaves are ``actual'' classes.} \TODO{The main advantage of the multi-level hierarchy is that methods can often be defined on a higher (virtual class) level which ensures consistency [and saves from ``cut \& paste'' and forgetting things]} \TODO{Using Group Methods} \section{Session Info} <>= toLatex(sessionInfo()) @ \bibliography{Matrix} \end{document} Matrix/vignettes/Introduction.Rnw0000644000176200001440000001753412070262574016716 0ustar liggesusers\documentclass{article} \usepackage{myVignette} \usepackage[authoryear,round]{natbib} \bibliographystyle{plainnat} %%\VignetteIndexEntry{Introduction to the Matrix Package} %%\VignetteDepends{Matrix} \SweaveOpts{engine=R,eps=FALSE,pdf=TRUE,width=5,height=3,strip.white=true,keep.source=TRUE} \title{Introduction to the Matrix package --- as of Feb.~2005\footnote{ There's an unfinished ``2nd Introduction to the Matrix package'' which contains partly newer information, but is not at all self-contained. Eventually that will replace this one.}} \author{Douglas Bates\\R Core Development Group\\\email{bates@r-project.org}} \date{\today} \begin{document} \maketitle \begin{abstract} Linear algebra is at the core of many areas of statistical computing and from its inception the \Slang{} has supported numerical linear algebra via a matrix data type and several functions and operators, such as \code{\%*\%}, \code{qr}, \code{chol}, and \code{solve}. However, these data types and functions do not provide direct access to all of the facilities for efficient manipulation of dense matrices, as provided by the Lapack subroutines, and they do not provide for manipulation of sparse matrices. The \code{Matrix} package provides a set of S4 classes for dense and sparse matrices that extend the basic matrix data type. Methods for a wide variety of functions and operators applied to objects from these classes provide efficient access to BLAS (Basic Linear Algebra Subroutines), Lapack (dense matrix), TAUCS (sparse matrix) and UMFPACK (sparse matrix) routines. One notable characteristic of the package is that whenever a matrix is factored, the factorization is stored as part of the original matrix so that further operations on the matrix can reuse this factorization. \end{abstract} <>= options(width=75) @ \section{Introduction} \label{sec:Intro} Linear algebra is at the core of many statistical computing techniques and, from its inception, the \Slang{} has supported numerical linear algebra via a matrix data type and several functions and operators, such as \code{\%*\%}, \code{qr}, \code{chol}, and \code{solve}. Initially the numerical linear algebra functions in \RR{} called underlying Fortran routines from the Linpack~\citep{Linpack} and Eispack~\cite{Eispack} libraries but over the years most of these functions have been switched to use routines from the Lapack~\cite{Lapack} library. Furthermore, \RR{} can be configured to use accelerated BLAS (Basic Linear Algebra Subroutines), such as those from the Atlas~\cite{Atlas} project or Goto's BLAS~\cite{GotosBLAS}. Lapack provides routines for operating on several special forms of matrices, such as triangular matrices and symmetric matrices. Furthermore,matrix decompositions like the QR decompositions produce multiple output components that should be regarded as parts of a single object. There is some support in R for operations on special forms of matrices (e.g. the \code{backsolve}, \code{forwardsolve} and \code{chol2inv} functions) and for special structures (e.g. a QR structure is implicitly defined as a list by the \code{qr}, \code{qr.qy}, \code{qr.qty}, and related functions) but it is not as fully developed as it could be. Also there is no direct support for sparse matrices in R although \citet{koen:ng:2003} have developed a contributed package for sparse matrices based on SparseKit. The \code{Matrix} package provides S4 classes and methods for dense and sparse matrices. The methods for dense matrices use Lapack and BLAS. The sparse matrix methods use TAUCS~\citep{Taucs}, UMFPACK~\citep{Umfpack}, and Metis~\citep{Metis}. \section{Classes for dense matrices} \label{sec:DenseClasses} The \code{Matrix} package will provide classes for real (stored as double precision) and complex (stored as double precision complex) dense matrices. At present only the real classes have been implemented. These classes are \begin{description} \item[dgeMatrix] Real matrices in general storage mode \item[dsyMatrix] Symmetric real matrices in non-packed storage \item[dspMatrix] Symmetric real matrices in packed storage (one triangle only) \item[dtrMatrix] Triangular real matrices in non-packed storage \item[dtpMatrix] Triangular real matrices in packed storage (triangle only) \item[dpoMatrix] Positive semi-definite symmetric real matrices in non-packed storage \item[dppMatrix] \ \ ditto \ \ in packed storage \end{description} Methods for these classes include coercion between these classes, when appropriate, and coercion to the \code{matrix} class; methods for matrix multiplication (\code{\%*\%}); cross products (\code{crossprod}), matrix norm (\code{norm}); reciprocal condition number (\code{rcond}); LU factorization (\code{lu}) or, for the \code{poMatrix} class, the Cholesky decomposition (\code{chol}); and solutions of linear systems of equations (\code{solve}). Further, group methods have been defined for the \code{Arith} (basic arithmetic, including with scalar numbers) and the \code{Math} (basic mathematical functions) group.. Whenever a factorization or a decomposition is calculated it is preserved as a (list) element in the \code{factors} slot of the original object. In this way a sequence of operations, such as determining the condition number of a matrix then solving a linear system based on the matrix, do not require multiple factorizations of the same matrix nor do they require the user to store the intermediate results. \section{Classes for sparse matrices} \label{sec:SparseClasses} \subsection{Representations of sparse matrices} \label{ssec:SparseReps} Conceptually, the simplest representation of a sparse matrix is as a triplet of an integer vector \code{i} giving the row numbers, an integer vector \code{j} giving the column numbers, and a numeric vector \code{x} giving the non-zero values in the matrix. An S4 class definition might be \begin{Schunk} \begin{Sinput} setClass("dgTMatrix", representation(i = "integer", j = "integer", x = "numeric", Dim = "integer")) \end{Sinput} \end{Schunk} The triplet representation is row-oriented if elements in the same row were adjacent and column-oriented if elements in the same column were adjacent. The compressed sparse row (csr) (or compressed sparse column - csc) representation is similar to row-oriented triplet (column-oriented triplet) except that \code{i} (\code{j}) just stores the index of the first element in the row (column). (There are a couple of other details but that is the gist of it.) These compressed representations remove the redundant row (column) indices and provide faster access to a given location in the matrix because you only need to check one row (column). The preferred representation of sparse matrices in the SparseM package is csr. Matlab uses csc. We hope that Octave will also use this representation. There are certain advantages to csc in systems like R and Matlab where dense matrices are stored in column-major order. For example, Sivan Toledo's TAUCS~\cite{Taucs} library and Tim Davis's UMFPACK~\cite{Umfpack} library are both based on csc and can both use level-3 BLAS in certain sparse matrix computations. The Matrix package provides the following classes for sparse matrices \begin{description} \item[dgTMatrix] general, numeric, sparse matrices in (a possibly redundant) triplet form. This can be a convenient form in which to construct sparse matrices. \item[dgCMatrix] general, numeric, sparse matrices in the (sorted) compressed sparse column format. \item[dsCMatrix] symmetric, real, sparse matrices in the (sorted) compressed sparse column format. Only the upper or the lower triangle is stored. Although there is provision for both forms, the lower triangle form works best with TAUCS. \item[dtCMatrix] triangular, real, sparse matrices in the (sorted) compressed sparse column format. \end{description} \bibliography{Matrix} \end{document} Matrix/vignettes/sparseModels.Rnw0000644000176200001440000002520213775317466016703 0ustar liggesusers\documentclass{article} % \usepackage{fullpage} \usepackage{myVignette} \usepackage[authoryear,round]{natbib} \bibliographystyle{plainnat} \newcommand{\noFootnote}[1]{{\small (\textit{#1})}} \newcommand{\myOp}[1]{{$\left\langle\ensuremath{#1}\right\rangle$}} %%\VignetteIndexEntry{Sparse Model Matrices} %%\VignetteDepends{Matrix,MASS} \title{Sparse Model Matrices} \author{Martin Maechler\\ R Core Development Team \\\email{maechler@R-project.org}} \date{July 2007, 2008 ({\tiny typeset on \tiny\today})} % \begin{document} \maketitle \SweaveOpts{engine=R, keep.source=TRUE} \SweaveOpts{eps=FALSE, pdf=TRUE, width=8, height=5.5, strip.white=true} \setkeys{Gin}{width=\textwidth} % \begin{abstract} % ............................ FIXME % \end{abstract} %% Note: These are explained in '?RweaveLatex' : <>= options(width=75) @ \section*{Introduction} Model matrices in the very widely used (generalized) linear models of statistics, (typically fit via \Rfun{lm} or \Rfun{glm} in \RR) are often practically sparse --- whenever categorical predictors, \code{factor}s in \RR, are used. %% FIXME: Introduce lm.fit.sparse() or not ? We show for a few classes of such linear models how to construct sparse model matrices using sparse matrix (S4) objects from the \pkg{Matrix} package, and typically \emph{without} using dense matrices in intermediate steps. %% only the latter is really novel, since "SparseM" (and others) %% have used the equivalent of %% as( model.matrix(.....), "sparseMatrix") \section{One factor: \texttt{y $\sim$ f1}} Let's start with an artifical small example: <>= (ff <- factor(strsplit("statistics_is_a_task", "")[[1]], levels=c("_",letters))) factor(ff) # drops the levels that do not occur f1 <- ff[, drop=TRUE] # the same, more transparently @ and now assume a model $$y_i = \mu + \alpha_{j(i)} + E_i,$$ for $i=1,\dots,n =$~\code{length(f1)}$= 20$, and $\alpha_{j(i)}$ with a constraint such as $\sum_j \alpha_j = 0$ (``sum'') or $\alpha_1 = 0$ (``treatment'') and $j(i) =$\code{as.numeric(f1[i])} being the level number of the $i$-th observation. For such a ``design'', the model is only estimable if the levels \code{c} and \code{k} are merged, and <>= levels(f1)[match(c("c","k"), levels(f1))] <- "ck" library(Matrix) Matrix(contrasts(f1)) # "treatment" contrasts by default -- level "_" = baseline Matrix(contrasts(C(f1, sum))) Matrix(contrasts(C(f1, helmert)), sparse=TRUE) # S-plus default; much less sparse @ where \Rfun{contrasts} is (conceptually) just one major ingredient in the well-known \Rfun{model.matrix} function to build the linear model matrix $\mathbf{X}$ of so-called ``dummy variables''. %% Since 2007, the \pkg{Matrix} package has been providing coercion from a \code{factor} object to a \code{sparseMatrix} one to produce the transpose of the model matrix corresponding to a model with that factor as predictor (and no intercept): <>= as(f1, "sparseMatrix") @ which is really almost the transpose of using the above sparsification of \Rfun{contrasts} (and arranging for nice printing), <>= printSpMatrix( t( Matrix(contrasts(f1))[as.character(f1) ,] ), col.names=TRUE) @ and that is the same as the ``sparsification'' of \Rfun{model.matrix}, apart from the column names (here transposed), <>= t( Matrix(model.matrix(~ 0+ f1))) # model with*OUT* intercept @ A more realistic small example is the \code{chickwts} data set, <>= str(chickwts)# a standard R data set, 71 x 2 x.feed <- as(chickwts$feed, "sparseMatrix") x.feed[ , (1:72)[c(TRUE,FALSE,FALSE)]] ## every 3rd column: @ % FIXME: Move this to ../../../MatrixModels/inst/doc/ ??? % ## Provisional (hence unexported) sparse lm.fit(): % Matrix:::lm.fit.sparse(x = t(x.feed), y = chickwts[,1]) %- for emacs: $ \section{One factor, one continuous: \texttt{y $\sim$ f1 + x}} To create the model matrix for the case of one factor and one continuous predictor---called ``analysis of covariance'' in the historical literature--- we can adopt the following simple scheme. %% Possible examples: %% - Puromycin %% - ToothGrowth %--- FIXME --- The final model matrix is the concatenation of: 1) create the sparse 0-1 matrix \code{m1} from the f1 main-effect 2) the single row/column 'x' == 'x' main-effect 3) replacing the values 1 in \code{m1@x} (the x-slot of the factor model matrix), by the values of \code{x} (our continuous predictor). \section{Two (or more) factors, main effects only: \texttt{y $\sim$ f1 + f2}} %% FIXME: 'warpbreaks' is smaller and more natural as fixed effect model! Let us consider the \code{warpbreaks} data set of 54 observations, <>= data(warpbreaks)# a standard R data set str(warpbreaks) # 2 x 3 (x 9) balanced two-way with 9 replicates: xtabs(~ wool + tension, data = warpbreaks) @ %It is \emph{not} statistically sensible to assume that \code{Run} is a %fixed effect, however the example is handy to depict how a model matrix This example depicts how a model matrix would be built for the model \code{breaks ~ wool + tension}. Since this is a main effects model (no interactions), the desired model matrix is simply the concatenation of the model matrices of the main effects. There are two here, but the principle applies to general main effects of factors. The most sparse matrix is reached by \emph{not} using an intercept, (which would give an all-1-column) but rather have one factor fully coded (aka ``swallow'' the intercept), and all others being at \code{"treatment"} contrast, i.e., here, the \emph{transposed} model matrix, \code{tmm}, is <>= tmm <- with(warpbreaks, rbind(as(tension, "sparseMatrix"), as(wool, "sparseMatrix")[-1,,drop=FALSE])) print( image(tmm) ) # print(.) the lattice object @ \\ The matrices are even sparser when the factors have more than just two or three levels, e.g., for the morley data set, <>= data(morley) # a standard R data set morley$Expt <- factor(morley$Expt) morley$Run <- factor(morley$Run) str(morley) t.mm <- with(morley, rbind(as(Expt, "sparseMatrix"), as(Run, "sparseMatrix")[-1,])) print( image(t.mm) ) # print(.) the lattice object @ %% Also see Doug's E-mail to R-help % From: "Douglas Bates" % Subject: Re: [R] Large number of dummy variables % Date: Mon, 21 Jul 2008 18:07:26 -0500 \section{Interactions of two (or more) factors,.....} %% Of course, this is *the* interesting part %% To form interactions, we would have to ``outer-multiply'' %% the single-factor model-matrices (after "[, -1]") In situations with more than one factor, particularly with interactions, the model matrix is currently not directly available via \pkg{Matrix} functions --- but we still show to build them carefully. The easiest---but not at memory resources efficient---way is to go via the dense \Rfun{model.matrix} result: <>= data(npk, package="MASS") npk.mf <- model.frame(yield ~ block + N*P*K, data = npk) ## str(npk.mf) # the data frame + "terms" attribute m.npk <- model.matrix(attr(npk.mf, "terms"), data = npk) class(M.npk <- Matrix(m.npk)) dim(M.npk)# 24 x 13 sparse Matrix t(M.npk) # easier to display, column names readably displayed as row.names(t(.)) @ %% printSpMatrix(M.npk, col.names = "abb1") Another example was reported by a user on R-help (July 15, 2008, {\small \url{https://stat.ethz.ch/pipermail/r-help/2008-July/167772.html}}) about an ``aov error with large data set''. \begin{citation} % RAS: in my PDF, I don't see the first character I I'm looking to analyze a large data set: a within-Ss 2*2*1500 design with 20 Ss. However, aov() gives me an error. %, reproducible as follows: \end{citation} And gave the following code example (slightly edited): <>= id <- factor(1:20) a <- factor(1:2) b <- factor(1:2) d <- factor(1:1500) aDat <- expand.grid(id=id, a=a, b=b, d=d) aDat$y <- rnorm(length(aDat[, 1])) # generate some random DV data dim(aDat) # 120'000 x 5 (120'000 = 2*2*1500 * 20 = 6000 * 20) @ %% ^^^^^^^ MM: "fix" and generate much more interesting data and then continued with \begin{Sinput} m.aov <- aov(y ~ a*b*d + Error(id/(a*b*d)), data=aDat) \end{Sinput} \begin{citation}\sffamily which yields the following error:\\ \ttfamily Error in model.matrix.default(mt, mf, contrasts) :\\ allocMatrix: too many elements specified\\ \end{citation} to which he got the explanation by Peter Dalgaard that the formal model matrix involved was much too large in this case, and that PD assumed, \pkg{lme4} would be able to solve the problem. However, currently there would still be a big problem with using \pkg{lme4}, because of the many levels of \emph{fixed} effects: Specifically\footnote{the following is not run in \RR\ on purpose, rather just displayed here}, \begin{Sinput} dim(model.matrix( ~ a*b*d, data = aDat)) # 120'000 x 6000 \end{Sinput} where we note that $120'000 \times 6000 = 720 \textrm{mio}$, which is $720'000'000 * 8 / 2^{20} \approx 5500$ Megabytes. \emph{Unfortunately} \pkg{lme4} does \emph{not} use a sparse $X$-matrix for the fixed effects (yet), it just uses sparse matrices for the $Z$-matrix of random effects and sparse matrix operations for computations related to $Z$. Let us use a smaller factor \code{d} in order to investigate how sparse the $X$ matrix would be: <>= d2 <- factor(1:150) # 10 times smaller tmp2 <- expand.grid(id=id, a=a, b=b, d=d2) dim(tmp2) dim(mm <- model.matrix( ~ a*b*d, data=tmp2)) ## is 100 times smaller than original example class(smm <- Matrix(mm)) # automatically coerced to sparse round(object.size(mm) / object.size(smm), 1) @ shows that even for the small \code{d} here, the memory reduction would be more than an order of magnitude. \\ %% Reasons to fake here: %% 1) print() is needed for lattice -- but looks ugly, %% 2) the resulting pdf file is too large -- use png instead: <>= image(t(smm), aspect = 1/3, lwd=0, col.regions = "red") <>= png("sparseModels-X-sparse-image.png", width=6, height=3, units='in', res=150) print( <> ) dev.off() @ %%--NB: 'keep.source=FALSE' above is workaround-a-bug-in-R-devel-(2.13.x)--- \par\vspace*{-1ex} \centerline{% \includegraphics[width=1.1\textwidth]{sparseModels-X-sparse-image.png}} and working with the sparse instead of the dense model matrix is considerably faster as well, <>= x <- 1:600 system.time(y <- smm %*% x) ## sparse is much faster system.time(y. <- mm %*% x) ## than dense identical(as.matrix(y), y.) ## TRUE @ <>= toLatex(sessionInfo()) @ \end{document} Matrix/R/0000755000176200001440000000000014154165363011727 5ustar liggesusersMatrix/R/AllClass.R0000644000176200001440000010414414041103731013536 0ustar liggesusers## --- New "logic" class -- currently using "raw" instead of "logical" ## LOGIC setClass("logic", contains = "raw") ##' To be used in initialize method or other Matrix constructors ##' ##' TODO: via .Call(..) .fixupDimnames <- function(dnms) { N.N <- list(NULL, NULL) if(is.null(dnms) || identical(dnms, N.N)) return(N.N) ## else if(any(i0 <- lengths(dnms) == 0) && !all(vapply(dnms[i0], is.null, NA))) ## replace character(0) etc, by NULL : dnms[i0] <- list(NULL) ## coerce, e.g. integer dimnames to character: -- as R's matrix(..): if(any(i0 <- vapply(dnms, function(d) !is.null(d) && !is.character(d), NA))) dnms[i0] <- lapply(dnms[i0], as.character) dnms } ## ------------- Virtual Classes ---------------------------------------- ## Mother class of all Matrix objects setClass("Matrix", contains = "VIRTUAL", slots = c(Dim = "integer", Dimnames = "list"), prototype = prototype(Dim = integer(2), Dimnames = list(NULL,NULL)), validity = function(object) { if(!isTRUE(r <- .Call(Dim_validate, object, "Matrix"))) r else .Call(dimNames_validate, object) }) if(FALSE)## Allowing 'Dimnames' to define 'Dim' --> would require changes in ## ../src/Mutils.c dimNames_validate() and how it is used in validity above setMethod("initialize", "Matrix", function(.Object, ...) { .Object <- callNextMethod() if(length(args <- list(...)) && any(nzchar(snames <- names(args))) && "Dimnames" %in% snames) { .Object@Dimnames <- DN <- .fixupDimnames(.Object@Dimnames) if(is.na(match("Dim", snames)) && !any(vapply(DN, is.null, NA))) ## take 'Dim' from 'Dimnames' dimensions .Object@Dim <- lengths(DN, use.names=FALSE) } .Object }) if(getRversion() >= "3.2.0") { setMethod("initialize", "Matrix", function(.Object, ...) { .Object <- callNextMethod() if(length(args <- list(...)) && any(nzchar(snames <- names(args))) && "Dimnames" %in% snames) .Object@Dimnames <- .fixupDimnames(.Object@Dimnames) .Object }) } else { ## R < 3.2.0 setMethod("initialize", "Matrix", function(.Object, ...) { .Object <- callNextMethod(.Object, ...) if(length(args <- list(...)) && any(nzchar(snames <- names(args))) && "Dimnames" %in% snames) .Object@Dimnames <- .fixupDimnames(.Object@Dimnames) .Object }) } ## The class of composite matrices - i.e. those for which it makes sense to ## create a factorization setClass("compMatrix", contains = c("Matrix", "VIRTUAL"), slots = c(factors = "list")) ## Virtual classes of Matrices determined by above/below diagonal relationships setClass("generalMatrix", contains = c("compMatrix", "VIRTUAL")) setClass("symmetricMatrix", contains = c("compMatrix", "VIRTUAL"), slots = c(uplo = "character"), prototype = prototype(uplo = "U"), validity = function(object) .Call(symmetricMatrix_validate, object)) setClass("triangularMatrix", contains = c("Matrix", "VIRTUAL"), slots = c(uplo = "character", diag = "character"), prototype = prototype(uplo = "U", diag = "N"), validity = function(object) .Call(triangularMatrix_validate, object)) ## Virtual class of numeric matrices setClass("dMatrix", contains = c("Matrix", "VIRTUAL"), slots = c(x = "numeric"), validity = function(object) .Call(dMatrix_validate, object)) ## Virtual class of integer matrices setClass("iMatrix", contains = c("Matrix", "VIRTUAL"), slots = c(x = "integer")) ## Virtual class of logical matrices setClass("lMatrix", contains = c("Matrix", "VIRTUAL"), slots = c(x = "logical")) ## Virtual class of nonzero pattern matrices setClass("nMatrix", contains = c("Matrix", "VIRTUAL")) ## aka 'pattern' matrices -- have no x slot ## Virtual class of complex matrices - 'z' as in the names of Lapack routines setClass("zMatrix", contains = c("Matrix", "VIRTUAL"), slots = c(x = "complex")) ## Virtual class of dense matrices (including "packed") setClass("denseMatrix", contains = c("Matrix", "VIRTUAL")) ## Virtual class of dense, numeric matrices setClass("ddenseMatrix", contains = c("dMatrix", "denseMatrix", "VIRTUAL")) ## Virtual class of dense, logical matrices setClass("ldenseMatrix", contains = c("lMatrix", "denseMatrix", "VIRTUAL")) if(FALSE) { ##--not yet-- setClass("idenseMatrix", contains = c("iMatrix", "denseMatrix", "VIRTUAL")) } ## Virtual class of dense, nonzero pattern matrices - rarely used, for completeness setClass("ndenseMatrix", contains = c("nMatrix", "denseMatrix", "VIRTUAL"), slots = c(x = "logical")) ## virtual SPARSE ------------ setClass("sparseMatrix", contains = c("Matrix", "VIRTUAL")) ## diagonal: has 'diag' slot; diag = "U" <--> have identity matrix setClass("diagonalMatrix", contains = c("sparseMatrix", "VIRTUAL"), ## NOTE: ^^^^^^ was dense Matrix, until 0.999375-11 (2008-07) slots = c(diag = "character"), validity = function(object) { d <- object@Dim if(d[1] != (n <- d[2])) return("matrix is not square") lx <- length(object@x) if(object@diag == "U") { if(lx != 0) return("diag = \"U\" (identity matrix) requires empty 'x' slot") } else if(object@diag == "N") { if(lx != n) return("diagonal matrix has 'x' slot of length != 'n'") } else return("diagonal matrix 'diag' slot must be \"U\" or \"N\"") TRUE }, prototype = prototype(diag = "N") ) ## sparse matrices in Triplet representation (dgT, lgT, ..): setClass("TsparseMatrix", contains = c("sparseMatrix", "VIRTUAL"), slots = c(i = "integer", j = "integer"), validity = function(object) .Call(Tsparse_validate, object) ) setClass("CsparseMatrix", contains = c("sparseMatrix", "VIRTUAL"), slots = c(i = "integer", p = "integer"), prototype = prototype(p = 0L),# to be valid validity = function(object) .Call(Csparse_validate, object) ) if(FALSE) { ## in theory.. would be neat for new("dgCMatrix", Dim = c(3L,3L)) setMethod("initialize", "CsparseMatrix", function(.Object, ...) { .Object <- callNextMethod() .Object@p <- integer(.Object@Dim[2L] + 1L) .Object }) setMethod("initialize", "RsparseMatrix", function(.Object, ...) { .Object <- callNextMethod() .Object@p <- integer(.Object@Dim[1L] + 1L) .Object }) }# not yet (fails) setClass("RsparseMatrix", contains = c("sparseMatrix", "VIRTUAL"), slots = c(p = "integer", j = "integer"), prototype = prototype(p = 0L),# to be valid validity = function(object) .Call(Rsparse_validate, object) ) setClass("dsparseMatrix", contains = c("dMatrix", "sparseMatrix", "VIRTUAL")) setClass("lsparseMatrix", contains = c("lMatrix", "sparseMatrix", "VIRTUAL")) if(FALSE) { ##--not yet-- setClass("isparseMatrix", contains = c("iMatrix", "sparseMatrix", "VIRTUAL")) } ## these are the "pattern" matrices for "symbolic analysis" of sparse OPs: setClass("nsparseMatrix", contains = c("nMatrix", "sparseMatrix", "VIRTUAL")) ## More Class Intersections {for method dispatch}: if(FALSE) { ## this is "natural" but gives WARNINGs when other packages use "it" setClass("dCsparseMatrix", contains = c("CsparseMatrix", "dsparseMatrix", "VIRTUAL")) setClass("lCsparseMatrix", contains = c("CsparseMatrix", "lsparseMatrix", "VIRTUAL")) setClass("nCsparseMatrix", contains = c("CsparseMatrix", "nsparseMatrix", "VIRTUAL")) ## dense general setClass("geMatrix", contains = c("denseMatrix", "generalMatrix", "VIRTUAL")) } else { ## ----------- a version that maybe works better for other pkgs --------- ##--> setClassUnion() ... below } ## ------------------ Proper (non-virtual) Classes ---------------------------- ##---------------------- DENSE ----------------------------------------- ## numeric, dense, general matrices setClass("dgeMatrix", contains = c("ddenseMatrix", "generalMatrix"), ## checks that length( @ x) == prod( @ Dim): validity = function(object) .Call(dgeMatrix_validate, object)) ## i.e. "dgeMatrix" cannot be packed, but "ddenseMatrix" can .. ## numeric, dense, non-packed, triangular matrices setClass("dtrMatrix", contains = c("ddenseMatrix", "triangularMatrix"), validity = function(object) .Call(dense_nonpacked_validate, object)) ## numeric, dense, packed, triangular matrices setClass("dtpMatrix", contains = c("ddenseMatrix", "triangularMatrix"), validity = function(object) .Call(dtpMatrix_validate, object)) ## numeric, dense, non-packed symmetric matrices setClass("dsyMatrix", contains = c("ddenseMatrix", "symmetricMatrix"), validity = function(object) .Call(dense_nonpacked_validate, object)) ## numeric, dense, packed symmetric matrices setClass("dspMatrix", contains = c("ddenseMatrix", "symmetricMatrix"), validity = function(object) .Call(dspMatrix_validate, object)) ## numeric, dense, non-packed, positive-definite, symmetric matrices setClass("dpoMatrix", contains = "dsyMatrix", validity = function(object) .Call(dpoMatrix_validate, object) ) ## numeric, dense, packed, positive-definite, symmetric matrices setClass("dppMatrix", contains = "dspMatrix", validity = function(object) .Call(dppMatrix_validate, object) ) ##----- logical dense Matrices -- e.g. as result of COMPARISON ## logical, dense, general matrices setClass("lgeMatrix", contains = c("ldenseMatrix", "generalMatrix"), ## since "lge" inherits from "ldenseMatrix", only need this: ## checks that length( @ x) == prod( @ Dim): validity = function(object) .Call(dense_nonpacked_validate, object)) ## i.e. "lgeMatrix" cannot be packed, but "ldenseMatrix" can .. ## logical, dense, non-packed, triangular matrices setClass("ltrMatrix", validity = function(object) .Call(dense_nonpacked_validate, object), contains = c("ldenseMatrix", "triangularMatrix")) ## logical, dense, packed, triangular matrices setClass("ltpMatrix", contains = c("ldenseMatrix", "triangularMatrix")) ## logical, dense, non-packed symmetric matrices setClass("lsyMatrix", validity = function(object) .Call(dense_nonpacked_validate, object), contains = c("ldenseMatrix", "symmetricMatrix")) ## logical, dense, packed symmetric matrices setClass("lspMatrix", contains = c("ldenseMatrix", "symmetricMatrix"), validity = function(object) .Call(dspMatrix_validate, object) ## "dsp", "lsp" and "nsp" have the same validate ) ##----- nonzero pattern dense Matrices -- "for completeness" ## logical, dense, general matrices setClass("ngeMatrix", contains = c("ndenseMatrix", "generalMatrix"), validity = function(object) .Call(dense_nonpacked_validate, object)) ## i.e. "ngeMatrix" cannot be packed, but "ndenseMatrix" can .. ## logical, dense, non-packed, triangular matrices setClass("ntrMatrix", validity = function(object) .Call(dense_nonpacked_validate, object), contains = c("ndenseMatrix", "triangularMatrix")) ## logical, dense, packed, triangular matrices setClass("ntpMatrix", contains = c("ndenseMatrix", "triangularMatrix")) ## logical, dense, non-packed symmetric matrices setClass("nsyMatrix", validity = function(object) .Call(dense_nonpacked_validate, object), contains = c("ndenseMatrix", "symmetricMatrix")) ## logical, dense, packed symmetric matrices setClass("nspMatrix", contains = c("ndenseMatrix", "symmetricMatrix"), validity = function(object) .Call(dspMatrix_validate, object) ## "dsp", "lsp" and "nsp" have the same validate ) ## 'diagonalMatrix' already has validity checking ## diagonal, numeric matrices; "dMatrix" has 'x' slot : setClass("ddiMatrix", contains = c("diagonalMatrix", "dMatrix")) ## diagonal, logical matrices; "lMatrix" has 'x' slot : setClass("ldiMatrix", contains = c("diagonalMatrix", "lMatrix")) setClass("corMatrix", slots = c(sd = "numeric"), contains = "dpoMatrix", validity = function(object) { ## assuming that 'dpoMatrix' validity check has already happened: n <- object@Dim[2] if(length(sd <- object@sd) != n) return("'sd' slot must be of length 'dim(.)[1]'") if(any(!is.finite(sd)))# including NA return("'sd' slot has non-finite entries") if(any(sd < 0)) return("'sd' slot has negative entries") TRUE }) ##-------------------- S P A R S E (non-virtual) -------------------------- ##---------- numeric sparse matrix classes -------------------------------- ## numeric, sparse, triplet general matrices setClass("dgTMatrix", contains = c("TsparseMatrix", "dsparseMatrix", "generalMatrix"), validity = function(object) .Call(xTMatrix_validate, object) ) ## Should not have dtTMatrix inherit from dgTMatrix because a dtTMatrix could ## be less than fully stored if diag = "U". Methods for the dgTMatrix ## class would not produce correct results even though all the slots ## are present. ## numeric, sparse, triplet triangular matrices setClass("dtTMatrix", contains = c("TsparseMatrix", "dsparseMatrix", "triangularMatrix"), validity = function(object) .Call(tTMatrix_validate, object) ) ## numeric, sparse, triplet symmetric matrices(also only store one triangle) setClass("dsTMatrix", contains = c("TsparseMatrix", "dsparseMatrix", "symmetricMatrix"), validity = function(object) .Call(tTMatrix_validate, object) ) ## numeric, sparse, sorted compressed sparse column-oriented general matrices setClass("dgCMatrix", contains = c("CsparseMatrix", "dsparseMatrix", "generalMatrix"), validity = function(object) .Call(xCMatrix_validate, object) ) ## special case: indicator rows for a factor - needs more careful definition ##setClass("indicators", contains = "dgCMatrix", slots = c(levels = "character")) ## see comments for dtTMatrix above ## numeric, sparse, sorted compressed sparse column-oriented triangular matrices setClass("dtCMatrix", contains = c("CsparseMatrix", "dsparseMatrix", "triangularMatrix"), validity = function(object) .Call(tCMatrix_validate, object) ) ## see comments for dsTMatrix above ## numeric, sparse, sorted compressed sparse column-oriented symmetric matrices setClass("dsCMatrix", contains = c("CsparseMatrix", "dsparseMatrix", "symmetricMatrix"), validity = function(object) .Call(tCMatrix_validate, object) ) if(FALSE) ## TODO ??? Class of positive definite (Csparse symmetric) Matrices: setClass("dpCMatrix", contains = "dsCMatrix", validity = function(object) TODO("test for pos.definite ??")) ## numeric, sparse, sorted compressed sparse row-oriented general matrices setClass("dgRMatrix", contains = c("RsparseMatrix", "dsparseMatrix", "generalMatrix"), validity = function(object) .Call(xRMatrix_validate, object) ) ## numeric, sparse, sorted compressed sparse row-oriented triangular matrices setClass("dtRMatrix", contains = c("RsparseMatrix", "dsparseMatrix", "triangularMatrix"), validity = function(object) .Call(tRMatrix_validate, object) ) ## numeric, sparse, sorted compressed sparse row-oriented symmetric matrices setClass("dsRMatrix", contains = c("RsparseMatrix", "dsparseMatrix", "symmetricMatrix"), validity = function(object) .Call(tRMatrix_validate, object) ) ##---------- logical sparse matrix classes -------------------------------- ## these classes are typically result of Matrix comparisons, e.g., ## <..Matrix> >= v (and hence can have NA's) ## logical, sparse, triplet general matrices setClass("lgTMatrix", contains = c("TsparseMatrix", "lsparseMatrix", "generalMatrix"), validity = function(object) .Call(xTMatrix_validate, object) ) ## logical, sparse, triplet triangular matrices setClass("ltTMatrix", contains = c("TsparseMatrix", "lsparseMatrix", "triangularMatrix"), validity = function(object) .Call(tTMatrix_validate, object) ) ## logical, sparse, triplet symmetric matrices setClass("lsTMatrix", contains = c("TsparseMatrix", "lsparseMatrix", "symmetricMatrix"), validity = function(object) .Call(tTMatrix_validate, object) ) ## logical, sparse, sorted compressed sparse column-oriented general matrices setClass("lgCMatrix", contains = c("CsparseMatrix", "lsparseMatrix", "generalMatrix"), validity = function(object) .Call(xCMatrix_validate, object) ) ## logical, sparse, sorted compressed sparse column-oriented triangular matrices setClass("ltCMatrix", contains = c("CsparseMatrix", "lsparseMatrix", "triangularMatrix"), validity = function(object) .Call(xCMatrix_validate, object) ) ## logical, sparse, sorted compressed sparse column-oriented symmetric matrices setClass("lsCMatrix", contains = c("CsparseMatrix", "lsparseMatrix", "symmetricMatrix"), validity = function(object) .Call(xCMatrix_validate, object) ) ## logical, sparse, sorted compressed sparse row-oriented general matrices setClass("lgRMatrix", contains = c("RsparseMatrix", "lsparseMatrix", "generalMatrix"), validity = function(object) .Call(xRMatrix_validate, object) ) ## logical, sparse, sorted compressed sparse row-oriented triangular matrices setClass("ltRMatrix", contains = c("RsparseMatrix", "lsparseMatrix", "triangularMatrix"), validity = function(object) .Call(tRMatrix_validate, object) ) ## logical, sparse, sorted compressed sparse row-oriented symmetric matrices setClass("lsRMatrix", contains = c("RsparseMatrix", "lsparseMatrix", "symmetricMatrix"), validity = function(object) .Call(tRMatrix_validate, object) ) ##---------- nonzero pattern sparse matrix classes --------------------------- ## these classes are used in symbolic analysis to determine the ## locations of non-zero entries ## nonzero pattern, sparse, triplet general matrices setClass("ngTMatrix", contains = c("TsparseMatrix", "nsparseMatrix", "generalMatrix") ## validity: Tsparse_validate should be enough ) ## nonzero pattern, sparse, triplet triangular matrices setClass("ntTMatrix", contains = c("TsparseMatrix", "nsparseMatrix", "triangularMatrix"), ## validity: Tsparse_ and triangular*_validate should be enough ) ## nonzero pattern, sparse, triplet symmetric matrices setClass("nsTMatrix", contains = c("TsparseMatrix", "nsparseMatrix", "symmetricMatrix"), ## validity: Tsparse_ and symmetric*_validate should be enough ) ## nonzero pattern, sparse, sorted compressed column-oriented matrices setClass("ngCMatrix", contains = c("CsparseMatrix", "nsparseMatrix", "generalMatrix"), ## validity: Csparse_validate should be enough ) setClass("ngCMatrix", contains = c("CsparseMatrix", "nsparseMatrix", "generalMatrix"), ## validity: Csparse_validate should be enough ) ## nonzero pattern, sparse, sorted compressed column-oriented triangular matrices setClass("ntCMatrix", contains = c("CsparseMatrix", "nsparseMatrix", "triangularMatrix"), ## validity: Csparse_ and triangular*_validate should be enough ) ## nonzero pattern, sparse, sorted compressed column-oriented symmetric matrices setClass("nsCMatrix", contains = c("CsparseMatrix", "nsparseMatrix", "symmetricMatrix"), ## validity: Csparse_ and symmetric*_validate should be enough ) ## nonzero pattern, sparse, sorted compressed row-oriented general matrices setClass("ngRMatrix", contains = c("RsparseMatrix", "nsparseMatrix", "generalMatrix"), ) ## nonzero pattern, sparse, sorted compressed row-oriented triangular matrices setClass("ntRMatrix", contains = c("RsparseMatrix", "nsparseMatrix", "triangularMatrix"), ) ## nonzero pattern, sparse, sorted compressed row-oriented symmetric matrices setClass("nsRMatrix", contains = c("RsparseMatrix", "nsparseMatrix", "symmetricMatrix"), ) if(FALSE) { ##--not yet-- ##---------- integer sparse matrix classes -------------------------------- ## integer, sparse, triplet general matrices setClass("igTMatrix", contains = c("TsparseMatrix", "isparseMatrix", "generalMatrix"), validity = function(object) .Call(xTMatrix_validate, object) ) ## integer, sparse, triplet triangular matrices setClass("itTMatrix", contains = c("TsparseMatrix", "isparseMatrix", "triangularMatrix"), validity = function(object) .Call(tTMatrix_validate, object) ) ## integer, sparse, triplet symmetric matrices setClass("isTMatrix", contains = c("TsparseMatrix", "isparseMatrix", "symmetricMatrix"), validity = function(object) .Call(tTMatrix_validate, object) ) ## integer, sparse, sorted compressed sparse column-oriented general matrices setClass("igCMatrix", contains = c("CsparseMatrix", "isparseMatrix", "generalMatrix"), validity = function(object) .Call(xCMatrix_validate, object) ) ## integer, sparse, sorted compressed sparse column-oriented triangular matrices setClass("itCMatrix", contains = c("CsparseMatrix", "isparseMatrix", "triangularMatrix"), validity = function(object) .Call(xCMatrix_validate, object) ) ## integer, sparse, sorted compressed sparse column-oriented symmetric matrices setClass("isCMatrix", contains = c("CsparseMatrix", "isparseMatrix", "symmetricMatrix"), validity = function(object) .Call(xCMatrix_validate, object) ) ## integer, sparse, sorted compressed sparse row-oriented general matrices setClass("igRMatrix", contains = c("RsparseMatrix", "isparseMatrix", "generalMatrix"), validity = function(object) .Call(xRMatrix_validate, object) ) ## integer, sparse, sorted compressed sparse row-oriented triangular matrices setClass("itRMatrix", contains = c("RsparseMatrix", "isparseMatrix", "triangularMatrix"), validity = function(object) .Call(tRMatrix_validate, object) ) ## integer, sparse, sorted compressed sparse row-oriented symmetric matrices setClass("isRMatrix", contains = c("RsparseMatrix", "isparseMatrix", "symmetricMatrix"), validity = function(object) .Call(tRMatrix_validate, object) ) }##--not yet-- ##-------------------- index and permutation matrices-------------------------- setClass("indMatrix", slots = c(perm = "integer"), contains = c("sparseMatrix", "generalMatrix"), validity = function(object) { n <- object@Dim[1] d <- object@Dim[2] perm <- object@perm if (length(perm) != n) return(paste("length of 'perm' slot must be", n)) if(n > 0 && (any(perm > d) || any(perm < 1))) return("'perm' slot is not a valid index") TRUE }) setClass("pMatrix", slots = c(perm = "integer"), contains = c("indMatrix"), validity = function(object) { d <- object@Dim if (d[2] != (n <- d[1])) return("pMatrix must be square") perm <- object@perm if (length(perm) != n) return(paste("length of 'perm' slot must be", n)) if(n > 0 && !(all(range(perm) == c(1, n)) && length(unique(perm)) == n)) return("'perm' slot is not a valid permutation") TRUE }) ### Factorization classes --------------------------------------------- ## Mother class: setClass("MatrixFactorization", slots = c(Dim = "integer"), contains = "VIRTUAL", validity = function(object) .Call(MatrixFactorization_validate, object)) setClass("CholeskyFactorization", contains = "MatrixFactorization", "VIRTUAL") ## -- Those (exceptions) inheriting from "Matrix" : --- setClass("Cholesky", contains = c("dtrMatrix", "CholeskyFactorization")) #unUsed: setClass("LDL", contains = c("dtrMatrix", "CholeskyFactorization")) setClass("pCholesky", contains = c("dtpMatrix", "CholeskyFactorization")) ## These are currently only produced implicitly from *solve() setClass("BunchKaufman", contains = c("dtrMatrix", "MatrixFactorization"), slots = c(perm = "integer"), validity = function(object) .Call(BunchKaufman_validate, object)) setClass("pBunchKaufman", contains = c("dtpMatrix", "MatrixFactorization"), slots = c(perm = "integer"), validity = function(object) .Call(pBunchKaufman_validate, object)) ## -- the usual ``non-Matrix'' factorizations : --------- setClass("CHMfactor", # cholmod_factor struct as S4 object contains = c("CholeskyFactorization", "VIRTUAL"), slots = c(colcount = "integer", perm = "integer", type = "integer"), validity = function(object) .Call(CHMfactor_validate, object)) setClass("CHMsuper", # supernodal cholmod_factor contains = c("CHMfactor", "VIRTUAL"), slots = c(super = "integer", pi = "integer", px = "integer", s = "integer"), validity = function(object) .Call(CHMsuper_validate, object)) setClass("CHMsimpl", # simplicial cholmod_factor contains = c("CHMfactor", "VIRTUAL"), slots = c(p = "integer", i = "integer", nz = "integer", nxt = "integer", prv = "integer"), validity = function(object) .Call(CHMsimpl_validate, object)) setClass("dCHMsuper", contains = "CHMsuper", slots = c(x = "numeric")) setClass("nCHMsuper", contains = "CHMsuper") setClass("dCHMsimpl", contains = "CHMsimpl", slots = c(x = "numeric")) setClass("nCHMsimpl", contains = "CHMsimpl") ##--- LU --- setClass("LU", contains = c("MatrixFactorization", "VIRTUAL")) setClass("denseLU", contains = "LU", slots = c(x = "numeric", perm = "integer", Dimnames = "list"), validity = function(object) .Call(LU_validate, object)) setClass("sparseLU", contains = "LU", slots = c(L = "dtCMatrix", U = "dtCMatrix", p = "integer", q = "integer")) ##--- QR --- setClass("sparseQR", contains = "MatrixFactorization", slots = c(V = "dgCMatrix", beta = "numeric", p = "integer", R = "dgCMatrix", q = "integer"), validity = function(object) .Call(sparseQR_validate, object)) ##-- "SPQR" ---> ./spqr.R for now ## "denseQR" -- ? (``a version of'' S3 class "qr") if (FALSE) { ## unused classes setClass("csn_QR", slots = c(U = "dgCMatrix", L = "dgCMatrix", beta = "numeric")) setClass("csn_LU", slots = c(U = "dgCMatrix", L = "dgCMatrix", Pinv = "integer")) setClass("css_QR", slots = c(Pinv = "integer", Q = "integer", parent = "integer", cp = "integer", nz = "integer")) setClass("css_LU", slots = c(Q = "integer", nz = "integer")) } ##-- Schur --- ## non-"Matrix" Class 1 --- For Eigen values: setClassUnion("number", members = c("numeric", "complex")) setClass("Schur", contains = "MatrixFactorization", slots = c(T = "Matrix", # <- "block-triangular"; maybe triangular Q = "Matrix", EValues = "number"), validity = function(object) { dim <- object@Dim if((n <- dim[1]) != dim[2]) "'Dim' slot is not (n,n)" else if(any(dim(object@T) != n)) "'dim(T)' is incorrect" else if(any(dim(object@Q) != n)) "'dim(Q)' is incorrect" else if(length(object@EValues) != n) "'EValues' is not of correct length" else TRUE }) ### Class Union : no inheritance, but is(*, ) : setClassUnion("mMatrix", members = c("matrix", "Matrix")) if(FALSE) ## to be used in setMethod("c", "numM...") -- once that works setClassUnion("numMatrixLike", members = c("logical", "integer", "numeric", "mMatrix")) ## CARE: Sometimes we'd want all those for which 'x' contains all the data. ## e.g. Diagonal() is "ddiMatrix" with 'x' slot of length 0, does *not* contain 1 setClassUnion("xMatrix", ## those Matrix classes with an 'x' slot c("dMatrix", "iMatrix", "lMatrix", "ndenseMatrix", "zMatrix")) if(TRUE) { ##--- variant of setClass("dCsparse..." ..) etc working better for other pkgs ----- setClassUnion("dCsparseMatrix", members = c("dgCMatrix", "dtCMatrix", "dsCMatrix")) setClassUnion("lCsparseMatrix", members = c("lgCMatrix", "ltCMatrix", "lsCMatrix")) setClassUnion("nCsparseMatrix", members = c("ngCMatrix", "ntCMatrix", "nsCMatrix")) ## dense general setClassUnion("geMatrix", members = c("dgeMatrix", "lgeMatrix", "ngeMatrix")) } ## Definition Packed := dense with length( . @x) < prod( . @Dim) ## ~~~~~~ ## REPLACED the following with isPacked() in ./Auxiliaries.R : ## setClassUnion("packedMatrix", ## members = c("dspMatrix", "dppMatrix", "dtpMatrix", ## "lspMatrix", "ltpMatrix", "diagonalMatrix")) ## --------------------- non-"Matrix" Classes -------------------------------- ## --- "General" (not Matrix at all) ---- ## e.g. for "Arith" methods, NB: --> see "numericVector" below (incl "integer") setClassUnion("numLike", members = c("numeric", "logical")) ##setClassUnion("numIndex", members = "numeric") ## Note "rle" is a sealed oldClass (and "virtual" as w/o prototype) setClass("rleDiff", slots = c(first = "numLike", rle = "rle"), prototype = prototype(first = integer(), rle = rle(integer())), validity = function(object) { if(length(object@first) != 1) return("'first' must be of length one") rl <- object@rle if(!is.list(rl) || length(rl) != 2 || !identical(sort(names(rl)), c("lengths", "values"))) return("'rle' must be a list (lengths = *, values = *)") if(length(lens <- rl$lengths) != length(vals <- rl$values)) return("'lengths' and 'values' differ in length") if(any(lens <= 0)) return("'lengths' must be positive") TRUE }) ### 2010-03-04 -- thinking about *implementing* some 'abIndex' methodology, ### I conclude that the following structure would probably be even more ### efficient than the "rleDiff" one : ### IDEA: Store subsequences in a numeric matrix of three rows, where ### ----- one column = [from, to, by] defining a sub seq()ence ## for now, at least use it, and [TODO!] define "seqMat" <--> "abIndex" coercions: setClass("seqMat", contains = "matrix", prototype = prototype(matrix(0, nrow = 3, ncol=0)), validity = function(object) { if(!is.numeric(object)) return("is not numeric") d <- dim(object) if(length(d) != 3 || d[1] != 3) return("not a 3 x n matrix") if(any(object != floor(object))) return("some entries are not integer valued") TRUE }) setClass("abIndex", # 'ABSTRact Index' slots = c(kind = "character", ## one of ("int32", "double", "rleDiff") # i.e., numeric or "rleDiff" x = "numLike", # for numeric [length 0 otherwise] rleD = "rleDiff"), # "rleDiff" result prototype = prototype(kind = "int32", x = integer(0)),# rleD = ... etc validity = function(object) { switch(object@kind, "int32" = if(!is.integer(object@x)) return("'x' slot must be integer when kind is 'int32'") , "double" = if(!is.double(object@x)) return("'x' slot must be double when kind is 'double'") , "rleDiff" = { if(length(object@x)) return("'x' slot must be empty when kind is 'rleDiff'") }, ## otherwise return("'kind' must be one of (\"int32\", \"double\", \"rleDiff\")") ) TRUE }) ## for 'i' in x[i] or A[i,] : (numeric = {double, integer}) ## TODO: allow "abIndex" as well ! setClassUnion("index", members = c("numeric", "logical", "character")) ## "atomic vectors" (-> ?is.atomic ) -- but note that is.atomic() ! ## --------------- those that we want to convert from old-style "matrix" setClassUnion("atomicVector", ## "double" is not needed, and not liked by some members = c("logical", "integer", "numeric", "complex", "raw", "character")) ## NB: --> see "numLike" above if(FALSE) # not used anywhere setClassUnion("numericVector", members = c("logical", "integer", "numeric")) ## --- Matrix - related (but not "Matrix" nor "Decomposition/Factorization): ### Sparse Vectors ---- here use 1-based indexing ! ----------- ## 'longindex' should allow sparseVectors of "length" > 2^32, ## which is necessary e.g. when converted from large sparse matrices ## setClass("longindex", contains = "numeric") ## but we use "numeric" instead, for simplicity (efficiency?) setClass("sparseVector", slots = c(length = "numeric", i = "numeric"), contains = "VIRTUAL", ## "longindex" "longindex" ## note that "numeric" contains "integer" (if I like it or not..) prototype = prototype(length = 0), validity = function(object) { n <- object@length if(anyNA(i <- object@i)) "'i' slot has NAs" else if(any(!is.finite(i))) "'i' slot is not all finite" else if(any(i < 1)) "'i' must be >= 1" else if(n == 0 && length(i))"'i' must be empty when the object length is zero" else if(any(i > n)) sprintf("'i' must be in 1:%d", n) else if(is.unsorted(i, strictly=TRUE)) "'i' must be sorted strictly increasingly" else TRUE }) ##' initialization -- ensuring that 'i' is sorted (and 'x' alongside) if(getRversion() >= "3.2.0") { setMethod("initialize", "sparseVector", function(.Object, i, x, ...) { has.x <- !missing(x) if(!missing(i)) { i <- ## (be careful to assign in all cases) if(is.unsorted(i, strictly=TRUE)) { if(is(.Object, "xsparseVector") && has.x) { si <- sort.int(i, index.return=TRUE) x <- x[si$ix] si$x } else sort.int(i, method = "quick") } else i } if(has.x) x <- x callNextMethod() }) } else { ## R < 3.2.0 setMethod("initialize", "sparseVector", function(.Object, i, x, ...) { has.x <- !missing(x) if(!missing(i)) { .Object@i <- ## (be careful to assign in all cases) if(is.unsorted(i, strictly=TRUE)) { if(is(.Object, "xsparseVector") && has.x) { si <- sort.int(i, index.return=TRUE) x <- x[si$ix] si$x } else sort.int(i, method = "quick") } else i } if(has.x) .Object@x <- x callNextMethod(.Object, ...) }) } .validXspVec <- function(object) { ## n <- object@length if(length(object@i) != length(object@x)) "'i' and 'x' differ in length" else TRUE } setClass("dsparseVector", slots = c(x = "numeric"), contains = "sparseVector", validity = .validXspVec) setClass("isparseVector", slots = c(x = "integer"), contains = "sparseVector", validity = .validXspVec) setClass("lsparseVector", slots = c(x = "logical"), contains = "sparseVector", validity = .validXspVec) setClass("zsparseVector", slots = c(x = "complex"), contains = "sparseVector", validity = .validXspVec) ## nsparse has no new slot: 'i' just contains the locations! setClass("nsparseVector", contains = "sparseVector") setClassUnion("xsparseVector", ## those sparseVector's with an 'x' slot c("dsparseVector", "isparseVector", "lsparseVector", "zsparseVector")) ## for 'value' in x[..] <- value hence for all "contents" of our Matrices: setClassUnion("replValue", members = c("numeric", "logical", "complex", "raw")) setClassUnion("replValueSp", members = c("replValue", "sparseVector", "Matrix")) setClass("determinant", slots = c(modulus = "numeric", logarithm = "logical", sign = "integer", call = "call")) Matrix/R/dsCMatrix.R0000644000176200001440000002174614132102367013751 0ustar liggesusers#### Symmetric Sparse Matrices in compressed column-oriented format setAs("dgCMatrix", "dsCMatrix", function(from) { ## r2130 ... | 2008-03-14 | added deprecation warning warning("as(.,\"dsCMatrix\") is deprecated (since 2008); do use as(., \"symmetricMatrix\")") as(from, "symmetricMatrix") }) ## Specific conversions, should they be necessary. Better to convert as ## as(x, "TsparseMatrix") or as(x, "denseMatrix") ## Moved to ./Csparse.R ## setAs("dsCMatrix", "dsTMatrix", ## function(from) .Call(Csparse_to_Tsparse, from, FALSE)) setAs("dsCMatrix", "dgTMatrix", # needed for show(), image() function(from) ## pre-Cholmod -- FIXME: get rid of .Call(dsCMatrix_to_dgTMatrix, from)) setAs("dsCMatrix", "dgeMatrix", function(from) as(as(from, "dgTMatrix"), "dgeMatrix")) setAs("dsCMatrix", "matrix", function(from) as(as(from, "generalMatrix"), "matrix")) setAs("matrix", "dsCMatrix", function(from) as(.m2dgC(from), "symmetricMatrix")) setAs("dsCMatrix", "lsCMatrix", function(from) new("lsCMatrix", i = from@i, p = from@p, uplo = from@uplo, x = as.logical(from@x), Dim = from@Dim, Dimnames = from@Dimnames)) setAs("dsCMatrix", "nsCMatrix", function(from) new("nsCMatrix", i = from@i, p = from@p, uplo = from@uplo, Dim = from@Dim, Dimnames = from@Dimnames)) setAs("dsCMatrix", "dgCMatrix", function(from) .Call(Csparse_symmetric_to_general, from)) setAs("dsCMatrix", "dsyMatrix", function(from) as(from, "denseMatrix")) ##' Check if \code{name} (== "[sS][pP][dD]Cholesky") fits the values of the ##' logicals (perm, LDL, super). ##' @param name a string such as "sPdCholesky" ##' @param perm also known as \code{pivot} ##' @param LDL ##' @param super ##' @return logical: TRUE if the name matches .chkName.CHM <- function(name, perm, LDL, super) .Call(R_chkName_Cholesky, name, perm, LDL, super) ## ../src/dsCMatrix.c .CHM.factor.name <- function(perm, LDL, super) .Call(R_chm_factor_name, perm, LDL, super) ## have rather tril() and triu() methods than ## setAs("dsCMatrix", "dtCMatrix", ....) setMethod("tril", "dsCMatrix", function(x, k = 0, ...) { if(x@uplo == "L" && k == 0) ## same internal structure (speedup potential !?) new("dtCMatrix", uplo = x@uplo, i = x@i, p = x@p, x = x@x, Dim = x@Dim, Dimnames = x@Dimnames) else tril(as(x, "dgCMatrix"), k = k, ...) }) setMethod("triu", "dsCMatrix", function(x, k = 0, ...) { if(x@uplo == "U" && k == 0) ## same internal structure (speedup potential !?) new("dtCMatrix", uplo = x@uplo, i = x@i, p = x@p, x = x@x, Dim = x@Dim, Dimnames = x@Dimnames) else triu(as(x, "dgCMatrix"), k = k, ...) }) msg.and.solve.dgC.lu <- function(name, r, wrns, a, b, tol) { if ((E <- inherits(r, "error")) || length(wrns) > 0) { if(!is.null(v <- getOption("Matrix.verbose")) && v >= 1) { ## as Matrix.msg() but more sophisticated fmt <- "%s(): Cholmod factorization unsuccessful %s --> using LU()" if(v == 1) ch <- "" else { # v >= 2 ch <- if(E) conditionMessage(r) # else NULL if(length(wrns)) # show them (possibly additionally) ch <- paste0(c(ch, unlist(lapply(wrns, conditionMessage))), collapse=";\n ") } message(gettextf(fmt, name, ch)) } .solve.dgC.lu(as(a,"dgCMatrix"), b=b, tol=tol) } else r } solve.dsC.mat <- function(a,b, LDL = NA, tol = .Machine$double.eps) { ## need to *not* catch warnings directly, so CHOLMOD free()s solveWrn <- list() r <- withCallingHandlers( tryCatch(.Call(dsCMatrix_matrix_solve, a, b, LDL), error = function(e) e), warning = function(w) { solveWrn[[length(solveWrn)+1L]] <<- w tryInvokeRestart("muffleWarning")} ) msg.and.solve.dgC.lu("solve.dsC.mat", r, solveWrn, a, b, tol) } ## ``Fully-sparse'' solve() {different Cholmod routine, otherwise "the same"}: solve.dsC.dC <- function(a,b, LDL = NA, tol = .Machine$double.eps) { ## need to *not* catch warnings directly, so CHOLMOD free()s solveWrn <- list() r <- withCallingHandlers( tryCatch(.Call(dsCMatrix_Csparse_solve, a, b, LDL), error = function(e) e), warning = function(w) { solveWrn[[length(solveWrn)+1L]] <<- w tryInvokeRestart("muffleWarning") }) msg.and.solve.dgC.lu("solve.dsC.dC", r, solveWrn, a, b, tol) } ## . ------------------------ setMethod("solve", signature(a = "dsCMatrix", b = "ddenseMatrix"), function(a, b, LDL = NA, tol = .Machine$double.eps, ...) { solve.dsC.mat(a, b = if(!is(b, "dgeMatrix")) ..2dge(b) else b, LDL=LDL, tol=tol) }, valueClass = "dgeMatrix") setMethod("solve", signature(a = "dsCMatrix", b = "denseMatrix"), ## only triggers for diagonal*, ldense*.. (but *not* ddense: above) function(a, b, LDL = NA, tol = .Machine$double.eps, ...) solve.dsC.mat(a, as(.Call(dup_mMatrix_as_geMatrix, b), "dgeMatrix"), LDL=LDL, tol=tol)) setMethod("solve", signature(a = "dsCMatrix", b = "matrix"), function(a, b, LDL = NA, tol = .Machine$double.eps, ...) solve.dsC.mat(a, ..2dge(b), LDL=LDL, tol=tol), valueClass = "dgeMatrix") setMethod("solve", signature(a = "dsCMatrix", b = "numeric"), function(a, b, LDL = NA, tol = .Machine$double.eps, ...) solve.dsC.mat(a, ..2dge(b), LDL=LDL, tol=tol), valueClass = "dgeMatrix") ## . ------------------------ setMethod("solve", signature(a = "dsCMatrix", b = "dsparseMatrix"), function(a, b, LDL = NA, tol = .Machine$double.eps, ...) { cb <- getClassDef(class(b)) if (!extends(cb, "CsparseMatrix")) cb <- getClassDef(class(b <- as(b, "CsparseMatrix"))) if (extends(cb, "symmetricMatrix")) ## not supported (yet) by cholmod_spsolve b <- as(b, "dgCMatrix") solve.dsC.dC(a,b, LDL=LDL, tol=tol) }) setMethod("solve", signature(a = "dsCMatrix", b = "missing"), function(a, b, ...) solve(a, .trDiagonal(nrow(a), unitri=FALSE), ...)) setMethod("chol", signature(x = "dsCMatrix"), function(x, pivot = FALSE, ...) .Call(dsCMatrix_chol, x, pivot), valueClass = "dtCMatrix") setMethod("Cholesky", signature(A = "dsCMatrix"), ## signature(): leaving away (perm, LDL,..), but specify below: ## <==> all "ANY" function(A, perm = TRUE, LDL = !super, super = FALSE, Imult = 0, ...) .Call(dsCMatrix_Cholesky, A, perm, LDL, super, Imult)) setMethod("t", signature(x = "dsCMatrix"), function(x) .Call(Csparse_transpose, x, FALSE), valueClass = "dsCMatrix") ### These two are very similar, the first one has the advantage to be applicable to 'Chx' directly: ## "used" currently only in ../tests/factorizing.R .diag.dsC <- function(x, Chx = Cholesky(x, LDL=TRUE), res.kind = "diag") { force(Chx) if(!missing(Chx)) stopifnot(.isLDL(Chx), is.integer(Chx@p), is.double(Chx@x)) .Call(diag_tC, Chx, res.kind) ## ^^^^^^^ from ../src/Csparse.c ## => res.kind in ("trace", "sumLog", "prod", "min", "max", "range", "diag", "diagBack") } ## nowhere used/tested (FIXME?) ## here, we *could* allow a 'mult = 0' factor : .CHM.LDL.D <- function(x, perm = TRUE, res.kind = "diag") { .Call(dsCMatrix_LDL_D, x, perm, res.kind) ## ^^^^^^^^^^^^^^^^ from ../src/dsCMatrix.c } ## FIXME: kind = "diagBack" is not yet implemented ## would be much more efficient, but there's no CHOLMOD UI (?) ## ## Note: for det(), permutation is unimportant; ## for diag(), apply *inverse* permutation ## q <- p ; q[q] <- seq_along(q); q ldet1.dsC <- function(x, ...) .Call(CHMfactor_ldetL2, Cholesky(x, ...)) ## these are slightly faster (ca. 3 to 4 %): ldet2.dsC <- function(x, ...) { Ch <- Cholesky(x, super = FALSE, ...) .Call(diag_tC, Ch, "sumLog") } ## only very slightly ( ~ < 1% ) faster (than "ldet2"): ldet3.dsC <- function(x, perm = TRUE) .Call(dsCMatrix_LDL_D, x, perm=perm, "sumLog") setMethod("determinant", signature(x = "dsCMatrix", logarithm = "missing"), function(x, logarithm, ...) determinant(x, TRUE)) setMethod("determinant", signature(x = "dsCMatrix", logarithm = "logical"), function(x, logarithm, ...) { if(x@Dim[1] <= 1L) return(mkDet(diag(x), logarithm)) Chx <- tryCatch(suppressWarnings(Cholesky(x, LDL=TRUE)), error = function(e) NULL) ## or ## ldet <- .Call("CHMfactor_ldetL2", Chx) # which would also work ## when Chx <- Cholesky(x, super=TRUE) ## ldet <- tryCatch(.Call(dsCMatrix_LDL_D, x, perm=TRUE, "sumLog"), ## if(is.null(ldet)) if(is.null(Chx)) ## we do *not* have a positive definite matrix detSparseLU(x, logarithm) else { d <- .Call(diag_tC, Chx, res.kind = "diag") mkDet(d, logarithm=logarithm) } }) ## setMethod("writeHB", signature(obj = "dsCMatrix"), ## function(obj, file, ...) { ## .Deprecated("writeMM") ## .Call(Matrix_writeHarwellBoeing, ## if (obj@uplo == "U") t(obj) else obj, ## as.character(file), "DSC") ## }) Matrix/R/bind2.R0000644000176200001440000004156113753506324013057 0ustar liggesusers#### Containing all cbind2() and rbind2() methods for all our Matrices ###-- General ----------------------------------------------------------- ###-- Dense, incl Diagonal ---------------------------------------------- ###-- Sparse ------------------------------------------------------------ setMethod("cbind2", signature(x = "sparseMatrix", y = "matrix"), function(x, y, ...) cbind2(x, .Call(dense_to_Csparse, y))) setMethod("cbind2", signature(x = "matrix", y = "sparseMatrix"), function(x, y, ...) cbind2(.Call(dense_to_Csparse, x), y)) setMethod("rbind2", signature(x = "sparseMatrix", y = "matrix"), function(x, y, ...) rbind2(x, .Call(dense_to_Csparse, y))) setMethod("rbind2", signature(x = "matrix", y = "sparseMatrix"), function(x, y, ...) rbind2(.Call(dense_to_Csparse, x), y)) ## originally from ./Matrix.R : ------------------------------- ## The trivial methods : setMethod("cbind2", signature(x = "Matrix", y = "NULL"), function(x, y, ...) x) setMethod("cbind2", signature(x = "Matrix", y = "missing"), function(x, y, ...) x) setMethod("cbind2", signature(x = "NULL", y="Matrix"), function(x, y, ...) y) ## using "atomicVector" not just "numeric" setMethod("cbind2", signature(x = "Matrix", y = "atomicVector"), function(x, y, ...) cbind2(x, matrix(y, nrow = nrow(x)))) setMethod("cbind2", signature(x = "atomicVector", y = "Matrix"), function(x, y, ...) cbind2(matrix(x, nrow = nrow(y)), y)) setMethod("cbind2", signature(x = "ANY", y = "Matrix"), function(x, y, ...) .bail.out.2(.Generic, class(x), class(y))) setMethod("cbind2", signature(x = "Matrix", y = "ANY"), function(x, y, ...) .bail.out.2(.Generic, class(x), class(y))) setMethod("rbind2", signature(x = "Matrix", y = "NULL"), function(x, y, ...) x) setMethod("rbind2", signature(x = "Matrix", y = "missing"), function(x, y, ...) x) setMethod("rbind2", signature(x = "NULL", y="Matrix"), function(x, y, ...) y) setMethod("rbind2", signature(x = "Matrix", y = "atomicVector"), function(x, y, ...) rbind2(x, matrix(y, ncol = ncol(x)))) setMethod("rbind2", signature(x = "atomicVector", y = "Matrix"), function(x, y, ...) rbind2(matrix(x, ncol = ncol(y)), y)) setMethod("rbind2", signature(x = "ANY", y = "Matrix"), function(x, y, ...) .bail.out.2(.Generic, class(x), class(y))) setMethod("rbind2", signature(x = "Matrix", y = "ANY"), function(x, y, ...) .bail.out.2(.Generic, class(x), class(y))) ## Makes sure one gets x decent error message for the unimplemented cases: setMethod("cbind2", signature(x = "Matrix", y = "Matrix"), function(x, y, ...) { rowCheck(x,y) .bail.out.2("cbind2", class(x), class(y)) }) ## Use a working fall back {particularly useful for sparse}: ## FIXME: implement rbind2 via "cholmod" for C* and Tsparse ones setMethod("rbind2", signature(x = "Matrix", y = "Matrix"), function(x, y, ...) { colCheck(x,y) t(cbind2(t(x), t(y))) }) ## originally from ./denseMatrix.R : ------------------------------- ### cbind2 setMethod("cbind2", signature(x = "denseMatrix", y = "numeric"), function(x, y, ...) { d <- dim(x); nr <- d[1]; nc <- d[2] y <- rep_len(y, nr) # 'silent procrustes' ## beware of (packed) triangular, symmetric, ... x <- as(x, geClass(x)) x@x <- c(x@x, as.double(y)) x@Dim[2] <- nc + 1L if(is.character(dn <- x@Dimnames[[2]])) x@Dimnames[[2]] <- c(dn, "") x }) ## the same, (x,y) <-> (y,x): setMethod("cbind2", signature(x = "numeric", y = "denseMatrix"), function(x, y, ...) { d <- dim(y); nr <- d[1]; nc <- d[2] x <- rep_len(x, nr) y <- as(y, geClass(y)) y@x <- c(as.double(x), y@x) y@Dim[2] <- nc + 1L if(is.character(dn <- y@Dimnames[[2]])) y@Dimnames[[2]] <- c("", dn) y }) setMethod("cbind2", signature(x = "denseMatrix", y = "matrix"), function(x, y, ...) cbind2(x, as_geSimpl(y))) setMethod("cbind2", signature(x = "matrix", y = "denseMatrix"), function(x, y, ...) cbind2(as_geSimpl(x), y)) cbind2DN <- function(dnx,dny, ncx,ncy) { ## R and S+ are different in which names they take ## if they differ -- but there's no warning in any case rn <- if(!is.null(dnx[[1]])) dnx[[1]] else dny[[1]] cx <- dnx[[2]] ; cy <- dny[[2]] cn <- if(is.null(cx) && is.null(cy)) NULL else c(if(!is.null(cx)) cx else character(ncx), if(!is.null(cy)) cy else character(ncy)) list(rn, cn) } setMethod("cbind2", signature(x = "denseMatrix", y = "denseMatrix"), function(x, y, ...) { rowCheck(x,y) ncx <- x@Dim[2] ncy <- y@Dim[2] ## beware of (packed) triangular, symmetric, ... hasDN <- !is.null.DN(dnx <- dimnames(x)) | !is.null.DN(dny <- dimnames(y)) x <- as(x, geClass(x)) y <- as(y, geClass(y)) xx <- c(x@x, y@x) ## be careful, e.g., if we have an 'n' and 'd' if(identical((tr <- typeof(xx)), typeof(x@x))) { x@x <- xx x@Dim[2] <- ncx + ncy if(hasDN) x@Dimnames <- cbind2DN(dnx,dny, ncx,ncy) x } else if(identical(tr, typeof(y@x))) { y@x <- xx y@Dim[2] <- ncx + ncy if(hasDN) y@Dimnames <- cbind2DN(dnx,dny, ncx,ncy) y } else stop("resulting x-slot has different type than x's or y's") }) ### rbind2 -- analogous to cbind2 --- more to do for @x though: setMethod("rbind2", signature(x = "denseMatrix", y = "numeric"), function(x, y, ...) { if(is.character(dn <- x@Dimnames[[1]])) dn <- c(dn, "") y <- rbind2(as(x,"matrix"), y) new(paste0(.M.kind(y), "geMatrix"), x = c(y), Dim = x@Dim + 1:0, Dimnames = list(dn, x@Dimnames[[2]])) }) ## the same, (x,y) <-> (y,x): setMethod("rbind2", signature(x = "numeric", y = "denseMatrix"), function(x, y, ...) { if(is.character(dn <- y@Dimnames[[1]])) dn <- c("", dn) x <- rbind2(x, as(y,"matrix")) new(paste0(.M.kind(x), "geMatrix"), x = c(x), Dim = y@Dim + 1:0, Dimnames = list(dn, y@Dimnames[[2]])) }) setMethod("rbind2", signature(x = "denseMatrix", y = "matrix"), function(x, y, ...) rbind2(x, as_geSimpl(y))) setMethod("rbind2", signature(x = "matrix", y = "denseMatrix"), function(x, y, ...) rbind2(as_geSimpl(x), y)) rbind2DN <- function(dnx, dny, nrx,nry) { if(!is.null.DN(dnx) || !is.null.DN(dny)) { ## R and S+ are different in which names they take ## if they differ -- but there's no warning in any case list(if(is.null(rx <- dnx[[1]]) & is.null(ry <- dny[[1]])) NULL else c(if(!is.null(rx)) rx else character(nrx), if(!is.null(ry)) ry else character(nry)), if(!is.null(dnx[[2]])) dnx[[2]] else dny[[2]]) } else list(NULL, NULL) } setMethod("rbind2", signature(x = "denseMatrix", y = "denseMatrix"), function(x, y, ...) { colCheck(x,y) nrx <- x@Dim[1] nry <- y@Dim[1] ## beware of (packed) triangular, symmetric, ... hasDN <- !is.null.DN(dnx <- dimnames(x)) | !is.null.DN(dny <- dimnames(y)) x <- as(x, geClass(x)) y <- as(y, geClass(y)) xx <- .Call(R_rbind2_vector, x, y) ## be careful, e.g., if we have an 'n' and 'd' if(identical((tr <- typeof(xx)), typeof(x@x))) { x@x <- xx x@Dim[1] <- nrx + nry if(hasDN) x@Dimnames <- rbind2DN(dnx,dny, nrx,nry) x } else if(identical(tr, typeof(y@x))) { y@x <- xx y@Dim[1] <- nrx + nry if(hasDN) y@Dimnames <- rbind2DN(dnx,dny, nrx,nry) y } else stop("resulting x-slot has different type than x's or y's") }) ## originally from ./diagMatrix.R : -------------------------------------- ## For diagonalMatrix: preserve sparseness {not always optimal, but "the law"} ## hack to suppress the obnoxious dispatch ambiguity warnings: diag2Sp <- function(x) suppressWarnings(as(x, "CsparseMatrix")) setMethod("cbind2", signature(x = "diagonalMatrix", y = "sparseMatrix"), function(x, y, ...) cbind2(diag2Sp(x), as(y,"CsparseMatrix"))) setMethod("cbind2", signature(x = "sparseMatrix", y = "diagonalMatrix"), function(x, y, ...) cbind2(as(x,"CsparseMatrix"), diag2Sp(y))) setMethod("rbind2", signature(x = "diagonalMatrix", y = "sparseMatrix"), function(x, y, ...) rbind2(diag2Sp(x), as(y,"CsparseMatrix"))) setMethod("rbind2", signature(x = "sparseMatrix", y = "diagonalMatrix"), function(x, y, ...) rbind2(as(x,"CsparseMatrix"), diag2Sp(y))) ## in order to evade method dispatch ambiguity, but still remain "general" ## we use this hack instead of signature x = "diagonalMatrix" for(cls in names(getClass("diagonalMatrix")@subclasses)) { setMethod("cbind2", signature(x = cls, y = "matrix"), function(x, y, ...) cbind2(diag2Sp(x), .Call(dense_to_Csparse, y))) setMethod("cbind2", signature(x = "matrix", y = cls), function(x, y, ...) cbind2(.Call(dense_to_Csparse, x), diag2Sp(y))) setMethod("rbind2", signature(x = cls, y = "matrix"), function(x, y, ...) rbind2(diag2Sp(x), .Call(dense_to_Csparse, y))) setMethod("rbind2", signature(x = "matrix", y = cls), function(x, y, ...) rbind2(.Call(dense_to_Csparse, x), diag2Sp(y))) ## These are already defined for "Matrix" ## -- repeated here for method dispatch disambiguation {"design-FIXME" ?} setMethod("cbind2", signature(x = cls, y = "atomicVector"), function(x, y, ...) cbind2(x, matrix(y, nrow = nrow(x)))) setMethod("cbind2", signature(x = "atomicVector", y = cls), function(x, y, ...) cbind2(matrix(x, nrow = nrow(y)), y)) setMethod("rbind2", signature(x = cls, y = "atomicVector"), function(x, y, ...) rbind2(x, matrix(y, ncol = ncol(x)))) setMethod("rbind2", signature(x = "atomicVector", y = cls), function(x, y, ...) rbind2(matrix(x, ncol = ncol(y)), y)) } ## originally from ./dsparseMatrix.R : -------------------------------- ## FIXME: dimnames() handling should happen in C code ## ------> ../src/Csparse.c ## Fast - almost non-checking methods .cbind2Csp <- function(x,y) .Call(Csparse_horzcat, as_Csp2(x), as_Csp2(y)) .rbind2Csp <- function(x,y) .Call(Csparse_vertcat, as_Csp2(x), as_Csp2(y)) cbind2sparse <- function(x,y) { ## beware of (packed) triangular, symmetric, ... if(identical(c(dnx <- dimnames(x), dny <- dimnames(y)), list(NULL,NULL,NULL,NULL))) ## keep empty dimnames .cbind2Csp(x,y) else { ## R and S+ are different in which names they take ## if they differ -- but there's no warning in any case rn <- if(!is.null(dnx[[1]])) dnx[[1]] else dny[[1]] cx <- dnx[[2]] ; cy <- dny[[2]] cn <- if(is.null(cx) && is.null(cy)) NULL else c(if(!is.null(cx)) cx else character(ncol(x)), if(!is.null(cy)) cy else character(ncol(y))) ans <- .cbind2Csp(x,y) ans@Dimnames <- list(rn, cn) ans } } setMethod("cbind2", signature(x = "sparseMatrix", y = "sparseMatrix"), function(x, y, ...) { rowCheck(x,y) cbind2sparse(x,y) }) rbind2sparse <- function(x,y) { ## beware of (packed) triangular, symmetric, ... if(identical(c(dnx <- dimnames(x), dny <- dimnames(y)), list(NULL,NULL,NULL,NULL))) ## keep empty dimnames .rbind2Csp(x,y) else { ## R and S+ are different in which names they take ## if they differ -- but there's no warning in any case cn <- if(!is.null(dnx[[2]])) dnx[[2]] else dny[[2]] rx <- dnx[[1]] ; ry <- dny[[1]] rn <- if(is.null(rx) && is.null(ry)) NULL else c(if(!is.null(rx)) rx else character(nrow(x)), if(!is.null(ry)) ry else character(nrow(y))) ans <- .rbind2Csp(x,y) ans@Dimnames <- list(rn, cn) ans } } setMethod("rbind2", signature(x = "sparseMatrix", y = "sparseMatrix"), function(x, y, ...) { colCheck(x,y) rbind2sparse(x,y) }) if(length(formals(cbind2)) >= 3) { ## newer R -- can use optional 'sparse = NA' setMethod("cbind2", signature(x = "sparseMatrix", y = "denseMatrix"), function(x, y, sparse = NA, ...) { nr <- rowCheck(x,y) if(is.na(sparse)) # result is sparse if "enough zeros" <==> sparseDefault() in Matrix() sparse <- (nnzero(x,na.counted=TRUE)+nnzero(y,na.counted=TRUE)) * 2 < as.double(nr) * (ncol(x)+ncol(y)) # as.double(): avoid integer overflow in '*' if(sparse) cbind2sparse(x,y) else cbind2(as(x, "denseMatrix"), y) }) setMethod("cbind2", signature(x = "denseMatrix", y = "sparseMatrix"), function(x, y, sparse = NA, ...) { nr <- rowCheck(x,y) if(is.na(sparse)) # result is sparse if "enough zeros" <==> sparseDefault() in Matrix() sparse <- (nnzero(x,na.counted=TRUE)+nnzero(y,na.counted=TRUE)) * 2 < as.double(nr) * (ncol(x)+ncol(y)) if(sparse) cbind2sparse(x,y) else cbind2(x, as(y, "denseMatrix")) }) setMethod("rbind2", signature(x = "sparseMatrix", y = "denseMatrix"), function(x, y, sparse = NA, ...) { nc <- colCheck(x,y) if(is.na(sparse)) # result is sparse if "enough zeros" <==> sparseDefault() in Matrix() sparse <- (nnzero(x,na.counted=TRUE)+nnzero(y,na.counted=TRUE)) * 2 < (nrow(x)+nrow(y)) * as.double(nc) if(sparse) rbind2sparse(x,y) else rbind2(as(x, "denseMatrix"), y) }) setMethod("rbind2", signature(x = "denseMatrix", y = "sparseMatrix"), function(x, y, sparse = NA, ...) { nc <- colCheck(x,y) if(is.na(sparse)) # result is sparse if "enough zeros" <==> sparseDefault() in Matrix() sparse <- (nnzero(x,na.counted=TRUE)+nnzero(y,na.counted=TRUE)) * 2 < (nrow(x)+nrow(y)) * as.double(nc) if(sparse) rbind2sparse(x,y) else rbind2(x, as(y, "denseMatrix")) }) } else { ## older version of R -- cbind2() has no "..." setMethod("cbind2", signature(x = "sparseMatrix", y = "denseMatrix"), function(x, y, ...) { nr <- rowCheck(x,y) ## result is sparse if "enough zeros" <==> sparseDefault() in Matrix() sparse <- (nnzero(x,na.counted=TRUE)+nnzero(y,na.counted=TRUE)) * 2 < as.double(nr) * (ncol(x)+ncol(y)) if(sparse) cbind2sparse(x,y) else cbind2(as(x, "denseMatrix"), y) }) setMethod("cbind2", signature(x = "denseMatrix", y = "sparseMatrix"), function(x, y, ...) { nr <- rowCheck(x,y) ## result is sparse if "enough zeros" <==> sparseDefault() in Matrix() sparse <- (nnzero(x,na.counted=TRUE)+nnzero(y,na.counted=TRUE)) * 2 < as.double(nr) * (ncol(x)+ncol(y)) if(sparse) cbind2sparse(x,y) else cbind2(x, as(y, "denseMatrix")) }) setMethod("rbind2", signature(x = "sparseMatrix", y = "denseMatrix"), function(x, y, ...) { nc <- colCheck(x,y) ## result is sparse if "enough zeros" <==> sparseDefault() in Matrix() sparse <- (nnzero(x,na.counted=TRUE)+nnzero(y,na.counted=TRUE)) * 2 < (nrow(x)+nrow(y)) * as.double(nc) if(sparse) rbind2sparse(x,y) else rbind2(as(x, "denseMatrix"), y) }) setMethod("rbind2", signature(x = "denseMatrix", y = "sparseMatrix"), function(x, y, ...) { nc <- colCheck(x,y) ## result is sparse if "enough zeros" <==> sparseDefault() in Matrix() sparse <- (nnzero(x,na.counted=TRUE)+nnzero(y,na.counted=TRUE)) * 2 < (nrow(x)+nrow(y)) * as.double(nc) if(sparse) rbind2sparse(x,y) else rbind2(x, as(y, "denseMatrix")) }) }# older R -- no "sparse = NA" if(FALSE) { ## FIXME ##------------- maybe a bit faster --- but too much to maintain ## would have to be done for "rbind2" as well ... setMethod("cbind2", signature(x = "sparseMatrix", y = "numeric"), function(x, y, ...) { d <- dim(x); nr <- d[1]; nc <- d[2]; cl <- class(x) x <- as(x, "CsparseMatrix") if(nr > 0) { y <- rep_len(y, nr) # 'silent procrustes' n0y <- y != 0 n.e <- length(x@i) x@i <- c(x@i, (0:(nr-1))[n0y]) x@p <- c(x@p, n.e + sum(n0y)) x@x <- c(x@x, y[n0y]) } else { ## nr == 0 } x@Dim[2] <- nc + 1L if(is.character(dn <- x@Dimnames[[2]])) x@Dimnames[[2]] <- c(dn, "") x }) ## the same, (x,y) <-> (y,x): setMethod("cbind2", signature(x = "numeric", y = "sparseMatrix"), function(x, y, ...) { d <- dim(y); nr <- d[1]; nc <- d[2]; cl <- class(y) y <- as(y, "CsparseMatrix") if(nr > 0) { x <- rep_len(x, nr) # 'silent procrustes' n0x <- x != 0 y@i <- c((0:(nr-1))[n0x], y@i) y@p <- c(0L, sum(n0x) + y@p) y@x <- c(x[n0x], y@x) } else { ## nr == 0 } y@Dim[2] <- nc + 1L if(is.character(dn <- y@Dimnames[[2]])) y@Dimnames[[2]] <- c(dn, "") y }) }## -- no longer ## Can be made very efficient setMethod("rbind2", signature(x = "indMatrix", y = "indMatrix"), function(x, y, ...) { dx <- x@Dim dy <- y@Dim if(dx[2] != dy[2]) stop(gettextf("Matrices must have same number of columns in %s", deparse(sys.call(sys.parent()))), call. = FALSE, domain=NA) new("indMatrix", Dim = c(dx[1]+dy[1], dx[2]), perm = c(x@perm,y@perm), Dimnames = rbind2DN(dimnames(x), dimnames(y), dx[1],dy[1])) }) Matrix/R/dtpMatrix.R0000644000176200001440000000537613047113565014036 0ustar liggesusers#### Triangular Packed Matrices -- Coercion and Methods setAs("dtpMatrix", "dtrMatrix", dtp2dtr <- function(from) .Call(dtpMatrix_as_dtrMatrix, from)) ## Is this needed? already have coercion to "TsparseMatrix" {FIXME} setAs("dtpMatrix", "dtTMatrix", function(from) { x <- as(from, "TsparseMatrix") cld <- getClassDef(class(x)) if(extends(cld, "dtTMatrix")) x else { ## triangularity lost: should not have happened warning("inefficient coercion (lost triangularity); please report") gT2tT(as(x, "dgTMatrix"), uplo = from@uplo, diag = from@diag, toClass = "dtTMatrix", do.n = FALSE) } }) setAs("dtpMatrix", "matrix", function(from) as(dtp2dtr(from), "matrix")) setAs("matrix", "dtpMatrix", function(from) as(as(from, "dtrMatrix"), "dtpMatrix")) setAs("pCholesky", "lMatrix", function(from) as(as(from, "dtpMatrix"), "lMatrix")) setAs("pBunchKaufman", "lMatrix", function(from) as(as(from, "dtpMatrix"), "lMatrix")) setMethod("determinant", signature(x = "dtpMatrix", logarithm = "missing"), function(x, logarithm, ...) determinant(x, TRUE)) setMethod("determinant", signature(x = "dtpMatrix", logarithm = "logical"), function(x, logarithm, ...) mkDet(diag(x), logarithm)) setMethod("diag", signature(x = "dtpMatrix"), function(x, nrow, ncol) .Call(dtpMatrix_getDiag, x), valueClass = "numeric") setMethod("diag<-", signature(x = "dtpMatrix"), function(x, value) { .Call(dtpMatrix_setDiag, if(x@diag == "U") .dense.diagU2N(x, "d", isPacked=TRUE) else x, value) }) setMethod("norm", signature(x = "dtpMatrix", type = "character"), function(x, type, ...) if(identical("2", type)) norm2(x) else .Call(dtpMatrix_norm, x, type), valueClass = "numeric") setMethod("norm", signature(x = "dtpMatrix", type = "missing"), function(x, type, ...) .Call(dtpMatrix_norm, x, "O"), valueClass = "numeric") setMethod("rcond", signature(x = "dtpMatrix", norm = "character"), function(x, norm, ...) .Call(dtpMatrix_rcond, x, norm), valueClass = "numeric") setMethod("rcond", signature(x = "dtpMatrix", norm = "missing"), function(x, norm, ...) .Call(dtpMatrix_rcond, x, "O"), valueClass = "numeric") setMethod("solve", signature(a = "dtpMatrix", b="missing"), function(a, b, ...) .Call(dtpMatrix_solve, a), valueClass = "dtpMatrix") setMethod("solve", signature(a = "dtpMatrix", b="ddenseMatrix"), function(a, b, ...) .Call(dtpMatrix_matrix_solve, a, b), valueClass = "dgeMatrix") setMethod("solve", signature(a = "dtpMatrix", b="matrix"), function(a, b, ...) .Call(dtpMatrix_matrix_solve, a, b), valueClass = "dgeMatrix") ## FIXME: speed up setMethod("t", "dtpMatrix", function(x) dtr2dtp(t(dtp2dtr(x))), valueClass = "dtpMatrix") Matrix/R/sparseQR.R0000644000176200001440000001377513347205204013617 0ustar liggesusers#### Methods for the sparse QR decomposition ## TODO: qr.R() generic that allows optional args ['backPermute'] ## --- so we can add it to our qr.R() method, *instead* of this : qrR <- function(qr, complete = FALSE, backPermute = TRUE, row.names = TRUE) { ir <- seq_len(qr@Dim[if(complete) 1L else 2L]) r <- if(backPermute <- backPermute && (n <- length(qr@q)) && !isSeq(qr@q, n-1L)) qr@R[ir, order(qr@q), drop = FALSE] else qr@R[ir, , drop = FALSE] if(row.names && !is.null(rn <- qr@V@Dimnames[[1]])) # qr.R() in 'base' gives rownames r@Dimnames[[1]] <- rn[seq_len(r@Dim[1L])] if(complete || backPermute) r else as(r, "triangularMatrix") } setMethod("qr.R", signature(qr = "sparseQR"), function(qr, complete = FALSE) { if(nonTRUEoption("Matrix.quiet.qr.R") && nonTRUEoption("Matrix.quiet")) warning("qr.R() may differ from qr.R() because of permutations. Possibly use our qrR() instead") qrR(qr, complete=complete, backPermute=FALSE) }) ## if(identical("", as.character(formals(qr.Q)$Dvec))) { # "new" setMethod("qr.Q", "sparseQR", function(qr, complete=FALSE, Dvec) { d <- qr@Dim ## ir <- seq_len(d[k <- if(complete) 1L else 2L]) k <- if(complete) 1L else 2L if(missing(Dvec)) Dvec <- rep.int(1, if(complete) d[1] else min(d)) D <- .sparseDiagonal(d[1], x=Dvec, cols=0L:(d[k] -1L)) qr.qy(qr, D) }) ## } else { ## setMethod("qr.Q", "sparseQR", ## function(qr, complete=FALSE, Dvec = rep.int(1, if(complete) d[1] else min(d))) ## { ## d <- qr@Dim ## ir <- seq_len(d[k <- if(complete) 1L else 2L]) ## D <- .sparseDiagonal(d[1], x=Dvec, cols=0L:(d[k] -1L)) ## qr.qy(qr, D) ## }) ## } ## NB: Here, the .Call()s to sparseQR_qty all set keep_names = TRUE ## --- instead of allowing it to become an argument, ## mainly because the base functions qr.qy() / qr.qty() have no '...' formal argument ## To change, would make these *implicit* generics in 'methods' - as qr.R ## Also, qr() itself has keep.names = TRUE/FALSE -- should be enough setMethod("qr.qy", signature(qr = "sparseQR", y = "ddenseMatrix"), function(qr, y) .Call(sparseQR_qty, qr, y, FALSE, TRUE), valueClass = "dgeMatrix") setMethod("qr.qy", signature(qr = "sparseQR", y = "matrix"), function(qr, y) .Call(sparseQR_qty, qr, y, FALSE, TRUE), valueClass = "dgeMatrix") setMethod("qr.qy", signature(qr = "sparseQR", y = "numeric"), ## drop to vector {to be 100% standard-R-matrix compatible} : function(qr, y) .Call(sparseQR_qty, qr, y, FALSE, TRUE)@x) setMethod("qr.qy", signature(qr = "sparseQR", y = "Matrix"), function(qr, y) .Call(sparseQR_qty, qr, as(as(y, "denseMatrix"),"dgeMatrix"), FALSE, TRUE), valueClass = "dgeMatrix") setMethod("qr.qty", signature(qr = "sparseQR", y = "ddenseMatrix"), function(qr, y) .Call(sparseQR_qty, qr, y, TRUE, TRUE), valueClass = "dgeMatrix") setMethod("qr.qty", signature(qr = "sparseQR", y = "matrix"), function(qr, y) .Call(sparseQR_qty, qr, y, TRUE, TRUE), valueClass = "dgeMatrix") setMethod("qr.qty", signature(qr = "sparseQR", y = "numeric"), function(qr, y) .Call(sparseQR_qty, qr, y, TRUE, TRUE)@x) setMethod("qr.qty", signature(qr = "sparseQR", y = "Matrix"), function(qr, y) .Call(sparseQR_qty, qr, as(as(y, "denseMatrix"),"dgeMatrix"), TRUE, TRUE), valueClass = "dgeMatrix") ## FIXME: really should happen in C, i.e sparseQR_coef() in ../src/sparseQR.c : .coef.trunc <- function(qr, res, drop=FALSE) { if(!all((d <- lengths(res@Dimnames)) == 0L) && !identical(d, D <- res@Dim)) { ## Fix dimnames from dim (when not NULL !) : if(d[[1]]) length(res@Dimnames[[1]]) <- D[[1]] if(d[[2]]) length(res@Dimnames[[2]]) <- D[[2]] } res[seq_len(ncol(qr@R)),,drop=drop] } setMethod("qr.coef", signature(qr = "sparseQR", y = "ddenseMatrix"), function(qr, y) .coef.trunc(qr, .Call(sparseQR_coef, qr, y)), valueClass = "dgeMatrix") setMethod("qr.coef", signature(qr = "sparseQR", y = "matrix"), function(qr, y) .coef.trunc(qr, .Call(sparseQR_coef, qr, y)), valueClass = "dgeMatrix") setMethod("qr.coef", signature(qr = "sparseQR", y = "numeric"), function(qr, y) .coef.trunc(qr, .Call(sparseQR_coef, qr, y), drop=TRUE)) setMethod("qr.coef", signature(qr = "sparseQR", y = "Matrix"), function(qr, y) .coef.trunc(qr, .Call(sparseQR_coef, qr, as(as(y, "denseMatrix"),"dgeMatrix"))), valueClass = "dgeMatrix") ## qr.resid() & qr.fitted() : --------------------------- setMethod("qr.resid", signature(qr = "sparseQR", y = "ddenseMatrix"), function(qr, y) .Call(sparseQR_resid_fitted, qr, y, TRUE), valueClass = "dgeMatrix") setMethod("qr.resid", signature(qr = "sparseQR", y = "matrix"), function(qr, y) .Call(sparseQR_resid_fitted, qr, y, TRUE), valueClass = "dgeMatrix") setMethod("qr.resid", signature(qr = "sparseQR", y = "numeric"), function(qr, y) drop(.Call(sparseQR_resid_fitted, qr, y, TRUE))) setMethod("qr.resid", signature(qr = "sparseQR", y = "Matrix"), function(qr, y) .Call(sparseQR_resid_fitted, qr, as(as(y, "denseMatrix"),"dgeMatrix"), TRUE), valueClass = "dgeMatrix") setMethod("qr.fitted", signature(qr = "sparseQR", y = "ddenseMatrix"), function(qr, y, k) .Call(sparseQR_resid_fitted, qr, y, FALSE), valueClass = "dgeMatrix") setMethod("qr.fitted", signature(qr = "sparseQR", y = "matrix"), function(qr, y, k) .Call(sparseQR_resid_fitted, qr, y, FALSE), valueClass = "dgeMatrix") setMethod("qr.fitted", signature(qr = "sparseQR", y = "numeric"), function(qr, y, k) drop(.Call(sparseQR_resid_fitted, qr, y, FALSE))) setMethod("qr.fitted", signature(qr = "sparseQR", y = "Matrix"), function(qr, y, k) .Call(sparseQR_resid_fitted, qr, as(as(y, "denseMatrix"),"dgeMatrix"), FALSE), valueClass = "dgeMatrix") ## setMethod("solve", signature(a = "sparseQR", b = "ANY"), function(a, b, ...) qr.coef(a, b)) Matrix/R/Tsparse.R0000644000176200001440000010023013774675543013504 0ustar liggesusers#### "TsparseMatrix" : Virtual class of sparse matrices in triplet-format ## more efficient than going via Csparse: setAs("matrix", "TsparseMatrix", function(from) if(is.numeric(from)) mat2dgT(from) else if(is.logical(from)) as(Matrix(from, sparse=TRUE), "TsparseMatrix") else stop("not-yet-implemented coercion to \"TsparseMatrix\"")) setAs("numeric", "TsparseMatrix", function(from) as(as.matrix(from), "TsparseMatrix")) setAs("TsparseMatrix", "matrix", function(from) .Call(dgTMatrix_to_matrix, as(from, "dgTMatrix"))) ## in ../src/Tsparse.c : |-> cholmod_T -> cholmod_C -> chm_sparse_to_SEXP ## adjusted for triangular matrices not represented in cholmod .T.2.C <- function(from) .Call(Tsparse_to_Csparse, from, ## is(from, "triangularMatrix")) ## fast, exported for power users .T2Cmat <- function(from, isTri = is(from, "triangularMatrix")) .Call(Tsparse_to_Csparse, from, isTri) setAs("TsparseMatrix", "CsparseMatrix", .T.2.C) .T.2.n <- function(from) { ## No: coercing to n(sparse)Matrix gives the "full" pattern including 0's ## if(any(is0(from@x))) ## 0 or FALSE -- the following should have drop0Tsp(.) ## from <- as(drop0(from), "TsparseMatrix") if(is(from, "triangularMatrix")) # i.e. ?tTMatrix new("ntTMatrix", i = from@i, j = from@j, uplo = from@uplo, diag = from@diag, Dim = from@Dim, Dimnames = from@Dimnames) else if(is(from, "symmetricMatrix")) # i.e. ?sTMatrix new("nsTMatrix", i = from@i, j = from@j, uplo = from@uplo, Dim = from@Dim, Dimnames = from@Dimnames) else new("ngTMatrix", i = from@i, j = from@j, Dim = from@Dim, Dimnames = from@Dimnames) } setAs("TsparseMatrix", "nsparseMatrix", .T.2.n) setAs("TsparseMatrix", "nMatrix", .T.2.n) .T.2.l <- function(from) { cld <- getClassDef(class(from)) xx <- if(extends(cld, "nMatrix")) rep.int(TRUE, length(from@i)) else as.logical(from@x) if(extends(cld, "triangularMatrix")) # i.e. ?tTMatrix new("ltTMatrix", i = from@i, j = from@j, x = xx, uplo = from@uplo, diag = from@diag, Dim = from@Dim, Dimnames = from@Dimnames) else if(extends(cld, "symmetricMatrix")) # i.e. ?sTMatrix new("lsTMatrix", i = from@i, j = from@j, x = xx, uplo = from@uplo, Dim = from@Dim, Dimnames = from@Dimnames) else new("lgTMatrix", i = from@i, j = from@j, x = xx, Dim = from@Dim, Dimnames = from@Dimnames) } setAs("TsparseMatrix", "lsparseMatrix", .T.2.l) setAs("TsparseMatrix", "lMatrix", .T.2.l) ## Special cases ("d", "l", "n") %o% ("g", "s", "t") : ## used e.g. in triu() setAs("dgTMatrix", "dgCMatrix", function(from) .Call(Tsparse_to_Csparse, from, FALSE)) setAs("dsTMatrix", "dsCMatrix", function(from) .Call(Tsparse_to_Csparse, from, FALSE)) setAs("dtTMatrix", "dtCMatrix", function(from) .Call(Tsparse_to_Csparse, from, TRUE)) setAs("lgTMatrix", "lgCMatrix", function(from) .Call(Tsparse_to_Csparse, from, FALSE)) setAs("lsTMatrix", "lsCMatrix", function(from) .Call(Tsparse_to_Csparse, from, FALSE)) setAs("ltTMatrix", "ltCMatrix", function(from) .Call(Tsparse_to_Csparse, from, TRUE)) setAs("ngTMatrix", "ngCMatrix", function(from) .Call(Tsparse_to_Csparse, from, FALSE)) setAs("nsTMatrix", "nsCMatrix", function(from) .Call(Tsparse_to_Csparse, from, FALSE)) setAs("ntTMatrix", "ntCMatrix", function(from) .Call(Tsparse_to_Csparse, from, TRUE)) ### "[" : ### ----- ## Test for numeric/logical/character ## method-*internally* ; this is not strictly OO, but allows to use ## the following utility and hence much more compact code. ## Otherwise have to write methods for all possible combinations of ## (i , j) \in ## (numeric, logical, character, missing) x (numeric, log., char., miss.) ##' a simplified "subset" of intI() below int2i <- function(i, n) { if(any(i < 0L)) { if(any(i > 0L)) stop("you cannot mix negative and positive indices") seq_len(n)[i] } else { if(length(i) && max(i, na.rm=TRUE) > n) stop(gettextf("index larger than maximal %d", n), domain=NA) if(any(z <- i == 0)) i <- i[!z] i } } intI <- function(i, n, dn, give.dn = TRUE) { ## Purpose: translate numeric | logical | character index ## into 0-based integer ## ---------------------------------------------------------------------- ## Arguments: i: index vector (numeric | logical | character) ## n: array extent { == dim(.) [margin] } ## dn: character col/rownames or NULL { == dimnames(.)[[margin]] } ## ---------------------------------------------------------------------- ## Author: Martin Maechler, Date: 23 Apr 2007 has.dn <- !is.null.DN(dn) DN <- has.dn && give.dn if(is.numeric(i) || is(i, "numeric")) { # inherits(, "numeric") is FALSE storage.mode(i) <- "integer" if(anyNA(i)) stop("'NA' indices are not (yet?) supported for sparse Matrices") if(any(i < 0L)) { if(any(i > 0L)) stop("you cannot mix negative and positive indices") i0 <- (0:(n - 1L))[i] } else { if(length(i) && max(i, na.rm=TRUE) > n) # base has "subscript out of bounds": stop(gettextf("index larger than maximal %d", n), domain=NA) if(any(z <- i == 0)) i <- i[!z] i0 <- i - 1L # transform to 0-indexing } if(DN) dn <- dn[i] } else if (is.logical(i) || inherits(i, "logical")) { if(length(i) > n) stop(gettextf("logical subscript too long (%d, should be %d)", length(i), n), domain=NA) if(anyNA(i)) stop("'NA' indices are not (yet?) supported for sparse Matrices") i0 <- (0:(n - 1L))[i] if(DN) dn <- dn[i] } else { ## character if(!has.dn) stop("no 'dimnames[[.]]': cannot use character indexing") i0 <- match(i, dn) if(anyNA(i0)) stop("invalid character indexing") if(DN) dn <- dn[i0] i0 <- i0 - 1L } if(!give.dn) i0 else list(i0 = i0, dn = dn) } ## {intI} .ind.prep <- function(xi, intIlist, iDup = duplicated(i0), anyDup = any(iDup)) { ## Purpose: do the ``common things'' for "*gTMatrix" indexing for 1 dim. ## and return match(.,.) + li = length of corresponding dimension ## ## xi = "x@i" ; intIlist = intI(i, dim(x)[margin], ....) i0 <- intIlist$i0 stopifnot(is.numeric(i0))# cheap fast check (i0 may have length 0 !) m <- match(xi, i0, nomatch=0) if(anyDup) { # assuming anyDup <- any(iDup <- duplicated(i0)) ## i0i: where in (non-duplicated) i0 are the duplicated ones i0i <- match(i0[iDup], i0) i.x <- which(iDup) - 1L jm <- lapply(i0i, function(.) which(. == m)) } c(list(m = m, li = length(i0), i0 = i0, anyDup = anyDup, dn = intIlist$dn), ## actually, iDup is rarely needed in calling code if(anyDup) list(iDup = iDup, i0i = i0i, i.x = i.x, jm = unlist(jm), i.xtra = rep.int(i.x, lengths(jm)))) } ## {.ind.prep} ##' ##' Do the ``common things'' for "*gTMatrix" sub-assignment ##' for 1 dimension, 'margin' , ##'
##' @title Indexing Preparation ##' @param i "index" ##' @param margin in {1,2}; ##' @param di = dim(x) { used when i is not character } ##' @param dn = dimnames(x) ##' @return match(.,.) + li = length of corresponding dimension ##' difference to .ind.prep(): use 1-indices; no match(xi,..), no dn at end ##' @author Martin Maechler .ind.prep2 <- function(i, margin, di, dn) { intI(i, n = di[margin], dn = dn[[margin]], give.dn = FALSE) } ## Select rows setMethod("[", signature(x = "TsparseMatrix", i = "index", j = "missing", drop = "logical"), function (x, i, j, ..., drop) { ## select rows na <- nargs() Matrix.msg("Tsp[i,m,l]: nargs()=", na, .M.level=2) if(na == 4) .as.Tsp(as(x,"CsparseMatrix")[i, , drop=drop], noCheck = !drop) else if(na == 3) ## e.g. M[0] , M[TRUE], M[1:2] .M.vectorSub(x,i) else ## should not happen stop("Matrix-internal error in [i,,d]; please report") }) ## Select columns setMethod("[", signature(x = "TsparseMatrix", i = "missing", j = "index", drop = "logical"), function (x, i, j, ..., drop) { ## select columns .as.Tsp(as(x,"CsparseMatrix")[, j, drop=drop], noCheck = !drop) }) setMethod("[", signature(x = "TsparseMatrix", i = "index", j = "index", drop = "logical"), function (x, i, j, ..., drop) .as.Tsp(as(x,"CsparseMatrix")[i, j, drop=drop], noCheck = !drop)) ## This is "just for now" -- Thinking of *not* doing this in the future .as.Tsp <- function(x, noCheck) if(noCheck || is(x,"sparseMatrix")) as(x, "TsparseMatrix") else x ## FIXME: Learn from .TM... below or rather .M.sub.i.2col(.) in ./Matrix.R ## ------ the following should be much more efficient than the ## subset.ij() based ./Matrix.R code : if(FALSE) ## A[ ij ] where ij is (i,j) 2-column matrix : setMethod("[", signature(x = "TsparseMatrix", i = "matrix", j = "missing"),# drop="ANY" function (x, i, j, ..., drop) { di <- dim(x) dn <- dimnames(x) ## TODO check i (= 2-column matrix of indices) --- ## as in .M.sub.i.2col() in ./Matrix.R j <- i[,2] i <- i[,1] if(is(x, "symmetricMatrix")) { isSym <- isTRUE(all(i == j))# work for i,j NA if(!isSym) x <- as(x, paste0(.M.kind(x), "gTMatrix")) } else isSym <- FALSE if(isSym) { offD <- x@i != x@j ip1 <- .ind.prep(c(x@i,x@j[offD]), intI(i, n= di[1], dn=dn[[1]])) ip2 <- .ind.prep(c(x@j,x@i[offD]), intI(j, n= di[2], dn=dn[[2]])) } else { ip1 <- .ind.prep(x@i, intI(i, n = di[1], dn = dn[[1]])) ip2 <- .ind.prep(x@j, intI(j, n = di[2], dn = dn[[2]])) } stop("FIXME: NOT YET FINISHED IMPLEMENTATION") ## The M[i_vec, j_vec] had -- we need "its diagonal" : sel <- ip1$m & ip2$m if(isSym) { # only those corresponding to upper/lower triangle sel <- sel & (if(x@uplo == "U") ip1$m <= ip2$m else ip2$m <= ip1$m) } x@i <- ip1$m[sel] - 1L x@j <- ip2$m[sel] - 1L if (!is(x, "nsparseMatrix")) x@x <- c(x@x, if(isSym) x@x[offD])[sel] if (drop && any(nd == 1)) drop(as(x,"matrix")) else x }) ###========= Sub-Assignment aka *Replace*Methods ========================= ### FIXME: make this `very fast' for the very very common case of ### ----- M[i,j] <- v with i,j = length-1-numeric; v= length-1 number ### *and* M[i,j] == 0 previously ## ## FIXME(2): keep in sync with replCmat() in ./Csparse.R ## FIXME(3): It's terribly slow when used e.g. from diag(M[,-1]) <- value ## ----- which has "workhorse" M[,-1] <- ## ## workhorse for "[<-" : replTmat <- function (x, i, j, ..., value) { ## NOTE: need '...', i.e., exact signature such that setMethod() ## does not use .local() such that nargs() will work correctly: di <- dim(x) dn <- dimnames(x) iMi <- missing(i) jMi <- missing(j) ## "FIXME": could pass this (and much ? more) when this function would not *be* a ## method but be *called* from methods clDv <- getClassDef(class(value)) spV <- extends(clDv, "sparseVector") ## own version of all0() that works both for sparseVector and atomic vectors: .all0 <- function(v) if(spV) length(v@i) == 0 else all0(v) delayedAssign("value.not.logical", !(if(spV) { extends1of(clDv, "lsparseVector", "nsparseVector") } else { is.logical(value) || is.logical(as.vector(value)) })) na <- nargs() if(na == 3) { ## i = vector indexing M[i] <- v, e.g., M[TRUE] <- v or M[] <- v ! Matrix.msg("diagnosing replTmat(x,i,j,v): nargs()= 3; ", if(iMi | jMi) sprintf("missing (i,j) = (%d,%d)", iMi,jMi)) if(iMi) stop("internal bug: missing 'i' in replTmat(): please report") if(is.character(i)) stop("[ ] indexing not allowed: forgot a \",\" ?") if(is.matrix(i)) stop("internal bug: matrix 'i' in replTmat(): please report") ## Now: have M[i] <- v with vector logical or "integer" i : ## Tmatrix maybe non-unique, have an entry split into a sum of several ones: if(!is(x,"generalMatrix")) { cl <- class(x) x <- as(x, paste0(.M.kind(x), "gTMatrix")) Matrix.msg("'sub-optimal sparse 'x[i] <- v' assignment: Coercing class ", cl," to ",class(x)) } nr <- di[1] x.i <- .Call(m_encodeInd2, x@i, x@j, di=di, FALSE, FALSE) if(anyDuplicated(x.i)) { ## == if(anyDuplicatedT(x, di = di)) x <- uniqTsparse(x) x.i <- .Call(m_encodeInd2, x@i, x@j, di=di, FALSE, FALSE) } n <- prod(di) i <- if(is.logical(i)) { # full-size logical indexing if(n) { if(isTRUE(i)) # shortcut 0:(n-1) else { if(length(i) < n) i <- rep_len(i, n) (0:(n-1))[i] # -> 0-based index vector as well {maybe LARGE!} } } else integer(0) } else { ## also works with *negative* indices etc: int2i(as.integer(i), n) - 1L ## 0-based indices [to match m_encodeInd2()] } clx <- class(x) clDx <- getClassDef(clx) # extends(), is() etc all use the class definition has.x <- "x" %in% slotNames(clDx) # === slotNames(x) if(!has.x && # <==> "n.TMatrix" ((iNA <- any(ina <- is.na(value))) || value.not.logical)) { if(value.not.logical) value <- as.logical(value) if(iNA) { value[ina] <- TRUE warning( gettextf("x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced; NA |--> TRUE.", dQuote(clx)), domain=NA) } else warning( gettextf("x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced.", dQuote(clx)), domain=NA) } ## now have 0-based indices x.i (entries) and i (new entries) ## the simplest case: if(.all0(value)) { ## just drop the non-zero entries if(!all(sel <- is.na(match(x.i, i)))) { ## non-zero there x@i <- x@i[sel] x@j <- x@j[sel] if(has.x) x@x <- x@x[sel] if(.hasSlot(x, "factors") && length(x@factors)) # drop cashed ones x@factors <- list() } return(x) } m <- length(i) if(length(value) != m) { ## use recycling rules if(m %% length(value) != 0) warning("number of items to replace is not a multiple of replacement length") value <- rep_len(value, m) } ## With duplicated entries i, only use the last ones! if(id <- anyDuplicated(i, fromLast=TRUE)) { i <- i[-id] value <- value[-id] if(any(id <- duplicated(i, fromLast=TRUE))) { nd <- -which(id) i <- i[nd] value <- value[nd] } } ## matching existing non-zeros and new entries; isE := "is Existing" ## isE <- i %in% x.i; mi <- {matching i's} isE <- !is.na(mi <- match(i, x.i)) ## => mi[isE] entries in (i,j,x) to be set to new value[]s ## 1) Change the matching non-zero entries if(has.x) x@x[mi[isE]] <- as(value[isE], class(x@x)) else if(any0(value[isE])) { ## "n.TMatrix" : remove (i,j) where value is FALSE get0 <- !value[isE] ## x[i,j] is TRUE, should become FALSE i.rm <- - mi[isE][get0] x@i <- x@i[i.rm] x@j <- x@j[i.rm] } ## 2) add the new non-zero entries i <- i[!isE] xv <- value[!isE] ## --- Be be efficient when 'value' is sparse : if(length(notE <- which(isN0(xv)))) { # isN0(): non-0's; NAs counted too xv <- xv[notE] i <- i[notE] if(has.x) { x@x <- c(x@x, as(xv, class(x@x))) } else { # n.TMatrix : assign (i,j) only where value is TRUE: i <- i[xv] } x@i <- c(x@i, i %% nr) x@j <- c(x@j, i %/% nr) } if(.hasSlot(x, "factors") && length(x@factors)) # drop cashed ones x@factors <- list() return(x) } ## {nargs = 3; x[ii] <- value } ## nargs() == 4 : x[i,j] <- value ## -------------------------------------------------------------------------- lenV <- length(value) Matrix.msg(".. replTmat(x,i,j,v): nargs()= 4; cl.(x)=", class(x),"; len.(value)=", lenV,"; ", if(iMi | jMi) sprintf("missing (i,j) = (%d,%d)", iMi,jMi), .M.level = 2)# level 1 gives too many messages ## FIXME: use 'abIndex' or a better algorithm, e.g. if(iMi) i1 <- if(iMi) 0:(di[1] - 1L) else .ind.prep2(i, 1, di, dn) i2 <- if(jMi) 0:(di[2] - 1L) else .ind.prep2(j, 2, di, dn) dind <- c(length(i1), length(i2)) # dimension of replacement region lenRepl <- prod(dind) if(lenV == 0) { if(lenRepl != 0) stop("nothing to replace with") else return(x) } ## else: lenV := length(value) is > 0 if(lenRepl %% lenV != 0) stop("number of items to replace is not a multiple of replacement length") if(!spV && lenRepl > 2^16) { # (somewhat arbitrary cutoff) value <- as(value, "sparseVector")# so that subsequent rep(.) are fast spV <- TRUE } ## Now deal with duplicated / repeated indices: "last one wins" if(!iMi && any(dup <- duplicated(i1, fromLast = TRUE))) { ## duplicated rows keep <- !dup i1 <- i1[keep] ## keep is "internally" recycled below {and that's important: it is dense!} lenV <- length(value <- rep_len(value, lenRepl)[keep]) dind[1] <- length(i1) lenRepl <- prod(dind) } if(!jMi && any(dup <- duplicated(i2, fromLast = TRUE))) { ## duplicated columns iDup <- which(dup) ## The following is correct, but rep(keep,..) can be *HUGE* ## keep <- !dup ## i2 <- i2[keep] ## lenV <- length(value <- rep_len(value, lenRepl)[rep(keep, each=dind[1])]) ## solution: sv[-i] is efficient for sparseVector: i2 <- i2[- iDup] nr <- dind[1] iDup <- rep((iDup - 1)*nr, each=nr) + seq_len(nr) lenV <- length(value <- rep_len(value, lenRepl)[-iDup]) dind[2] <- length(i2) lenRepl <- prod(dind) } clx <- class(x) clDx <- getClassDef(clx) # extends() , is() etc all use the class definition stopifnot(extends(clDx, "TsparseMatrix")) ## Tmatrix maybe non-unique, have an entry split into a sum of several ones: if(anyDuplicatedT(x, di = di)) x <- uniqTsparse(x) toGeneral <- r.sym <- FALSE if(extends(clDx, "symmetricMatrix")) { ## using array() for large dind is a disaster... mkArray <- if(spV) # TODO: room for improvement function(v, dim) spV2M(v, dim[1],dim[2]) else array r.sym <- (dind[1] == dind[2] && all(i1 == i2) && (lenRepl == 1 || lenV == 1 || isSymmetric(mkArray(value, dim=dind)))) if(r.sym) { ## result is *still* symmetric --> keep symmetry! xU <- x@uplo == "U" # later, we will consider only those indices above / below diagonal: } else toGeneral <- TRUE } else if(extends(clDx, "triangularMatrix")) { xU <- x@uplo == "U" r.tri <- ((any(dind == 1) || dind[1] == dind[2]) && if(xU) max(i1) <= min(i2) else max(i2) <= min(i1)) if(r.tri) { ## result is *still* triangular if(any(i1 == i2)) # diagonal will be changed x <- diagU2N(x) # keeps class (!) } else toGeneral <- TRUE } if(toGeneral) { # go to "generalMatrix" and continue if((.w <- isTRUE(getOption("Matrix.warn"))) || (!is.null(v <- getOption("Matrix.verbose")) && v >= 1)) (if(.w) warning else message)( "M[i,j] <- v : coercing symmetric M[] into non-symmetric") x <- as(x, paste0(.M.kind(x), "gTMatrix")) clDx <- getClassDef(clx <- class(x)) } ## TODO (efficiency): replace 'sel' by 'which(sel)' get.ind.sel <- function(ii,ij) (match(x@i, ii, nomatch = 0L) & match(x@j, ij, nomatch = 0L)) ## sel[k] := TRUE iff k-th non-zero entry (typically x@x[k]) is to be replaced sel <- get.ind.sel(i1,i2) has.x <- "x" %in% slotNames(clDx) # === slotNames(x) ## the simplest case: for all Tsparse, even for i or j missing if(.all0(value)) { ## just drop the non-zero entries if(any(sel)) { ## non-zero there x@i <- x@i[!sel] x@j <- x@j[!sel] if(has.x) x@x <- x@x[!sel] if(.hasSlot(x, "factors") && length(x@factors)) # drop cashed ones x@factors <- list() } return(x) } ## else -- some( value != 0 ) -- if(lenV > lenRepl) stop("too many replacement values") ## now have lenV <= lenRepl if(!has.x && # <==> "n.TMatrix" ((iNA <- anyNA(value)) || value.not.logical)) warning(if(iNA) gettextf("x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced NA |--> TRUE.", dQuote(clx)) else gettextf("x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced.", dQuote(clx)), domain=NA) ## another simple, typical case: if(lenRepl == 1) { if(spV && has.x) value <- as(value, "vector") if(any(sel)) { ## non-zero there if(has.x) x@x[sel] <- value } else { ## new non-zero x@i <- c(x@i, i1) x@j <- c(x@j, i2) if(has.x) x@x <- c(x@x, value) } if(.hasSlot(x, "factors") && length(x@factors)) # drop cashed ones x@factors <- list() return(x) } ### Otherwise, for large lenRepl, we get into trouble below if(lenRepl > 2^20) { # (somewhat arbitrary cutoff) ## FIXME: just for testing !! ## if(identical(Sys.getenv("USER"),"maechler") ## if(lenRepl > 2) { # __________ ___ JUST for testing! _______________ if(nonTRUEoption("Matrix.quiet")) message(gettextf("x[.,.] <- val : x being coerced from Tsparse* to CsparseMatrix"), domain = NA) return(replCmat4(as(x,"CsparseMatrix"), i1, i2, iMi=iMi, jMi=jMi, value = if(spV) value else as(value, "sparseVector"), spV = TRUE)) } ## if(r.sym) # value already adjusted, see above ## lenRepl <- length(value) # shorter (since only "triangle") if(!r.sym && lenV < lenRepl) value <- rep_len(value, lenRepl) ## now: length(value) == lenRepl {but value is sparseVector if it's "long" !} ## value[1:lenRepl]: which are structural 0 now, which not? ## v0 <- is0(value) ## - replaced by using isN0(as.vector(.)) on a typical small subset value[.] ## --> more efficient for sparse 'value' & large 'lenRepl' : ## FIXME [= FIXME(3) above]: ## ----- The use of seq_len(lenRepl) below is *still* inefficient ## (or impossible e.g. when lenRepl == 50000^2) ## and the vN0 <- isN0(as.vector(value[iI0])) is even more ... ## One idea: use "abIndex", (a very efficient storage of index vectors which are ## a concatenation of only a few arithmetic seq()ences use.abI <- isTRUE(getOption("Matrix.use.abIndex")) ## This 'use.abI' should later depend on the *dimension* of things ! ##>>> But for that, we need to implement the following abIndex - "methods": ##>>> [-n], [ ] , intersect(, ) ## and for intersect(): typically sort(), unique() & similar iI0 <- if(use.abI) abIseq1(1L, lenRepl) else seq_len(lenRepl) if(any(sel)) { ## the 0-based indices of non-zero entries -- WRT to submatrix iN0 <- 1L + .Call(m_encodeInd2, match(x@i[sel], i1), match(x@j[sel], i2), di = dind, orig1=TRUE, FALSE) ## 1a) replace those that are already non-zero with non-0 values vN0 <- isN0(value[iN0]) if(any(vN0) && has.x) { vv0 <- which(vN0) x@x[sel][vv0] <- as.vector(value[iN0[vv0]]) } ## 1b) replace non-zeros with 0 --> drop entries if(!all(vN0)) { ##-> ii will not be empty ii <- which(sel)[which(!vN0)] # <- vN0 may be sparseVector if(has.x) x@x <- x@x[-ii] x@i <- x@i[-ii] x@j <- x@j[-ii] } iI0 <- if(length(iN0) < lenRepl) iI0[-iN0] ## else NULL # == complementInd(non0, dind) } if(length(iI0)) { if(r.sym) { ## should only set new entries above / below diagonal, i.e., ## subset iI0 such as to contain only above/below .. iSel <- if(use.abI) abIindTri(dind[1], upper=xU, diag=TRUE) else indTri(dind[1], upper=xU, diag=TRUE) ## select also the corresponding triangle of values ### TODO for "abIndex" -- note we KNOW that both iI0 and iSel ### are strictly increasing : iI0 <- intersect(iI0, iSel) } full <- length(iI0) == lenRepl vN0 <- if(spV) ## "sparseVector" (if(full) value else value[iI0])@i else which(isN0(if(full) value else value[iI0])) if(length(vN0)) { ## 2) add those that were structural 0 (where value != 0) iIN0 <- if(full) vN0 else iI0[vN0] ij0 <- decodeInd(iIN0 - 1L, nr = dind[1]) x@i <- c(x@i, i1[ij0[,1] + 1L]) x@j <- c(x@j, i2[ij0[,2] + 1L]) if(has.x) x@x <- c(x@x, as.vector(value[iIN0])) } } if(.hasSlot(x, "factors") && length(x@factors)) # drop cashed ones x@factors <- list() x } ## end{replTmat} ## A[ ij ] <- value, where ij is a matrix; typically (i,j) 2-column matrix : ## ---------------- ./Matrix.R has a general cheap method ## This one should become as fast as possible -- is also used from Csparse.R -- .TM.repl.i.mat <- function (x, i, j, ..., value) { nA <- nargs() if(nA != 3) stop(gettextf("nargs() = %d should never happen; please report.", nA), domain=NA) ## else: nA == 3 i.e., M [ cbind(ii,jj) ] <- value or M [ Lmat ] <- value if(is.logical(i)) { Matrix.msg(".TM.repl.i.mat(): drop 'matrix' case ...", .M.level=2) ## c(i) : drop "matrix" to logical vector x[as.vector(i)] <- value return(x) } else if(extends1of(cli <- getClassDef(class(i)), c("lMatrix", "nMatrix"))) { Matrix.msg(".TM.repl.i.mat(): \"lMatrix\" case ...", .M.level=2) i <- which(as(i, if(extends(cli, "sparseMatrix")) "sparseVector" else "vector")) ## x[i] <- value ; return(x) return(`[<-`(x,i, value=value)) } else if(extends(cli, "Matrix")) { # "dMatrix" or "iMatrix" if(ncol(i) != 2) stop("such indexing must be by logical or 2-column numeric matrix") i <- as(i, "matrix") } else if(!is.numeric(i) || ncol(i) != 2) stop("such indexing must be by logical or 2-column numeric matrix") if(!is.integer(i)) storage.mode(i) <- "integer" if(any(i < 0)) stop("negative values are not allowed in a matrix subscript") if(anyNA(i)) stop("NAs are not allowed in subscripted assignments") if(any(i0 <- (i == 0))) # remove them i <- i[ - which(i0, arr.ind = TRUE)[,"row"], ] if(length(attributes(i)) > 1) # more than just 'dim'; simplify: will use identical attributes(i) <- list(dim = dim(i)) ## now have integer i >= 1 m <- nrow(i) if(m == 0) return(x) if(length(value) == 0) stop("nothing to replace with") ## mod.x <- .type.kind[.M.kind(x)] if(length(value) != m) { ## use recycling rules if(m %% length(value) != 0) warning("number of items to replace is not a multiple of replacement length") value <- rep_len(value, m) } clx <- class(x) clDx <- getClassDef(clx) # extends() , is() etc all use the class definition stopifnot(extends(clDx, "TsparseMatrix")) di <- dim(x) nr <- di[1] nc <- di[2] i1 <- i[,1] i2 <- i[,2] if(any(i1 > nr)) stop(gettextf("row indices must be <= nrow(.) which is %d", nr), domain=NA) if(any(i2 > nc)) stop(gettextf("column indices must be <= ncol(.) which is %d", nc), domain=NA) ## Tmatrix maybe non-unique, have an entry split into a sum of several ones: if(anyDuplicatedT(x, di = di)) x <- uniqTsparse(x) toGeneral <- FALSE isN <- extends(clDx, "nMatrix") if(r.sym <- extends(clDx, "symmetricMatrix")) { ## Tests to see if the assignments are symmetric as well r.sym <- all(i1 == i2) if(!r.sym) { # do have *some* Lower or Upper entries iL <- i1 > i2 iU <- i1 < i2 r.sym <- sum(iL) == sum(iU) # same number if(r.sym) { iLord <- order(i1[iL], i2[iL]) iUord <- order(i2[iU], i1[iU]) # row <-> col. ! r.sym <- { identical(i[iL, , drop=FALSE][iLord,], i[iU, 2:1, drop=FALSE][iUord,]) && all(value[iL][iLord] == value[iU][iUord]) } } } if(r.sym) { ## result is *still* symmetric --> keep symmetry! ## now consider only those indices above / below diagonal: useI <- if(x@uplo == "U") i1 <= i2 else i2 <= i1 i <- i[useI, , drop=FALSE] value <- value[useI] } else toGeneral <- TRUE } else if(extends(clDx, "triangularMatrix")) { r.tri <- all(if(x@uplo == "U") i1 <= i2 else i2 <= i1) if(r.tri) { ## result is *still* triangular if(any(ieq <- i1 == i2)) { # diagonal will be changed if(x@diag == "U" && all(ieq) && all(value == if(isN) TRUE else as1(x@x))) ## only diagonal values are set to 1 -- i.e. unchanged return(x) x <- diagU2N(x) # keeps class (!) } } else toGeneral <- TRUE } if(toGeneral) { # go to "generalMatrix" and continue if((.w <- isTRUE(getOption("Matrix.warn"))) || isTRUE(getOption("Matrix.verbose"))) (if(.w) warning else message)( "M[ij] <- v : coercing symmetric M[] into non-symmetric") x <- as(x, paste0(.M.kind(x), "gTMatrix")) clDx <- getClassDef(clx <- class(x)) } ii.v <- .Call(m_encodeInd, i, di, orig1=TRUE, checkBounds = TRUE) if(id <- anyDuplicated(ii.v, fromLast=TRUE)) { Matrix.msg("duplicate ij-entries in 'Matrix[ ij ] <- value'; using last", .M.level = 1) ii.v <- ii.v [-id] value <- value[-id] if(any(id <- duplicated(ii.v, fromLast=TRUE))) { nd <- -which(id) ii.v <- ii.v [nd] value <- value[nd] } } ii.x <- .Call(m_encodeInd2, x@i, x@j, di, FALSE, FALSE) m1 <- match(ii.v, ii.x) i.repl <- !is.na(m1) # those that need to be *replaced* if(isN) { ## no 'x' slot isN <- all(value %in% c(FALSE, TRUE)) # will result remain "nMatrix" ? if(!isN) x <- as(x, paste0(if(extends(clDx, "lMatrix")) "l" else "d", .sparse.prefixes[.M.shape(x)], "TMatrix")) } has.x <- !isN ## isN <===> "remains pattern matrix" <===> has no 'x' slot if(any(i.repl)) { ## some to replace at matching (@i, @j) if(has.x) x@x[m1[i.repl]] <- value[i.repl] else { # nMatrix ; eliminate entries that are set to FALSE; keep others if(any(isF <- !value[i.repl])) { ii <- m1[i.repl][isF] x@i <- x@i[ -ii] x@j <- x@j[ -ii] } } } if(any(i.new <- !i.repl & isN0(value))) { ## some new entries i.j <- decodeInd(ii.v[i.new], nr) x@i <- c(x@i, i.j[,1]) x@j <- c(x@j, i.j[,2]) if(has.x) x@x <- c(x@x, value[i.new]) } if(.hasSlot(x, "factors") && length(x@factors)) # drop cashed ones x@factors <- list() x } ## end{.TM.repl.i.mat} setReplaceMethod("[", signature(x = "TsparseMatrix", i = "index", j = "missing", value = "replValue"), replTmat) setReplaceMethod("[", signature(x = "TsparseMatrix", i = "missing", j = "index", value = "replValue"), replTmat) setReplaceMethod("[", signature(x = "TsparseMatrix", i = "index", j = "index", value = "replValue"), replTmat) setReplaceMethod("[", signature(x = "TsparseMatrix", i = "matrix", j = "missing", value = "replValue"), .TM.repl.i.mat) setReplaceMethod("[", signature(x = "TsparseMatrix", i = "Matrix", j = "missing", value = "replValue"), .TM.repl.i.mat) ### When the RHS 'value' is a sparseVector, now can use replTmat as well setReplaceMethod("[", signature(x = "TsparseMatrix", i = "missing", j = "index", value = "sparseVector"), replTmat) setReplaceMethod("[", signature(x = "TsparseMatrix", i = "index", j = "missing", value = "sparseVector"), replTmat) setReplaceMethod("[", signature(x = "TsparseMatrix", i = "index", j = "index", value = "sparseVector"), replTmat) setMethod("solve", signature(a = "TsparseMatrix", b = "ANY"), function(a, b, ...) solve(as(a, "CsparseMatrix"), b)) setMethod("solve", signature(a = "TsparseMatrix", b = "missing"), function(a, b, ...) solve(as(a, "CsparseMatrix"))) ## Want tril(), triu(), band() --- just as "indexing" --- ## return a "close" class: setMethod("tril", "TsparseMatrix", function(x, k = 0, ...) as(tril(.T.2.C(x), k = k, ...), "TsparseMatrix")) setMethod("triu", "TsparseMatrix", function(x, k = 0, ...) as(triu(.T.2.C(x), k = k, ...), "TsparseMatrix")) setMethod("band", "TsparseMatrix", function(x, k1, k2, ...) as(band(.T.2.C(x), k1 = k1, k2 = k2, ...), "TsparseMatrix")) ## For the "general" T ones (triangular & symmetric have special methods): setMethod("t", signature(x = "TsparseMatrix"), function(x) { cld <- getClassDef(class(x)) r <- new(cld) r@i <- x@j r@j <- x@i if(any("x" == slotNames(cld))) r@x <- x@x r@Dim <- x@Dim[2:1] r@Dimnames <- x@Dimnames[2:1] r }) isDiagTsp <- function(object) { d <- dim(object) if(d[1] != d[2]) FALSE else length(i <- object@i) == length(j <- object@j) && all(i == j) } setMethod("isDiagonal", signature(object = "TsparseMatrix"), isDiagTsp) Matrix/R/nnzero.R0000644000176200001440000000577612501612602013367 0ustar liggesusers#### Number of "structural" non-zeros --- this is nnzmax() in Matlab #### of effectively non-zero values = nnz() " " ## Our nnzero() is like Matlab's nnz() -- but more sophisticated because of NAs ## New: generic function instead of if(..) ... else if(..) ...... ## ## na.counted: TRUE : NA's are counted, they are not 0 ## NA : NA's are not known (0 or not) ==> result := NA ## FALSE: NA's are omitted before counting ## "Default" : for non-"Matrix" (e.g. classical matrices): setMethod("nnzero", "ANY", function(x, na.counted = NA) sum(nz.NA(x, na.counted))) setMethod("nnzero", "diagonalMatrix", function(x, na.counted = NA) sum(nz.NA(diag(x), na.counted))) setMethod("nnzero", "indMatrix", function(x, na.counted = NA) x@Dim[1]) ## other (not "indMatrix", not "diagonalMatrix") "sparseMatrix": setMethod("nnzero", "sparseMatrix", function(x, na.counted = NA) { d <- x@Dim if(any(d == 0)) return(0L) cl <- class(x) ## speedup: cld <- getClassDef(cl) n <- d[1] iSym <- extends(cld, "symmetricMatrix") iTri <- if(iSym) FALSE else extends(cld, "triangularMatrix") nn <- switch(.sp.class(cl), "CsparseMatrix" = x@p[d[2]+1L],# == length(x@i) only if not over-alloc. "TsparseMatrix" = { if(anyDuplicatedT(x, di = d)) x <- .Call(Tsparse_to_Csparse, x, iTri) length(x@i) }, "RsparseMatrix" = x@p[n+1L]) if(!extends(cld, "nMatrix")) # <==> has 'x' slot : consider NAs in it: nn <- sum(nz.NA(if(nn < length(x@x)) x@x[seq_len(nn)] else x@x, na.counted)) if(iSym) nn+nn - sum(nz.NA(diag(x), na.counted)) else if(iTri && x@diag == "U") nn + n else nn }) setMethod("nnzero", "denseMatrix", function(x, na.counted = NA) { d <- x@Dim if(any(d == 0)) return(0L) cl <- class(x) ## speedup: cld <- getClassDef(cl) n <- d[1] iSym <- extends(cld, "symmetricMatrix") ## dense, not diagonal: Can use 'x' slot; if(iSym || extends(cld, "triangularMatrix")) { ## now !iSym <==> "triangularMatrix" upper <- (x@uplo == "U") if(length(x@x) < n*n) { ## packed symmetric | triangular if(iSym) { ## indices of *diagonal* entries for packed : iDiag <- cumsum(if(upper) 1:n else c(1L, if(n > 1)n:2)) ## symmetric packed: count off-diagonals *twice* 2L* sum(nz.NA(x@x[-iDiag], na.counted)) + sum(nz.NA(x@x[ iDiag], na.counted)) } else ## triangular packed sum(nz.NA(x@x, na.counted)) } else { ## not packed, but may have "arbitrary" ## entries in the non-relevant upper/lower triangle s <- sum(nz.NA(x@x[indTri(n, upper=upper)], na.counted)) (if(iSym) 2L * s else s) + (if(!iSym && x@diag == "U") n else sum(nz.NA(x@x[indDiag(n)], na.counted))) } } else { ## dense general <--> .geMatrix sum(nz.NA(x@x, na.counted)) } }) ## Working via sparse*: setMethod("nnzero", "CHMfactor", function(x, na.counted = NA) nnzero(as(x,"sparseMatrix"), na.counted=na.counted)) Matrix/R/ntCMatrix.R0000644000176200001440000000235513253131430013753 0ustar liggesusers#### Logical Sparse Triangular Matrices in Compressed column-oriented format setAs("ntCMatrix", "matrix", function(from) as(copyClass(diagU2N(from), "ngCMatrix"), "matrix")) setAs("matrix", "ntCMatrix", function(from) { if(!is.logical(from)) storage.mode(from) <- "logical" if(anyNA(from)) stop("cannot coerce NA values to pattern \"ntCMatrix\"") .Call(matrix_to_Csparse, from, "ntCMatrix") }) setAs("ntCMatrix", "TsparseMatrix", function(from) .Call(Csparse_to_Tsparse, from, TRUE)) setAs("ntCMatrix", "ngCMatrix", function(from) copyClass(diagU2N(from), "ngCMatrix")) ## "FIXME": Not needed, once we use "nCsparseMatrix" (-> ./ngCMatrix.R ): setAs("ntCMatrix", "dMatrix", .nC2d) setAs("ntCMatrix", "dsparseMatrix", .nC2d) setAs("ntCMatrix", "dtCMatrix", .nC2d) ## setAs("ntCMatrix", "lMatrix", .nC2l) setAs("ntCMatrix", "lsparseMatrix", .nC2l) setAs("ntCMatrix", "ltCMatrix", .nC2l) setAs("ngCMatrix", "ntCMatrix", # to triangular, needed for triu,.. function(from) as(as(as(from, "TsparseMatrix"), "ntTMatrix"), "ntCMatrix")) ## setMethod("t", signature(x = "ntCMatrix"), ## function(x) .Call(ntCMatrix_trans, x), ## valueClass = "ntCMatrix") Matrix/R/ddenseMatrix.R0000644000176200001440000001335313253131430014471 0ustar liggesusers### Define Methods that can be inherited for all subclasses ## This replaces many "d..Matrix" -> "dgeMatrix" ones ## >> but << needs all sub(sub(sub)) classes of "ddenseMatrix" listed ## ----- in ../src/Mutils.c setAs("ddenseMatrix", "dgeMatrix", ..2dge) setAs("ddenseMatrix", "matrix", function(from) as(..2dge(from), "matrix")) ## d(ouble) to l(ogical): setAs("dgeMatrix", "lgeMatrix", function(from) d2l_Matrix(from, "dgeMatrix")) setAs("dsyMatrix", "lsyMatrix", function(from) d2l_Matrix(from, "dsyMatrix")) setAs("dspMatrix", "lspMatrix", function(from) d2l_Matrix(from, "dspMatrix")) setAs("dtrMatrix", "ltrMatrix", function(from) d2l_Matrix(from, "dtrMatrix")) setAs("dtpMatrix", "ltpMatrix", function(from) d2l_Matrix(from, "dtpMatrix")) if(FALSE) ## FIXME, this fails for ("dtpMatrix" -> "CsparseMatrix") where .dense2C() works setAs("ddenseMatrix", "CsparseMatrix", function(from) { if (class(from) != "dgeMatrix") # don't lose symmetry/triangularity/... as_Csparse(from) else .Call(dense_to_Csparse, from) }) ## special case setAs("dgeMatrix", "dgCMatrix", function(from) .Call(dense_to_Csparse, from)) setMethod("as.numeric", "ddenseMatrix", function(x, ...) ..2dge(x)@x) ## -- see also ./Matrix.R e.g., for a show() method ## These methods are the 'fallback' methods for all dense numeric ## matrices in that they simply coerce the ddenseMatrix to a ## dgeMatrix. Methods for special forms override these. setMethod("norm", signature(x = "ddenseMatrix", type = "missing"), function(x, type, ...) norm(..2dge(x))) setMethod("norm", signature(x = "ddenseMatrix", type = "character"), function(x, type, ...) norm(..2dge(x), type)) setMethod("rcond", signature(x = "ddenseMatrix", norm = "missing"), function(x, norm, ...) rcond(..2dge(x), ...)) setMethod("rcond", signature(x = "ddenseMatrix", norm = "character"), function(x, norm, ...) rcond(..2dge(x), norm, ...)) ## Not really useful; now require *identical* class for result: ## setMethod("t", signature(x = "ddenseMatrix"), ## function(x) callGeneric(..2dge(x))) ## "diag" --> specific methods for dge, dtr,dtp, dsy,dsp setMethod("solve", signature(a = "ddenseMatrix", b = "missing"), function(a, b, ...) solve(..2dge(a))) for(.b in c("Matrix","ANY")) ## << against ambiguity notes setMethod("solve", signature(a = "ddenseMatrix", b = .b), function(a, b, ...) solve(..2dge(a), b)) for(.b in c("matrix","numeric")) ## << against ambiguity notes setMethod("solve", signature(a = "ddenseMatrix", b = .b), function(a, b, ...) solve(..2dge(a), Matrix(b))) rm(.b) setMethod("lu", signature(x = "ddenseMatrix"), function(x, ...) .set.factors(x, "LU", lu(..2dge(x), ...))) setMethod("chol", signature(x = "ddenseMatrix"), cholMat) setMethod("determinant", signature(x = "ddenseMatrix", logarithm = "missing"), function(x, logarithm, ...) determinant(..2dge(x))) setMethod("determinant", signature(x = "ddenseMatrix", logarithm = "logical"), function(x, logarithm, ...) determinant(..2dge(x), logarithm)) ## now done for "dMatrix": ## setMethod("expm", signature(x = "ddenseMatrix"), ## function(x) callGeneric(..2dge(x))) .trilDense <- function(x, k = 0, ...) { k <- as.integer(k[1]) d <- dim(x) stopifnot(-d[1] <= k, k <= d[1]) # had k <= 0 ## returns "lower triangular" if k <= 0 && sqr .Call(dense_band, x, -d[1], k) } ## NB: have extra tril(), triu() methods for symmetric ["dsy" and "dsp"] and ## for triangular ["dtr" and "dtp"] setMethod("tril", "denseMatrix", .trilDense) setMethod("tril", "matrix", .trilDense) .triuDense <- function(x, k = 0, ...) { k <- as.integer(k[1]) d <- dim(x) stopifnot(-d[1] <= k, k <= d[1]) # had k >= 0 ## returns "upper triangular" if k >= 0 .Call(dense_band, x, k, d[2]) } setMethod("triu", "denseMatrix", .triuDense) setMethod("triu", "matrix", .triuDense) .bandDense <- function(x, k1, k2, ...) { k1 <- as.integer(k1[1]) k2 <- as.integer(k2[1]) dd <- dim(x) sqr <- dd[1] == dd[2] stopifnot(-dd[1] <= k1, k1 <= k2, k2 <= dd[2]) r <- .Call(dense_band, x, k1, k2) if (sqr && k1 < 0 && k1 == -k2 && isSymmetric(x)) ## symmetric forceSymmetric(r) else r } setMethod("band", "denseMatrix", .bandDense) setMethod("band", "matrix", .bandDense) setMethod("symmpart", signature(x = "ddenseMatrix"), function(x) .Call(ddense_symmpart, x)) setMethod("skewpart", signature(x = "ddenseMatrix"), function(x) .Call(ddense_skewpart, x)) setMethod("is.finite", signature(x = "dgeMatrix"), function(x) { if(all(ifin <- is.finite(x@x))) allTrueMat(x) else if(any(ifin)) { r <- as(x, "lMatrix") #-> logical x-slot r@x <- ifin as(r, "nMatrix") } else is.na_nsp(x) }) ## TODO? -- rather methods for specific subclasses of ddenseMatrix setMethod("is.finite", signature(x = "ddenseMatrix"), function(x) { if(all(ifin <- is.finite(x@x))) return(allTrueMat(x)) ## *NOT* dge, i.e., either triangular or symmetric ## (possibly packed): has finite 0-triangle cdx <- getClassDef(class(x)) r <- new(if(extends(cdx,"symmetricMatrix"))"nsyMatrix" else "ngeMatrix") r@Dim <- (d <- x@Dim) r@Dimnames <- x@Dimnames isPacked <- (le <- prod(d)) > length(ifin) r@x <- rep.int(TRUE, le) iTr <- indTri(d[1], upper= x@uplo == "U", diag= TRUE) if(isPacked) { ## x@x is "usable" r@x[iTr] <- ifin } else { r@x[iTr] <- ifin[iTr] } r }) setMethod("is.infinite", signature(x = "ddenseMatrix"), function(x) { if(any((isInf <- is.infinite(x@x)))) { r <- as(x, "lMatrix")#-> logical x-slot; 0 |--> FALSE r@x <- isInf as(r, "nMatrix")# often sparse .. better way? } else is.na_nsp(x) }) Matrix/R/zzz.R0000644000176200001440000000450014005343565012703 0ustar liggesusers### Note that "in theory" even base::as.vector() should be overloaded. ### In practice that could be too much of a performance penalty in some cases. .MatrixEnv <- new.env(parent = emptyenv(), hash = FALSE)# e.g., for once-per-session warnings .chm_common <- new.env(parent = emptyenv()) ## environment in which to store some settings from cholmod_common .onLoad <- function(libname, pkgname) { .Call(CHM_set_common_env, .chm_common) ## S4 method dispatch ambiguity warnings if(is.null(getOption("ambiguousMethodSelection"))) { if((!is.null(v <- getOption("Matrix.verbose")) && v >= 1) || isTRUE(getOption("Matrix.ambiguityNotes")) || interactive() && identical(Sys.info()[["user"]], "maechler")) { ## nothing } else { # ambiguity notices are trashed N <- function(cond) NULL; environment(N) <- emptyenv() options(ambiguousMethodSelection = N) assign("no.methods.ambiguityNotes", TRUE, envir=.MatrixEnv) } } } Rv <- getRversion() # removed at end ## Instead, simply re-assign the [cr]bind()s which are recursively ## based on [cr]bind2 : ## ## save to cBind / rBind ("rename") ## R >= "3.2.0" : ## New (2015-02) base :: cbind(), rbind() which dispatch on S4 "when needed": cBind <- function (..., deparse.level = 1) { .Defunct(msg = "'cBind' is defunct. Since R version 3.2.0, base's cbind() should work fine with S4 objects") } rBind <- function (..., deparse.level = 1) { .Defunct(msg = "'rBind' is defunct. Since R version 3.2.0, base's rbind() should work fine with S4 objects") } if(Rv < "4.0.0") { deparse1 <- function (expr, collapse = " ", width.cutoff = 500L, ...) paste(deparse(expr, width.cutoff, ...), collapse = collapse) ## not equivalent ... ...length <- function() eval(quote(length(list(...))), sys.frame(-1L)) if(Rv < "3.5.0") { isFALSE <- function (x) is.logical(x) && length(x) == 1L && !is.na(x) && !x isTRUE <- function (x) is.logical(x) && length(x) == 1L && !is.na(x) && x } } rm(Rv) .onUnload <- function(libpath) { library.dynam.unload("Matrix", libpath) if(isTRUE(.MatrixEnv $ no.methods.ambiguityNotes))# revert options(ambiguousMethodSelection = NULL) } .SuiteSparse_version <- function() { ssv <- .Call(get_SuiteSparse_version) package_version(list(major = ssv[1], minor = paste(ssv[2:3], collapse="."))) } Matrix/R/indMatrix.R0000644000176200001440000001702513153267746014024 0ustar liggesusers#### Index Matrices -- Coercion and Methods (--> ../man/indMatrix-class.Rd ) ## The typical 'constructor' : coerce from 'perm' setAs("integer", "indMatrix", function(from) new("indMatrix", Dim = c(length(from), max(from)), Dimnames = list(names(from), NULL), perm = from)) setAs("numeric", "indMatrix", function(from) if(all(from == (i <- as.integer(from)))) as(i, "indMatrix") else stop("coercion to \"indMatrix\" only works from integer numeric")) ## A constructor from a list giving the index ('perm') and the number of columns ## (need this for cases in which the value(s) represented by the last ## column(s) has no observations): .list2indMatrix <- function(from) { if(length(from) == 2 && all(from[[1]] == (i <- as.integer(from[[1]]))) && from[[2]] == (d <- as.integer(from[[2]])) && length(d) == 1 && d >= max(i)) { new("indMatrix", perm = i, Dim = c(length(i), d)) } else stop("coercion from list(i1,...,ik, d) to \"indMatrix\" failed. All entries must be integer valued and the number of columns, d, not smaller than the maximal index i*.") } setAs("list", "indMatrix", .list2indMatrix) setAs("indMatrix", "matrix", function(from) { fp <- from@perm r <- ldiag(n = from@Dim[2])[fp,] if(.has.DN(from)) dimnames(r) <- from@Dimnames r }) ## coerce to 0/1 sparse matrix, i.e. sparse pattern .ind2ngT <- function(from) { d <- from@Dim new("ngTMatrix", i = seq_len(d[1]) - 1L, j = from@perm - 1L, Dim = d, Dimnames = from@Dimnames) } setAs("indMatrix", "ngTMatrix", .ind2ngT) setAs("indMatrix", "TsparseMatrix", .ind2ngT) setAs("indMatrix", "nMatrix", .ind2ngT) setAs("indMatrix", "lMatrix", function(from) as(.ind2ngT(from), "lMatrix")) setAs("indMatrix", "dMatrix", function(from) as(.ind2ngT(from), "dMatrix")) setAs("indMatrix", "dsparseMatrix", function(from) as(from, "dMatrix")) setAs("indMatrix", "lsparseMatrix", function(from) as(from, "lMatrix")) setAs("indMatrix", "nsparseMatrix", .ind2ngT) setAs("indMatrix", "CsparseMatrix", function(from) as(.ind2ngT(from), "CsparseMatrix")) setAs("indMatrix", "ngeMatrix", function(from) as(.ind2ngT(from),"ngeMatrix")) setAs("nMatrix", "indMatrix", function(from) { from <- as(as(from, "TsparseMatrix"), "ngTMatrix") n <- (d <- from@Dim)[1] if(length(i <- from@i) != n) stop("the number of non-zero entries differs from nrow(.)") if((need.sort <- is.unsorted(i))) { ii <- sort.list(i) i <- i[ii] } if(n >= 1 && !identical(i, 0:(n - 1))) stop("must have exactly one non-zero entry per row") new("indMatrix", ## validity checking checks the 'perm' slot: perm = 1L + if(need.sort) from@j[ii] else from@j, Dim = d, Dimnames = from@Dimnames) }) setAs("matrix", "indMatrix", function(from) as(as(from, "nMatrix"), "indMatrix")) setAs("indMatrix", "matrix", function(from) as(.ind2ngT(from), "matrix")) setAs("sparseMatrix", "indMatrix", function(from) as(as(from, "nsparseMatrix"), "indMatrix")) setMethod("is.na", signature(x = "indMatrix"), is.na_nsp) setMethod("is.infinite", signature(x = "indMatrix"), is.na_nsp) setMethod("is.finite", signature(x = "indMatrix"), allTrueMatrix) setMethod("t", signature(x = "indMatrix"), function(x) t(.ind2ngT(x))) setMethod("isSymmetric", signature(object = "indMatrix"), function(object, ...) { d <- dim(object) if(d[1L] != d[2L]) FALSE else ## using "!=" (instead of "==") as the former is typically sparse !any(object != t(object)) }) setMethod("%*%", signature(x = "matrix", y = "indMatrix"), function(x, y) x %*% as(y, "lMatrix")) setMethod("%*%", signature(x = "Matrix", y = "indMatrix"), function(x, y) x %*% as(y, "lMatrix")) setMethod("%*%", signature(x = "indMatrix", y = "matrix"), function(x, y) { mmultCheck(x,y); y[x@perm ,] }) setMethod("%*%", signature(x = "indMatrix", y = "Matrix"), function(x, y) { mmultCheck(x,y); y[x@perm ,] }) setMethod("crossprod", signature(x = "indMatrix", y = "matrix"), function(x, y) as(t(x), "lMatrix") %*% y) setMethod("crossprod", signature(x = "indMatrix", y = "Matrix"), function(x, y) as(t(x), "lMatrix") %*% y) setMethod("crossprod", signature(x = "indMatrix", y = "indMatrix"), function(x, y) { mmultCheck(x,y, 2L) ## xy <- interaction(x@perm, y@perm) ## this is wrong if any of the columns in X or Y are empty because interaction() ## drops non-occuring levels from a non-factor. Explicitly defining a factor with ## levels 1:ncol() avoids that. nx <- x@Dim[2L] ny <- y@Dim[2L] ## xy <- interaction(factor(x@perm, levels=seq_len(nx)), ## factor(y@perm, levels=seq_len(ny))) ## much faster (notably for large x,y): xy <- x@perm + nx*as.double(y@perm-1L) Matrix(tabulate(xy, nbins = nx*ny), nrow = nx, ncol = ny, dimnames = list(x@Dimnames[[2L]], y@Dimnames[[2L]])) }) setMethod("tcrossprod", signature(x = "matrix", y = "indMatrix"), function(x, y) { mmultCheck(x,y, 3L); x[, y@perm] }) setMethod("tcrossprod", signature(x = "Matrix", y = "indMatrix"), function(x, y) { mmultCheck(x,y, 3L); x[, y@perm] }) setMethod("tcrossprod", signature(x = "indMatrix", y = "indMatrix"), function(x, y) { mmultCheck(x,y, 3L); x[, y@perm] }) setMethod("crossprod", signature(x = "indMatrix", y = "missing"), function(x, y=NULL) Diagonal(x = tabulate(x@perm, nbins=x@Dim[2L]))) setMethod("tcrossprod", signature(x = "indMatrix", y = "missing"), function(x, y=NULL) x[,x@perm]) setMethod("kronecker", signature(X = "indMatrix", Y = "indMatrix"), function (X, Y, FUN = "*", make.dimnames = FALSE, ...) { if (FUN != "*") stop("kronecker method must use default 'FUN'") if(any(as.double(X@Dim)*Y@Dim >= .Machine$integer.max)) stop("resulting matrix dimension would be too large") ## Explicitly defining a factor with levels 1:ncol(.) avoids that ## interaction() drops non-occuring levels when any of the ## columns in X or Y are empty: ## perm <- as.integer(interaction(factor(rep(X@perm, each =Y@Dim[1]), ## levels=seq_len(X@Dim[2])), ## factor(rep.int(Y@perm, times=X@Dim[1]), ## levels=seq_len(Y@Dim[2])), ## lex.order=TRUE)) ## much faster (notably for large X, Y): fX <- rep (X@perm-1L, each = Y@Dim[1]) fY <- rep.int(Y@perm-1L, times = X@Dim[1]) new("indMatrix", perm = 1L + fY + Y@Dim[2] * fX, Dim = X@Dim*Y@Dim) }) setMethod("[", signature(x = "indMatrix", i = "index", j = "missing", drop = "logical"), function (x, i, j, ..., drop) { n <- length(newperm <- x@perm[i]) if(drop && n == 1) { ## -> logical unit vector newperm == seq_len(x@Dim[2]) } else { ## stay matrix if(!is.null((DN <- x@Dimnames)[[1]])) DN[[1]] <- DN[[1]][i] new("indMatrix", perm = newperm, Dim = c(n, x@Dim[2]), Dimnames = DN) } }) .indMat.nosense <- function (x, i, j, ..., value) stop('replacing "indMatrix" entries is not allowed, as rarely sensible') setReplaceMethod("[", signature(x = "indMatrix", i = "index"), .indMat.nosense) setReplaceMethod("[", signature(x = "indMatrix", i = "missing", j = "index"), .indMat.nosense) ## explicit ^^^^^^^^^^^^ for disambiguation setReplaceMethod("[", signature(x = "indMatrix", i = "missing", j = "missing"), .indMat.nosense) ### rbind2() method: --> bind2.R Matrix/R/sparseVector.R0000644000176200001440000007644314147005603014540 0ustar liggesusers#### All Methods in relation with the sparseVector (sub)classes ## atomicVector : classUnion (logical,integer,double,....) setAs("atomicVector", "sparseVector", function(from) { n <- length(from)# *is* integer for atomic vectors r <- new(paste0(.V.kind(from), "sparseVector"), length = n) ii <- isN0(from) r@x <- from[ii] r@i <- seq_len(n)[ii] r }) ## dsparseVector: currently important, as later potentially made into d..Matrix : setAs("atomicVector", "dsparseVector", function(from) { n <- length(from)# *is* integer for atomic vectors r <- new("dsparseVector", length = n) ii <- isN0(from) r@x <- as.numeric(from)[ii] r@i <- seq_len(n)[ii] r }) setAs("nsparseVector", "lsparseVector", function(from) new("lsparseVector", i = from@i, length = from@length, x = rep.int(TRUE, length(from@i)))) setAs("nsparseVector", "dsparseVector", function(from) as(as(from, "lsparseVector"), "dsparseVector")) setAs("nsparseVector", "isparseVector", function(from) as(as(from, "lsparseVector"), "isparseVector")) setAs("nsparseVector", "zsparseVector", function(from) as(as(from, "lsparseVector"), "zsparseVector")) ## "xsparseVector" : those with an 'x' slot (i.e., currently := not nsparse*) setAs("xsparseVector", "dsparseVector", function(from) new("dsparseVector", x= as.double(from@x) , i= from@i, length= from@length)) setAs("xsparseVector", "isparseVector", function(from) new("isparseVector", x= as.integer(from@x), i= from@i, length= from@length)) setAs("xsparseVector", "lsparseVector", function(from) new("lsparseVector", x= as.logical(from@x), i= from@i, length= from@length)) setAs("xsparseVector", "zsparseVector", function(from) new("zsparseVector", x= as.complex(from@x), i= from@i, length= from@length)) setAs("xsparseVector", "nsparseVector", function(from) { if(anyNA(from@x)) stop("cannot coerce 'NA's to \"nsparseVector\"") new("nsparseVector", i = from@i, length = from@length) }) setMethod("is.na", signature(x = "nsparseVector"), function(x) new("nsparseVector", length = x@length))## all FALSE setMethod("is.na", signature(x = "sparseVector"), ## x is *not* "nsparse*" as that has own method function(x) new("nsparseVector", i = x@i[is.na(x@x)], length= x@length)) if(getRversion() >= "3.1.0") { setMethod("anyNA", signature(x = "nsparseVector"), function(x) FALSE) setMethod("anyNA", signature(x = "sparseVector"), function(x) anyNA(x@x)) } setMethod("is.infinite", signature(x = "nsparseVector"), function(x) new("nsparseVector", length = x@length))## all FALSE setMethod("is.infinite", signature(x = "sparseVector"), ## x is *not* "nsparse*" as that has own method function(x) new("nsparseVector", i = x@i[is.infinite(x@x)], length= x@length)) setMethod("is.finite", signature(x = "nsparseVector"), function(x) rep.int(TRUE, x@length))## all TRUE setMethod("is.finite", signature(x = "sparseVector"), function(x) { ## x is *not* "nsparse*" as that has own method r <- rep.int(TRUE, x@length) ## mostly TRUE r[x@i[!is.finite(x@x)]] <- FALSE r }) ##' Uniquify sparceVectors, i.e., bring them in "regularized" from, ##' --- similar in spirit (and action!) as uniqTsparse(.) for "TsparseMatrix" ##' __FIXME__ better name ?? , then export and document! __TODO__ uniqSpVec <- function(x) { ii <- sort.list(x@i, method = "radix") x@i <- x@i[ii] x@x <- x@x[ii] x } sp2vec <- function(x, mode = .type.kind[.M.kindC(class(x))]) { ## sparseVector -> vector has.x <- .hasSlot(x, "x")## has "x" slot m.any <- (mode == "any") if(m.any) mode <- if(has.x) mode(x@x) else "logical" else if(has.x) # is.() is much faster than inherits() | is(): xxOk <- switch(mode, "double" = is.double(x@x), "logical" = is.logical(x@x), "integer" = is.integer(x@x), "complex" = is.complex(x@x), ## otherwise (does not happen with default 'mode'): inherits(x@x, mode)) r <- vector(mode, x@length) r[x@i] <- if(has.x) { if(m.any || xxOk) x@x else as(x@x, mode) } else TRUE r } ## so base functions calling as.vector() work too: ## S3 dispatch works for base::as.vector(), but S4 dispatch does not: as.vector.sparseVector <- sp2vec ## work as in base: as.matrix.sparseVector <- function(x, ...) as.matrix.default(sp2vec(x)) as.array.sparseVector <- function(x, ...) as.array.default (sp2vec(x)) ##' Construct new sparse vector , *dropping* zeros ##' @param class character, the sparseVector class ##' @param x numeric/logical/...: the 'x' slot -- if missing ==> "nsparseVector" ##' @param i integer: index of non-zero entries ##' @param length integer: the 'length' slot ##' @return a sparseVector, with 0-dropped 'x' (and 'i') newSpV <- function(class, x, i, length, drop0 = TRUE, checkSort = TRUE) { if(has.x <- !missing(x)) { if(length(x) == 1 && (li <- length(i)) != 1) ## recycle x : x <- rep.int(x, li) if(drop0 && isTRUE(any(x0 <- x == 0))) { keep <- is.na(x) | !x0 x <- x[keep] i <- i[keep] } } if(checkSort && is.unsorted(i)) { ii <- sort.list(i) if(has.x) x <- x[ii] i <- i[ii] } if(has.x) new(class, x = x, i = i, length = length) else new(class, i = i, length = length) } ## a "version" of 'prev' with changed contents: newSpVec <- function(class, x, prev) newSpV(class, x=x, i=prev@i, length=prev@length) ## Exported: sparseVector <- function(x, i, length) { newSpV(class = paste0(if(missing(x)) "n" else .V.kind(x), "sparseVector"), x=x, i=i, length=length) } setAs("sparseVector", "vector", function(from) sp2vec(from)) setMethod("as.vector", "sparseVector", sp2vec) setMethod("as.numeric", "sparseVector", function(x) sp2vec(x, mode = "double")) setMethod("as.logical", "sparseVector", function(x) sp2vec(x, mode = "logical")) setAs("sparseVector", "numeric", function(from) sp2vec(from, mode = "double")) setAs("sparseVector", "integer", function(from) sp2vec(from, mode = "integer")) setAs("sparseVector", "logical", function(from) sp2vec(from, mode = "logical")) ## the "catch all remaining" method: setAs("ANY", "sparseVector", function(from) as(as.vector(from), "sparseVector")) ## "nsparse*" is special -- by default "lsparseVector" are produced setAs("ANY", "nsparseVector", function(from) as(as(from, "sparseVector"),"nsparseVector")) setAs("diagonalMatrix", "sparseVector", function(from) { kind <- .M.kind(from) ## currently only "l" and "d" --> have 'x' n <- nrow(from) n2 <- as.double(n) * n if(n2 > .Machine$integer.max) { ## double (i, length) ii <- seq(1, by = n+1, length.out = n) ## 1-based indexing } else { # integer ok n2 <- as.integer(n2) ii <- as.integer(seq(1L, by = n+1L, length.out = n)) } new(paste0(kind, "sparseVector"), length = n2, i = ii, x = if(from@diag != "U") from@x else rep.int(switch(kind, "d" = 1, "l" = TRUE, "i" = 1L, "z" = 1+0i), n)) }) setAs("sparseMatrix", "sparseVector", function(from) as(as(from, "TsparseMatrix"), "sparseVector")) setAs("CsparseMatrix", "sparseVector", ## could go via TsparseMatrix, but this is faster: function(from) { d <- dim(from) n <- prod(d) # -> numeric, no integer overflow if((int.n <- n <= .Machine$integer.max)) n <- as.integer(n) cld <- getClassDef(class(from)) kind <- .M.kind(from, cld) if(extends(cld, "symmetricMatrix")) from <- as(from, "generalMatrix") else if(extends(cld, "triangularMatrix") && from@diag == "U") from <- .Call(Csparse_diagU2N, from) xj <- .Call(Matrix_expand_pointers, from@p) ii <- if(int.n) 1L + from@i + d[1] * xj else 1 + from@i + as.double(d[1]) * xj cl <- paste0(kind, "sparseVector") if(kind != "n") ## have 'x' slot new(cl, i = ii, length = n, x = from@x) else new(cl, i = ii, length = n) }) setAs("TsparseMatrix", "sparseVector", function(from) { d <- dim(from) n <- prod(d) # -> numeric, no integer overflow if((int.n <- n <= .Machine$integer.max)) n <- as.integer(n) cld <- getClassDef(class(from)) kind <- .M.kind(from, cld) if(extends(cld, "symmetricMatrix")) from <- as(from, "generalMatrix") else if(extends(cld, "triangularMatrix") && from@diag == "U") from <- .Call(Tsparse_diagU2N, from) if(anyDuplicatedT(from, di = d)) from <- uniqTsparse(from) ii <- if(int.n) 1L + from@i + d[1] * from@j else 1 + from@i + as.double(d[1]) * from@j cl <- paste0(kind, "sparseVector") if(kind != "n") ## have 'x' slot new(cl, i = ii, length = n, x = from@x) else new(cl, i = ii, length = n) }) ##' ##' ##'
## Utility -- used in `dim<-` below, but also in Matrix(.) : ##' @title sparseVector --> sparseMatrix constructor ##' @param x "sparseVector" object ##' @param nrow integer or missing, as in matrix(), see ?matrix ##' @param ncol (ditto) ##' @param byrow logical (see ?matrix) ##' @param check logical indicating if it needs to be checked that 'x' is a sparseVector ##' @param symmetric logical indicating if result must be "symmetricMatrix" ##' @return an object inheriting from "sparseMatrix" ##' @author Martin Maechler, May 2007 ff. spV2M <- function (x, nrow, ncol, byrow = FALSE, check = TRUE, symmetric = FALSE) { cx <- class(x) if(check && !extends(cx, "sparseVector")) stop("'x' must inherit from \"sparseVector\"") if(!missing(ncol)) { ncol <- as.integer(ncol) if(ncol < 0) stop("'ncol' must be >= 0") } if(!missing(nrow)) { nrow <- as.integer(nrow) if(nrow < 0) stop("'nrow' must be >= 0") } n <- length(x) if(symmetric) { if(missing(nrow)) stop("Must specify 'nrow' when 'symmetric' is true") if(!missing(ncol) && nrow != ncol) stop("'nrow' and 'ncol' must be the same when 'symmetric' is true") ## otherwise ncol will not used at all when (symmetric) if(check && as.double(nrow)^2 != n) stop("'x' must have length nrow^2 when 'symmetric' is true") ## x <- x[indTri(nrow, upper=TRUE, diag=TRUE)] } else if(missing(nrow)) { nrow <- as.integer( if(missing(ncol)) { ## both missing: --> (n x 1) ncol <- 1L n } else { if(n %% ncol != 0) warning("'ncol' is not a factor of length(x)") as.integer(ceiling(n / ncol)) }) } else if(missing(ncol)) { ncol <- if(symmetric) nrow else { if(n %% nrow != 0) warning("'nrow' is not a factor of length(x)") as.integer(ceiling(n / nrow)) } } else { ## both nrow and ncol specified n.n <- as.double(ncol) * nrow # no integer overflow if(n.n < n) stop("nrow * ncol < length(x)", domain = NA) if(n.n != n) warning("nrow * ncol != length(x)", domain = NA) } ## now nrow * ncol >= n (or 'symmetric') ## ~~~~~~~~~~~~~~~~ cld <- getClassDef(cx) kind <- .M.kindC(cld) # "d", "n", "l", "i", "z", ... has.x <- kind != "n" clStem <- if(symmetric) "sTMatrix" else "gTMatrix" ## "careful_new()" : cNam <- paste0(kind, clStem) chngCl <- is.null(slotNames(newCl <- getClass(cNam, .Force=TRUE))) if(chngCl) { ## e.g. "igTMatrix" is not yet implemented if(substr(cNam,1,1) == "z") stop(gettextf("Class %s is not yet implemented", dQuote(cNam)), domain=NA) ## coerce to "double": newCl <- getClass(paste0("d", clStem)) } r <- new(newCl, Dim = c(nrow, ncol)) ## now "compute" the (i,j,x) slots given x@(i,x) i0 <- x@i - 1L if(byrow) { ## need as.integer(.) since @ i can be double j <- as.integer(i0 %% ncol) i <- as.integer(i0 %/% ncol) } else { ## default{byrow = FALSE} i <- as.integer(i0 %% nrow) j <- as.integer(i0 %/% nrow) } if(has.x) x <- if(chngCl) as.numeric(x@x) else x@x if(symmetric) { ## using uplo = "U" i0 <- i <= j ## i.e., indTri(nrow, upper=TRUE, diag=TRUE) i <- i[i0] j <- j[i0] if(has.x) x <- x[i0] } r@j <- j r@i <- i if(has.x) r@x <- x r }## {spV2M} .sparseV2Mat <- function(from) spV2M(from, nrow=from@length, ncol=1L, check=FALSE) setAs("sparseVector","Matrix", .sparseV2Mat) setAs("sparseVector","sparseMatrix", .sparseV2Mat) setAs("sparseVector","TsparseMatrix", .sparseV2Mat) setAs("sparseVector","CsparseMatrix", function(from) .Call(Tsparse_to_Csparse, .sparseV2Mat(from), FALSE)) ## This is very similar to the 'x = "sparseMatrix"' method in ./sparseMatrix.R: setMethod("dim<-", signature(x = "sparseVector", value = "ANY"), function(x, value) { if(!is.numeric(value) || length(value) != 2) stop("dim(.) value must be numeric of length 2") if(length(x) != prod(value <- round(value))) stop("dimensions don't match the number of cells") spV2M(x, nrow=value[1], ncol=value[2]) }) setMethod("length", "sparseVector", function(x) x@length) setMethod("t", "sparseVector", function(x) spV2M(x, nrow=1L, ncol=x@length, check=FALSE)) setMethod("show", signature(object = "sparseVector"), function(object) { n <- object@length cl <- class(object) cat(sprintf('sparse vector (nnz/length = %d/%.0f) of class "%s"\n', length(object@i), as.double(n), cl)) maxp <- max(1, getOption("max.print")) if(n <= maxp) { prSpVector(object, maxp = maxp) } else { # n > maxp : will cut length of what we'll display : ## cannot easily show head(.) & tail(.) because of "[1] .." printing of tail prSpVector(head(object, maxp), maxp = maxp) cat(" ............................", "\n ........suppressing ", n - maxp, " entries in show(); maybe adjust 'options(max.print= *)'", "\n ............................\n\n", sep='') } invisible(object) }) prSpVector <- function(x, digits = getOption("digits"), maxp = getOption("max.print"), zero.print = ".") { cld <- getClassDef(class(x)) stopifnot(extends(cld, "sparseVector"), maxp >= 1) if(is.logical(zero.print)) zero.print <- if(zero.print) "0" else " " ## kind <- .M.kindC(cld) ## has.x <- kind != "n" n <- x@length if(n > 0) { if(n > maxp) { # n > maxp =: nn : will cut length of what we'll display : x <- head(x, maxp) n <- maxp } xi <- x@i is.n <- extends(cld, "nsparseVector") logi <- is.n || extends(cld, "lsparseVector") cx <- if(logi) rep.int("N", n) else character(n) cx[if(length(xi)) -xi else TRUE] <- zero.print cx[ xi] <- { if(is.n) "|" else if(logi) c(":","|")[x@x + 1L] else ## numeric (or --not yet-- complex): 'has.x' in any cases format(x@x, digits = digits) } ## right = TRUE : cheap attempt to get better "." alignment print(cx, quote = FALSE, right = TRUE, max = maxp) } invisible(x) # TODO? in case of n > maxp, "should" return original x } ## This is a simplified intI() {-> ./Tsparse.R } -- for sparseVector indexing: intIv <- function(i, n, cl.i = getClass(class(i))) { ### Note: undesirable to use this for negative indices; ### ---- using seq_len(n) below means we are NON-sparse ... ### Fixed, for "x[i] with negative i" at least. ## Purpose: translate numeric | logical index into 1-based integer ## -------------------------------------------------------------------- ## Arguments: i: index vector (numeric | logical) *OR* sparseVector ## n: array extent { == length(.) } if(missing(i)) seq_len(n) else if(extends(cl.i, "numeric")) { ## not ok, when max(i) > .Machine$integer.max ! storage.mode(i) <- "integer" int2i(i,n) ##-> ./Tsparse.R } else if (extends(cl.i, "logical")) { seq_len(n)[i] } else if(extends(cl.i, "nsparseVector")) { i@i # the indices are already there ! } else if(extends(cl.i, "lsparseVector")) { i@i[i@x] # "drop0", i.e. FALSE; NAs ok } else if (extends(cl.i, "sparseVector")) { ## 'i'sparse, 'd'sparse (etc) as.integer(i@x[i@i]) } else stop("index must be numeric, logical or sparseVector for indexing sparseVectors") } ## intIv() setMethod("head", signature(x = "sparseVector"), function(x, n = 6, ...) { stopifnot(length(n) == 1) if(n >= (nx <- x@length)) return(x) if(is.integer(x@i)) n <- as.integer(n) else stopifnot(n == round(n)) if(n < 0) n <- max(0L, n + nx) x@length <- n if(length(x@i)) { ## now be careful *NOT* to use seq_len(n), as this be efficient for huge n ## As we *know* that '@i' is sorted increasingly: [x@i <= n] <==> [1:kk] x@i <- x@i[ii <- seq_len(which.max(x@i > n) - 1L)] if(.hasSlot(x, "x")) ## has.x: has "x" slot x@x <- x@x[ii] } x }) setMethod("tail", signature(x = "sparseVector"), function(x, n = 6, ...) { stopifnot(length(n) == 1) if(n >= (nx <- x@length)) return(x) if(is.integer(x@i)) n <- as.integer(n) else stopifnot(n == round(n)) if(n < 0) n <- max(0L, n + nx) x@length <- n if((N <- length(x@i))) { ## now be careful *NOT* to use seq_len(n) ... (see above) n <- nx-n # and keep indices > n ii <- if(any(G <- x@i > n)) which.max(G):N else FALSE x@i <- x@i[ii] - n if(.hasSlot(x, "x")) ## has.x: has "x" slot x@x <- x@x[ii] } x }) setMethod("[", signature(x = "sparseVector", i = "index"), function (x, i, j, ..., drop) { has.x <- .hasSlot(x, "x")## has "x" slot n <- x@length if(extends(cl.i <- getClass(class(i)), "numeric") && any(i < 0)) { if(any(i > 0)) stop("you cannot mix negative and positive indices") if(any(z <- i == 0)) i <- i[!z] ## all (i < 0), negative indices: ## want to remain sparse --> *not* using intIv() ## ## TODO: more efficient solution would use C .. i <- unique(sort(-i)) # so we need to drop the 'i's nom <- is.na(m <- match(x@i, i)) ## eliminate those non-0 which do match: x@i <- x@i[nom] if(has.x) x@x <- x@x[nom] ## now all x@i "appear in 'i' but must be adjusted for the removals: x@i <- x@i - findInterval(x@i, i) x@length <- n - length(i) } else { ## i >= 0 or non-numeric 'i' ii <- intIv(i, n, cl.i=cl.i) m <- match(x@i, ii, nomatch = 0) sel <- m > 0L x@length <- length(ii) x@i <- m[sel] if(any(iDup <- duplicated(ii))) { i.i <- match(ii[iDup], ii) jm <- lapply(i.i, function(.) which(. == m)) if (has.x) sel <- c(which(sel), unlist(jm)) x@i <- c(x@i, rep.int(which(iDup), lengths(jm))) } if(doSort <- is.unsorted(x@i)) { io <- order(x@i, method="radix") x@i <- x@i[io] } if (has.x) x@x <- if(doSort) x@x[sel][io] else x@x[sel] } x }) setMethod("[", signature(x = "sparseVector", i = "lsparseVector"), function (x, i, j, ..., drop) x[sort.int(i@i[i@x])]) setMethod("[", signature(x = "sparseVector", i = "nsparseVector"), function (x, i, j, ..., drop) x[sort.int(i@i)]) ##--- Something else: Allow v[ ] -- exactly similarly: if(FALSE) { ## R_FIXME: Not working, as internal "[" only dispatches on 1st argument setMethod("[", signature(x = "atomicVector", i = "lsparseVector"), function (x, i, j, ..., drop) x[sort.int(i@i[i@x])]) setMethod("[", signature(x = "atomicVector", i = "nsparseVector"), function (x, i, j, ..., drop) x[sort.int(i@i)]) } ##' Implement x[i] <- value ##' @param x a "sparseVector" ##' @param i an "index" (integer, logical, ..) ##' @param value ##' @return a "sparseVector" of the same length as 'x' ## This is much analogous to replTmat in ./Tsparse.R: replSPvec <- function (x, i, value) { n <- x@length ii <- intIv(i, n) lenRepl <- length(ii) if(!lenRepl) return(x) ## else: lenRepl = length(ii) > 0 lenV <- length(value) if(lenV == 0) stop("nothing to replace with") ## else: lenV := length(value) > 0 if(lenRepl %% lenV != 0) stop("number of items to replace is not a multiple of replacement length") if(anyDuplicated(ii)) { ## multiple *replacement* indices: last one wins ## TODO: in R 2.6.0 use duplicate(*, fromLast=TRUE) ir <- lenRepl:1 keep <- match(ii, ii[ir]) == ir ii <- ii[keep] lenV <- length(value <- rep(value, length = lenRepl)[keep]) lenRepl <- length(ii) } has.x <- .hasSlot(x, "x")## has "x" slot m <- match(x@i, ii, nomatch = 0) sel <- m > 0L ## the simplest case if(all0(value)) { ## just drop the non-zero entries if(any(sel)) { ## non-zero there x@i <- x@i[!sel] if(has.x) x@x <- x@x[!sel] } return(x) } ## else -- some( value != 0 ) -- if(lenV > lenRepl) stop("too many replacement values") else if(lenV < lenRepl) value <- rep(value, length = lenRepl) ## now: length(value) == lenRepl > 0 v0 <- is0(value) ## value[1:lenRepl]: which are structural 0 now, which not? v.sp <- inherits(value, "sparseVector") if(any(sel)) { ## indices of non-zero entries -- WRT to subvector iN0 <- m[sel] ## == match(x@i[sel], ii) ## 1a) replace those that are already non-zero with new val. vN0 <- !v0[iN0] if(any(vN0) && has.x) { vs <- value[iN0[vN0]] x@x[sel][vN0] <- if(v.sp) sp2vec(vs, mode=typeof(x@x)) else vs } ## 1b) replace non-zeros with 0 --> drop entries if(any(!vN0)) { i <- which(sel)[!vN0] if(has.x) x@x <- x@x[-i] x@i <- x@i[-i] } iI0 <- if(length(iN0) < lenRepl) seq_len(lenRepl)[-iN0] # else NULL } else iI0 <- seq_len(lenRepl) if(length(iI0) && any(vN0 <- !v0[iI0])) { ## 2) add those that were structural 0 (where value != 0) ij0 <- iI0[vN0] ii <- c(x@i, ii[ij0]) # new x@i, must be sorted: iInc <- sort.list(ii) x@i <- ii[iInc] if(has.x) # new @x, sorted along '@i': x@x <- c(x@x, if(v.sp) sp2vec(value[ij0], mode=typeof(x@x)) else value[ij0] )[iInc] } x } setReplaceMethod("[", signature(x = "sparseVector", i = "index", j = "missing", value = "replValueSp"), replSPvec) setReplaceMethod("[", signature(x = "sparseVector", i = "sparseVector", j = "missing", value = "replValueSp"), ## BTW, the important case: 'i' a *logical* sparseVector replSPvec) ## Something else: Also allow x[ ] <- v e.g. for atomic x : if(FALSE) { ## R_FIXME: Not working, as internal "[<-" only dispatches on 1st argument ## Now "the work is done" inside intIv() : setReplaceMethod("[", signature(x = "atomicVector", i = "sparseVector", j = "missing", value = "replValue"), function (x, i, value) callGeneric(x, i = intIv(i, x@length), value=value)) } ## a "method" for c(<(sparse)Vector>, <(sparse)Vector>): ## FIXME: This is not exported, nor used (nor documented) c2v <- function(x, y) { ## these as(., "sp..V..") check input implicitly: cx <- class(x <- as(x, "sparseVector")) cy <- class(y <- as(y, "sparseVector")) if(cx != cy) { ## find "common" class; result does have 'x' slot cxy <- c(cx,cy) commType <- { if(all(cxy %in% c("nsparseVector", "lsparseVector"))) "lsparseVector" else { # ==> "numeric" ("integer") or "complex" xslot1 <- function(u, cl.u) if(cl.u != "nsparseVector") u@x[1] else TRUE switch(typeof(xslot1(x, cx) + xslot1(y, cy)), ## "integer", "double", or "complex" "integer" = "isparseVector", "double" = "dsparseVector", "complex" = "zsparseVector") } } if(cx != commType) x <- as(x, commType) if(cy != commType) y <- as(y, commType) cx <- commType } ## now *have* common type -- transform 'x' into result: nx <- x@length x@length <- nx + y@length x@i <- c(x@i, nx + y@i) if(cx != "nsparseVector") x@x <- c(x@x, y@x) x } ## sort.default() does ## x[order(x, na.last = na.last, decreasing = decreasing)] ## but that uses a *dense* integer order vector ## ==> need direct sort() method for "sparseVector" for mean(*,trim), median(),.. sortSparseV <- function(x, decreasing = FALSE, na.last = NA) { if(length(ina <- which(is.na(x)))) { if(is.na(na.last)) x <- x[-ina] } ## TODO .NotYetImplemented() } all.equal.sparseV <- function(target, current, ...) { if(!is(target, "sparseVector") || !is(current, "sparseVector")) { return(paste0("target is ", data.class(target), ", current is ", data.class(current))) } lt <- length(target) lc <- length(current) if(lt != lc) { return(paste0("sparseVector", ": lengths (", lt, ", ", lc, ") differ")) } t.has.x <- .hasSlot(target, "x")## has "x" slot c.has.x <- .hasSlot(current, "x")## has "x" slot nz.t <- length(i.t <- target @i) nz.c <- length(i.c <- current@i) t.x <- if(t.has.x) target@x else rep.int(TRUE, nz.t) c.x <- if(c.has.x) current@x else rep.int(TRUE, nz.c) if(nz.t != nz.c || any(i.t != i.c)) { ## "work" if indices are not the same i1.c <- setdiff(i.t, i.c)# those in i.t, not yet in i.c i1.t <- setdiff(i.c, i.t) if((n1t <- length(i1.t))) { target@i <- i.t <- c(i.t, i1.t) t.x <- c(t.x, rep.int(if(t.has.x) 0 else 0L, n1t)) } if((n1c <- length(i1.c))) { current@i <- i.c <- c(i.c, i1.c) c.x <- c(c.x, rep.int(if(c.has.x) 0 else 0L, n1c)) } } if(is.unsorted(i.t)) { ## method="quick" {"radix" not ok for large range} ii <- sort.list(i.t, method = "quick", na.last=NA) target@i <- i.t <- i.t[ii] t.x <- t.x[ii] } if(is.unsorted(i.c)) { ii <- sort.list(i.c, method = "quick", na.last=NA) current@i <- i.c <- i.c[ii] c.x <- c.x[ii] } ## Now, we have extended both target and current ## *and* have sorted the respective i-slot, the i-slots should match! stopifnot(all(i.c == i.t)) all.equal.numeric(c.x, t.x, ...) } ## all.equal.sparseV ## For these, we remain sparse: setMethod("all.equal", c(target = "sparseVector", current = "sparseVector"), all.equal.sparseV) setMethod("all.equal", c(target = "sparseVector", current = "sparseMatrix"), function(target, current, ...) all.equal.sparseV(target, as(current, "sparseVector"), ...)) setMethod("all.equal", c(target = "sparseMatrix", current = "sparseVector"), function(target, current, ...) all.equal.sparseV(as(target, "sparseVector"), current, ...)) ## For the others, where one is "dense", "go to" dense rather now than later: setMethod("all.equal", c(target = "ANY", current = "sparseVector"), function(target, current, ...) all.equal(target, as.vector(current), ...)) setMethod("all.equal", c(target = "sparseVector", current = "ANY"), function(target, current, ...) all.equal(as.vector(target), current, ...)) ## S3 method for 'c' [but only for dispatch on 1st arg, hence also exported as fn] c.sparseVector <- function(...) { svl <- lapply(list(...), as, Class = "sparseVector") ## cls <- unique(unlist(lapply(svl, is))) ns <- vapply(svl, slot, 1, "length") if((N <- sum(ns)) < .Machine$integer.max) { # some purism .. ns <- as.integer(ns) N <- as.integer(N) } narg <- length(ns) iss <- lapply(svl, slot, "i") ## new 'i' slot: ii <- unlist(iss) + rep(cumsum(c(0L, ns[-narg])), lengths(iss)) ## result must have 'x' slot if we have any has.x <- any(have.x <- vapply(svl, .hasSlot, logical(1L), name = "x")) if(has.x) { cls <- if (any(vapply(svl, is, NA, "zsparseVector"))) "zsparseVector" else if(any(vapply(svl, is, NA, "dsparseVector"))) "dsparseVector" else if(any(vapply(svl, is, NA, "isparseVector"))) "isparseVector" else "lsparseVector" if(!(all.x <- all(have.x))) one <- if (identical(cls, "lsparseVector")) TRUE else if(identical(cls, "isparseVector")) 1L else 1. xx <- unlist(if(all.x) lapply(svl, slot, "x") else lapply(seq_len(narg), function(i) { if(have.x[[i]]) svl[[i]]@x else rep_len(one, length(iss[[i]])) })) new(cls, x = xx, i = ii, length = N) } else ## no "x" slot new("nsparseVector", i = ii, length = N) } ### rep(x, ...) -- rep() is primitive with internal default method with these args: ### ----------- ### till R 2.3.1, it had rep.default() which we use as 'model' here. repSpV <- function(x, times) { ## == rep.int(, times)" times <- as.integer(times)# truncating as rep.default() n <- x@length has.x <- .hasSlot(x, "x")## has "x" slot ## just assign new correct slots: if(times <= 1) { ## be quick for {0, 1} times if(times < 0) stop("'times >= 0' is required") if(times == 0) { x@length <- 0L x@i <- integer(0) if(has.x) x@x <- rep.int(x@x, 0) } return(x) } n. <- as.double(n) if(n. * times >= .Machine$integer.max) n <- n. # so won't have overflow in subsequent multiplys x@length <- n * times x@i <- rep.int(x@i, times) + n * rep(0:(times-1L), each=length(x@i)) ## := outer(x@i, 0:(times-1) * n, "+") but a bit faster if(has.x) x@x <- rep.int(x@x, times) x } setMethod("rep", "sparseVector", function(x, times, length.out, each, ...) { if (length(x) == 0) return(if(missing(length.out)) x else head(x, length.out)) if (!missing(each)) { tm <- rep.int(each, length(x)) x <- rep(x, tm) # "recursively" if(missing(length.out) && missing(times)) return(x) } ## else : if (!missing(length.out)) # takes precedence over times times <- ceiling(length.out/length(x)) r <- repSpV(x, times) if (!missing(length.out) && length(r) != length.out) { if(length.out > 0) head(r, length.out) else r[integer(0)] } else r }) ### Group Methods (!) ## "Ops" : ["Arith", "Compare", "Logic"]: ---> in ./Ops.R ## ----- ## "Summary" ---> ./Summary.R ## --------- ## "Math", "Math2": ./Math.R ## ------- setMethod("solve", signature(a = "Matrix", b = "sparseVector"), function(a, b, ...) callGeneric(a, as(b, "sparseMatrix"))) ## the 'i' slot is 1-based *and* has no NA's: setMethod("which", "nsparseVector", function(x, arr.ind, useNames) x@i) setMethod("which", "lsparseVector", function(x, arr.ind, useNames) x@i[is1(x@x)]) ## and *error* for "dsparseVector", "i*", ... ##' indices of vector x[] to construct Toeplitz matrix ##' FIXME: write in C, port to R('stats' package), and use in stats::toeplitz() ind4toeplitz <- function(n) { A <- matrix(raw(), n, n) abs(as.vector(col(A) - row(A))) + 1L } .toeplitz.spV <- function(x, symmetric=TRUE, repr = c("C","T","R"), giveCsparse) { ## semantically "identical" to stats::toeplitz n <- length(x) r <- spV2M(x[ind4toeplitz(n)], n,n, symmetric=symmetric, check=FALSE) if(!missing(giveCsparse)) { if(missing(repr)) { repr <- if(giveCsparse) "C" else "T" warning(gettextf( "'giveCsparse' has been deprecated; setting 'repr = \"%s\"' for you", repr), domain=NA) } else ## !missing(repr) if((.w <- isTRUE(getOption("Matrix.warn"))) || isTRUE(getOption("Matrix.verbose"))) (if(.w) warning else message)( "'giveCsparse' has been deprecated; will use 'repr' instead") } switch(match.arg(repr), "C" = as(r, "CsparseMatrix"), "T" = r,# TsparseMatrix "R" = as(r, "RsparseMatrix")) } setMethod("toeplitz", "sparseVector", .toeplitz.spV) Matrix/R/lMatrix.R0000644000176200001440000001202713704061603013464 0ustar liggesuserssetAs("matrix", "lMatrix", function(from) { storage.mode(from) <- "logical" ; Matrix(from) }) ## NOTE: This is *VERY* parallel to ("dMatrix" -> "nMatrix") in ./dMatrix.R : setAs("lMatrix", "nMatrix", function(from) { if(anyNA(from@x) && ((.w <- isTRUE(getOption("Matrix.warn"))) || isTRUE(getOption("Matrix.verbose")))) { (if(.w) warning else message)( "\"lMatrix\" object with NAs coerced to \"nMatrix\": NA |-> TRUE") from@x[is.na(from@x)] <- TRUE } ## ==> from@x are in {TRUE, FALSE} cld <- getClassDef(cl <- MatrixClass(class(from))) if(extends(cld, "diagonalMatrix")) # no "ndi*" class ## should not happen, setAs(diagonalMatrix -> nMatrix) in ./diagMatrix.R: return(di2nMat(from)) ## else isSp <- extends(cld, "sparseMatrix") if(isSp && !all(from@x)) { from <- drop0(from) # was drop0(from, cld) if(cl != (c. <- class(from))) cld <- getClassDef(cl <- c.) } sNams <- slotNames(cld) copyClass(from, sub("^l", "n", cl), if(isSp) sNams[sNams != "x"] else sNams) }) ## and the reverse as well : setAs("nMatrix", "lMatrix", function(from) { cld <- getClassDef(cl <- MatrixClass(class(from))) r <- copyClass(from, sub("^n", "l", cl), slotNames(cld)) if(extends(cld, "sparseMatrix")) r@x <- rep.int(TRUE, length(if(!extends(cld, "RsparseMatrix")) from@i else from@j)) r }) setAs("dMatrix", "lMatrix", function(from) { cld <- getClassDef(newCl <- class2(class(from), "l")) sNams <- slotNames(cld) r <- copyClass(from, newCl, sNames = sNams[sNams != "x"]) r@x <- as.logical(from@x) r }) setAs("lMatrix", "dMatrix", function(from) { cld <- getClassDef(cl <- MatrixClass(class(from))) sNams <- slotNames(cld) r <- copyClass(from, newCl = sub("^l", "d", cl), sNames = sNams[sNams != "x"]) r@x <- as.double(from@x) r }) ## needed at least for lsparse* : setAs("lMatrix", "dgCMatrix", function(from) as(as(from, "lgCMatrix"), "dgCMatrix")) ###-------------- which( ) ----------------------------------------------------- ## "ldi: is both "sparseMatrix" and "lMatrix" but not "lsparseMatrix" setMethod("which", "ldiMatrix", function(x, arr.ind, useNames) { n <- x@Dim[1L] i <- if(x@diag == "U") seq_len(n) else which(x@x) ## ensure no integer overflow in i + n*(i - ._1) {int. if (n <= 46340L)}: ._1 <- if(n <= as.integer(sqrt(.Machine$integer.max))) 1L else 1 i <- i + n*(i - ._1) if(arr.ind) arrayInd(i, x@Dim, x@Dimnames, useNames=useNames) else i }) whichDense <- function(x, arr.ind = FALSE, useNames = TRUE) { wh <- which(x@x) ## faster but "forbidden": .Internal(which(x@x)) if (arr.ind && !is.null(d <- dim(x))) arrayInd(wh, d, dimnames(x), useNames=useNames) else wh } setMethod("which", "ndenseMatrix", function(x, arr.ind, useNames) whichDense(as(x, "ngeMatrix"), arr.ind=arr.ind, useNames=useNames)) setMethod("which", "ldenseMatrix", function(x, arr.ind, useNames) whichDense(as(x, "lgeMatrix"), arr.ind=arr.ind, useNames=useNames)) setMethod("which", "nsparseMatrix", function(x, arr.ind, useNames = TRUE) { if(arr.ind) which(as(x, "TsparseMatrix"), arr.ind=TRUE, useNames=useNames) else as(x, "sparseVector")@i }) setMethod("which", "lsparseMatrix", function(x, arr.ind, useNames = TRUE) { if(arr.ind) which(as(x, "TsparseMatrix"), arr.ind=TRUE, useNames=useNames) else which(as(x, "sparseVector")) }) ##' construct dimnames as in arrayInd(*, useNames=TRUE) arrDimnames <- function(i, .dimnames) list(.dimnames[[1L]][i], if(any(nzchar(nd <- names(.dimnames)))) nd else c("row", "col")) which.ngT <- function(x, arr.ind, useNames = TRUE) if(arr.ind) { ij <- cbind(x@i, x@j) + 1L if (useNames) dimnames(ij) <- arrDimnames(ij[,1L], x@Dimnames) ij } else as(x, "sparseVector")@i setMethod("which", "ngTMatrix", which.ngT) setMethod("which", "ntTMatrix", function(x, arr.ind, useNames = TRUE) which.ngT(.Call(Tsparse_diagU2N, x), arr.ind, useNames)) setMethod("which", "nsTMatrix", function(x, arr.ind, useNames = TRUE) which.ngT(as(x, "generalMatrix"), arr.ind, useNames)) which.lgT <- function(x, arr.ind, useNames = TRUE) { if(arr.ind) { iT <- is1(x@x) ij <- cbind(x@i[iT], x@j[iT]) + 1L if (useNames) dimnames(ij) <- arrDimnames(ij[,1L], x@Dimnames) ij } else which(as(x, "sparseVector")) } setMethod("which", "lgTMatrix", which.lgT) setMethod("which", "ltTMatrix", function(x, arr.ind, useNames = TRUE) which.lgT(.Call(Tsparse_diagU2N, x), arr.ind, useNames)) setMethod("which", "lsTMatrix", function(x, arr.ind, useNames = TRUE) which.lgT(as(x, "generalMatrix"), arr.ind, useNames)) setMethod("is.finite", signature(x = "lMatrix"), function(x) !is.na(x)) setMethod("is.finite", signature(x = "nMatrix"), allTrueMatrix) setMethod("is.infinite", signature(x = "lMatrix"), is.na_nsp)# all FALSE setMethod("is.infinite", signature(x = "nMatrix"), is.na_nsp)# all FALSE Matrix/R/CHMfactor.R0000644000176200001440000001653012524132306013653 0ustar liggesusers ### TODO: We really want the separate parts (P,L,D) of A = P' L D L' P ### --- --> ~/R/MM/Pkg-ex/Matrix/chol-ex.R --------------- ## but we currently only get A = P' L L' P --- now documented in ../man/Cholesky.Rd setAs("CHMfactor", "sparseMatrix", function(from) .Call(CHMfactor_to_sparse, from)) setAs("CHMfactor", "triangularMatrix", function(from) .Call(CHMfactor_to_sparse, from)) setAs("CHMfactor", "Matrix", function(from) .Call(CHMfactor_to_sparse, from)) setAs("CHMfactor", "pMatrix", function(from) as(from@perm + 1L, "pMatrix")) setMethod("expand", signature(x = "CHMfactor"), function(x, ...) list(P = as(x, "pMatrix"), L = as(x, "sparseMatrix"))) ##' Determine if a CHMfactor object is LDL or LL ##' @param x - a CHMfactor object ##' @return TRUE if x is LDL, otherwise FALSE isLDL <- function(x) { stopifnot(is(x, "CHMfactor")) as.logical(! x@type[2])# "!" = not as type[2] := (cholmod_factor)->is_ll } .isLDL <- function(x) as.logical(! x@type[2])# "!" = not as type[2] := (cholmod_factor)->is_ll setMethod("image", "CHMfactor", function(x, ...) image(as(as(x, "sparseMatrix"), "dgTMatrix"), ...)) .CHM_solve <- function(a, b, system = c("A", "LDLt", "LD", "DLt", "L", "Lt", "D", "P", "Pt"), ...) { chk.s(..., which.call=-2) sysDef <- eval(formals()$system) .Call(CHMfactor_solve, ##-> cholmod_solve() in ../src/CHOLMOD/Cholesky/cholmod_solve.c a, b, ## integer in 1 ("A"), 2 ("LDLt"), ..., 9 ("Pt") : match(match.arg(system, sysDef), sysDef, nomatch = 0L)) } setMethod("solve", signature(a = "CHMfactor", b = "ddenseMatrix"), .CHM_solve, valueClass = "dgeMatrix") setMethod("solve", signature(a = "CHMfactor", b = "matrix"), .CHM_solve, valueClass = "dgeMatrix") setMethod("solve", signature(a = "CHMfactor", b = "numeric"), function(a, b, ...) .CHM_solve(a, matrix(if(is.double(b)) b else as.double(b), length(b), 1L), ...), valueClass = "dgeMatrix") setMethod("solve", signature(a = "CHMfactor", b = "dsparseMatrix"), function(a, b, system = c("A", "LDLt", "LD", "DLt", "L", "Lt", "D", "P", "Pt"), ...) { chk.s(..., which.call=-2) sysDef <- eval(formals()$system) .Call(CHMfactor_spsolve, #--> cholmod_spsolve() in ../src/CHOLMOD/Cholesky/cholmod_spsolve.c a, as(as(b, "CsparseMatrix"), "dgCMatrix"), match(match.arg(system, sysDef), sysDef, nomatch = 0L)) }, valueClass = "CsparseMatrix")# < virtual value ? setMethod("solve", signature(a = "CHMfactor", b = "diagonalMatrix"), function(a, b, ...) solve(a, as(b, "dsparseMatrix"), ...)) setMethod("solve", signature(a = "CHMfactor", b = "missing"), ## <--> b = Diagonal(.) function(a, b, system = c("A", "LDLt", "LD","DLt", "L","Lt", "D", "P","Pt"), ...) { chk.s(..., which.call=-2) sysDef <- eval(formals()$system) system <- match.arg(system, sysDef) i.sys <- match(system, sysDef, nomatch = 0L) as(.Call(CHMfactor_spsolve, a, .sparseDiagonal(a@Dim[1], shape="g"), i.sys), switch(system, A=, LDLt = "symmetricMatrix",# was "dsCMatrix" LD=, DLt=, L=, Lt =, D = "dtCMatrix", # < diagonal: still as "Csparse.." P=, Pt = "pMatrix")) }) ## Catch-all the rest : make sure 'system' is not lost setMethod("solve", signature(a = "CHMfactor", b = "ANY"), function(a, b, system = c("A", "LDLt", "LD","DLt", "L","Lt", "D", "P","Pt"), ...) solve(a, as(b, "dMatrix"), system, ...)) setMethod("chol2inv", signature(x = "CHMfactor"), function (x, ...) { chk.s(..., which.call=-2) solve(x, system = "A") }) setMethod("determinant", signature(x = "CHMfactor", logarithm = "missing"), function(x, logarithm, ...) determinant(x, TRUE)) setMethod("determinant", signature(x = "CHMfactor", logarithm = "logical"), function(x, logarithm, ...) { ldet <- .Call(CHMfactor_ldetL2, x) / 2 mkDet(logarithm=logarithm, ldet=ldet, sig = 1L) }) setMethod("update", signature(object = "CHMfactor"), function(object, parent, mult = 0, ...) { stopifnot(extends(clp <- class(parent), "sparseMatrix")) d <- dim(parent) if(!extends(clp, "dsparseMatrix")) clp <- class(parent <- as(parent, "dsparseMatrix")) if(!extends(clp, "CsparseMatrix")) clp <- class(parent <- as(parent, "CsparseMatrix")) if(d[1] == d[2] && !extends(clp, "dsCMatrix") && !is.null(v <- getOption("Matrix.verbose")) && v >= 1) message(gettextf("Quadratic matrix '%s' (=: A) is not formally\n symmetric. Will be treated as A A' ", "parent"), domain=NA) chk.s(..., which.call=-2) .Call(CHMfactor_update, object, parent, mult) }) ##' fast version, somewhat hidden; here parent *must* be 'd[sg]CMatrix' .updateCHMfactor <- function(object, parent, mult) .Call(CHMfactor_update, object, parent, mult) setMethod("updown", signature(update="ANY", C="ANY", L="ANY"), ## fallback method -- give a "good" error message: function(update,C,L) stop("'update' must be logical or '+' or '-'; 'C' a matrix, and 'L' a \"CHMfactor\"")) setMethod("updown", signature(update="logical", C="mMatrix", L="CHMfactor"), function(update,C,L){ bnew <- as(L,'pMatrix') %*% C .Call(CHMfactor_updown,update, as(bnew,'sparseMatrix'), L) }) setMethod("updown", signature(update="character", C="mMatrix", L="CHMfactor"), function(update,C,L){ if(! update %in% c("+","-")) stop("update must be TRUE/FALSE or '+' or '-'") update <- update=="+" bnew <- as(L,'pMatrix') %*% C .Call(CHMfactor_updown,update, as(bnew,'sparseMatrix'), L) }) ## Currently hidden: ldetL2up <- function(x, parent, Imult) { ## Purpose: compute log Det |A + m*I| for many values of m ## ---------------------------------------------------------------------- ## Arguments: x: CHMfactor to be updated ## parent : CsparseMatrix M; for symmetric M, A = M, otherwise A = MM' ## Imult : a numeric *vector* of 'm's (= I multipliers) ## ---------------------------------------------------------------------- ## Author: Doug Bates, Date: 19 Mar 2008 stopifnot(is(x, "CHMfactor"), is(parent, "CsparseMatrix"), nrow(x) == nrow(parent)) .Call(CHMfactor_ldetL2up, x, parent, as.double(Imult)) } ##' Update a sparse Cholesky factorization in place ##' @param L A sparse Cholesky factor that inherits from CHMfactor ##' @param parent a sparse matrix for updating the factor. Either a ##' dsCMatrix, in which case L is updated to the Cholesky ##' factorization of parent, or a dgCMatrix, in which case L is ##' updated to the Cholesky factorization of tcrossprod(parent) ##' @param Imult an optional positive scalar to be added to the ##' diagonal before factorization, ##' @return NULL. This function always returns NULL. It is called ##' for its side-effect of updating L in place. ##' @note This function violates the functional language semantics of ##' R in that it updates its argument L in place (i.e. without copying). ##' This is intentional but it means the function should be used ##' with caution. If the preceding sentences do not make sense to ##' you, you should not use this function,. destructive_Chol_update <- function(L, parent, Imult = 1) { stopifnot(is(L, "CHMfactor"), is(parent, "sparseMatrix")) .Call(destructive_CHM_update, L, parent, Imult) } Matrix/R/Rsparse.R0000644000176200001440000001734214020107701013460 0ustar liggesusers#### Sparse Matrices in Compressed row-oriented format #### --- "R" ### ``mainly for completeness'' --- we *do* favour Csparse ## - - - - - - - - - - - - hence only "minimal" methods here ! ## see also ./SparseM-conv.R ### contains = "dMatrix" ## compressed_to_TMatrix -- fails on 32bit--enable-R-shlib with segfault {Kurt} ## ------------ --> ../src/dgCMatrix.c .R.2.T <- function(from) .Call(compressed_to_TMatrix, from, FALSE) ## slow R-level workaround ## this is cheap; alternative: going there directly, using ## i <- .Call(Matrix_expand_pointers, from@p), if(FALSE) .R.2.T <- function(from) as(.R.2.C(from), "TsparseMatrix") ## R_to_CMatrix ## ------------ --> ../src/dgCMatrix.c .R.2.C <- function(from) .Call(R_to_CMatrix, from) if(FALSE)## "slow" unneeded R-level version .R.2.C <- function(from) { cl <- class(from) valid <- c("dgRMatrix", "dsRMatrix", "dtRMatrix", "lgRMatrix", "lsRMatrix", "ltRMatrix", "ngRMatrix", "nsRMatrix", "ntRMatrix", "zgRMatrix", "zsRMatrix", "ztRMatrix") icl <- match(cl, valid) - 1L if(is.na(icl)) stop(gettextf("invalid class: %s", dQuote(cl)), domain=NA) Ccl <- sub("^(..)R","\\1C", cl) # corresponding Csparse class name r <- new(Ccl) r@Dim <- from@Dim[2:1] if(icl %/% 3 != 2) ## not "n..Matrix" --> has 'x' slot r@x <- from@x if(icl %% 3 != 0) { # symmetric or triangular r@uplo <- from@uplo if(icl %% 3 == 2) # triangular r@diag <- from@diag } r@i <- from@j r@p <- from@p r <- t(r) r@Dimnames <- from@Dimnames r } ## However, a quick way to "treat a t() as corresponding " : .tR.2.C <- function(from) { cl <- class(from) valid <- c("dgRMatrix", "dsRMatrix", "dtRMatrix", "lgRMatrix", "lsRMatrix", "ltRMatrix", "ngRMatrix", "nsRMatrix", "ntRMatrix", "zgRMatrix", "zsRMatrix", "ztRMatrix") icl <- match(cl, valid) - 1L if(is.na(icl)) stop(gettextf("invalid class: %s", dQuote(cl)), domain=NA) Ccl <- sub("^(..)R","\\1C", cl) # corresponding Csparse class name r <- new(Ccl) r@i <- from@j ##- - r@p <- from@p r@Dim <- from@Dim[2:1] r@Dimnames <- from@Dimnames[2:1] if(icl %/% 3 != 2) ## not "n..Matrix" --> has 'x' slot r@x <- from@x if(icl %% 3 != 0) { # symmetric or triangular r@uplo <- from@uplo if(icl %% 3 == 2) # triangular r@diag <- from@diag } r } ## coercion to other virtual classes --- the functionality we want to encourage setAs("RsparseMatrix", "TsparseMatrix", .R.2.T) setAs("RsparseMatrix", "CsparseMatrix", .R.2.C) setAs("RsparseMatrix", "denseMatrix", function(from) as(.R.2.C(from), "denseMatrix")) setAs("RsparseMatrix", "dsparseMatrix", function(from) as(.R.2.C(from), "dsparseMatrix")) setAs("RsparseMatrix", "lsparseMatrix", function(from) as(.R.2.C(from), "lsparseMatrix")) setAs("RsparseMatrix", "nsparseMatrix", function(from) as(.R.2.C(from), "nsparseMatrix")) setAs("RsparseMatrix", "dMatrix", function(from) as(.R.2.C(from), "dMatrix")) setAs("RsparseMatrix", "lMatrix", function(from) as(.R.2.C(from), "lMatrix")) setAs("RsparseMatrix", "nMatrix", function(from) as(.R.2.C(from), "nMatrix")) setAs("RsparseMatrix", "generalMatrix", function(from) as(.R.2.C(from), "generalMatrix")) ## for printing etc: setAs("RsparseMatrix", "dgeMatrix", function(from) as(.R.2.C(from), "dgeMatrix")) setAs("RsparseMatrix", "matrix", function(from) as(.R.2.C(from), "matrix")) ## **VERY** cheap substitute: work via dgC and t(.) .viaC.to.dgR <- function(from) { m <- as(t(from), "dgCMatrix") new("dgRMatrix", Dim = dim(from), Dimnames = .M.DN(from), p = m@p, j = m@i, x = m@x) } ## one of the few coercions "to " {tested in ../tests/Class+Meth.R} setAs("matrix", "dgRMatrix", .viaC.to.dgR) ## *very* cheap substitute: work via t(.) and Csparse .viaC.to.R <- function(from) { m <- as(t(from), "CsparseMatrix")# preserve symmetry/triangular clx <- getClassDef(class(m)) has.x <- !extends(clx, "nsparseMatrix")## <==> has 'x' slot sh <- .M.shapeC(m,clx) r <- new(paste0(.M.kindC(clx), sh, "RMatrix")) r@Dim <- dim(from) r@Dimnames <- .M.DN(from) r@p <- m@p r@j <- m@i if(has.x) r@x <- m@x if(sh != "g") { r@uplo <- if(m@uplo != "U") "U" else "L" if(sh == "t") r@diag <- m@diag } r } setAs("matrix", "RsparseMatrix", .viaC.to.R) setAs("denseMatrix", "RsparseMatrix", .viaC.to.R) setAs("sparseMatrix","RsparseMatrix", .viaC.to.R) ## symmetric: can use same 'p' slot setAs("dsCMatrix", "dsRMatrix", function(from) new("dsRMatrix", Dim = dim(from), Dimnames = .M.DN(from), p = from@p, j = from@i, x = from@x, uplo = if (from@uplo == "U") "L" else "U")) ## FIXME: if this makes sense, do it for "l" and "n" as well as "d" ## setAs("dtCMatrix", "dtRMatrix", .viaC.to.dgR) # should work; can NOT use 'p' ##setAs("dgRMatrix", "dgeMatrix", ## function(from) .Call(csc_to_dgeMatrix, from)) ##setAs("matrix", "dgRMatrix", ## function(from) { ## storage.mode(from) <- "double" ## .Call(matrix_to_csc, from) ## }) ##setMethod("diag", signature(x = "dgRMatrix"), ## function(x = 1, nrow, ncol = n) .Call(csc_getDiag, x)) ## try to define for "Matrix" -- once and for all -- but that fails -- why? __ FIXME __ ## setMethod("dim", signature(x = "dgRMatrix"), ## function(x) x@Dim, valueClass = "integer") ##setMethod("t", signature(x = "dgRMatrix"), ## function(x) .Call(csc_transpose, x), ## valueClass = "dgRMatrix") setMethod("image", "dgRMatrix", function(x, ...) image(as(x, "TsparseMatrix"), ...)) setMethod("t", "RsparseMatrix", function(x) as(t(.R.2.T(x)), "RsparseMatrix")) ## Want tril(), triu(), band() --- just as "indexing" --- ## return a "close" class: setMethod("tril", "RsparseMatrix", function(x, k = 0, ...) as(tril(.R.2.C(x), k = k, ...), "RsparseMatrix")) setMethod("triu", "RsparseMatrix", function(x, k = 0, ...) as(triu(.R.2.C(x), k = k, ...), "RsparseMatrix")) setMethod("band", "RsparseMatrix", function(x, k1, k2, ...) as(band(.R.2.C(x), k1 = k1, k2 = k2, ...), "RsparseMatrix")) setReplaceMethod("[", signature(x = "RsparseMatrix", i = "index", j = "missing", value = "replValue"), function (x, i, j, ..., value) replTmat(as(x,"TsparseMatrix"), i=i, , value=value)) setReplaceMethod("[", signature(x = "RsparseMatrix", i = "missing", j = "index", value = "replValue"), function (x, i, j, ..., value)# extra " , ": want nargs() == 4 replTmat(as(x,"TsparseMatrix"), , j=j, value=value)) setReplaceMethod("[", signature(x = "RsparseMatrix", i = "index", j = "index", value = "replValue"), function (x, i, j, ..., value) replTmat(as(x,"TsparseMatrix"), i=i, j=j, value=value)) setReplaceMethod("[", signature(x = "RsparseMatrix", i = "index", j = "missing", value = "sparseVector"), function (x, i, j, ..., value) replTmat(as(x,"TsparseMatrix"), i=i, value=value)) setReplaceMethod("[", signature(x = "RsparseMatrix", i = "missing", j = "index", value = "sparseVector"), function (x, i, j, ..., value)# extra " , ": want nargs() == 4 replTmat(as(x,"TsparseMatrix"), , j=j, value=value)) setReplaceMethod("[", signature(x = "RsparseMatrix", i = "index", j = "index", value = "sparseVector"), function (x, i, j, ..., value) replTmat(as(x,"TsparseMatrix"), i=i, j=j, value=value)) setReplaceMethod("[", signature(x = "RsparseMatrix", i = "matrix", j = "missing", value = "replValue"), function (x, i, j, ..., value) .TM.repl.i.mat(as(x,"TsparseMatrix"), i=i, value=value)) Matrix/R/ngTMatrix.R0000644000176200001440000000537012507220173013763 0ustar liggesusers#### Nonzero Pattern Sparse Matrices in triplet format ### contains = "nsparseMatrix" ### ============= ---> superclass methods in ./nsparseMatrix.R setAs("ngTMatrix", "lgeMatrix", function(from) .Call(lgTMatrix_to_lgeMatrix, as(from,"lgTMatrix"))) setAs("ngTMatrix", "ngeMatrix", function(from) as(as(from, "lgeMatrix"), "nMatrix")) setAs("ngTMatrix", "generalMatrix", function(from) as(from, "ngeMatrix")) setAs("ngTMatrix", "matrix", function(from) .Call(lgTMatrix_to_matrix, as(from, "lgTMatrix"))) ## setAs("ngTMatrix", "matrix", # go via fast C code: ## function(from) as(as(from, "ngCMatrix"), "matrix")) setAs("matrix", "ngTMatrix", function(from) { if(!is.logical(from)) storage.mode(from) <- "logical" if(anyNA(from)) stop("cannot coerce 'NA's to \"nsparseMatrix\"") dn <- dimnames(from) if(is.null.DN(dn)) dn <- list(NULL,NULL) else dimnames(from) <- NULL # such that which(.) does not see any: ij <- which(from, arr.ind = TRUE, useNames = FALSE) - 1L if(length(ij) == 0) ij <- matrix(ij, 0, 2) new("ngTMatrix", i = ij[,1], j = ij[,2], Dim = as.integer(dim(from)), Dimnames = dn) }) setAs("matrix", "nMatrix", function(from) as(from, "ngTMatrix")) setAs("ngTMatrix", "dgTMatrix", function(from) ## more efficient than ## as(as(as(sM, "ngCMatrix"), "dgCMatrix"), "dgTMatrix") new("dgTMatrix", i = from@i, j = from@j, x = rep.int(1, length(from@i)), ## cannot copy factors, but can we use them? Dim = from@Dim, Dimnames= from@Dimnames)) setAs("ngTMatrix", "dMatrix", function(from) as(from, "dgTMatrix")) setAs("ngTMatrix", "dsparseMatrix", function(from) as(from, "dgTMatrix")) setAs("ngTMatrix", "lgTMatrix", function(from) new("lgTMatrix", i = from@i, j = from@j, x = rep.int(TRUE, length(from@i)), ## cannot copy factors, but can we use them? Dim = from@Dim, Dimnames= from@Dimnames)) setAs("ngTMatrix", "lMatrix", function(from) as(from, "lgTMatrix")) setAs("ngTMatrix", "triangularMatrix", function(from) check.gT2tT(from, toClass = "ntTMatrix", do.n=TRUE)) setAs("ngTMatrix", "ntTMatrix", function(from) check.gT2tT(from, toClass = "ntTMatrix", do.n=TRUE)) setAs("ngTMatrix", "symmetricMatrix", function(from) check.gT2sT(from, toClass = "nsTMatrix", do.n=TRUE)) ## We favor coercion to super-classes, here, "symmetricMatrix" ## setAs("ngTMatrix", "nsTMatrix", ## function(from) check.gT2sT(from, toClass = "nsTMatrix", do.n=TRUE)) if(FALSE) ## unneeded: use t. setMethod("t", signature(x = "ngTMatrix"), function(x) new("ngTMatrix", i = x@j, j = x@i, Dim = x@Dim[2:1], Dimnames= x@Dimnames[2:1]), valueClass = "ngTMatrix") Matrix/R/sparseMatrix.R0000644000176200001440000011670613774675543014564 0ustar liggesusers### Define Methods that can be inherited for all subclasses ### Idea: Coercion between *VIRTUAL* classes -- as() chooses "closest" classes ### ---- should also work e.g. for dense-triangular --> sparse-triangular ! ##-> see als ./dMatrix.R, ./ddenseMatrix.R and ./lMatrix.R setAs("ANY", "sparseMatrix", function(from) as(from, "CsparseMatrix")) ## If people did not use xtabs(), but table(): setAs("table", "sparseMatrix", function(from) { if(length(dim(from)) != 2L) stop("only 2-dimensional tables can be directly coerced to sparse matrices") as(unclass(from), "CsparseMatrix") }) setAs("sparseMatrix", "generalMatrix", as_gSparse) setAs("sparseMatrix", "symmetricMatrix", as_sSparse) setAs("sparseMatrix", "triangularMatrix", as_tSparse) spMatrix <- function(nrow, ncol, i = integer(), j = integer(), x = numeric()) { dim <- c(as.integer(nrow), as.integer(ncol)) ## The conformability of (i,j,x) with itself and with 'dim' ## is checked automatically by internal "validObject()" inside new(.): kind <- .M.kind(x) new(paste0(kind, "gTMatrix"), Dim = dim, x = if(kind == "d") as.double(x) else x, ## our "Tsparse" Matrices use 0-based indices : i = as.integer(i - 1L), j = as.integer(j - 1L)) } sparseMatrix <- function(i = ep, j = ep, p, x, dims, dimnames, symmetric = FALSE, triangular = FALSE, index1 = TRUE, repr = "C", giveCsparse = (repr == "C"), check = TRUE, use.last.ij = FALSE) { ## Purpose: user-level substitute for most new(, ..) calls ## Author: Douglas Bates, Date: 12 Jan 2009, based on Martin's version if((m.i <- missing(i)) + (m.j <- missing(j)) + (m.p <- missing(p)) != 1) stop("exactly one of 'i', 'j', or 'p' must be missing from call") if(!m.p) { p <- as.integer(p) if((lp <- length(p)) < 1 || p[1] != 0 || any((dp <- p[-1] - p[-lp]) < 0)) stop("'p' must be a non-decreasing vector (0, ...)") ep <- rep.int(seq_along(dp), dp) } stopifnot(length(repr) == 1L, repr %in% c("C", "T", "R")) ## NB: up to 2020-05, only had giveCsparse=TRUE --> "C" or "T" -- remain back-compatible: if(missing(repr) && !giveCsparse) { warning("'giveCsparse' has been deprecated; setting 'repr = \"T\"' for you") repr <- "T" } else if(!missing(repr) && !missing(giveCsparse)) warning("'giveCsparse' has been deprecated; will use 'repr' instead") ## i and j are now both defined (via default = ep). Make them 1-based indices. i1 <- as.logical(index1)[1] i <- as.integer(i + !(m.i || i1)) j <- as.integer(j + !(m.j || i1)) ## "minimal dimensions" from (i,j,p); no warnings from empty i or j : dims.min <- suppressWarnings(c(max(i), max(j))) if(anyNA(dims.min)) stop("NA's in (i,j) are not allowed") if(missing(dims)) { dims <- if(symmetric || triangular) rep(max(dims.min), 2) else dims.min } else { ## check dims stopifnot(all(dims >= dims.min)) dims <- as.integer(dims) } if(symmetric && triangular) stop("Both 'symmetric' and 'triangular', i.e. asking for diagonal matrix. Use 'Diagonal()' instead") sx <- if(symmetric) { if(dims[1] != dims[2]) stop("symmetric matrix must be square") "s" } else if(triangular) { if(dims[1] != dims[2]) stop("triangular matrix must be square") "t" } else "g" isPat <- missing(x) ## <-> patter"n" Matrix kx <- if(isPat) "n" else .M.kind(x) r <- new(paste0(kx, sx, "TMatrix")) r@Dim <- dims if(symmetric && all(i >= j)) r@uplo <- "L" # else "U", the default else if(triangular) { r@uplo <- if(all(i >= j)) "L" else if(all(i <= j)) "U" else stop("triangular matrix must have all i >= j or i <= j") } if(!isPat) { if(kx == "d" && !is.double(x)) x <- as.double(x) if(length(x) != (n <- length(i))) { ## recycle if(length(x) != 1 && n %% length(x) != 0) warning("length(i) is not a multiple of length(x)") x <- rep_len(x, n) } if(use.last.ij && (id <- anyDuplicated(cbind(i,j), fromLast=TRUE))) { i <- i[-id] j <- j[-id] x <- x[-id] if(any(idup <- duplicated(cbind(i,j), fromLast=TRUE))) { ndup <- -which(idup) i <- i[ndup] j <- j[ndup] x <- x[ndup] } } r@x <- x } r@i <- i - 1L r@j <- j - 1L if(!missing(dimnames)) r@Dimnames <- .fixupDimnames(dimnames) if(check) validObject(r) switch(repr, "C" = as(r, "CsparseMatrix"), "T" = r,# TsparseMatrix "R" = as(r, "RsparseMatrix"), stop("invalid 'repr'; must be \"C\", \"T\", or \"R\"")) } ## "graph" coercions -- this needs the graph package which is currently ## ----- *not* required on purpose ## Note: 'undirected' graph <==> 'symmetric' matrix ## Use 'graph::' as it is not impoted into Matrix, and may only be loaded, not attached: ## Add some utils that may no longer be needed in future versions of the 'graph' package graph.has.weights <- function(g) "weight" %in% names(graph::edgeDataDefaults(g)) graph.non.1.weights <- function(g) any(unlist(graph::edgeData(g, attr = "weight")) != 1) graph.wgtMatrix <- function(g) { ## Purpose: work around "graph" package's as(g, "matrix") bug ## ---------------------------------------------------------------------- ## Arguments: g: an object inheriting from (S4) class "graph" ## ---------------------------------------------------------------------- ## Author: Martin Maechler, based on Seth Falcon's code; Date: 12 May 2006 ## MM: another buglet for the case of "no edges": if(graph::numEdges(g) == 0) { p <- length(nd <- graph::nodes(g)) return( matrix(0, p,p, dimnames = list(nd, nd)) ) } ## Usual case, when there are edges: if(has.w <- graph.has.weights(g)) { ## graph.non.1.weights(g) : w <- unlist(graph::edgeData(g, attr = "weight")) has.w <- any(w != 1) } ## now 'has.w' is TRUE iff there are weights != 1 ## now 'has.w' is TRUE iff there are weights != 1 m <- as(g, "matrix") ## now is a 0/1 - matrix (instead of 0/wgts) with the 'graph' bug if(has.w) { ## fix it if needed tm <- t(m) tm[tm != 0] <- w t(tm) } else m } setAs("graphAM", "sparseMatrix", function(from) { symm <- graph::edgemode(from) == "undirected" && isSymmetric(from@adjMat) ## This is only ok if there are no weights... if(graph.has.weights(from)) { as(graph.wgtMatrix(from), if(symm) "dsTMatrix" else "dgTMatrix") } else { ## no weights: 0/1 matrix -> logical as(as(from, "matrix"), if(symm) "nsTMatrix" else "ngTMatrix") } }) setAs("graph", "CsparseMatrix", function(from) as(as(from, "graphNEL"), "CsparseMatrix")) setAs("graph", "Matrix", function(from) as(from, "CsparseMatrix")) setAs("graphNEL", "CsparseMatrix", function(from) as(as(from, "TsparseMatrix"), "CsparseMatrix")) graph2T <- function(from, use.weights = graph.has.weights(from) && graph.non.1.weights(from)) { nd <- graph::nodes(from); dnms <- list(nd,nd) dm <- rep.int(length(nd), 2) edge2i <- function(e) { ## return (0-based) row indices 'i' rep.int(0:(dm[1]-1L), lengths(e)) } if(use.weights) { eWts <- graph::edgeWeights(from); names(eWts) <- NULL i <- edge2i(eWts) To <- unlist(lapply(eWts, names)) j <- as.integer(match(To,nd)) - 1L # columns indices (0-based) ## symm <- symm && : improbable ## if(symm) new("dsTMatrix", .....) else new("dgTMatrix", i = i, j = j, x = unlist(eWts), Dim = dm, Dimnames = dnms) } else { ## no weights: 0/1 matrix -> logical edges <- lapply(from@edgeL[nd], "[[", "edges") symm <- graph::edgemode(from) == "undirected" if(symm)# each edge appears twice; keep upper triangle only edges <- lapply(seq_along(edges), function(i) {e <- edges[[i]]; e[e >= i]}) i <- edge2i(edges) j <- as.integer(unlist(edges)) - 1L # column indices (0-based) ## if(symm) { # symmetric: ensure upper triangle ## tmp <- i ## flip <- i > j ## i[flip] <- j[flip] ## j[flip] <- tmp[flip] ## new("nsTMatrix", i = i, j = j, Dim = dm, Dimnames = dnms, uplo = "U") ## } else { ## new("ngTMatrix", i = i, j = j, Dim = dm, Dimnames = dnms) ## } new(if(symm) "nsTMatrix" else "ngTMatrix", i = i, j = j, Dim = dm, Dimnames = dnms)# uplo = "U" is default } } setAs("graphNEL", "TsparseMatrix", function(from) graph2T(from)) setAs("sparseMatrix", "graph", function(from) as(from, "graphNEL")) setAs("sparseMatrix", "graphNEL", ## since have specific method for Tsparse below, 'from' is *not*, ## i.e. do not need to "uniquify" the T* matrix: function(from) T2graph(as(from, "TsparseMatrix"), need.uniq=FALSE)) setAs("TsparseMatrix", "graphNEL", function(from) T2graph(from)) T2graph <- function(from, need.uniq = is_not_uniqT(from), edgemode = NULL) { d <- dim(from) if(d[1] != d[2]) stop("only square matrices can be used as incidence matrices for graphs") n <- d[1] if(n == 0) return(new("graphNEL")) if(is.null(rn <- dimnames(from)[[1]])) rn <- as.character(1:n) if(need.uniq) ## Need to 'uniquify' the triplets! from <- uniqTsparse(from) if(is.null(edgemode)) edgemode <- if(isSymmetric(from)) { # either "symmetricMatrix" or otherwise ##-> undirected graph: every edge only once! if(!is(from, "symmetricMatrix")) { ## a general matrix which happens to be symmetric ## ==> remove the double indices from <- tril(from) } "undirected" } else { "directed" } ## every edge is there only once, either upper or lower triangle ft1 <- cbind(rn[from@i + 1L], rn[from@j + 1L]) graph::ftM2graphNEL(ft1, W = if(.hasSlot(from,"x")) as.numeric(from@x), ## else NULL V = rn, edgemode=edgemode) } ### Subsetting -- basic things (drop = "missing") are done in ./Matrix.R ### FIXME : we defer to the "*gT" -- conveniently, but not efficient for gC ! ## [dl]sparse -> [dl]gT -- treat both in one via superclass ## -- more useful when have "z" (complex) and even more setMethod("[", signature(x = "sparseMatrix", i = "index", j = "missing", drop = "logical"), function (x, i,j, ..., drop) { Matrix.msg("sp[i,m,l] : nargs()=",nargs(), .M.level = 2) cld <- getClassDef(class(x)) na <- nargs() x <- if(na == 4) as(x, "TsparseMatrix")[i, , drop=drop] else if(na == 3) as(x, "TsparseMatrix")[i, drop=drop] else ## should not happen stop("Matrix-internal error in [i,,d]; please report") ## ## try_as(x, c(cl, sub("T","C", viaCl))) if(is(x, "Matrix") && extends(cld, "CsparseMatrix")) as(x, "CsparseMatrix") else x }) setMethod("[", signature(x = "sparseMatrix", i = "missing", j = "index", drop = "logical"), function (x,i,j, ..., drop) { Matrix.msg("sp[m,i,l] : nargs()=",nargs(), .M.level = 2) cld <- getClassDef(class(x)) ##> why should this be needed; can still happen in [..]: ##> if(!extends(cld, "generalMatrix")) x <- as(x, "generalMatrix") ## viaCl <- paste0(.M.kind(x, cld), "gTMatrix") x <- as(x, "TsparseMatrix")[, j, drop=drop] ##simpler than x <- callGeneric(x = as(x, "TsparseMatrix"), j=j, drop=drop) if(is(x, "Matrix") && extends(cld, "CsparseMatrix")) as(x, "CsparseMatrix") else x }) setMethod("[", signature(x = "sparseMatrix", i = "index", j = "index", drop = "logical"), function (x, i, j, ..., drop) { Matrix.msg("sp[i,i,l] : nargs()=",nargs(), .M.level = 2) cld <- getClassDef(class(x)) ## be smart to keep symmetric indexing of symmetric: ##> doSym <- (extends(cld, "symmetricMatrix") && ##> length(i) == length(j) && all(i == j)) ##> why should this be needed; can still happen in [..]: ##> if(!doSym && !extends(cld, "generalMatrix")) ##> x <- as(x, "generalMatrix") ## viaCl <- paste0(.M.kind(x, cld), ## if(doSym) "sTMatrix" else "gTMatrix") x <- as(x, "TsparseMatrix")[i, j, drop=drop] if(is(x, "Matrix") && extends(cld, "CsparseMatrix")) as(x, "CsparseMatrix") else x }) ### "[<-" : ----------------- ## setReplaceMethod("[", .........) ## -> ./Tsparse.R ## & ./Csparse.R & ./Rsparse.R {those go via Tsparse} ## x[] <- value : setReplaceMethod("[", signature(x = "sparseMatrix", i = "missing", j = "missing", value = "ANY"),## double/logical/... function (x, i,j,..., value) { if(all0(value)) { # be faster cld <- getClassDef(class(x)) x <- diagU2N(x, cl = cld) for(nm in intersect(nsl <- names(cld@slots), c("x", "i","j", "factors"))) length(slot(x, nm)) <- 0L if("p" %in% nsl) x@p <- rep.int(0L, ncol(x)+1L) } else { ## typically non-sense: assigning to full sparseMatrix x[TRUE] <- value } x }) ## Do not use as.vector() (see ./Matrix.R ) for sparse matrices : setReplaceMethod("[", signature(x = "sparseMatrix", i = "missing", j = "ANY", value = "sparseMatrix"), function (x, i, j, ..., value) callGeneric(x=x, , j=j, value = as(value, "sparseVector"))) setReplaceMethod("[", signature(x = "sparseMatrix", i = "ANY", j = "missing", value = "sparseMatrix"), function (x, i, j, ..., value) if(nargs() == 3) callGeneric(x=x, i=i, value = as(value, "sparseVector")) else callGeneric(x=x, i=i, , value = as(value, "sparseVector"))) setReplaceMethod("[", signature(x = "sparseMatrix", i = "ANY", j = "ANY", value = "sparseMatrix"), function (x, i, j, ..., value) callGeneric(x=x, i=i, j=j, value = as(value, "sparseVector"))) ### --- print() and show() methods --- .formatSparseSimple <- function(m, asLogical=FALSE, digits=NULL, col.names, note.dropping.colnames = TRUE, dn=dimnames(m)) { stopifnot(is.logical(asLogical)) if(asLogical) cx <- array("N", dim(m), dimnames=dn) else { ## numeric (or --not yet implemented-- complex): cx <- apply(m, 2, format, digits=digits) if(is.null(dim(cx))) {# e.g. in 1 x 1 case dim(cx) <- dim(m) dimnames(cx) <- dn } } if (missing(col.names)) col.names <- { if(!is.null(cc <- getOption("sparse.colnames"))) cc else if(is.null(dn[[2]])) FALSE else { # has column names == dn[[2]] ncol(m) < 10 } } if(identical(col.names, FALSE)) cx <- emptyColnames(cx, msg.if.not.empty = note.dropping.colnames) else if(is.character(col.names)) { stopifnot(length(col.names) == 1) cn <- col.names switch(substr(cn, 1,3), "abb" = { iarg <- as.integer(sub("^[^0-9]*", '', cn)) colnames(cx) <- abbreviate(colnames(cx), minlength = iarg) }, "sub" = { iarg <- as.integer(sub("^[^0-9]*", '', cn)) colnames(cx) <- substr(colnames(cx), 1, iarg) }, stop(gettextf("invalid 'col.names' string: %s", cn), domain=NA)) } ## else: nothing to do for col.names == TRUE cx }## .formatSparseSimple ### NB: Want this to work also for logical or numeric traditional matrix 'x': formatSparseM <- function(x, zero.print = ".", align = c("fancy", "right"), m = as(x,"matrix"), asLogical=NULL, uniDiag=NULL, digits=NULL, cx, iN0, dn = dimnames(m)) { cld <- getClassDef(class(x)) if(is.null(asLogical)) { asLogical <- extends1of(cld, c("nsparseMatrix", "indMatrix", # -> simple T / F{ binary "lsparseMatrix")) || (extends(cld, "matrix") && is.logical(x)) # has NA and (non-)structural FALSE } if(missing(cx)) cx <- .formatSparseSimple(m, asLogical=asLogical, digits=digits, dn=dn) if(is.null(d <- dim(cx))) {# e.g. in 1 x 1 case d <- dim(cx) <- dim(m) dimnames(cx) <- dn } if(missing(iN0)) iN0 <- 1L + .Call(m_encodeInd, non0ind(x, cld), di = d, FALSE, FALSE) ## ne <- length(iN0) if(asLogical) { cx[m] <- "|" if(!extends(cld, "sparseMatrix")) x <- as(x,"sparseMatrix") if(anyFalse(x@x)) { ## any (x@x == FALSE) ## Careful for *non-sorted* Tsparse, e.g. from U-diag if(extends(cld, "TsparseMatrix")) { ## have no "fast uniqTsparse(): x <- as(x, "CsparseMatrix") cld <- getClassDef(class(x)) } F. <- is0(x@x) # the 'FALSE' ones ### FIXME: have iN0 already above -- *really* need the following ??? --FIXME-- ij <- non0.i(x, cld, uniqT=FALSE) if(extends(cld, "symmetricMatrix")) { ## also get "other" triangle notdiag <- ij[,1] != ij[,2] # but not the diagonals again ij <- rbind(ij, ij[notdiag, 2:1], deparse.level=0) F. <- c(F., F.[notdiag]) } iN0 <- 1L + .Call(m_encodeInd, ij, di = d, FALSE, FALSE) cx[iN0[F.]] <- ":" # non-structural FALSE (or "o", "," , "-" or "f")? } } else if(match.arg(align) == "fancy" && !is.integer(m)) { fi <- apply(m, 2, format.info) ## fi[3,] == 0 <==> not expo. ## now 'format' the zero.print by padding it with ' ' on the right: ## case 1: non-exponent: fi[2,] + as.logical(fi[2,] > 0) ## the column numbers of all 'zero' entries -- (*large*) cols <- 1L + (0:(prod(d)-1L))[-iN0] %/% d[1] pad <- ifelse(fi[3,] == 0, fi[2,] + as.logical(fi[2,] > 0), ## exponential: fi[2,] + fi[3,] + 4) ## now be efficient ; sprintf() is relatively slow ## and pad is much smaller than 'cols'; instead of "simply" ## zero.print <- sprintf("%-*s", pad[cols] + 1, zero.print) if(any(doP <- pad > 0)) { # ## only pad those that need padding - *before* expanding z.p.pad <- rep.int(zero.print, length(pad)) z.p.pad[doP] <- sprintf("%-*s", pad[doP] + 1, zero.print) zero.print <- z.p.pad[cols] } else zero.print <- rep.int(zero.print, length(cols)) } ## else "right" : nothing to do if(!asLogical && isTRUE(uniDiag)) { ## use "I" in diagonal -- pad correctly if(any(diag(x) != 1)) stop("uniDiag=TRUE, but not all diagonal entries are 1") D <- diag(cx) # use if(any((ir <- regexpr("1", D)) < 0)) { warning("uniDiag=TRUE, not all entries in diagonal coded as 1") } else { ir <- as.vector(ir) nD <- nchar(D, "bytes") ## replace "1..." by "I " (I plus blanks) substr(D, ir, nD) <- sprintf("I%*s", nD - ir, "") diag(cx) <- D } } cx[-iN0] <- zero.print cx }## formatSparseM() ##' The `format()` method for sparse Matrices; also used inside sparseMatrix print()ing, ##' exported as it might be useful directly. formatSpMatrix <- function(x, digits = NULL, # getOption("digits"), maxp = 1e9, # ~ 1/2 * .Machine$integer.max, ## getOption("max.print"), cld = getClassDef(class(x)), zero.print = ".", col.names, note.dropping.colnames = TRUE, uniDiag = TRUE, align = c("fancy", "right")) { stopifnot(extends(cld, "sparseMatrix")) validObject(x) # have seen seg.faults for invalid objects d <- dim(x) unitD <- extends(cld, "triangularMatrix") && x@diag == "U" ## Will note it is *unit*-diagonal by using "I" instead of "1" if(unitD) { if(extends(cld, "CsparseMatrix")) x <- .Call(Csparse_diagU2N, x) else if(extends(cld, "TsparseMatrix")) x <- .Call(Tsparse_diagU2N, x) else { kind <- .M.kind(x, cld) x <- .Call(Tsparse_diagU2N, as(as(x, paste0(kind, "Matrix")), "TsparseMatrix")) cld <- getClassDef(class(x)) } } if(maxp < 100) maxp <- 100L # "stop gap" if(prod(d) > maxp) { # "Large" => will be "cut" ## only coerce to dense that part which won't be cut : nr <- maxp %/% d[2] m <- as(x[1:max(1, nr), ,drop=FALSE], "matrix") } else { m <- as(x, "matrix") } dn <- dimnames(m) ## will be === dimnames(cx) binary <- extends(cld,"nsparseMatrix") || extends(cld, "indMatrix") # -> simple T / F logi <- binary || extends(cld,"lsparseMatrix") # has NA and (non-)structural FALSE cx <- .formatSparseSimple(m, asLogical = logi, digits=digits, col.names=col.names, note.dropping.colnames=note.dropping.colnames, dn=dn) if(is.logical(zero.print)) zero.print <- if(zero.print) "0" else " " if(binary) { cx[!m] <- zero.print cx[m] <- "|" } else { # non-binary ==> has 'x' slot ## show only "structural" zeros as 'zero.print', not all of them.. ## -> cannot use 'm' alone d <- dim(cx) ne <- length(iN0 <- 1L + .Call(m_encodeInd, non0ind(x, cld), di = d, FALSE, FALSE)) if(0 < ne && (logi || ne < prod(d))) { cx <- formatSparseM(x, zero.print, align, m=m, asLogical = logi, uniDiag = unitD & uniDiag, digits=digits, cx=cx, iN0=iN0, dn=dn) } else if (ne == 0)# all zeroes cx[] <- zero.print } cx }## formatSpMatrix() ## FIXME(?) -- ``merge this'' (at least ``synchronize'') with ## - - - prMatrix() from ./Auxiliaries.R ## FIXME: prTriang() in ./Auxiliaries.R should also get align = "fancy" ## printSpMatrix <- function(x, digits = NULL, # getOption("digits"), maxp = max(100L, getOption("max.print")), cld = getClassDef(class(x)), zero.print = ".", col.names, note.dropping.colnames = TRUE, uniDiag = TRUE, col.trailer = '', align = c("fancy", "right")) { stopifnot(extends(cld, "sparseMatrix")) cx <- formatSpMatrix(x, digits=digits, maxp=maxp, cld=cld, zero.print=zero.print, col.names=col.names, note.dropping.colnames=note.dropping.colnames, uniDiag=uniDiag, align=align) if(col.trailer != '') cx <- cbind(cx, col.trailer, deparse.level = 0) ## right = TRUE : cheap attempt to get better "." alignment print(cx, quote = FALSE, right = TRUE, max = maxp) invisible(x) } ## printSpMatrix() ##' The "real" show() / print() method, calling the above printSpMatrix(): printSpMatrix2 <- function(x, digits = NULL, # getOption("digits"), maxp = max(100L, getOption("max.print")), zero.print = ".", col.names, note.dropping.colnames = TRUE, uniDiag = TRUE, suppRows = NULL, suppCols = NULL, col.trailer = if(suppCols) "......" else "", align = c("fancy", "right"), width = getOption("width"), fitWidth = TRUE) { d <- dim(x) cl <- class(x) cld <- getClassDef(cl) xtra <- if(extends(cld, "triangularMatrix") && x@diag == "U") " (unitriangular)" else "" cat(sprintf('%d x %d sparse Matrix of class "%s"%s\n', d[1], d[2], cl, xtra)) setW <- !missing(width) && width > getOption("width") if(setW) { op <- options(width = width) ; on.exit( options(op) ) } if((isFALSE(suppRows) && isFALSE(suppCols)) || (!isTRUE(suppRows) && !isTRUE(suppCols) && prod(d) <= maxp)) { ## "small matrix" and supp* not TRUE : no rows or columns are suppressed if(missing(col.trailer) && is.null(suppCols)) suppCols <- FALSE # for default 'col.trailer' printSpMatrix(x, cld=cld, digits=digits, maxp=maxp, zero.print=zero.print, col.names=col.names, note.dropping.colnames=note.dropping.colnames, uniDiag=uniDiag, col.trailer=col.trailer, align=align) } else { ## d[1] > maxp / d[2] >= nr : -- this needs [,] working: validObject(x) sTxt <- c(" ", gettext( "in show(); maybe adjust 'options(max.print= *, width = *)'"), "\n ..............................\n") useW <- width - (format.info(d[1], digits=digits)[1] + 3+1) ## == width - space for the largest row label : "[,] " ## Suppress rows and/or columns in printing ... ## ---------------------------------------- but which exactly depends on format ## Determining number of columns - first assuming all zeros : ". . "..: 2 chars/column ## i.e., we get the *maximal* numbers of columns to keep, nc : if(is.null(suppCols)) # i.e., "it depends" .. suppCols <- (d[2] * 2 > useW) # used in 'col.trailer' default nCc <- 1 + nchar(col.trailer, "width") if(suppCols) { nc <- (useW - nCc) %/% 2 x <- x[ , 1:nc, drop = FALSE] } else nc <- d[2] nr <- maxp %/% nc # if nc becomes smaller, nr will become larger (!) if(is.null(suppRows)) suppRows <- (nr < d[1]) if(suppRows) { n2 <- ceiling(nr / 2) nr1 <- min(d[1], max(1L, n2)) #{rows} in 1st part nr2 <- max(1L, nr-n2) #{rows} in 2nd part nr <- nr1+nr2 # total #{rows} to be printed if(fitWidth) { ## one iteration of improving the width, by "fake printing" : cM <- formatSpMatrix(x[seq_len(nr1), , drop = FALSE], digits=digits, maxp=maxp, zero.print=zero.print, col.names=col.names, align=align, note.dropping.colnames=note.dropping.colnames, uniDiag=FALSE) ## width needed (without the 'col.trailer's 'nCc'): matW <- nchar(capture.output(print(cM, quote=FALSE, right=FALSE))[[1]]) needW <- matW + (if(suppCols) nCc else 0) if(needW > useW) { ## need more width op <- options(width = width+(needW-useW)) if(!setW) on.exit( options(op) ) } } printSpMatrix(x[seq_len(nr1), , drop=FALSE], digits=digits, maxp=maxp, zero.print=zero.print, col.names=col.names, note.dropping.colnames=note.dropping.colnames, uniDiag=uniDiag, col.trailer = col.trailer, align=align) suppTxt <- if(suppCols) gettextf("suppressing %d columns and %d rows", d[2]-nc , d[1]-nr) else gettextf("suppressing %d rows", d[1]-nr) cat("\n ..............................", "\n ........", suppTxt, sTxt, sep='') ## tail() automagically uses "[..,]" rownames: printSpMatrix(tail(x, nr2), digits=digits, maxp=maxp, zero.print=zero.print, col.names=col.names, note.dropping.colnames=note.dropping.colnames, uniDiag=FALSE, col.trailer = col.trailer, align=align) } else if(suppCols) { printSpMatrix(x[ , 1:nc , drop = FALSE], digits=digits, maxp=maxp, zero.print=zero.print, col.names=col.names, note.dropping.colnames=note.dropping.colnames, uniDiag=uniDiag, col.trailer = col.trailer, align=align) cat("\n .....", gettextf("suppressing %d columns", d[2]-nc), sTxt, sep='') } else stop("logic programming error in printSpMatrix2(), please report") invisible(x) } } ## printSpMatrix2 () setMethod("format", signature(x = "sparseMatrix"), formatSpMatrix) setMethod("print", signature(x = "sparseMatrix"), printSpMatrix2) setMethod("show", signature(object = "sparseMatrix"), function(object) printSpMatrix2(object)) ## For very large and very sparse matrices, the above show() ## is not really helpful; Use summary() showing "triplet" as an alternative: mat2triplet <- function(x, uniqT = FALSE) { T <- as(x, "TsparseMatrix") if(uniqT && anyDuplicatedT(T)) T <- .uniqTsparse(T) if(is(T, "nsparseMatrix")) list(i = T@i + 1L, j = T@j + 1L) else list(i = T@i + 1L, j = T@j + 1L, x = T@x) } setMethod("summary", signature(object = "sparseMatrix"), function(object, uniqT = FALSE, ...) { d <- dim(object) ## return a data frame (int, int, {double|logical|...}) : r <- as.data.frame(mat2triplet(object, uniqT=uniqT)) attr(r, "header") <- sprintf('%d x %d sparse Matrix of class "%s", with %d entries', d[1], d[2], class(object), nrow(r)) ## use ole' S3 technology for such a simple case class(r) <- c("sparseSummary", class(r)) r }) print.sparseSummary <- function (x, ...) { cat(attr(x, "header"),"\n") print.data.frame(x, ...) invisible(x) } ### FIXME [from ../TODO ]: Use cholmod_symmetry() -- ## Possibly even use 'option' as argument here for fast check to use sparse solve !! ##' This case should be particularly fast setMethod("isSymmetric", signature(object = "dgCMatrix"), function(object, tol = 100*.Machine$double.eps, ...) isTRUE(all.equal(.dgC.0.factors(object), t(object), tolerance = tol, ...))) setMethod("isSymmetric", signature(object = "sparseMatrix"), function(object, tol = 100*.Machine$double.eps, ...) { ## pretest: is it square? d <- dim(object) if(d[1] != d[2]) return(FALSE) ## else slower test using t() -- ## FIXME (for tol = 0): use cholmod_symmetry(A, 1, ...) ## for tol > 0 should modify cholmod_symmetry(..) to work with tol ## or slightly simpler, rename and export is_sym() in ../src/cs_utils.c if (is(object, "dMatrix")) ## use gC; "T" (triplet) is *not* unique! isTRUE(all.equal(.as.dgC.0.factors( object), .as.dgC.0.factors(t(object)), tolerance = tol, ...)) else if (is(object, "lMatrix")) ## test for exact equality; FIXME(?): identical() too strict? identical(as( object, "lgCMatrix"), as(t(object), "lgCMatrix")) else if (is(object, "nMatrix")) ## test for exact equality; FIXME(?): identical() too strict? identical(as( object, "ngCMatrix"), as(t(object), "ngCMatrix")) else stop("not yet implemented") }) setMethod("isTriangular", signature(object = "CsparseMatrix"), isTriC) setMethod("isTriangular", signature(object = "TsparseMatrix"), isTriT) ## no longer used for "Csparse*" which has own method in ./Csparse.R , nor ## for "Tsparse*" which has own method in ./Tsparse.R ... so only for Rsparse*? setMethod("isDiagonal", signature(object = "sparseMatrix"), function(object) { d <- dim(object) if(d[1] != d[2]) return(FALSE) ## else gT <- as(object, "TsparseMatrix") all(gT@i == gT@j) }) setMethod("determinant", signature(x = "sparseMatrix", logarithm = "missing"), function(x, logarithm, ...) determinant(x, logarithm = TRUE, ...)) setMethod("determinant", signature(x = "sparseMatrix", logarithm = "logical"), function(x, logarithm = TRUE, ...) determinant(as(x,"dsparseMatrix"), logarithm, ...)) setMethod("Cholesky", signature(A = "sparseMatrix"), function(A, perm = TRUE, LDL = !super, super = FALSE, Imult = 0, ...) Cholesky(as(A, "CsparseMatrix"), perm=perm, LDL=LDL, super=super, Imult=Imult, ...)) setMethod("diag", signature(x = "sparseMatrix"), function(x, nrow, ncol) diag(as(x, "CsparseMatrix"))) setMethod("dim<-", signature(x = "sparseMatrix", value = "ANY"), function(x, value) { if(!is.numeric(value) || length(value) != 2) stop("dim(.) value must be numeric of length 2") if(prod(dim(x)) != prod(value <- round(value))) # *not* as.integer ! stop("dimensions don't match the number of cells") ## be careful to keep things sparse r <- spV2M(as(x, "sparseVector"), nrow=value[1], ncol=value[2]) ## r now is "dgTMatrix" if(is(x, "CsparseMatrix")) as(r, "CsparseMatrix") else r }) setMethod("rep", "sparseMatrix", function(x, ...) rep(as(x, "sparseVector"), ...)) setMethod("norm", signature(x = "sparseMatrix", type = "character"), function(x, type, ...) { type <- toupper(substr(type[1], 1, 1)) switch(type, ## max(, 0) |--> 0 "O" = , "1" = max(colSums(abs(x)), 0), ## One-norm (L_1) "I" = max(rowSums(abs(x)), 0), ## L_Infinity "F" = sqrt(sum(x^2)), ## Frobenius "M" = max(abs(x), 0), ## Maximum modulus of all "2" = norm2(x), # maximal singular value ## otherwise: stop("invalid 'type'")) }) ## FIXME: need a version of LAPACK's rcond() algorithm, using sparse-arithmetic setMethod("rcond", signature(x = "sparseMatrix", norm = "character"), function(x, norm, useInv=FALSE, ...) { ## as workaround, allow use of 1/(norm(A) * norm(solve(A))) if(!identical(FALSE,useInv)) { Ix <- if(isTRUE(useInv)) solve(x) else if(is(useInv, "Matrix")) useInv return( 1/(norm(x, type=norm) * norm(Ix, type=norm)) ) } ## else d <- dim(x) ## FIXME: qr.R(qr(.)) warns about differing R (permutation!) ## really fix qr.R() *or* go via dense even in those cases rcond(if(d[1] == d[2]) { warning("rcond(.) via sparse -> dense coercion") as(x, "denseMatrix") } else if(d[1] > d[2]) qr.R(qr(x)) else qr.R(qr(t(x))), norm = norm, ...) }) setMethod("cov2cor", signature(V = "sparseMatrix"), function(V) { ## like stats::cov2cor() but making sure all matrices stay sparse p <- (d <- dim(V))[1] if (p != d[2]) stop("'V' is not a *square* matrix") if(!is(V, "dMatrix")) V <- as(V, "dMatrix")# actually "dsparseMatrix" Is <- sqrt(1/diag(V)) if (any(!is.finite(Is))) ## original had 0 or NA warning("diag(.) had 0 or NA entries; non-finite result is doubtful") Is <- Diagonal(x = Is) r <- Is %*% V %*% Is r[cbind(1:p,1:p)] <- 1 # exact in diagonal as(r, "symmetricMatrix") }) setMethod("is.na", signature(x = "sparseMatrix"),## NB: nsparse* have own method! function(x) { if(any((inax <- is.na(x@x)))) { cld <- getClassDef(class(x)) if(extends(cld, "triangularMatrix") && x@diag == "U") inax <- is.na((x <- .diagU2N(x, cld))@x) r <- as(x, "lMatrix") # will be "lsparseMatrix" - *has* x slot r@x <- if(length(inax) == length(r@x)) inax else is.na(r@x) if(!extends(cld, "CsparseMatrix")) r <- as(r, "CsparseMatrix") as(.Call(Csparse_drop, r, 0), "nMatrix") # a 'pattern matrix } else is.na_nsp(x) }) ## all.equal(): similar to all.equal_Mat() in ./Matrix.R ; ## ----------- eventually defer to "sparseVector" methods: setMethod("all.equal", c(target = "sparseMatrix", current = "sparseMatrix"), function(target, current, check.attributes = TRUE, ...) { msg <- attr.all_Mat(target, current, check.attributes=check.attributes, ...) if(is.list(msg)) msg[[1]] else .a.e.comb(msg, all.equal(as(target, "sparseVector"), as(current, "sparseVector"), check.attributes=check.attributes, ...)) }) setMethod("all.equal", c(target = "sparseMatrix", current = "ANY"), function(target, current, check.attributes = TRUE, ...) { msg <- attr.all_Mat(target, current, check.attributes=check.attributes, ...) if(is.list(msg)) msg[[1]] else .a.e.comb(msg, all.equal(as(target, "sparseVector"), current, check.attributes=check.attributes, ...)) }) setMethod("all.equal", c(target = "ANY", current = "sparseMatrix"), function(target, current, check.attributes = TRUE, ...) { msg <- attr.all_Mat(target, current, check.attributes=check.attributes, ...) if(is.list(msg)) msg[[1]] else .a.e.comb(msg, all.equal(target, as(current, "sparseVector"), check.attributes=check.attributes, ...)) }) setMethod("writeMM", "sparseMatrix", function(obj, file, ...) writeMM(as(obj, "CsparseMatrix"), as.character(file), ...)) ### --- sparse model matrix, fac2sparse, etc ----> ./spModels.R ### xtabs(*, sparse = TRUE) ---> part of standard package 'stats' since R 2.10.0 ##' @title Random Sparse Matrix ##' @param nrow, ##' @param ncol number of rows and columns, i.e., the matrix dimension ##' @param nnz number of non-zero entries ##' @param rand.x random number generator for 'x' slot ##' @param ... optionally further arguments passed to sparseMatrix() ##' @return a sparseMatrix of dimension (nrow, ncol) ##' @author Martin Maechler ##' @examples M1 <- rsparsematrix(1000, 20, nnz = 200) ##' summary(M1) if(FALSE) ## better version below rsparsematrix <- function(nrow, ncol, nnz, rand.x = function(n) signif(rnorm(nnz), 2), warn.nnz = TRUE, ...) { maxi.sample <- 2^31 # maximum n+1 for which sample(n) returns integer stopifnot((nnz <- as.integer(nnz)) >= 0, nrow >= 0, ncol >= 0, nnz <= nrow * ncol, nrow < maxi.sample, ncol < maxi.sample) ## to ensure that nnz is strictly followed, must act on duplicated (i,j): i <- sample.int(nrow, nnz, replace = TRUE) j <- sample.int(ncol, nnz, replace = TRUE) dim <- c(nrow, ncol) it <- 0 while((it <- it+1) < 100 && anyDuplicated(n.ij <- encodeInd2(i, j, dim, checkBnds=FALSE))) { m <- length(k.dup <- which(duplicated(n.ij))) Matrix.msg(sprintf("%3g duplicated (i,j) pairs", m), .M.level = 2) if(runif(1) <= 1/2) i[k.dup] <- sample.int(nrow, m, replace = TRUE) else j[k.dup] <- sample.int(ncol, m, replace = TRUE) } if(warn.nnz && it == 100 && anyDuplicated(encodeInd2(i, j, dim, checkBnds=FALSE))) warning("number of non zeros is smaller than 'nnz' because of duplicated (i,j)s") sparseMatrix(i = i, j = j, x = rand.x(nnz), dims = dim, ...) } ## No warn.nnz needed, as we sample the encoded (i,j) with*out* replacement: rsparsematrix <- function(nrow, ncol, density, nnz = round(density * maxE), symmetric = FALSE, rand.x = function(n) signif(rnorm(n), 2), ...) { maxE <- if(symmetric) nrow*(nrow+1)/2 else nrow*ncol stopifnot((nnz <- as.integer(nnz)) >= 0, nrow >= 0, ncol >= 0, nnz <= maxE) ## sampling with*out* replacement (replace=FALSE !): ijI <- -1L + if(symmetric) sample(indTri(nrow, diag=TRUE), nnz) else sample.int(maxE, nnz) ## i,j below correspond to ij <- decodeInd(code, nr) : if(is.null(rand.x)) sparseMatrix(i = ijI %% nrow, j = ijI %/% nrow, index1 = FALSE, symmetric = symmetric, dims = c(nrow, ncol), ...) else sparseMatrix(i = ijI %% nrow, j = ijI %/% nrow, index1 = FALSE, symmetric = symmetric, x = rand.x(nnz), dims = c(nrow, ncol), ...) } if(FALSE) ### FIXME: This would *NOT* be needed, if as.matrix() was a no-op ; ### ----- and then, base::scale() -> base::scale.default() would work "magically" already.. ## scale() is S3 generic in base scale.sparseMatrix <- function(x, center = FALSE, scale = TRUE) { if(center) warning("a sparseMatrix should rarely be centered: will not be sparse anymore") ## x <- as.matrix(x) ## This rest is *identically* == base :: scale.default : nc <- ncol(x) if (is.logical(center)) { if (center) { center <- colMeans(x, na.rm=TRUE) x <- sweep(x, 2L, center, check.margin=FALSE) } } else if (is.numeric(center) && (length(center) == nc)) x <- sweep(x, 2L, center, check.margin=FALSE) else stop("length of 'center' must equal the number of columns of 'x'") if (is.logical(scale)) { if (scale) { f <- function(v) { v <- v[!is.na(v)] sqrt(sum(v^2) / max(1, length(v) - 1L)) } scale <- apply(x, 2L, f) x <- sweep(x, 2L, scale, "/", check.margin=FALSE) } } else if (is.numeric(scale) && length(scale) == nc) x <- sweep(x, 2L, scale, "/", check.margin=FALSE) else stop("length of 'scale' must equal the number of columns of 'x'") if(is.numeric(center)) attr(x, "scaled:center") <- center if(is.numeric(scale)) attr(x, "scaled:scale") <- scale x } Matrix/R/abIndex.R0000644000176200001440000005666012622367447013446 0ustar liggesusers#### Methods for the "abIndex" := ``abstract Index'' class ### Note: this partly builds on ideas and code from Jens Oehlschlaegel, ### ---- as implemented (in the GPL'ed part of) package 'ff'. ## Basic idea: a vector x of integer indices often has long stretches ## i, i+1, i+2, ... such that diff(x) has stretches of '1'. ## Now keep x[1] =: first and diff(x) =: d, ## and use rle() to encode d. Here, use a C version for rle() rleMaybe <- function(i, force = FALSE) { ## TODO: move all this to a new C fnc., still keeping the *_i() and *_d() if(is.na(force <- as.logical(force))) stop("'force' must be (coercable to) TRUE or FALSE") int <- is.integer(i) || is.logical(i) || { i. <- suppressWarnings(as.integer(i)) if(r <- isTRUE(all(is.na(i) | i. == i))) i <- i. r } ## if(int), 'i' will be coerced to integer on C level ##N R-devel codetools get FP again: ##N Matrix.rle <- if(int) Matrix_rle_i else Matrix_rle_d ##N .Call(Matrix.rle, i, force) if(int) Matrix_rle_d <- Matrix_rle_i .Call(Matrix_rle_d, i, force) } .rle <- function(lengths, values) structure(list(lengths = lengths, values = values), class = "rle") ##' @param x ##' ##' @return diff(x), giving '0' for 'Inf - Inf' or similar .diff <- function(x) { ## TODO: considerably faster in C if((n <- length(x)) <= 1) return(x[0]) r <- (x1 <- x[-1]) - (x2 <- x[-n]) if(any(ina <- is.na(r))) r[ina & (x1 == x2 | (is.na(x1) & is.na(x2)))] <- 0 r } ##' @param from: logical or numeric vector ##' ##' @return an "abIndex" vector, "semantically equivalent" to 'from' vec2abI <- function(from, force = FALSE) { ans <- new("abIndex") r <- rleMaybe(.diff(from), force=force)## .diff(): also work for rep(Inf, *) if(is.null(r)) { ## no "compression" ans@kind <- if(is.integer(from)) "int32" else "double" ans@x <- from } else { ans@kind <- "rleDiff" ## ans@x <- integer(0) # <- prototype does that ans@rleD <- new("rleDiff", first = from[1], rle = r) } ans } ## "abIndex" version of indDiag(n) === which(diag(n) == 1) -> ./Auxiliaries.R abIindDiag <- function(n) { ## cumsum(c(1L, rep.int(n+1L, n-1))) stopifnot((n <- as.integer(n)) >= 1) rl <- if(n == 1) .rle(n[0],n[0]) else .rle(n-1L, n+1L) new("abIndex", kind = "rleDiff", rleD = new("rleDiff", first = 1, rle = rl)) } ## "abIndex" version of indTri(n) ... --> ./Auxiliaries.R abIindTri <- function(n, upper = TRUE, diag = FALSE) { ## Indices of strict upper/lower triangular part ## == which(upper.tri(diag(n), diag=diag) or ## which(lower.tri(diag(n), diag=diag) -- but as abIndex stopifnot(length(n) == 1, n == (n. <- as.integer(n)), (n <- n.) >= 0) if(n <= 2) { vec2abI( if(n == 0) integer(0) else if(n == 1) { if(diag) 1L else integer(0) } else { ## n == 2 v <- if(upper) 3L else 2L if(diag) c(1L, v, 4L) else v }) } else { ## n >= 3 [also for n == 2 && diag (==TRUE)] : ## First, compute the 'diff(.)' of the result [fast, using integers] n. <- if(diag) n else n - 1L n1 <- n. - 1L tt <- if(diag) 2L else 3L mk1s <- function(n,m) as.vector(rbind(1L, n:m)) mks1 <- function(n,m) as.vector(rbind(n:m, 1L)) rl <- .rle(lengths= if(upper) mk1s(1L,n1) else mks1(n1,1L), values = if(upper) mks1(n, tt) else mk1s(tt, n)) frst <- if(diag) 1L else if(upper) n+1L else 2L new("abIndex", kind = "rleDiff", rleD = new("rleDiff", first = frst, rle = rl)) } } setAs("numeric", "abIndex", function(from) vec2abI(from)) setAs("logical", "abIndex", function(from) vec2abI(from)) setMethod("show", "rleDiff", function(object) { cat(sprintf(## first can be 'NULL' --> cannot use %g " RLE difference (class 'rleDiff'): first = %s, \"rle\":%s", format(object@first), if(length(rl <- object@rle)) "\n" else " ")) print(rl, prefix = " ") invisible(object) }) setMethod("show", "abIndex", function(object) { knd <- object@kind cat(sprintf( "Abstract Index vector (class 'abIndex') of length %.0f, kind \"%s\"\n", length(object), knd)) if(knd == "rleDiff") { ### FIXME: show something like this is equivalent to c(2:10, 13:34, ...) cat(" and slot \"rleD\":\n") show(object@rleD) } else { cat(" and \"x\" slot\n") show(object@x) } invisible(object) }) ##' Constructor of "abIndex" version of n:m ##' @param from ##' @param to ##' ##' @return an "abIndex" object semantically equivalent to from:to abIseq1 <- function(from = 1, to = 1) { stopifnot(length(from) == 1L, length(to) == 1L) to <- to - from new("abIndex", kind="rleDiff", rleD = new("rleDiff", first = as.integer(from), rle = .rle(lengths = abs(to),# <- double : maybe > .Machine$integer.max values = as.integer(sign(to))))) } ## an "abIndex" version of seq(), i.e. seq.default(): abIseq <- function(from = 1, to = 1, by = ((to - from)/(length.out - 1)), length.out = NULL, along.with = NULL) { if((One <- nargs() == 1L) && !missing(from)) { lf <- length(from) return(if(mode(from) == "numeric" && lf == 1L) abIseq1(1L, from) else if(lf) abIseq1(1L, lf) else new("abIndex")) } if(!missing(along.with)) { length.out <- length(along.with) if(One) return(if(length.out) abIseq1(1L, length.out) else new("abIndex")) } else if(!missing(length.out)) length.out <- ceiling(length.out) if(is.null(length.out)) if(missing(by)) abIseq1(from,to) else { # dealing with 'by' del <- to - from if(del == 0 && to == 0) return(as(to, "abIndex")) n <- del/by if(!(length(n) && is.finite(n))) { if(length(by) && by == 0 && length(del) && del == 0) return(as(from, "abIndex")) stop("invalid (to - from)/by in seq(.)") } if(n < 0L) stop("wrong sign in 'by' argument") if(n > .Machine$integer.max) stop("'by' argument is much too small") dd <- abs(del)/max(abs(to), abs(from)) if (dd < 100*.Machine$double.eps) return(from) n <- as.integer(n + 1e-7) x <- from + abIseq1(0L,n) * by ## correct for overshot because of fuzz -- FIXME: need pmin() for "abIndex": if(by > 0) pmin(x, to) else pmax(x, to) } else if(!is.finite(length.out) || length.out < 0L) stop("length must be non-negative number") else if(length.out == 0L) new("abIndex") else if (One) abIseq1(1L, length.out) else if(missing(by)) { # if(from == to || length.out < 2) by <- 1 if(missing(to)) to <- from + length.out - 1L if(missing(from)) from <- to - length.out + 1L if(length.out > 2L) if(from == to) rep2abI(from, length.out) ## rep.int(from, length.out) else c(as(from,"abIndex"), from + abIseq1(1L, length.out - 2L) * by, to) else as(c(from, to)[seq_len(length.out)],"abIndex") } else if(missing(to)) from + abIseq1(0L, length.out - 1L) * by else if(missing(from)) to - abIseq1(length.out - 1L, 0L) * by else stop("too many arguments") } ##' rep.int(x, times) " as abIndex " ##' @param x numeric vector ##' @param times integer (valued) scalar: the number of repetitions ##' ##' @return an "abIndex" vector rep2abI <- function(x, times) { r <- new("abIndex") if((n <- length(x)) == 0) return(r) if(n == 1) { # clear case for compression r@kind <- "rleDiff" rD <- new("rleDiff") rD@first <- x[1L] rD@rle <- .rle(lengths = times - 1L, values = 0L) r@rleD <- rD } else { ## n >= 2 .. check if compression is worth it: ## .. say if compression of x itself is worth {FIXME? optimal cutoff} rr <- rleMaybe(.diff(x)) if(is.null(rr)) { r@kind <- if(is.integer(x)) "int32" else "double" r@x <- rep.int(x, times) } else { r@kind <- "rleDiff" rD <- new("rleDiff") rD@first <- x[1L] Dx <- x[1L] - x[length(x)] N <- (length(rr$lengths) + 1L)*times rD@rle <- .rle(lengths = rep.int(c(rr$lengths, 1L), times)[-N], values = rep.int(c(rr$values, Dx), times)[-N]) r@rleD <- rD } } r } combine_rleD <- function(rleList, m = length(rleList)) { ## Combine list of "rleDiff"s into a new one -- for c(..) ## auxiliary (and main working horse) for c.abIndex() ### TODO: really should do this in C i1 <- unlist(lapply(rleList, slot, "first")) rles <- lapply(rleList, slot, "rle") ## the list of vectors of 'lengths' and 'values' : lens <- lapply(rles, `[[`, "lengths") vals <- lapply(rles, `[[`, "values") ## the 'ends' are needed for the "jump sizes" in between: ends2 <- function(x) # related to ends.rleD() above x@first + c(0, with(x@rle, sum(lengths*values))) ends <- unlist(lapply(rleList, ends2))[-c(1, 2*m)] ii <- 2L*seq_len(m - 1) d.ends <- ends[ii] - ends[ii-1L] ## llen1 <- unlist(lapply(lens, length)) + 1L ## n <- sum(llen1) n <- m + sum(lengths(lens, use.names=FALSE)) ## comb(): intersperse x2[[j]] between lis[[j] & lis[[j+1]] : comb <- function(lis, x2) unlist(mapply(c, lis, x2, SIMPLIFY=FALSE, USE.NAMES=FALSE)) n.len <- comb(lens, 1L)[-n] n.val <- comb(vals, c(d.ends,NA))[-n] new("rleDiff", first = i1[1], rle = .rle(lengths = n.len, values = n.val)) } ## {combine_rleD} ## For now -- S4 method on c(), i.e., setMethod("c", ...) ## seems "difficult", and this works "magically" ## when the first argument is an abIndex : c.abIndex <- function(...) { m <- length(list(...)) if(m <= 1) return(if(m == 0) new("abIndex") else as(..1, "abIndex")) ## else: have length m >= 2 labi <- lapply(list(...), as, Class = "abIndex") knd <- unlist(lapply(labi, slot, "kind")) ## Convention: Result kind should be the 'kind' of the first neq.k <- knd != (k1 <- knd[1]) if(any(neq.k)) { if(all(not.rD <- knd != "rleDiff")) { ## either "double" or "int32" .. using 'x' k1 <- "double" ## and it will just work to c(.) the 'x' slots } else { warning("c(,..) of different kinds, coercing all to 'rleDiff'") labi[not.rD] <- lapply(labi[not.rD], function(av) vec2abI(av@x, force=TRUE)) k1 <- "rleDiff" } } switch(k1, "rleDiff" = { new("abIndex", kind="rleDiff", rleD = combine_rleD(lapply(labi, slot, "rleD"), m)) }, "double" =, "int32" = { new("abIndex", kind = k1, x = do.call(c, lapply(labi, slot, "x"))) }) } setMethod("length", "abIndex", function(x) if(identical(x@kind, "rleDiff")) sum(x@rleD@rle$lengths)+ 1L else length(x@x)) abI2num <- function(from) { switch(from@kind, "rleDiff" = { x <- from@rleD ## as inverse.rle(): cumsum(c(x@first, rep.int(x@rle$values, x@rle$lengths))) }, "int32" =, "double" = from@x) } setAs("abIndex", "numeric", abI2num) setAs("abIndex", "vector", abI2num) setAs("abIndex", "integer", function(from) as.integer(abI2num(from))) ## for S3 lovers and back-compatibility: setMethod(as.integer, "abIndex", function(x) as.integer(abI2num(x))) setMethod(as.numeric, "abIndex", function(x) abI2num(x)) setMethod("as.vector", "abIndex", function(x, mode) as.vector(abI2num(x), mode)) ## Need max(), min(), all( == ) any( == ) ## ---> Groups "Summary" and "Compare" (maybe all "Ops") ## For that, we really need "[" and/or "rep"() methods -- TODO -- ## setMethod("[", signature(x = "abIndex", i = "index"), function (x, i, j, ..., drop) { switch(x@kind, "rleDiff" = { ## FIXME ## intIv() in ./sparseVector.R -- not memory-efficient (??) ## n <- length(x) ## ii <- intIv(i, n) ## ii : 1-based integer indices ## d <- x@rleD ## Now work with the equivalent of ## cumsum(c(d@first, rep.int(d@rle$values, d@rle$lengths))) stop("[i] is not yet implemented") }, "int32" =, "double" = ## as it's not rle-packed, can remain simple: x@x[i]) }) ##' Endpoints of all linear stretches -- auxiliary for range(.) ##' @param x an "rleDiff" object ##' ##' @return numeric vector of end points of all linear stretches of x. ends.rleD <- function(x) { rl <- x@rle stopifnot(length(lens <- rl$lengths) == length(vals <- rl$values)) cumsum(c(x@first, lens*vals)) } ##' Collapse or "uniquify" an 'rle' object, i.e., ##' 1) drop 'lengths' 0 parts ##' 2) *merge* adjacent parts where 'values' are the same ##' ##' @param x an "rle" object ##' ##' @return an "rle" object, a "unique" version of the input 'x' rleCollapse <- function(x) { ## TODO: faster (and simpler!) in C ## TODO(2): move this to 'R base' L <- x$lengths V <- x$values chng <- FALSE if((chng <- any(i0 <- L == 0))) { ## drop 0 'lengths' parts L <- L[!i0] ; V <- V[!i0] } ## FIXME: This is not elegant nor efficient: while(any(i0 <- diff(V) == 0)) { ## merge adjacent parts with same values if(!chng) chng <- TRUE ## fix one stretch (and repeat), starting at ii0 and total length 1+ li0 ii0 <- which.max(i0)# index of first TRUE li0 <- if((l0 <- length(i0)) <= ii0) 1 else which.min(!i0[ii0:l0]) stopifnot(li0 >= 1)## <- for now L[ii0] <- sum(L[ii0+(0:li0)]) ii <- -(ii0 + seq_len(li0)) L <- L[ii] V <- V[ii] } if(chng) { x$lengths <- L ; x$values <- V } x } ## {rleCollapse} setMethod("drop", "abIndex", function(x) { if(x@kind == "rleDiff") x@rleD@rle <- rleCollapse(x@rleD@rle) x }) ## Summary: { max, min, range, prod, sum, any, all } : ## have 'summGener1' := those without prod, sum setMethod("Summary", signature(x = "abIndex", na.rm = "ANY"), function(x, ..., na.rm) { switch(x@kind, "rleDiff" = { d <- x@rleD if(.Generic %in% c("range","min","max")) { callGeneric(ends.rleD(d), ..., na.rm=na.rm) } else { ## "sum", "prod" : switch(.Generic, "all" = { ## these often, but *not* always come in pairs ## en <- ends.rleD(d) ## so maybe it does not really help! stop("all() is not yet implemented") ## all(c(d@first, d@rle$values), ..., na.rm=na.rm) }, "any" = any(c(d@first, d@rle$values), ..., na.rm=na.rm), "sum" = { stop("sum() is not yet implemented") }, "prod"= { stop("prod() is not yet implemented") }) } }, "int32" =, "double" = callGeneric(x@x, ..., na.rm = na.rm) ) }) ### "Ops" := sub-groups "Arith", "Compare", and "Logic" ## ## For now (*), only "Arith" does make sense ## --> keep "Ops" undefined and define "Arith" : ## ---- ## (*) : TODO: logical <-> abIndex --> "Compare" etc as well setMethod("Ops", signature(e1 = "abIndex", e2 = "abIndex"), function(e1, e2) { .bail.out.2(.Generic, class(e1), class(e2)) }) setMethod("Ops", signature(e1 = "abIndex", e2 = "ANY"), function(e1, e2) { .bail.out.2(.Generic, class(e1), class(e2)) }) setMethod("Ops", signature(e1 = "ANY", e2 = "abIndex"), function(e1, e2) { .bail.out.2(.Generic, class(e1), class(e2)) }) setMethod("Arith", signature(e1 = "abIndex", e2 = "abIndex"), function(e1, e2) { l1 <- length(e1) l2 <- length(e2) mM <- range(l1,l2) stop("not yet implemented") ## FIXME ------------------ if(mM[1] != mM[2]) { ## lengths differ if(mM[1] %% mM[2] != 0) ## identical warning as in main/arithmetic.c warning("longer object length\n\tis not a multiple of shorter object length") if(l1 < l2) { } else { ## l1 > l2 } } switch(e1@kind, "rleDiff" = { }, "int32" =, "double" = { }) }) ## numLike = {numeric, logical}: setMethod("Arith", signature(e1 = "abIndex", e2 = "numLike"), function(e1, e2) { if(!length(e1)) return(e1) if(e1@kind != "rleDiff") { # no compression e1@x <- callGeneric(e1@x, e2) if(e1@kind != "double" && is.double(e1@x)) e1@kind <- "double" return(e1) } if(length(e2) == 1) { ## scalar if(is.na(e2)) return(rep2abI(e2, length(e1))) ## else 'e2' is not NA and scalar switch(.Generic, "+" =, "-" = { e1@rleD@first <- callGeneric(e1@rleD@first, e2) e1 }, "*" = { e1@rleD@first <- e1@rleD@first * e2 r <- e1@rleD@rle$values * e2 if(is0(e2) && all0(r)) { ## result all 0: collapse e1@rleD@rle$values <- r[1L] e1@rleD@rle$lengths <- sum(e1@rleD@rle$lengths) } else ## normal case e1@rleD@rle$values <- r e1 }, "/" = { if(is0(e2) ## division by 0 && length(unique(sign(ends.rleD(e1@rleD)))) > 1) { ## at least one subsequence contains 0, i.e., changes sign: warning("x / 0 for an x with sign-change\n no longer representable as 'rleDiff'") return(vec2abI(abI2num(e1) / 0)) } e1@rleD@first <- e1@rleD@first / e2 e1@rleD@rle$values <- e1@rleD@rle$values / e2 e1 }, "^" = { if(e2 == 1) e1 else vec2abI(abI2num(e1) ^ e2) }, "%%" = , "%/%" = vec2abI(callGeneric(abI2num(e1), e2))) } else ## length(e2) != 1 callGeneric(e1, as(e2, "abIndex")) }) setMethod("Arith", signature(e1 = "numLike", e2 = "abIndex"), function(e1, e2) { if(!length(e2)) return(e2) if(e2@kind != "rleDiff") { # no compression e2@x <- callGeneric(e1, e2@x) if(e2@kind != "double" && is.double(e2@x)) e2@kind <- "double" return(e2) } if(length(e1) == 1) { ## scalar if(is.na(e1)) return(rep2abI(e1, length(e2))) ## else 'e1' is not NA and scalar switch(.Generic, "+" = { e2@rleD@first <- e1 + e2@rleD@first e2 }, "-" = { e2@rleD@first <- e1 - e2@rleD@first e2@rleD@rle$values <- -e2@rleD@rle$values e2 }, "*" = { e2@rleD@first <- e1 * e2@rleD@first r <- e1 * e2@rleD@rle$values if(is0(e1) && all0(r)) { ## result all 0: collapse e2@rleD@rle$values <- r[1L] e2@rleD@rle$lengths <- sum(e2@rleD@rle$lengths) } else ## normal case e2@rleD@rle$values <- r e2 }, "/" = , "^" =, "%%" = , "%/%" = vec2abI(callGeneric(e1, abI2num(e2)))) } else ## length(e1) != 1 callGeneric(as(e1, "abIndex"), e2) }) setMethod("is.na", signature(x = "abIndex"), function(x) { if(x@kind != "rleDiff") is.na(x@x) else { rd <- x@rleD rl <- rd@rle len <- 1+ sum(L <- rl$lengths) if(is.na(rd@first)) rep.int(TRUE, len) else { ## interesting case V <- rl$values if(!any(ina <- is.na(V))) rep.int(FALSE, len) else { ## at least one V is NA --> "x" is NA from then on: k <- match(TRUE,ina) # the first one l1 <- 1+ sum(L[seq_len(k-1)]) c(rep.int(FALSE, l1), rep.int(TRUE, len - l1)) } } } }) ## TODO ?? "is.nan" analogously ?? ## setMethod("is.finite", signature(x = "abIndex"), function(x) { if(x@kind != "rleDiff") is.finite(x@x) else { rd <- x@rleD rl <- rd@rle len <- 1+ sum(L <- rl$lengths) if(!is.finite(rd@first)) rep.int(FALSE, len) else { ## interesting case V <- rl$values if(all(iFin <- is.finite(V))) rep.int(TRUE, len) else { ## at least one V is +- Inf --> "x" is Inf/NaN from there k <- match(FALSE,iFin) # the first non-finite one l1 <- 1+ sum(L[seq_len(k-1)]) c(rep.int(TRUE, l1), rep.int(FALSE, len - l1)) } } } }) setMethod("is.infinite", signature(x = "abIndex"), function(x) { if(x@kind != "rleDiff") is.infinite(x@x) else { rd <- x@rleD rl <- rd@rle len <- 1+ sum(L <- rl$lengths) if(is.infinite(rd@first)) rep.int(TRUE, len) else { ## interesting case V <- rl$values if(!any(iInf <- is.infinite(V))) rep.int(FALSE, len) else { ## at least one V is +- Inf --> "x" is Inf/NaN from there k <- match(TRUE,iInf) # the first one l1 <- 1+ sum(L[seq_len(k-1)]) ## FIXME? do *not* consider 'NaN' (changing TRUE to FALSE): c(rep.int(FALSE, l1), rep.int(TRUE, len - l1)) } } } }) all.equal.abI <- function(target, current, ...) { if(!is(target, "abIndex") || !is(current, "abIndex")) return(paste0("target is ", data.class(target), ", current is ", data.class(current))) lt <- length(target) lc <- length(current) if(lt != lc) paste0("abIndex", ": lengths (", lt, ", ", lc, ") differ") else if(target@kind == current@kind) { all.equal.default(target, current, ...) } else ## different 'kinds' -- take "easy" exit: all.equal(abI2num(target), abI2num(current), ...) } ## {all.equal.abI} setMethod("all.equal", c(target = "abIndex", current = "abIndex"), all.equal.abI) setMethod("all.equal", c(target = "abIndex", current = "numLike"), function(target, current, ...) all.equal.abI(target, as(current, "abIndex"), ...)) setMethod("all.equal", c(target = "numLike", current = "abIndex"), function(target, current, ...) all.equal.abI(as(target, "abIndex"), current, ...)) ## Then I want something like get.ind.sel(.) [ ./Tsparse.R ] working, ## i.e. possibly match(i, , nomatch = 0) setAs("seqMat", "numeric", function(from) { do.call(c, lapply(seq_len(ncol(from)), function(j) seq(from=from[1L,j], to = from[2L,j]))) }) setAs("numeric", "seqMat", function(from) as(as(from, "abIndex"), "seqMat")) setAs("abIndex", "seqMat", function(from) { n <- length(from) d <- from@rleD va <- d@rle$values le <- d@rle$lengths m <- length(le) ## Now work the 'ends' are cumsum(c(d@first, le * va)) ## we need to care for the "length 1" stretches: if(any(nonPair <- le[2* seq_len(m2 <- m %/% 2)] != 1)) { m2 + n + va + nonPair # <- "dummy" using "unused" ## an "easy" (but not so efficient when 'm' is "large") ## way would be to "make these" into pairs, then work for that case... } ## use ~/R/MM/Pkg-ex/Matrix/abIndex-experi.R for trying things ... stop(" --> is not yet implemented") }) setAs("seqMat", "abIndex", function(from) { stop(" --> is not yet implemented") }) Matrix/R/SparseM-conv.R0000644000176200001440000000574512050202345014363 0ustar liggesusers####----------- Minimal conversion utilities <--> "SparseM" ### I. The "natural pairs" between the two packages: setAs("matrix.csr", "dgRMatrix", function(from) { new("dgRMatrix", x = from@ra, j = from@ja - 1L, p = from@ia - 1L, Dim = from@dimension) }) setAs("dgRMatrix", "matrix.csr", function(from) { new("matrix.csr", ra = from@x, ja = from@j + 1L, ia = from@p + 1L, dimension = from@Dim) }) setAs("matrix.csc", "dgCMatrix", function(from) { new("dgCMatrix", x = from@ra, i = from@ja - 1L, p = from@ia - 1L, Dim = from@dimension) }) setAs("dgCMatrix", "matrix.csc", function(from) { new("matrix.csc", ra = from@x, ja = from@i + 1L, ia = from@p + 1L, dimension = from@Dim) }) setAs("matrix.coo", "dgTMatrix", function(from) { new("dgTMatrix", x = from@ra, i = from@ia - 1L, j = from@ja - 1L, Dim = from@dimension) }) setAs("dgTMatrix", "matrix.coo", function(from) { new("matrix.coo", ra = from@x, ia = from@i + 1L, ja = from@j + 1L, dimension = from@Dim) }) ### II. Enable coercion to the ``favorite'' of each package; ### --- ---------------------------- ### i.e., "dgCMatrix" and "matrix.csr" setAs("dsparseMatrix", "matrix.csr", function(from) as(as(as(from, "RsparseMatrix"), "dgRMatrix"), "matrix.csr")) ## setAs("matrix.csr", "dgCMatrix", function(from) as(as(from, "dgRMatrix"), "CsparseMatrix")) setAs("matrix.coo", "dgCMatrix", function(from) as(as(from, "dgTMatrix"), "dgCMatrix")) ### also define the virtual coercions that we (should) advertize: setAs("matrix.csr", "RsparseMatrix", function(from) as(from, "dgRMatrix")) setAs("matrix.csc", "CsparseMatrix", function(from) as(from, "dgCMatrix")) setAs("matrix.coo", "TsparseMatrix", function(from) as(from, "dgTMatrix")) ## to "Csparse*" and "Tsparse*" should work for all sparse: setAs("matrix.csr", "CsparseMatrix", function(from) as(as(from, "dgRMatrix"), "CsparseMatrix")) setAs("matrix.coo", "CsparseMatrix", function(from) as(as(from, "dgTMatrix"), "CsparseMatrix")) setAs("matrix.csc", "TsparseMatrix", function(from) as(as(from, "dgCMatrix"), "TsparseMatrix")) setAs("matrix.csr", "TsparseMatrix", function(from) as(as(from, "dgRMatrix"), "TsparseMatrix")) ## Also *from* (our favorite) Csparse should work to all 3 SparseM setAs("CsparseMatrix", "matrix.csr", function(from) as(as(from, "RsparseMatrix"), "matrix.csr")) setAs("CsparseMatrix", "matrix.coo", function(from) as(as(from, "TsparseMatrix"), "matrix.coo")) setAs("CsparseMatrix", "matrix.csc", function(from) as(as(from, "dgCMatrix"), "matrix.csc")) ## Easy coercion: just always use as( , "Matrix") : setAs("matrix.csr", "Matrix", function(from) as(from, "CsparseMatrix")) # we favor! setAs("matrix.coo", "Matrix", function(from) as(from, "TsparseMatrix")) setAs("matrix.csc", "Matrix", function(from) as(from, "CsparseMatrix")) Matrix/R/lsTMatrix.R0000644000176200001440000000163512501023016013764 0ustar liggesusers#### Logical Sparse Symmetric Matrices in Triplet format ### contains = "lsparseMatrix" setAs("lsTMatrix", "matrix", function(from) as(as(from, "lgTMatrix"), "matrix")) setAs("lsTMatrix", "lgCMatrix", # for diag function(from) as(as(from, "lsCMatrix"), "lgCMatrix")) setAs("lsTMatrix", "lgTMatrix", function(from) .Call(lsTMatrix_as_lgTMatrix, from)) if(FALSE) # should use as(., "dMatrix") setAs("lsTMatrix", "dsTMatrix", function(from) new("dsTMatrix", i = from@i, j = from@j, uplo = from@uplo, x = as.double(from@x), # *not* just 1; from@x *can* have FALSE Dim = from@Dim, Dimnames = from@Dimnames)) setAs("lsTMatrix", "lsyMatrix", function(from) .Call(lsTMatrix_as_lsyMatrix, from)) setMethod("t", "lsTMatrix", function(x) new("lsTMatrix", Dim = x@Dim, Dimnames = x@Dimnames[2:1], i = x@j, j = x@i, x = x@x, uplo = if (x@uplo == "U") "L" else "U")) Matrix/R/nsCMatrix.R0000644000176200001440000000334112507007442013754 0ustar liggesusers#### Logical Symmetric Sparse Matrices in Compressed column-oriented format ### contains = "nsparseMatrix" setAs("nsCMatrix", "matrix", function(from) as(as(from, "ngCMatrix"), "matrix")) setAs("nsCMatrix", "ngCMatrix", function(from) .Call(Csparse_symmetric_to_general, from)) ## Specific conversions, should they be necessary. Better to convert as ## as(x, "TsparseMatrix") or as(x, "denseMatrix") setAs("nsCMatrix", "nsTMatrix", function(from) .Call(Csparse_to_Tsparse, from, FALSE)) ## Not needed, once we use "nCsparseMatrix" (-> ./ngCMatrix.R ): setAs("nsCMatrix", "dMatrix", .nC2d) setAs("nsCMatrix", "dsparseMatrix", .nC2d) setAs("nsCMatrix", "dsCMatrix", .nC2d) ## setAs("nsCMatrix", "lMatrix", .nC2l) setAs("nsCMatrix", "lsparseMatrix", .nC2l) setAs("nsCMatrix", "lsCMatrix", .nC2l) ## have rather tril() and triu() methods than ## setAs("nsCMatrix", "ntCMatrix", ....) setMethod("tril", "nsCMatrix", function(x, k = 0, ...) { if(x@uplo == "L" && k == 0) ## same internal structure + diag new("ntCMatrix", uplo = x@uplo, i = x@i, p = x@p, Dim = x@Dim, Dimnames = x@Dimnames) else tril(as(x, "ngCMatrix"), k = k, ...) }) setMethod("triu", "nsCMatrix", function(x, k = 0, ...) { if(x@uplo == "U" && k == 0) new("ntCMatrix", uplo = x@uplo, i = x@i, p = x@p, Dim = x@Dim, Dimnames = x@Dimnames) else triu(as(x, "ngCMatrix"), k = k, ...) }) setMethod("chol", signature(x = "nsCMatrix"), function(x, pivot=FALSE, ...) stop("temporarily disabled"))## FIXME ## Use more general method from CsparseMatrix class ## setMethod("t", signature(x = "nsCMatrix"), ## function(x) ## .Call(nsCMatrix_trans, x), ## valueClass = "nsCMatrix") Matrix/R/HBMM.R0000644000176200001440000001544213347205204012573 0ustar liggesusers## Utilities for the Harwell-Boeing and MatrixMarket formats readone <- function(ln, iwd, nper, conv) { ln <- gsub("D", "E", ln) inds <- seq(0, by = iwd, length = nper + 1) (conv)(substring(ln, 1 + inds[-length(inds)], inds[-1])) } readmany <- function(conn, nlines, nvals, fmt, conv) { if (!grep("[[:digit:]]+[DEFGI][[:digit:]]+", fmt)) stop("Not a valid format") Iind <- regexpr('[DEFGI]', fmt) nper <- as.integer(substr(fmt, regexpr('[[:digit:]]+[DEFGI]', fmt), Iind - 1)) iwd <- as.integer(substr(fmt, Iind + 1, regexpr('[\\.\\)]', fmt) - 1)) rem <- nvals %% nper full <- nvals %/% nper ans <- vector("list", nvals %/% nper) for (i in seq_len(full)) ans[[i]] <- readone(readLines(conn, 1, ok = FALSE), iwd, nper, conv) if (!rem) return(unlist(ans)) c(unlist(ans), readone(readLines(conn, 1, ok = FALSE), iwd, rem, conv)) } readHB <- function(file) { if (is.character(file)) file <- if (file == "") stdin() else file(file) if (!inherits(file, "connection")) stop("'file' must be a character string or connection") if (!isOpen(file)) { open(file) on.exit(close(file)) } hdr <- readLines(file, 4, ok = FALSE) ## Title <- sub('[[:space:]]+$', '', substr(hdr[1], 1, 72)) ## Key <- sub('[[:space:]]+$', '', substr(hdr[1], 73, 80)) ## totln <- as.integer(substr(hdr[2], 1, 14)) ptrln <- as.integer(substr(hdr[2], 15, 28)) indln <- as.integer(substr(hdr[2], 29, 42)) valln <- as.integer(substr(hdr[2], 43, 56)) rhsln <- as.integer(substr(hdr[2], 57, 70)) if (!(t1 <- substr(hdr[3], 1, 1)) %in% c('C', 'R', 'P')) stop(gettextf("Invalid storage type: %s", t1), domain=NA) if (t1 != 'R') stop("Only numeric sparse matrices allowed") ## _FIXME: Patterns should also be allowed if (!(t2 <- substr(hdr[3], 2, 2)) %in% c('H', 'R', 'S', 'U', 'Z')) stop(gettextf("Invalid storage format: %s", t2), domain=NA) if (!(t3 <- substr(hdr[3], 3, 3)) %in% c('A', 'E')) stop(gettextf("Invalid assembled indicator: %s", t3), domain=NA) nr <- as.integer(substr(hdr[3], 15, 28)) nc <- as.integer(substr(hdr[3], 29, 42)) nz <- as.integer(substr(hdr[3], 43, 56)) ## nel <- as.integer(substr(hdr[3], 57, 70)) ptrfmt <- toupper(sub('[[:space:]]+$', '', substr(hdr[4], 1, 16))) indfmt <- toupper(sub('[[:space:]]+$', '', substr(hdr[4], 17, 32))) valfmt <- toupper(sub('[[:space:]]+$', '', substr(hdr[4], 33, 52))) ## rhsfmt <- toupper(sub('[[:space:]]+$', '', substr(hdr[4], 53, 72))) if (!is.na(rhsln) && rhsln > 0) readLines(file, 1, ok = FALSE) # h5 ptr <- readmany(file, ptrln, nc + 1, ptrfmt, as.integer) ind <- readmany(file, indln, nz, indfmt, as.integer) vals <- readmany(file, valln, nz, valfmt, as.numeric) if (t2 == 'S') new("dsCMatrix", uplo = "L", p = ptr - 1L, i = ind - 1L, x = vals, Dim = c(nr, nc)) else new("dgCMatrix", p = ptr - 1L, i = ind - 1L, x = vals, Dim = c(nr, nc)) } readMM <- function(file) { if (is.character(file)) file <- if(file == "") stdin() else file(file) if (!inherits(file, "connection")) stop("'file' must be a character string or connection") if (!isOpen(file)) { open(file) on.exit(close(file)) } scan1 <- function(what, ...) scan(file, nmax = 1, what = what, quiet = TRUE, ...) if (scan1(character()) != "%%MatrixMarket")# hdr stop("file is not a MatrixMarket file") if (!(typ <- tolower(scan1(character()))) %in% "matrix") stop(gettextf("type '%s' not recognized", typ), domain = NA) if (!(repr <- tolower(scan1(character()))) %in% c("coordinate", "array")) stop(gettextf("representation '%s' not recognized", repr), domain = NA) elt <- tolower(scan1(character())) if (!elt %in% c("real", "complex", "integer", "pattern")) stop(gettextf("element type '%s' not recognized", elt), domain = NA) sym <- tolower(scan1(character())) if (!sym %in% c("general", "symmetric", "skew-symmetric", "hermitian")) stop(gettextf("symmetry form '%s' not recognized", sym), domain = NA) nr <- scan1(integer(), comment.char = "%") nc <- scan1(integer()) nz <- scan1(integer()) checkIJ <- function(els) { if(any(els$i < 1 | els$i > nr)) stop("readMM(): row values 'i' are not in 1:nr", call.=FALSE) if(any(els$j < 1 | els$j > nc)) stop("readMM(): column values 'j' are not in 1:nc", call.=FALSE) } if (repr == "coordinate") { switch(elt, "real" = , "integer" = { ## TODO: the "integer" element type should be returned as ## an object of an "iMatrix" subclass--once there are els <- scan(file, nmax = nz, quiet = TRUE, what= list(i= integer(), j= integer(), x= numeric())) checkIJ(els) switch(sym, "general" = { new("dgTMatrix", Dim = c(nr, nc), i = els$i - 1L, j = els$j - 1L, x = els$x) }, "symmetric" = { new("dsTMatrix", uplo = "L", Dim = c(nr, nc), i = els$i - 1L, j = els$j - 1L, x = els$x) }, "skew-symmetric" = { stop("symmetry form 'skew-symmetric' not yet implemented for reading") ## FIXME: use dgT... but must expand the (i,j,x) slots! new("dgTMatrix", uplo = "L", Dim = c(nr, nc), i = els$i - 1L, j = els$j - 1L, x = els$x) }, "hermitian" = { stop("symmetry form 'hermitian' not yet implemented for reading") }, ## otherwise (not possible; just defensive programming): stop(gettextf("symmetry form '%s' is not yet implemented", sym), domain = NA) ) }, "pattern" = { els <- scan(file, nmax = nz, quiet = TRUE, what = list(i = integer(), j = integer())) checkIJ(els) switch(sym, "general" = { new("ngTMatrix", Dim = c(nr, nc), i = els$i - 1L, j = els$j - 1L) }, "symmetric" = { new("nsTMatrix", uplo = "L", Dim = c(nr, nc), i = els$i - 1L, j = els$j - 1L) }, "skew-symmetric" = { stop("symmetry form 'skew-symmetric' not yet implemented for reading") ## FIXME: use dgT... but must expand the (i,j,x) slots! new("ngTMatrix", uplo = "L", Dim = c(nr, nc), i = els$i - 1L, j = els$j - 1L) }, "hermitian" = { stop("symmetry form 'hermitian' not yet implemented for reading") }, ## otherwise (not possible; just defensive programming): stop(gettextf("symmetry form '%s' is not yet implemented", sym), domain = NA) ) }, "complex" = { stop("element type 'complex' not yet implemented") }, ## otherwise (not possible currently): stop(gettextf("'%s()' is not yet implemented for element type '%s'", "readMM", elt), domain = NA)) } else stop(gettextf("'%s()' is not yet implemented for representation '%s'", "readMM", repr), domain = NA) } Matrix/R/lgTMatrix.R0000644000176200001440000000371712475031340013764 0ustar liggesusers#### Logical Sparse Matrices in triplet format ### contains = "lsparseMatrix" ### ============= ---> superclass methods in ./lsparseMatrix.R setAs("lgTMatrix", "lgeMatrix", function(from) .Call(lgTMatrix_to_lgeMatrix, from)) setAs("lgTMatrix", "matrix", function(from) .Call(lgTMatrix_to_matrix, from)) ## setAs("lgTMatrix", "matrix", # go via fast C code: ## function(from) as(as(from, "lgCMatrix"), "matrix")) setAs("matrix", "lgTMatrix", function(from) { stopifnot(is.logical(from)) dn <- dimnames(from) if(is.null.DN(dn)) dn <- list(NULL,NULL) else dimnames(from) <- NULL TorNA <- is.na(from) | from ij <- which(TorNA, arr.ind = TRUE, useNames = FALSE) - 1L if(length(ij) == 0) ij <- matrix(ij, 0, 2) new("lgTMatrix", i = ij[,1], j = ij[,2], x = from[TorNA], Dim = as.integer(dim(from)), Dimnames = dn) }) setAs("lgTMatrix", "dgTMatrix", function(from) ## more efficient than ## as(as(as(sM, "lgCMatrix"), "dgCMatrix"), "dgTMatrix") new("dgTMatrix", i = from@i, j = from@j, x = as.double(from@x), ## cannot copy factors, but can we use them? Dim = from@Dim, Dimnames= from@Dimnames)) setAs("lgTMatrix", "triangularMatrix", function(from) check.gT2tT(from, toClass = "ltTMatrix", do.n=FALSE)) setAs("lgTMatrix", "ltTMatrix", function(from) check.gT2tT(from, toClass = "ltTMatrix", do.n=FALSE)) setAs("lgTMatrix", "symmetricMatrix", function(from) check.gT2sT(from, toClass = "lsTMatrix", do.n=FALSE)) ## We favor coercion to super-classes, here, "symmetricMatrix" ## setAs("lgTMatrix", "lsTMatrix", ## function(from) check.gT2sT(from, toClass = "lsTMatrix", do.n=FALSE)) if(FALSE) ## unneeded: use t. setMethod("t", signature(x = "lgTMatrix"), function(x) new("lgTMatrix", i = x@j, j = x@i, x = x@x, Dim = x@Dim[2:1], Dimnames= x@Dimnames[2:1]), valueClass = "lgTMatrix") Matrix/R/Hilbert.R0000644000176200001440000000027110615611763013441 0ustar liggesusersHilbert <- function(n) { ## generate the Hilbert matrix of dimension n n <- as.integer(n) i <- seq_len(n) new("dpoMatrix", x = c(1/outer(i - 1L, i, "+")), Dim = c(n,n)) } Matrix/R/ndenseMatrix.R0000644000176200001440000001422713047113565014516 0ustar liggesusers#### "ndenseMatrix" - virtual class of nonzero pattern dense matrices #### ------------ #### Contains nge*; ntr*, ntp*; nsy*, nsp*; ndi* ### NOTA BENE: Much of this is *very* parallel to ./ldenseMatrix.R ### ~~~~~~~~~~~~~~~~ ## packed <-> non-packed : setAs("nspMatrix", "nsyMatrix", ## 1L for "n*", 0L for "l*" : vv nsp2nsy <- function(from) .Call(lspMatrix_as_lsyMatrix, from, 1L)) setAs("nsyMatrix", "nspMatrix", nsy2nsp <- function(from) .Call(lsyMatrix_as_lspMatrix, from, 1L)) setAs("ntpMatrix", "ntrMatrix", ntp2ntr <- function(from) .Call(ltpMatrix_as_ltrMatrix, from, 1L)) setAs("ntrMatrix", "ntpMatrix", ntr2ntp <- function(from) .Call(ltrMatrix_as_ltpMatrix, from, 1L)) ## Nonzero Pattern -> Double {of same structure}: setAs("ngeMatrix", "dgeMatrix", function(from) n2d_Matrix(from, "ngeMatrix")) setAs("nsyMatrix", "dsyMatrix", function(from) n2d_Matrix(from, "nsyMatrix")) setAs("nspMatrix", "dspMatrix", function(from) n2d_Matrix(from, "nspMatrix")) setAs("ntrMatrix", "dtrMatrix", function(from) n2d_Matrix(from, "ntrMatrix")) setAs("ntpMatrix", "dtpMatrix", function(from) n2d_Matrix(from, "ntpMatrix")) setAs("ndenseMatrix", "ldenseMatrix", function(from) n2l_Matrix(from)) setAs("ngeMatrix", "lgeMatrix", function(from) n2l_Matrix(from, "ngeMatrix")) setAs("nsyMatrix", "lsyMatrix", function(from) n2l_Matrix(from, "nsyMatrix")) setAs("nspMatrix", "lspMatrix", function(from) n2l_Matrix(from, "nspMatrix")) setAs("ntrMatrix", "ltrMatrix", function(from) n2l_Matrix(from, "ntrMatrix")) setAs("ntpMatrix", "ltpMatrix", function(from) n2l_Matrix(from, "ntpMatrix")) ## all need be coercable to "ngeMatrix": setAs("nsyMatrix", "ngeMatrix", nsy2nge <- function(from) .Call(lsyMatrix_as_lgeMatrix, from, 1L)) setAs("ntrMatrix", "ngeMatrix", ntr2nge <- function(from) .Call(ltrMatrix_as_lgeMatrix, from, 1L)) setAs("ntpMatrix", "ngeMatrix", function(from) ntr2nge(ntp2ntr(from))) setAs("nspMatrix", "ngeMatrix", function(from) nsy2nge(nsp2nsy(from))) ## and the reverse setAs("ngeMatrix", "ntpMatrix", function(from) ntr2ntp(as(from, "ntrMatrix"))) setAs("ngeMatrix", "nspMatrix", function(from) nsy2nsp(as(from, "nsyMatrix"))) ### -> symmetric : setAs("ngeMatrix", "nsyMatrix", function(from) { if(isSymmetric(from)) new("nsyMatrix", x = from@x, Dim = from@Dim, Dimnames = from@Dimnames, factors = from@factors) else stop("not a symmetric matrix; consider forceSymmetric() or symmpart()") }) setAs("ngeMatrix", "ntrMatrix", function(from) { if(isT <- isTriangular(from)) new("ntrMatrix", x = from@x, Dim = from@Dim, Dimnames = from@Dimnames, uplo = attr(isT, "kind") %||% "U") ## TODO: also check 'diag' else stop("not a triangular matrix") }) ### ldense* <-> "matrix" : ## 1) "nge* : setAs("ngeMatrix", "matrix", ge2mat) setAs("matrix", "ngeMatrix", function(from) { new("ngeMatrix", x = as.logical(from), Dim = as.integer(dim(from)), Dimnames = .M.DN(from)) }) ## 2) base others on "nge*": setAs("matrix", "nsyMatrix", function(from) as(as(from, "ngeMatrix"), "nsyMatrix")) setAs("matrix", "nspMatrix", function(from) nsy2nsp(as(from, "nsyMatrix"))) setAs("matrix", "ntrMatrix", function(from) as(as(from, "ngeMatrix"), "ntrMatrix")) setAs("matrix", "ntpMatrix", function(from) ntr2ntp(as(from, "ntrMatrix"))) ## Useful if this was called e.g. for as(*, "nsyMatrix"), but it isn't setAs("matrix", "ndenseMatrix", function(from) as(from, "ngeMatrix")) setAs("ndenseMatrix", "matrix", ## uses the above l*M. -> lgeM. function(from) as(as(from, "ngeMatrix"), "matrix")) ## dense |-> compressed : ## go via "l" because dense_to_Csparse can't be used for "n" [missing CHOLMOD function] setAs("ndenseMatrix", "CsparseMatrix", function(from) as(as(as(from, "lMatrix"), "CsparseMatrix"), "nMatrix")) setAs("ndenseMatrix", "nsparseMatrix", function(from) as(as(as(from, "lMatrix"), "sparseMatrix"), "nMatrix")) setAs("ndenseMatrix", "sparseMatrix", function(from) as(from, "nsparseMatrix")) setAs("ndenseMatrix", "TsparseMatrix", function(from) { if(is(from, "generalMatrix")) { ## cheap but not so efficient: ij <- which(as(from,"matrix"), arr.ind = TRUE, useNames = FALSE) - 1L new("ngTMatrix", i = ij[,1], j = ij[,2], Dim = from@Dim, Dimnames = from@Dimnames, factors = from@factors) } else ## triangular or symmetric (have *no* diagonal nMatrix) ## is delicate {packed or not, upper /lower indices ..} -> easy way as(as(as(from, "lMatrix"), "TsparseMatrix"), "nMatrix") }) ## Not sure, if these are needed or more efficient than the above: ## First one probably is setAs("ngeMatrix", "ngTMatrix", function(from) { ## cheap but not so efficient: ij <- which(as(from,"matrix"), arr.ind = TRUE, useNames = FALSE) - 1L new("ngTMatrix", i = ij[,1], j = ij[,2], Dim = from@Dim, Dimnames = from@Dimnames, factors = from@factors) }) setAs("ngeMatrix", "ngCMatrix", function(from) as(as(from, "ngTMatrix"), "ngCMatrix")) setMethod("as.logical", signature(x = "ndenseMatrix"), function(x, ...) as(x, "ngeMatrix")@x) ###---------------------------------------------------------------------- setMethod("t", signature(x = "ngeMatrix"), t_geMatrix) setMethod("t", signature(x = "ntrMatrix"), t_trMatrix) setMethod("t", signature(x = "nsyMatrix"), t_trMatrix) setMethod("t", signature(x = "ntpMatrix"), function(x) as(t(as(x, "ntrMatrix")), "ntpMatrix")) setMethod("t", signature(x = "nspMatrix"), function(x) as(t(as(x, "nsyMatrix")), "nspMatrix")) ## NOTE: "&" and "|" are now in group "Logic" c "Ops" --> ./Ops.R ## "!" is in ./not.R setMethod("as.vector", "ndenseMatrix", function(x, mode) as.vector(as(x, "ngeMatrix")@x, mode)) setMethod("norm", signature(x = "ndenseMatrix", type = "character"), function(x, type, ...) if(identical("2", type)) norm2(x) else .Call(dgeMatrix_norm, as(as(x,"dMatrix"),"dgeMatrix"), type), valueClass = "numeric") setMethod("rcond", signature(x = "ndenseMatrix", norm = "character"), .rcond_via_d, valueClass = "numeric") Matrix/R/bandSparse.R0000644000176200001440000000746513711014657014145 0ustar liggesusersbandSparse <- function(n, m = n, k, diagonals, symmetric = FALSE, repr = "C", giveCsparse = (repr == "C")) { ## Purpose: Compute a band-matrix by speciyfying its (sub-)diagonal(s) ## ---------------------------------------------------------------------- ## Arguments: (n,m) : Matrix dimension ## k : integer vector of "diagonal numbers", with identical ## meaning as in band(*, k) ## diagonals: (optional!) list of (sub/super)diagonals ## symmetric: if TRUE, specify only upper or lower triangle; ## ---------------------------------------------------------------------- ## Author: Martin Maechler, Date: 20 Feb 2009, 22:42 if(use.x <- !missing(diagonals)) # when specified, must be matrix or list diag.isMat <- is.matrix(diagonals) len.k <- length(k) stopifnot(!use.x || is.list(diagonals) || diag.isMat, k == as.integer(k), n == as.integer(n), m == as.integer(m)) k <- as.integer(k) n <- as.integer(n) m <- as.integer(m) stopifnot(n >= 0, m >= 0, -n+1 <= (mik <- min(k)), (mak <- max(k)) <= m - 1) if(missing(repr) && !giveCsparse) { warning("'giveCsparse' has been deprecated; setting 'repr = \"T\"' for you") repr <- "T" } else if(!missing(repr) && !missing(giveCsparse)) warning("'giveCsparse' has been deprecated; will use 'repr' instead") if(use.x) { if(diag.isMat) { if(ncol(diagonals) != len.k) stop(gettextf("'diagonals' matrix must have %d columns (= length(k) )", len.k), domain=NA) getD <- function(j) diagonals[,j] } else { ## is.list(diagonals): if(length(diagonals) != len.k) stop(gettextf("'diagonals' must have the same length (%d) as 'k'", len.k), domain=NA) getD <- function(j) diagonals[[j]] } } sqr <- n == m if(symmetric) { if(!sqr) stop("matrix can only be symmetric if square, but n != m") if(mik < 0 && mak > 0) stop("for symmetric band matrix, only specify upper or lower triangle\n hence, all k must have the same sign") } else tri <- sqr && sign(mik)*sign(mak) >= 0 # triangular result dims <- c(n,m) k.lengths <- ## This is a bit "ugly"; I got the cases "by inspection" if(n >= m) { ifelse(k >= m-n, m - pmax(0,k), n+k) } else { ## n < m (?? k >= -n+1 always !!) ifelse(k >= -n+1, n + pmin(0,k), m-k) } i <- j <- integer(sum(k.lengths)) if(use.x) x <- if(len.k > 0) # carefully getting correct type/mode rep.int(getD(1)[1], length(i)) off.i <- 0L for(s in seq_len(len.k)) { kk <- k[s] ## *is* integer l.kk <- k.lengths[s] ## == length of (sub-)diagonal kk ii1 <- seq_len(l.kk) ind <- ii1 + off.i if(kk >= 0) { i[ind] <- ii1 j[ind] <- ii1 + kk } else { ## k < 0 i[ind] <- ii1 - kk j[ind] <- ii1 } if(use.x) { xx <- getD(s) if(length(xx) < l.kk) warning(gettextf("the %d-th (sub)-diagonal (k = %d) is too short; filling with NA's", s, kk), domain=NA) x[ind] <- xx[ii1] } off.i <- off.i + l.kk } if(symmetric) { ## we should have smarter sparseMatrix() UpLo <- if(min(k) >= 0) "U" else "L" T <- if(use.x) { if(is.integer(x)) x <- as.double(x) cc <- paste0(.M.kind(x), "sTMatrix") new(cc, i= i-1L, j= j-1L, x = x, Dim= dims, uplo=UpLo) } else new("nsTMatrix", i= i-1L, j= j-1L, Dim= dims, uplo=UpLo) switch(repr, "C" = as(T, "CsparseMatrix"), "T" = T,# TsparseMatrix "R" = as(T, "RsparseMatrix"), stop("invalid 'repr'; must be \"C\", \"T\", or \"R\"")) } else { ## not symmetric, possibly triangular if(use.x) sparseMatrix(i=i, j=j, x=x, dims=dims, triangular=tri, repr=repr) else sparseMatrix(i=i, j=j, dims=dims, triangular=tri, repr=repr) } } Matrix/R/ngCMatrix.R0000644000176200001440000000203113253131430013725 0ustar liggesusers#### Logical Sparse Matrices in Compressed column-oriented format ### contains = "nsparseMatrix" .nC2d <- function(from) .Call(nz_pattern_to_Csparse, from, 0L)## 0 --> "double" .nC2l <- function(from) .Call(nz_pattern_to_Csparse, from, 1L)## 1 --> "logical" if(FALSE) { ## nice idea, but needs more method re-definitions --- setAs("nCsparseMatrix", "dMatrix", .nC2d) setAs("nCsparseMatrix", "dsparseMatrix", .nC2d) setAs("nCsparseMatrix", "dgCMatrix", .nC2d) setAs("nCsparseMatrix", "lMatrix", .nC2l) setAs("nCsparseMatrix", "lsparseMatrix", .nC2l) setAs("nCsparseMatrix", "lgCMatrix", .nC2l) } else { setAs("ngCMatrix", "dMatrix", .nC2d) setAs("ngCMatrix", "dsparseMatrix", .nC2d) setAs("ngCMatrix", "dgCMatrix", .nC2d) setAs("ngCMatrix", "lMatrix", .nC2l) setAs("ngCMatrix", "lsparseMatrix", .nC2l) setAs("ngCMatrix", "lgCMatrix", .nC2l) } setAs("ngCMatrix", "matrix", function(from) .Call(ngC_to_matrix, from)) ## not this: .Call(Csparse_to_matrix, from)), since it goes via dense -> double precision setAs("matrix", "ngCMatrix", .m2ngC) Matrix/R/triangularMatrix.R0000644000176200001440000000457113774675543015433 0ustar liggesusers#### Methods for the virtual class 'triangularMatrix' of triangular matrices #### Note that specific methods are in (8 different) ./?t?Matrix.R setAs("triangularMatrix", "symmetricMatrix", function(from) as(as(from, "generalMatrix"), "symmetricMatrix")) setAs("dgeMatrix", "triangularMatrix", function(from) asTri(from, "dtrMatrix")) setAs("lgeMatrix", "triangularMatrix", function(from) asTri(from, "ltrMatrix")) setAs("ngeMatrix", "triangularMatrix", function(from) asTri(from, "ntrMatrix")) setAs("matrix", "triangularMatrix", function(from) mat2tri(from)) .tril.tr <- function(x, k = 0, ...) { # are always square k <- as.integer(k[1]) dd <- dim(x) stopifnot(-dd[1] <= k, k <= dd[1]) # had k <= 0 if(k == 0 && x@uplo == "L") x else { ## more to do if(x@diag == "U") x <- .diagU2N(x, class(x), checkDense = TRUE) callNextMethod() } } .triu.tr <- function(x, k = 0, ...) { # are always square k <- as.integer(k[1]) dd <- dim(x) stopifnot(-dd[1] <= k, k <= dd[1]) # had k >= 0 if(k == 0 && x@uplo == "U") x else { ## more to do if(x@diag == "U") x <- .diagU2N(x, class(x), checkDense = TRUE) callNextMethod() } } ## In order to evade method dispatch ambiguity (with [CTR]sparse* and ddense*), ## but still remain "general" ## we use this hack instead of signature x = "triangularMatrix" : trCls <- names(getClass("triangularMatrix")@subclasses) trCls. <- trCls[grep(".t.Matrix", trCls)] # not "*Cholesky", "*Kaufman" .. for(cls in trCls.) { setMethod("tril", cls, .tril.tr) setMethod("triu", cls, .triu.tr) } ## ditto here: isTriTri <- function(x, upper=NA) { if(is.na(upper)) structure(TRUE, kind=x@uplo) else if(upper) x@uplo == "U" else x@uplo == "L" } for(cls in trCls) setMethod("isTriangular", signature(object = cls), function(object, upper=NA, ...) isTriTri(object, upper)) ## instead of just for .... signature(object = "triangularMatrix") rm(trCls, trCls., cls) cholTrimat <- function(x, ...) { if(isDiagonal(x)) cholDiag(as(x, "diagonalMatrix"), ...) else stop("'x' is not symmetric -- chol() undefined.") } setMethod("chol", signature(x = "dtCMatrix"), cholTrimat) setMethod("chol", signature(x = "dtTMatrix"), cholTrimat) setMethod("chol", signature(x = "dtRMatrix"), cholTrimat) ## setMethod("chol", signature(x = "triangularMatrix"), cholTrimat) Matrix/R/MatrixFactorization.R0000644000176200001440000000241710772211561016051 0ustar liggesusers#### The "mother" of all Matrix factorizations ## use a "fits all" bail-out method -- eventually this should not happen anymore setMethod("expand", "MatrixFactorization", function(x, ...) .bail.out.1(.Generic, class(x))) setMethod("show", "MatrixFactorization", function(object) { ## cheap one -- can have better for sub-classes ## cl <- class(object) ## cat(sprintf("'MatrixFactorization' of class \"%s\"\n", cl)) cat("'MatrixFactorization' of ") str(object) }) setMethod("show", "BunchKaufman", function(object) { cat("'Bunch-Kaufman' factorization of ") str(object) }) setMethod("show", "pBunchKaufman", function(object) { cat("packed 'Bunch-Kaufman' factorization of ") str(object) }) setMethod("dim", "MatrixFactorization", function(x) x@Dim) ## e.g., for (CHMfactor, ): setMethod("solve", signature(a = "MatrixFactorization", b = "numeric"), function(a, b, ...) callGeneric(a, Matrix(b))) ## catch others, otherwise base::solve is. setMethod("solve", signature(a = "MatrixFactorization", b = "ANY"), function(a, b, ...) .bail.out.2("solve", class(a), class(b))) setMethod("solve", signature(a = "MatrixFactorization", b = "missing"), function(a, b, ...) .bail.out.1("solve", class(a))) Matrix/R/dMatrix.R0000644000176200001440000000373612507176717013500 0ustar liggesusers### Define Methods that can be inherited for all subclasses ##-> "dMatrix" <--> "lMatrix" ---> ./lMatrix.R ## these two are parallel to "n <-> l" in the above : setAs("nMatrix", "dMatrix", function(from) { cld <- getClassDef(cl <- MatrixClass(class(from))) isSp <- extends(cld, "sparseMatrix") ## faster(not "nicer"): any(substr(cl,3,3) == c("C","T","R")) sNams <- slotNames(cld) r <- copyClass(from, sub("^n", "d", cl), if(isSp) sNams else sNams[sNams != "x"]) r@x <- if(isSp) rep.int(1., nnzSparse(from)) else as.double(from@x) r }) ## NOTE: This is *VERY* parallel to ("lMatrix" -> "nMatrix") in ./lMatrix.R : setAs("dMatrix", "nMatrix", function(from) { if(anyNA(from@x) && ((.w <- isTRUE(getOption("Matrix.warn"))) || isTRUE(getOption("Matrix.verbose")))) { (if(.w) warning else message)( "\"dMatrix\" object with NAs coerced to \"nMatrix\": NA |-> TRUE") from@x[is.na(from@x)] <- 1 # "TRUE" } cld <- getClassDef(cl <- MatrixClass(class(from))) if(extends(cld, "diagonalMatrix")) # no "ndi*" class ## should not happen, setAs(diagonalMatrix -> nMatrix) in ./diagMatrix.R: return(di2nMat(from)) ## else isSp <- extends(cld, "sparseMatrix") if(isSp && any(from@x == 0)) { from <- drop0(from) # was drop0(from, cld) if(cl != (c. <- class(from))) cld <- getClassDef(cl <- c.) } sNams <- slotNames(cld) r <- copyClass(from, sub("^d", "n", cl), sNams[sNams != "x"]) if(!isSp) # 'x' slot |--> logical r@x <- as.logical(from@x) r }) ## Group Methods: ## ----- ## "Math", "Math2" in --> ./Math.R ## "Summary" --> ./Summary.R ## "Ops" ("Arith", "Compare", "Logic") --> ./Ops.R ## Methods for single-argument transformations setMethod("zapsmall", signature(x = "dMatrix"), function(x, digits = getOption("digits")) { x@x <- zapsmall(x@x, digits) x }) ## -- end(single-argument transformations) ------ Matrix/R/ltCMatrix.R0000644000176200001440000000230213253131430013741 0ustar liggesusers#### Logical Sparse Triangular Matrices in Compressed column-oriented format setAs("ltCMatrix", "matrix", function(from) as(as(from, "lgCMatrix"), "matrix")) setAs("matrix", "ltCMatrix", function(from) { if(!is.logical(from)) storage.mode(from) <- "logical" .Call(matrix_to_Csparse, from, "ltCMatrix") }) setAs("ltCMatrix", "lgCMatrix", function(from) copyClass(diagU2N(from), "lgCMatrix", c("i", "p", "x", "Dim", "Dimnames"))) setAs("ltCMatrix", "ltTMatrix", function(from) .Call(Csparse_to_Tsparse, from, TRUE)) setAs("ltCMatrix", "dMatrix", # < instead of "dtCMatrix" function(from) new("dtCMatrix", i = from@i, p = from@p, x = as.double(from@x), uplo = from@uplo, diag = from@diag, Dim = from@Dim, Dimnames = from@Dimnames)) setAs("lgCMatrix", "ltCMatrix", # to triangular {needed in triu() } function(from) as(as(as(from, "lgTMatrix"), "ltTMatrix"), "ltCMatrix")) ## setAs("ltCMatrix", "generalMatrix", ## function(from) ......) ## setMethod("t", signature(x = "ltCMatrix"), ## function(x) .Call(ltCMatrix_trans, x), ## valueClass = "ltCMatrix") Matrix/R/nearPD.R0000644000176200001440000001103513506410762013217 0ustar liggesusers## Copyright (C) 2007-2019 Martin Maechler ## ## nearcor.R : ## Copyright (C) 2007 Jens Oehlschlägel ## ## This program 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 of the License, or ## (at your option) any later version. ## ## This program 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. ## ## A copy of the GNU General Public License is available at ## https://www.R-project.org/Licenses/ nearPD <- ## Computes the nearest correlation matrix to an approximate ## correlation matrix, i.e. not positive semidefinite. function(x # n-by-n approx covariance/correlation matrix , corr = FALSE, keepDiag = FALSE , base.matrix = FALSE # if TRUE return "base matrix" otherwise "dpoMatrix" , do2eigen = TRUE # if TRUE do a sfsmisc::posdefify() eigen step , doSym = FALSE # symmetrize after tcrossprod() , doDykstra = TRUE # do use Dykstra's correction , only.values = FALSE# if TRUE simply return lambda[j]. , ensureSymmetry = !isSymmetric(x)# so user can set to FALSE iff she knows.. , eig.tol = 1e-6 # defines relative positiveness of eigenvalues compared to largest , conv.tol = 1e-7 # convergence tolerance for algorithm , posd.tol = 1e-8 # tolerance for enforcing positive definiteness , maxit = 100L # maximum number of iterations allowed , conv.norm.type = "I" , trace = FALSE # set to TRUE (or 1 ..) to trace iterations ) { if(ensureSymmetry) { ## only if needed/wanted ... ## message("applying nearPD() to symmpart(x)") x <- symmpart(x) } n <- ncol(x) if(keepDiag) diagX0 <- diag(x) if(doDykstra) { ## D_S should be like x, but filled with '0' -- following also works for 'Matrix': D_S <- x; D_S[] <- 0 } X <- x iter <- 0L ; converged <- FALSE; conv <- Inf while (iter < maxit && !converged) { Y <- X if(doDykstra) R <- Y - D_S ## project onto PSD matrices X_k = P_S (R_k) e <- eigen(if(doDykstra) R else Y, symmetric = TRUE) ## Q <- e$vectors d <- e$values ## D <- diag(d) ## create mask from relative positive eigenvalues p <- d > eig.tol*d[1] if(!any(p)) stop("Matrix seems negative semi-definite") ## use p mask to only compute 'positive' part Q <- Q[,p, drop = FALSE] ## X <- Q %*% D[p,p,drop = FALSE] %*% t(Q) --- more efficiently : X <- tcrossprod(Q * rep(d[p], each=nrow(Q)), Q) if(doDykstra) ## update Dykstra's correction D_S = \Delta S_k D_S <- X - R ## project onto symmetric and possibly 'given diag' matrices: if(doSym) X <- (X + t(X))/2 if(corr) diag(X) <- 1 else if(keepDiag) diag(X) <- diagX0 conv <- norm(Y-X, conv.norm.type) / norm(Y, conv.norm.type) iter <- iter + 1L if (trace) cat(sprintf("iter %3d : #{p}=%d, ||Y-X|| / ||Y||= %11g\n", iter, sum(p), conv)) converged <- (conv <= conv.tol) } if(!converged) warning(gettextf("'nearPD()' did not converge in %d iterations", iter), domain = NA) ## force symmetry is *NEVER* needed, we have symmetric X here! ## X <- (X + t(X))/2 if(do2eigen || only.values) { ## begin from posdefify(sfsmisc) e <- eigen(X, symmetric = TRUE) d <- e$values Eps <- posd.tol * abs(d[1]) if (d[n] < Eps) { d[d < Eps] <- Eps if(!only.values) { Q <- e$vectors o.diag <- diag(X) X <- Q %*% (d * t(Q)) D <- sqrt(pmax(Eps, o.diag)/diag(X)) X[] <- D * X * rep(D, each = n) } } if(only.values) return(d) ## unneeded(?!): X <- (X + t(X))/2 if(corr) diag(X) <- 1 else if(keepDiag) diag(X) <- diagX0 } ## end from posdefify(sfsmisc) structure(list(mat = if(base.matrix) X else new("dpoMatrix", x = as.vector(X), Dim = c(n,n), Dimnames = .M.DN(x)), eigenvalues = d, corr = corr, normF = norm(x-X, "F"), iterations = iter, rel.tol = conv, converged = converged), class = "nearPD") } Matrix/R/products.R0000644000176200001440000012346513141330160013710 0ustar liggesusers#### All %*%, crossprod() and tcrossprod() methods of the Matrix package #### ^^^ ---------------------------------------------------------- ### with EXCEPTIONS: ./diagMatrix.R ./indMatrix.R ./pMatrix.R ### ~~~~~~~~~~ ------------ ----------- --------- ### NOTA BENE: vector %*% Matrix _and_ Matrix %*% vector ### --------- The k-vector is treated as (1,k)-matrix *or* (k,1)-matrix ### on both sides when ever it "helps fit" the matrix dimensions: ##--- ./products.Rout ## ~~~~~~~~~~~~~~~ ## ========> in a M.v or v.M operation , ## you *must* look at dim(M) to see how to treat v !!!!!!!!!!!!!!!! ## For %*% (M = Matrix; v = vector (double, integer,.. or "sparsevector"): ## Drawback / bug: for (dense)vectors, the *names* are lost [sparsevectors have no names!] .M.v <- function(x, y) { # dim(y) <- if(ncol(x) == (n <- length(y))) c(n, 1L) else c(1L, n) ## which works when m == 1, otherwise errors x %*% y } ## For %*% : .v.M <- function(x, y) { dim(x) <- if(nrow(y) == (n <- length(x))) c(1L, n) else c(n, 1L) x %*% y } ## For tcrossprod() : .v.Mt <- function(x, y=NULL, boolArith=NA, ...) { ##_ Not needed: y is never "missing", when used: ##_ if(is.null(y)) y <- x dim(x) <- if(ncol(y) == (n <- length(x))) c(1L, n) else c(n, 1L) tcrossprod(x, y, boolArith=boolArith, ...) } ## tcrossprod(, ) .M.vt <- function(x, y=NULL, boolArith=NA, ...) tcrossprod(x, if(nrow(x) == 1L) spV2M(y, nrow=1L, ncol=y@length, check=FALSE) else spV2M(y, nrow=y@length, ncol=1L, check=FALSE), boolArith=boolArith, ...) ###-- I --- %*% ------------------------------------------------------ ## General method for dense matrix multiplication in case specific methods ## have not been defined. for ( c.x in paste0(c("d", "l", "n"), "denseMatrix")) { for(c.y in c("matrix", paste0(c("d", "l", "n"), "denseMatrix"))) setMethod("%*%", signature(x = c.x, y = c.y), function(x, y) .Call(geMatrix_matrix_mm, x, y, FALSE), valueClass = "dgeMatrix") setMethod("%*%", signature(x = "matrix", y = c.x), function(x, y) .Call(geMatrix_matrix_mm, y, x, TRUE), valueClass = "dgeMatrix") } setMethod("%*%", signature(x = "dgeMatrix", y = "dgeMatrix"), function(x, y) .Call(dgeMatrix_matrix_mm, x, y, FALSE), valueClass = "dgeMatrix") setMethod("%*%", signature(x = "dgeMatrix", y = "matrix"), function(x, y) .Call(dgeMatrix_matrix_mm, x, y, FALSE), valueClass = "dgeMatrix") setMethod("%*%", signature(x = "matrix", y = "dgeMatrix"), function(x, y) .Call(dgeMatrix_matrix_mm, y, x, TRUE), valueClass = "dgeMatrix") .dsy_m_mm <- function(x, y) .Call(dsyMatrix_matrix_mm, x, y, FALSE) setMethod("%*%", signature(x = "dsyMatrix", y = "matrix"), .dsy_m_mm) setMethod("%*%", signature(x = "dsyMatrix", y = "ddenseMatrix"), .dsy_m_mm) ## for disambiguity : setMethod("%*%", signature(x = "dsyMatrix", y = "dsyMatrix"), .dsy_m_mm) ## or even ## for(yCl in .directSubClasses(getClass("ddenseMatrix"))) ## setMethod("%*%", signature(x = "dsyMatrix", y = yCl), .dsy_m_mm) setMethod("%*%", signature(x = "ddenseMatrix", y = "dsyMatrix"), function(x, y) .Call(dsyMatrix_matrix_mm, y, x, TRUE)) setMethod("%*%", signature(x = "matrix", y = "dsyMatrix"), function(x, y) .Call(dsyMatrix_matrix_mm, y, x, TRUE)) setMethod("%*%", signature(x = "dspMatrix", y = "ddenseMatrix"), function(x, y) .Call(dspMatrix_matrix_mm, x, y), valueClass = "dgeMatrix") setMethod("%*%", signature(x = "dspMatrix", y = "matrix"), function(x, y) .Call(dspMatrix_matrix_mm, x, y), valueClass = "dgeMatrix") ## Not needed because of c("numeric", "Matrix") method ##setMethod("%*%", signature(x = "numeric", y = "CsparseMatrix"), ## function(x, y) .Call(Csparse_dense_crossprod, y, x, "B"), ## valueClass = "dgeMatrix") ## FIXME -- do the "same" for "dtpMatrix" {also, with [t]crossprod()} ## all just like these "%*%" : setMethod("%*%", signature(x = "dtrMatrix", y = "dtrMatrix"), function(x, y) .Call(dtrMatrix_dtrMatrix_mm, x, y, FALSE, FALSE)) setMethod("%*%", signature(x = "dtrMatrix", y = "ddenseMatrix"), function(x, y) .Call(dtrMatrix_matrix_mm, x, y, FALSE, FALSE), valueClass = "dgeMatrix") setMethod("%*%", signature(x = "dtrMatrix", y = "matrix"), function(x, y) .Call(dtrMatrix_matrix_mm, x, y, FALSE, FALSE), valueClass = "dgeMatrix") setMethod("%*%", signature(x = "ddenseMatrix", y = "dtrMatrix"), function(x, y) .Call(dtrMatrix_matrix_mm, y, x, TRUE, FALSE), valueClass = "dgeMatrix") setMethod("%*%", signature(x = "matrix", y = "dtrMatrix"), function(x, y) .Call(dtrMatrix_matrix_mm, y, x, TRUE, FALSE), valueClass = "dgeMatrix") setMethod("%*%", signature(x = "dtpMatrix", y = "ddenseMatrix"), function(x, y) .Call(dtpMatrix_matrix_mm, x, y, FALSE, FALSE)) setMethod("%*%", signature(x = "dgeMatrix", y = "dtpMatrix"), function(x, y) .Call(dgeMatrix_dtpMatrix_mm, x, y)) ## dtpMatrix <-> matrix : will be used by the "numeric" one setMethod("%*%", signature(x = "dtpMatrix", y = "matrix"), function(x, y) .Call(dtpMatrix_matrix_mm, x, y, FALSE, FALSE)) setMethod("%*%", signature(x = "matrix", y = "dtpMatrix"), function(x, y) ..2dge(x) %*% y) ## dtpMatrix <-> numeric : the auxiliary functions are R version specific! ##setMethod("%*%", signature(x = "dtpMatrix", y = "numeric"), .M.v) ##setMethod("%*%", signature(x = "numeric", y = "dtpMatrix"), .v.M) ## For multiplication operations, sparseMatrix overrides other method ## selections. Coerce a ddensematrix argument to a lsparseMatrix. setMethod("%*%", signature(x = "lsparseMatrix", y = "ldenseMatrix"), function(x, y) x %*% as(y, "sparseMatrix")) setMethod("%*%", signature(x = "ldenseMatrix", y = "lsparseMatrix"), function(x, y) as(x, "sparseMatrix") %*% y) ## and coerce lsparse* to lgC* setMethod("%*%", signature(x = "lsparseMatrix", y = "lsparseMatrix"), function(x, y) as(x, "lgCMatrix") %*% as(y, "lgCMatrix")) for(c.x in c("lMatrix", "nMatrix")) { setMethod("%*%", signature(x = c.x, y = "dMatrix"), function(x, y) as(x, "dMatrix") %*% y) setMethod("%*%", signature(x = "dMatrix", y = c.x), function(x, y) x %*% as(y, "dMatrix")) for(c.y in c("lMatrix", "nMatrix")) setMethod("%*%", signature(x = c.x, y = c.y), function(x, y) as(x, "dMatrix") %*% as(y, "dMatrix")) }; rm(c.x, c.y) setMethod("%*%", signature(x = "CsparseMatrix", y = "CsparseMatrix"), function(x, y) .Call(Csparse_Csparse_prod, x, y, boolArith=NA)) setMethod("%*%", signature(x = "CsparseMatrix", y = "ddenseMatrix"), function(x, y) .Call(Csparse_dense_prod, x, y, " ")) setMethod("%*%", signature(x = "CsparseMatrix", y = "matrix"), function(x, y) .Call(Csparse_dense_prod, x, y, " ")) # was x %*% Matrix(y) setMethod("%*%", signature(x = "CsparseMatrix", y = "numLike"), function(x, y) .Call(Csparse_dense_prod, x, y, " ")) setMethod("%*%", signature(x = "sparseMatrix", y = "matrix"), function(x, y) .Call(Csparse_dense_prod, as(x,"CsparseMatrix"), y, " ")) ## Not yet. Don't have methods for y = "CsparseMatrix" and general x #setMethod("%*%", signature(x = "ANY", y = "TsparseMatrix"), # function(x, y) callGeneric(x, as(y, "CsparseMatrix"))) setMethod("%*%", signature(x = "TsparseMatrix", y = "ANY"), function(x, y) .T.2.C(x) %*% y) setMethod("%*%", signature(x = "ANY", y = "TsparseMatrix"), function(x, y) x %*% .T.2.C(y)) setMethod("%*%", signature(x = "TsparseMatrix", y = "Matrix"), function(x, y) .T.2.C(x) %*% y) setMethod("%*%", signature(x = "Matrix", y = "TsparseMatrix"), function(x, y) x %*% .T.2.C(y)) setMethod("%*%", signature(x = "TsparseMatrix", y = "TsparseMatrix"), function(x, y) .T.2.C(x) %*% .T.2.C(y)) ##-------- Work via as(*, lgC) : ------------ ## For multiplication operations, sparseMatrix overrides other method ## selections. Coerce a ddensematrix argument to a nsparseMatrix. setMethod("%*%", signature(x = "nsparseMatrix", y = "ndenseMatrix"), function(x, y) x %*% as(y, "nsparseMatrix")) setMethod("%*%", signature(x = "ndenseMatrix", y = "nsparseMatrix"), function(x, y) as(x, "nsparseMatrix") %*% y) ## and coerce nsparse* to lgC* setMethod("%*%", signature(x = "nsparseMatrix", y = "nsparseMatrix"), function(x, y) as(x, "ngCMatrix") %*% as(y, "ngCMatrix")) ## x %*% y = t(crossprod(y, t(x))) unless when x is vector setMethod("%*%", signature(x = "ddenseMatrix", y = "CsparseMatrix"), function(x, y) .Call(Csparse_dense_crossprod, y, x, "B"), valueClass = "dgeMatrix") setMethod("%*%", signature(x = "matrix", y = "CsparseMatrix"), function(x, y) .Call(Csparse_dense_crossprod, y, x, "B"), valueClass = "dgeMatrix") setMethod("%*%", signature(x = "matrix", y = "sparseMatrix"), function(x, y) .Call(Csparse_dense_crossprod, as(y, "CsparseMatrix"), x, "B"), valueClass = "dgeMatrix") setMethod("%*%", signature(x = "numLike", y = "CsparseMatrix"), function(x, y) .Call(Csparse_dense_crossprod, y, x, "c"), valueClass = "dgeMatrix") ## "Matrix" ## Methods for operations where one argument is numeric setMethod("%*%", signature(x = "Matrix", y = "numLike"), .M.v) setMethod("%*%", signature(x = "numLike", y = "Matrix"), .v.M) setMethod("%*%", signature(x = "Matrix", y = "matrix"), function(x, y) x %*% Matrix(y)) setMethod("%*%", signature(x = "matrix", y = "Matrix"), function(x, y) Matrix(x) %*% y) ## bail-out methods in order to get better error messages .local.bail.out <- function (x, y) stop(gettextf('not-yet-implemented method for <%s> %%*%% <%s>', class(x), class(y)), domain=NA) setMethod("%*%", signature(x = "ANY", y = "Matrix"), .local.bail.out) setMethod("%*%", signature(x = "Matrix", y = "ANY"), .local.bail.out) ### sparseVector sp.x.sp <- function(x, y) Matrix(sum(x * y), 1L, 1L, sparse=FALSE) ## inner product -- no sense to return sparse! sp.X.sp <- function(x, y) { if((n <- length(x)) == length(y)) sp.x.sp(x,y) else if(n == 1L) spV2M(x, nrow = 1L, ncol = 1L, check = FALSE) %*% y else stop("non-conformable arguments") } v.X.sp <- function(x, y) { if((n <- length(x)) == length(y)) sp.x.sp(x,y) else if(n == 1L) matrix(x, nrow = 1L, ncol = 1L) %*% y else stop("non-conformable arguments") } setMethod("%*%", signature(x = "mMatrix", y = "sparseVector"), .M.v) setMethod("%*%", signature(x = "sparseVector", y = "mMatrix"), .v.M) setMethod("%*%", signature(x = "sparseVector", y = "sparseVector"), sp.X.sp) setMethod("%*%", signature(x = "sparseVector", y = "numLike"), sp.X.sp) setMethod("%*%", signature(x = "numLike", y = "sparseVector"), v.X.sp) ## setMethod("%*%", signature(x = "sparseMatrix", y = "sparseVector"), ## function(x, y) x %*% .sparseV2Mat(y)) ###--- II --- crossprod ----------------------------------------------------- setMethod("crossprod", signature(x = "dgeMatrix", y = "missing"), function(x, y = NULL, boolArith=NA, ...) { if(isTRUE(boolArith)) ## FIXME: very inefficient crossprod(as(x,"sparseMatrix"), boolArith=TRUE) else .Call(dgeMatrix_crossprod, x, FALSE) }) ## crossprod (x,y) setMethod("crossprod", signature(x = "dgeMatrix", y = "dgeMatrix"), function(x, y=NULL, boolArith=NA, ...) { if(isTRUE(boolArith)) ## FIXME: very inefficient crossprod(as(x,"sparseMatrix"), as(y,"sparseMatrix"), boolArith=TRUE) else .Call(dgeMatrix_dgeMatrix_crossprod, x, y, FALSE) }) setMethod("crossprod", signature(x = "dgeMatrix", y = "matrix"), function(x, y=NULL, boolArith=NA, ...) { if(isTRUE(boolArith)) ## FIXME: very inefficient crossprod(as(x,"sparseMatrix"), as(y,"sparseMatrix"), boolArith=TRUE) else .Call(dgeMatrix_matrix_crossprod, x, y, FALSE) }) setMethod("crossprod", signature(x = "dgeMatrix", y = "numLike"), function(x, y=NULL, boolArith=NA, ...) { if(isTRUE(boolArith)) crossprod(as(x,"sparseMatrix"), as(y,"sparseVector"), boolArith=TRUE) else .Call(dgeMatrix_matrix_crossprod, x, y, FALSE) }) setMethod("crossprod", signature(x = "matrix", y = "dgeMatrix"), function(x, y=NULL, boolArith=NA, ...) crossprod(..2dge(x), y, boolArith=boolArith, ...)) setMethod("crossprod", signature(x = "numLike", y = "dgeMatrix"), function(x, y=NULL, boolArith=NA, ...) crossprod(cbind(as.double(x), deparse.level=0L), y, boolArith=boolArith, ...)) for(c.x in paste0(c("d", "l", "n"), "denseMatrix")) { setMethod("crossprod", signature(x = c.x, y = "missing"), function(x, y = NULL, boolArith=NA, ...) if(isTRUE(boolArith)) ## FIXME: very inefficient crossprod(as(x,"sparseMatrix"), boolArith=TRUE) else .Call(geMatrix_crossprod, x, FALSE)) for(c.y in c("matrix", paste0(c("d", "l", "n"), "denseMatrix"))) { setMethod("crossprod", signature(x = c.x, y = c.y), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) ## FIXME: very inefficient crossprod(as(x,"sparseMatrix"), as(y,"sparseMatrix"), boolArith=TRUE) else .Call(geMatrix_geMatrix_crossprod, x, y, FALSE)) } } ## setMethod("crossprod", signature(x = "dtrMatrix", y = "missing"), ## function(x, y = NULL, boolArith=NA, ...) ## crossprod(..2dge(x), boolArith=boolArith, ...)) ## "dtrMatrix" - remaining (uni)triangular if possible setMethod("crossprod", signature(x = "dtrMatrix", y = "dtrMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) ## FIXME: very inefficient crossprod(as(x,"sparseMatrix"), as(y,"sparseMatrix"), boolArith=TRUE) else .Call(dtrMatrix_dtrMatrix_mm, x, y, FALSE, TRUE)) setMethod("crossprod", signature(x = "dtrMatrix", y = "ddenseMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) ## FIXME: very inefficient crossprod(as(x,"sparseMatrix"), as(y,"sparseMatrix"), boolArith=TRUE) else .Call(dtrMatrix_matrix_mm, x, y, FALSE, TRUE)) setMethod("crossprod", signature(x = "dtrMatrix", y = "matrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) ## FIXME: very inefficient crossprod(as(x,"sparseMatrix"), as(y,"sparseMatrix"), boolArith=TRUE) else .Call(dtrMatrix_matrix_mm, x, y, FALSE, TRUE)) ## Not quite optimal, have unnecessary t(x) below: _FIXME_ setMethod("crossprod", signature(x = "matrix", y = "dtrMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) ## FIXME: very inefficient crossprod(as(x,"sparseMatrix"), as(y,"sparseMatrix"), boolArith=TRUE) else .Call(dtrMatrix_matrix_mm, y, t(x), TRUE, FALSE)) ## "dtpMatrix" if(FALSE) ## not yet in C setMethod("crossprod", signature(x = "dtpMatrix", y = "dtpMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) crossprod(as(x,"sparseMatrix"), as(y,"sparseMatrix"), boolArith=TRUE) else .Call(dtpMatrix_dtpMatrix_mm, x, y, FALSE, TRUE)) setMethod("crossprod", signature(x = "dtpMatrix", y = "ddenseMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) crossprod(as(x,"sparseMatrix"), as(y,"sparseMatrix"), boolArith=TRUE) else .Call(dtpMatrix_matrix_mm, x, y, FALSE, TRUE)) setMethod("crossprod", signature(x = "dtpMatrix", y = "matrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) crossprod(as(x,"sparseMatrix"), as(y,"sparseMatrix"), boolArith=TRUE) else .Call(dtpMatrix_matrix_mm, x, y, FALSE, TRUE)) ## "crossprod" methods too ... ## setMethod("crossprod", signature(x = "dgTMatrix", y = "missing"), ## function(x, y=NULL, boolArith=NA, ...) ## .Call(csc_crossprod, as(x, "dgCMatrix"))) ## setMethod("crossprod", signature(x = "dgTMatrix", y = "matrix"), ## function(x, y) ## .Call(csc_matrix_crossprod, as(x, "dgCMatrix"), y)) ##setMethod("crossprod", signature(x = "dgTMatrix", y = "numeric"), ## function(x, y) ## .Call(csc_matrix_crossprod, as(x, "dgCMatrix"), as.matrix(y))) ## setMethod("tcrossprod", signature(x = "dgTMatrix", y = "missing"), ## function(x, y=NULL, boolArith=NA, ...) ## .Call(csc_tcrossprod, as(x, "dgCMatrix"))) setMethod("crossprod", signature(x = "CsparseMatrix", y = "missing"), function(x, y = NULL, boolArith=NA, ...) .Call(Csparse_crossprod, x, trans = FALSE, triplet = FALSE, boolArith=boolArith)) setMethod("crossprod", signature(x = "CsparseMatrix", y = "CsparseMatrix"), function(x, y = NULL, boolArith = NA, ...) .Call(Csparse_Csparse_crossprod, x, y, trans = FALSE, boolArith=boolArith)) ## FIXME: Generalize the class of y. (?? still ??) setMethod("crossprod", signature(x = "CsparseMatrix", y = "ddenseMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) crossprod(x, as(y,"sparseMatrix"), boolArith=TRUE) else .Call(Csparse_dense_crossprod, x, y, " ")) setMethod("crossprod", signature(x = "CsparseMatrix", y = "matrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) crossprod(x, as(y,"sparseMatrix"), boolArith=TRUE) else .Call(Csparse_dense_crossprod, x, y, " ")) setMethod("crossprod", signature(x = "CsparseMatrix", y = "numLike"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) crossprod(x, as(y,"sparseVector"), boolArith=TRUE) else .Call(Csparse_dense_crossprod, x, y, " ")) setMethod("crossprod", signature(x = "TsparseMatrix", y = "missing"), function(x, y = NULL, boolArith = NA, ...) .Call(Csparse_crossprod, x, trans = FALSE, triplet = TRUE, boolArith=boolArith)) setMethod("crossprod", signature(x = "TsparseMatrix", y = "ANY"), function(x, y = NULL, boolArith = NA, ...) crossprod(.T.2.C(x), y, boolArith=boolArith, ...)) setMethod("crossprod", signature(x = "ANY", y = "TsparseMatrix"), function(x, y=NULL, boolArith=NA, ...) crossprod(x, .T.2.C(y), boolArith=boolArith, ...)) setMethod("crossprod", signature(x = "TsparseMatrix", y = "Matrix"), function(x, y=NULL, boolArith=NA, ...) crossprod(.T.2.C(x), y, boolArith=boolArith, ...)) setMethod("crossprod", signature(x = "Matrix", y = "TsparseMatrix"), function(x, y=NULL, boolArith=NA, ...) crossprod(x, .T.2.C(y), boolArith=boolArith, ...)) setMethod("crossprod", signature(x = "TsparseMatrix", y = "TsparseMatrix"), function(x, y=NULL, boolArith=NA, ...) crossprod(.T.2.C(x), .T.2.C(y), boolArith=boolArith, ...)) setMethod("crossprod", signature(x = "dsparseMatrix", y = "ddenseMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) crossprod(as(x, "CsparseMatrix"), as(y,"sparseMatrix"), boolArith=TRUE) else .Call(Csparse_dense_crossprod, as(x, "CsparseMatrix"), y, " ")) setMethod("crossprod", signature(x = "ddenseMatrix", y = "dgCMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) crossprod(as(x, "sparseMatrix"), y, boolArith=TRUE) else .Call(Csparse_dense_crossprod, y, x, "c")) setMethod("crossprod", signature(x = "ddenseMatrix", y = "dsparseMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) crossprod(as(x, "sparseMatrix"), as(y, "CsparseMatrix"), boolArith=TRUE) else .Call(Csparse_dense_crossprod, as(y, "CsparseMatrix"), x, "c")) setMethod("crossprod", signature(x = "dgCMatrix", y = "dgeMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) crossprod(x, as(y, "CsparseMatrix"), boolArith=TRUE) else .Call(Csparse_dense_crossprod, x, y, " ")) setMethod("crossprod", signature(x = "dsparseMatrix", y = "dgeMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) crossprod(as(x, "CsparseMatrix"), as(y, "CsparseMatrix"), boolArith=TRUE) else .Call(Csparse_dense_crossprod, as(x, "CsparseMatrix"), y, " ")) ## NB: there's already ## ("CsparseMatrix", "missing") and ("TsparseMatrix", "missing") methods ## infinite recursion: ## setMethod("crossprod", signature(x = "dgeMatrix", y = "dsparseMatrix"), ## function(x, y) crossprod(x, as(y, "dgCMatrix"))) setMethod("crossprod", signature(x = "lsparseMatrix", y = "ldenseMatrix"), function(x, y=NULL, boolArith=NA, ...) crossprod(x, as(y, "sparseMatrix"), boolArith=boolArith, ...)) setMethod("crossprod", signature(x = "ldenseMatrix", y = "lsparseMatrix"), function(x, y=NULL, boolArith=NA, ...) crossprod(as(x, "sparseMatrix"), y, boolArith=boolArith, ...)) setMethod("crossprod", signature(x = "lsparseMatrix", y = "lsparseMatrix"), function(x, y=NULL, boolArith=NA, ...) crossprod(as(x, "lgCMatrix"), as(y, "lgCMatrix"), boolArith=boolArith, ...)) setMethod("crossprod", signature(x = "nsparseMatrix", y = "ndenseMatrix"), function(x, y=NULL, boolArith=NA, ...) crossprod(x, as(y, "sparseMatrix"), boolArith=boolArith, ...)) setMethod("crossprod", signature(x = "ndenseMatrix", y = "nsparseMatrix"), function(x, y=NULL, boolArith=NA, ...) crossprod(as(x, "sparseMatrix"), y, boolArith=boolArith, ...)) setMethod("crossprod", signature(x = "nsparseMatrix", y = "nsparseMatrix"), function(x, y=NULL, boolArith=NA, ...) crossprod(as(x, "ngCMatrix"), as(y, "ngCMatrix"), boolArith=boolArith, ...)) setMethod("crossprod", signature(x = "ddenseMatrix", y = "CsparseMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) crossprod(as(x, "CsparseMatrix"), y, boolArith=TRUE) else .Call(Csparse_dense_crossprod, y, x, "c")) setMethod("crossprod", signature(x = "matrix", y = "CsparseMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) crossprod(as(x, "CsparseMatrix"), y, boolArith=TRUE) else .Call(Csparse_dense_crossprod, y, x, "c")) setMethod("crossprod", signature(x = "numLike", y = "CsparseMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) crossprod(as(x, "sparseVector"), y, boolArith=TRUE) else .Call(Csparse_dense_crossprod, y, x, "c")) ## "Matrix" : cbind(), rbind() do names -> dimnames setMethod("crossprod", signature(x = "Matrix", y = "numLike"), function(x, y=NULL, boolArith=NA, ...) crossprod(x, cbind(y, deparse.level=0), boolArith=boolArith, ...)) setMethod("crossprod", signature(x = "numLike", y = "Matrix"), function(x, y=NULL, boolArith=NA, ...) crossprod(cbind(x, deparse.level=0), y, boolArith=boolArith, ...)) setMethod("crossprod", signature(x = "Matrix", y = "matrix"), function(x, y=NULL, boolArith=NA, ...) crossprod(x, Matrix(y), boolArith=boolArith, ...)) setMethod("crossprod", signature(x = "matrix", y = "Matrix"), function(x, y=NULL, boolArith=NA, ...) crossprod(Matrix(x), y, boolArith=boolArith, ...)) ## sparseVector setMethod("crossprod", signature(x = "mMatrix", y = "sparseVector"), function(x, y=NULL, boolArith=NA, ...) crossprod(x, if(nrow(x) == 1L) spV2M(y, nrow=1L, ncol=y@length, check=FALSE) else spV2M(y, nrow=y@length, ncol=1L, check=FALSE), boolArith=boolArith, ...)) setMethod("crossprod", signature(x = "sparseVector", y = "mMatrix"), function(x, y=NULL, boolArith=NA, ...) crossprod(spV2M(x, nrow = length(x), ncol = 1L, check = FALSE), y, boolArith=boolArith, ...)) sp.t.sp <- function(x, y=NULL, boolArith=NA, ...) Matrix(if(isTRUE(boolArith)) any(x & y) else sum(x * y), 1L, 1L, sparse=FALSE) ## inner product -- no sense to return sparse! sp.T.sp <- function(x, y=NULL, boolArith=NA, ...) { if((n <- length(x)) == length(y)) sp.t.sp(x,y, boolArith=boolArith, ...) else if(n == 1L) (if(isTRUE(boolArith)) `%&%` else `%*%`)( spV2M(x, nrow = 1L, ncol = 1L, check = FALSE), y) else stop("non-conformable arguments") } v.T.sp <- function(x, y=NULL, boolArith=NA, ...) { if((n <- length(x)) == length(y)) sp.t.sp(x,y, boolArith=boolArith, ...) else if(n == 1L) (if(isTRUE(boolArith)) `%&%` else `%*%`)(matrix(x, nrow = 1L, ncol = 1L), y) else stop("non-conformable arguments") } setMethod("crossprod", signature(x = "sparseVector", y = "sparseVector"), sp.T.sp) setMethod("crossprod", signature(x = "sparseVector", y = "numLike"), sp.T.sp) setMethod("crossprod", signature(x = "numLike", y = "sparseVector"), v.T.sp) setMethod("crossprod", signature(x = "sparseVector", y = "missing"), function(x, y=NULL, boolArith=NA, ...) sp.t.sp(x,x, boolArith=boolArith, ...)) ## Fallbacks -- symmetric LHS --> saving a t(.): ## {FIXME: want the method to be `%*%` -- but primitives are not allowed as methods} setMethod("crossprod", signature(x = "symmetricMatrix", y = "missing"), function(x,y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) x %&% x else x %*% x) setMethod("crossprod", signature(x = "symmetricMatrix", y = "Matrix"), function(x,y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) x %&% y else x %*% y) setMethod("crossprod", signature(x = "symmetricMatrix", y = "ANY"), function(x,y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) x %&% y else x %*% y) ## ## cheap fallbacks setMethod("crossprod", signature(x = "Matrix", y = "Matrix"), function(x, y=NULL, boolArith=NA, ...) { Matrix.msg(sprintf( "potentially suboptimal crossprod(\"%s\",\"%s\") as t(.) %s y", class(x), class(y), "%*%")) if(isTRUE(boolArith)) t(x) %&% y else t(x) %*% y }) setMethod("crossprod", signature(x = "Matrix", y = "missing"), function(x, y=NULL, boolArith=NA, ...) { Matrix.msg(paste0( "potentially suboptimal crossprod(<",class(x),">) as t(.) %*% . ")) if(isTRUE(boolArith)) t(x) %&% x else t(x) %*% x }) setMethod("crossprod", signature(x = "Matrix", y = "ANY"), function(x, y=NULL, boolArith=NA, ...) { Matrix.msg(sprintf( "potentially suboptimal crossprod(\"%s\", <%s>[=]) as t(.) %s y", class(x), class(y), "%*%")) if(isTRUE(boolArith)) t(x) %&% y else t(x) %*% y }) setMethod("crossprod", signature(x = "ANY", y = "Matrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) t(x) %&% y else t(x) %*% y) ###--- III --- tcrossprod --------------------------------------------------- setMethod("tcrossprod", signature(x = "dgeMatrix", y = "dgeMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) ## FIXME: very inefficient tcrossprod(as(x, "sparseMatrix"), as(y,"sparseMatrix"), boolArith=TRUE) else .Call(dgeMatrix_dgeMatrix_crossprod, x, y, TRUE)) setMethod("tcrossprod", signature(x = "dgeMatrix", y = "matrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) ## FIXME: very inefficient tcrossprod(as(x, "sparseMatrix"), as(y,"sparseMatrix"), boolArith=TRUE) else .Call(dgeMatrix_matrix_crossprod, x, y, TRUE)) setMethod("tcrossprod", signature(x = "dgeMatrix", y = "numLike"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) ## FIXME: very inefficient tcrossprod(as(x, "sparseMatrix"), as(y,"sparseVector"), boolArith=TRUE) else .Call(dgeMatrix_matrix_crossprod, x, y, TRUE)) setMethod("tcrossprod", signature(x = "matrix", y = "dgeMatrix"), function(x, y=NULL, boolArith=NA, ...) tcrossprod(..2dge(x), y, boolArith=boolArith, ...)) setMethod("tcrossprod", signature(x = "numLike", y = "dgeMatrix"), .v.Mt) setMethod("tcrossprod", signature(x = "dgeMatrix", y = "missing"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) ## FIXME: very inefficient tcrossprod(as(x, "sparseMatrix"), boolArith=TRUE) else .Call(dgeMatrix_crossprod, x, TRUE)) for(c.x in paste0(c("d", "l", "n"), "denseMatrix")) { setMethod("tcrossprod", signature(x = c.x, y = "missing"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) ## FIXME: very inefficient tcrossprod(as(x, "sparseMatrix"), boolArith=TRUE) else .Call(geMatrix_crossprod, x, TRUE)) for(c.y in c("matrix", paste0(c("d", "l", "n"), "denseMatrix"))) { setMethod("tcrossprod", signature(x = c.x, y = c.y), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) ## FIXME: very inefficient tcrossprod(as(x,"sparseMatrix"), as(y,"sparseMatrix"), boolArith=TRUE) else .Call(geMatrix_geMatrix_crossprod, x, y, TRUE)) } } if(FALSE) { ## this would mask 'base::tcrossprod' setMethod("tcrossprod", signature(x = "matrix", y = "missing"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) ## FIXME: very inefficient tcrossprod(as(x, "sparseMatrix"), boolArith=TRUE) else .Call(dgeMatrix_crossprod, ..2dge(x), TRUE)) setMethod("tcrossprod", signature(x = "numLike", y = "missing"), function(x, y=NULL, boolArith=NA, ...) tcrossprod(cbind(as.double(x), deparse.level=0L), boolArith=boolArith, ...)) }# FALSE setMethod("tcrossprod", signature(x = "ddenseMatrix", y = "missing"), function(x, y=NULL, boolArith=NA, ...) tcrossprod(as(x, "dgeMatrix"), boolArith=boolArith, ...)) setMethod("tcrossprod", signature(x = "dtrMatrix", y = "dtrMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) ## FIXME: very inefficient tcrossprod(as(x, "sparseMatrix"), as(y,"sparseMatrix"), boolArith=TRUE) else .Call(dtrMatrix_dtrMatrix_mm, y, x, TRUE, TRUE)) ## Must have 1st arg. = "dtrMatrix" in dtrMatrix_matrix_mm (): ## would need another way, to define tcrossprod() --- TODO? --- ## ## setMethod("tcrossprod", signature(x = "dtrMatrix", y = "ddenseMatrix"), ## function(x, y=NULL, boolArith=NA, ...) .Call(dtrMatrix_matrix_mm, y, x, TRUE, TRUE)) ###__ FIXME __ currently goes via geMatrix and loses triangularity !! ## setMethod("tcrossprod", signature(x = "dtrMatrix", y = "matrix"), ## function(x, y=NULL, boolArith=NA, ...) .Call(dtrMatrix_matrix_mm, y, x, TRUE, TRUE)) setMethod("tcrossprod", signature(x = "ddenseMatrix", y = "dtrMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) ## FIXME: very inefficient tcrossprod(as(x, "sparseMatrix"), as(y,"sparseMatrix"), boolArith=TRUE) else .Call(dtrMatrix_matrix_mm, y, x, TRUE, TRUE)) setMethod("tcrossprod", signature(x = "matrix", y = "dtrMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) ## FIXME: very inefficient tcrossprod(as(x, "sparseMatrix"), as(y,"sparseMatrix"), boolArith=TRUE) else .Call(dtrMatrix_matrix_mm, y, x, TRUE, TRUE)) if(FALSE) { ## TODO in C setMethod("tcrossprod", signature(x = "ddenseMatrix", y = "dtpMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) ## FIXME: very inefficient tcrossprod(as(x, "sparseMatrix"), as(y,"sparseMatrix"), boolArith=TRUE) else .Call(dtpMatrix_matrix_mm, y, x, TRUE, TRUE)) setMethod("tcrossprod", signature(x = "matrix", y = "dtpMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) ## FIXME: very inefficient tcrossprod(as(x, "sparseMatrix"), as(y,"sparseMatrix"), boolArith=TRUE) else .Call(dtpMatrix_matrix_mm, y, x, TRUE, TRUE)) }# FALSE setMethod("tcrossprod", signature(x = "CsparseMatrix", y = "CsparseMatrix"), function(x, y = NULL, boolArith = NA, ...) .Call(Csparse_Csparse_crossprod, x, y, trans = TRUE, boolArith=boolArith)) setMethod("tcrossprod", signature(x = "CsparseMatrix", y = "missing"), function(x, y = NULL, boolArith = NA, ...) .Call(Csparse_crossprod, x, trans = TRUE, triplet = FALSE, boolArith=boolArith)) for(dmat in c("ddenseMatrix", "matrix")) { setMethod("tcrossprod", signature(x = "CsparseMatrix", y = dmat), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) ## FIXME: very inefficient tcrossprod(x, as(y,"CsparseMatrix"), boolArith=TRUE) else .Call(Csparse_dense_prod, x, y, "2")) setMethod("tcrossprod", signature(x = dmat, y = "CsparseMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) ## FIXME: very inefficient tcrossprod(as(x,"CsparseMatrix"), y, boolArith=TRUE) else .Call(Csparse_dense_prod, y, x, "B")) } setMethod("tcrossprod", signature(x = "CsparseMatrix", y = "numLike"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) ## FIXME: very inefficient tcrossprod(x, as(y,"sparseVector"), boolArith=TRUE) else .Call(Csparse_dense_prod, x, y, "2")) setMethod("tcrossprod", signature(x = "numLike", y = "CsparseMatrix"), function(x, y=NULL, boolArith=NA, ...) ## ~== .v.Mt : if(isTRUE(boolArith)) ## FIXME: very inefficient tcrossprod(as(x,"sparseVector"), y, boolArith=TRUE) else ## x or t(x) depending on dimension of y [checked inside C]: .Call(Csparse_dense_prod, y, x, "B")) ### -- xy' = (yx')' -------------------- tcr.dd.sC <- function(x, y=NULL, boolArith=NA, ...) { if(isTRUE(boolArith)) ## FIXME: very inefficient tcrossprod(as(x,"CsparseMatrix"), y, boolArith=TRUE) else .Call(Csparse_dense_prod, y, x, "c") } for(.sCMatrix in paste0(c("d", "l", "n"), "sCMatrix")) { ## speedup for *symmetric* RHS setMethod("tcrossprod", signature(x = "ddenseMatrix", y = .sCMatrix), tcr.dd.sC) setMethod("tcrossprod", signature(x = "matrix", y = .sCMatrix), tcr.dd.sC) } rm(dmat, .sCMatrix) setMethod("tcrossprod", signature(x = "TsparseMatrix", y = "missing"), function(x, y = NULL, boolArith = NA, ...) .Call(Csparse_crossprod, x, trans = TRUE, triplet = TRUE, boolArith=boolArith)) setMethod("tcrossprod", signature(x = "ANY", y = "TsparseMatrix"), function(x, y=NULL, boolArith=NA, ...) tcrossprod(x, .T.2.C(y), boolArith=boolArith, ...)) setMethod("tcrossprod", signature(x = "TsparseMatrix", y = "ANY"), function(x, y=NULL, boolArith=NA, ...) tcrossprod(.T.2.C(x), y, boolArith=boolArith, ...)) setMethod("tcrossprod", signature(x = "Matrix", y = "TsparseMatrix"), function(x, y=NULL, boolArith=NA, ...) tcrossprod(x, .T.2.C(y), boolArith=boolArith, ...)) setMethod("tcrossprod", signature(x = "TsparseMatrix", y = "Matrix"), function(x, y=NULL, boolArith=NA, ...) tcrossprod(.T.2.C(x), y, boolArith=boolArith, ...)) setMethod("tcrossprod", signature(x = "TsparseMatrix", y = "TsparseMatrix"), function(x, y=NULL, boolArith=NA, ...) tcrossprod(.T.2.C(x), .T.2.C(y), boolArith=boolArith, ...)) ## "Matrix" setMethod("tcrossprod", signature(x = "Matrix", y = "numLike"), function(x, y=NULL, boolArith=NA, ...) (if(isTRUE(boolArith)) `%&%` else `%*%`)(x, rbind(y, deparse.level=0))) setMethod("tcrossprod", signature(x = "numLike", y = "Matrix"), .v.Mt) setMethod("tcrossprod", signature(x = "Matrix", y = "matrix"), function(x, y=NULL, boolArith=NA, ...) tcrossprod(x, Matrix(y), boolArith=boolArith, ...)) setMethod("tcrossprod", signature(x = "matrix", y = "Matrix"), function(x, y=NULL, boolArith=NA, ...) tcrossprod(Matrix(x), y, boolArith=boolArith, ...)) ## sparseVector ## NB: the two "sparseMatrix" are "unneeded", only used to avoid ambiguity warning setMethod("tcrossprod", signature(x = "sparseMatrix", y = "sparseVector"), .M.vt) setMethod("tcrossprod", signature(x = "mMatrix", y = "sparseVector"), .M.vt) setMethod("tcrossprod", signature(x = "sparseVector", y = "sparseMatrix"), .v.Mt) setMethod("tcrossprod", signature(x = "sparseVector", y = "mMatrix"), .v.Mt) setMethod("tcrossprod", signature(x = "sparseVector", y = "sparseVector"), function(x, y=NULL, boolArith=NA, ...) { if(isTRUE(boolArith)) .sparseV2Mat(x) %&% spV2M(y, nrow=1L, ncol=length(y), check=FALSE) else { if(!is.na(boolArith)) warning(gettextf("'boolArith = %d' not yet implemented", boolArith), domain=NA) .sparseV2Mat(x) %*% spV2M(y, nrow=1L, ncol=length(y), check=FALSE) } }) setMethod("tcrossprod", signature(x = "sparseVector", y = "missing"), ## could be speeded: spV2M(x, *) called twice with different ncol/nrow function(x, y=NULL, boolArith=NA, ...) { if(isTRUE(boolArith)) .sparseV2Mat(x) %&% spV2M(x, nrow=1L, ncol=length(x), check=FALSE) else { if(!is.na(boolArith)) warning(gettextf("'boolArith = %d' not yet implemented", boolArith), domain=NA) .sparseV2Mat(x) %*% spV2M(x, nrow=1L, ncol=length(x), check=FALSE) } }) setMethod("tcrossprod", signature(x = "numLike", y = "sparseVector"), function(x, y=NULL, boolArith=NA, ...) tcrossprod(x, .sparseV2Mat(y), boolArith=boolArith, ...)) setMethod("tcrossprod", signature(x = "sparseVector", y = "numLike"), function(x, y=NULL, boolArith=NA, ...) { if(isTRUE(boolArith)) .sparseV2Mat(x) %&% t(x) else { if(!is.na(boolArith)) warning(gettextf("'boolArith = %d' not yet implemented", boolArith), domain=NA) .sparseV2Mat(x) %*% t(x) } }) ## Fallbacks -- symmetric RHS --> saving a t(.): ## {FIXME: want the method to be `%*%` -- but primitives are not allowed as methods} setMethod("tcrossprod", signature(x = "Matrix", y = "symmetricMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) x %&% y else x %*% y) setMethod("tcrossprod", signature(x = "ANY", y = "symmetricMatrix"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) x %&% y else x %*% y) ## ## cheap fallbacks setMethod("tcrossprod", signature(x = "Matrix", y = "Matrix"), function(x, y=NULL, boolArith=NA, ...) { Matrix.msg(sprintf( "potentially suboptimal tcrossprod(\"%s\",\"%s\") as x %s t(y)", class(x), class(y), "%*%")) if(isTRUE(boolArith)) x %&% t(y) else x %*% t(y) }) setMethod("tcrossprod", signature(x = "Matrix", y = "missing"), function(x, y=NULL, boolArith=NA, ...) { Matrix.msg(paste0( "potentially suboptimal tcrossprod(<",class(x), ">) as . %*% t(.)")) if(isTRUE(boolArith)) x %&% t(x) else x %*% t(x) }) setMethod("tcrossprod", signature(x = "Matrix", y = "ANY"), function(x, y=NULL, boolArith=NA, ...) if(isTRUE(boolArith)) x %&% t(y) else x %*% t(y)) setMethod("tcrossprod", signature(x = "ANY", y = "Matrix"), function(x, y=NULL, boolArith=NA, ...) { Matrix.msg(sprintf( "potentially suboptimal tcrossprod(<%s>[=], \"%s\") as x %s t(y)", class(x), class(y), "%*%")) if(isTRUE(boolArith)) x %&% t(y) else x %*% t(y) }) ###--- IV --- %&% Boolean Matrix Products ---------------------------------- ## Goal: crossprod / tcrossprod with a 'boolArith' option: ## ---- boolArith = NA [default now] <==> boolean arithmetic if *both* matrices ## are pattern matrices ## boolArith = TRUE <==> boolean arithmetic: return n.CMatrix ## boolArith = FALSE [default later?] <==> numeric arithmetic even for pattern ## ## A %&% B <==> prod(..... boolArith = TRUE) ## A %*% B <==> now: prod(..... boolArith = NA) ## but later: prod(..... boolArith = FALSE) # <==> always numeric ## RFC: Should we introduce matprod(x, y, boolArith) as generalized "%*%" ## which also has all three boolArith options ? ## since %*% does not allow 'boolArith = FALSE' now, or 'boolArith = NA' later setMethod("%&%", signature(x = "ANY", y = "ANY"), function(x, y) as.matrix(x) %&% as.matrix(y)) setMethod("%&%", signature(x = "matrix", y = "ANY"), function(x, y) x %&% as.matrix(y)) setMethod("%&%", signature(x = "ANY", y = "matrix"), function(x, y) as.matrix(x) %&% y) setMethod("%&%", signature(x = "Matrix", y = "ANY"), function(x, y) x %&% as(y, "Matrix")) setMethod("%&%", signature(x = "ANY", y = "Matrix"), function(x, y) as(x, "Matrix") %&% y) ## catch all setMethod("%&%", signature(x = "mMatrix", y = "mMatrix"), function(x, y) as(x, "nMatrix") %&% as(y, "nMatrix")) setMethod("%&%", signature(x = "Matrix", y = "Matrix"), function(x, y) as(x, "nMatrix") %&% as(y, "nMatrix")) setMethod("%&%", signature(x = "mMatrix", y = "nMatrix"), function(x, y) as(x, "nMatrix") %&% y) setMethod("%&%", signature(x = "nMatrix", y = "mMatrix"), function(x, y) x %&% as(y, "nMatrix")) ## sparseVectors : sp.bx.sp <- function(x, y) Matrix(any(x & y), 1L, 1L, sparse=FALSE) sp.bX.sp <- function(x, y) { if((n <- length(x)) == length(y)) sp.bx.sp(x,y) else if(n == 1L) spV2M(x, nrow = 1L, ncol = 1L, check = FALSE) %&% y else stop("non-conformable arguments") } v.bX.sp <- function(x, y) { if((n <- length(x)) == length(y)) sp.bx.sp(x,y) else if(n == 1L) matrix(x, nrow = 1L, ncol = 1L) %&% y else stop("non-conformable arguments") } setMethod("%&%", signature(x = "mMatrix", y = "sparseVector"), function(x, y) x %&% `dim<-`(y, if(ncol(x) == (n <- length(y))) c(n, 1L) else c(1L, n))) setMethod("%&%", signature(x = "sparseVector", y = "mMatrix"), function(x, y) `dim<-`(x, if(nrow(y) == (n <- length(x))) c(1L, n) else c(n, 1L)) %&% y) setMethod("%&%", signature(x = "sparseVector", y = "sparseVector"), sp.bX.sp) setMethod("%&%", signature(x = "sparseVector", y = "numLike"), sp.bX.sp) setMethod("%&%", signature(x = "numLike", y = "sparseVector"), v.bX.sp) ## For now --- suboptimally!!! --- we coerce to nsparseMatrix always: setMethod("%&%", signature(x = "nMatrix", y = "nsparseMatrix"), function(x, y) as(x, "nsparseMatrix") %&% y) setMethod("%&%", signature(x = "nsparseMatrix", y = "nMatrix"), function(x, y) x %&% as(y, "nsparseMatrix")) setMethod("%&%", signature(x = "nMatrix", y = "nMatrix"), function(x, y) as(x, "nsparseMatrix") %&% as(y, "nsparseMatrix")) setMethod("%&%", signature(x = "nsparseMatrix", y = "nsparseMatrix"), function(x, y) .Call(Csparse_Csparse_prod, as(x,"CsparseMatrix"), as(y,"CsparseMatrix"), boolArith=TRUE)) setMethod("%&%", signature(x = "nsparseMatrix", y = "nCsparseMatrix"), function(x, y) .Call(Csparse_Csparse_prod, as(x,"CsparseMatrix"), y, boolArith=TRUE)) setMethod("%&%", signature(x = "nCsparseMatrix", y = "nsparseMatrix"), function(x, y) .Call(Csparse_Csparse_prod, x, as(y,"CsparseMatrix"), boolArith=TRUE)) setMethod("%&%", signature(x = "nCsparseMatrix", y = "nCsparseMatrix"), function(x, y) .Call(Csparse_Csparse_prod, x, y, boolArith=TRUE)) ## Local variables: ## mode: R ## page-delimiter: "^###---" ## End: Matrix/R/corMatrix.R0000644000176200001440000000124211004063753014010 0ustar liggesusers#### "corMatrix" (was "correlation" in 2005) --- #### ----------- correlation matrices, inheriting from "dpoMatrix" ## dpo* -> cor* is in ./dpoMatrix.R .M.2cor <- function(from) as(as(from, "dpoMatrix"), "corMatrix") setAs("Matrix", "corMatrix", .M.2cor) setAs("matrix", "corMatrix", .M.2cor) ## This is necessary : setAs("dsyMatrix", "corMatrix", .M.2cor) ## BUT only because __ MM thinks __ ## the *automatical* (by inheritance) coercion ### dsyMatrix -> corMatrix coercion is wrong: ## selectMethod(coerce, c("dsyMatrix","corMatrix")) # gives ## function (from, to) ## { ## obj <- new("corMatrix") ## as(obj, "dsyMatrix") <- from ## obj ## } rm(.M.2cor) Matrix/R/ntTMatrix.R0000644000176200001440000000236211004710614013771 0ustar liggesusers#### Logical Sparse Triangular Matrices in Triplet format ### contains = "nsparseMatrix" setAs("matrix", "ntTMatrix", function(from) as(as(from, "ntrMatrix"), "TsparseMatrix")) setAs("ntTMatrix", "ngTMatrix", function(from) tT2gT(from, cl = "ntTMatrix", toClass = "ngTMatrix")) setAs("ntTMatrix", "generalMatrix", function(from) tT2gT(from, cl = "ntTMatrix", toClass = "ngTMatrix")) setAs("ntTMatrix", "ntCMatrix", function(from) .Call(Tsparse_to_Csparse, from, TRUE)) setAs("ntTMatrix", "ngCMatrix", function(from) as(.Call(Tsparse_to_Csparse, from, TRUE), "ngCMatrix")) setAs("ntTMatrix", "dtTMatrix", function(from) new("dtTMatrix", i = from@i, j = from@j, x = rep.int(1, length(from@i)), uplo = from@uplo, diag = from@diag, Dim = from@Dim, Dimnames = from@Dimnames)) setAs("ntTMatrix", "ntrMatrix", function(from) .Call(ntTMatrix_as_ntrMatrix, from)) setAs("ntTMatrix", "matrix", function(from) as(as(from, "ntrMatrix"), "matrix")) setMethod("t", "ntTMatrix", function(x) new("ntTMatrix", Dim = x@Dim[2:1], Dimnames = x@Dimnames[2:1], i = x@j, j = x@i, diag = x@diag, uplo = if (x@uplo == "U") "L" else "U")) Matrix/R/spModels.R0000644000176200001440000003763414060675611013653 0ustar liggesusers#### Utilities for Sparse Model Matrices ## The "first" version {no longer used}: fac2sparse <- function(from, to = c("d","i","l","n","z"), drop.unused.levels = FALSE) { ## factor(-like) --> sparseMatrix {also works for integer, character} fact <- if (drop.unused.levels) factor(from) else as.factor(from) levs <- levels(fact) n <- length(fact) to <- match.arg(to) ## MM: using new() and then assigning slots has efficiency "advantage" ## of *not* validity checking res <- new(paste0(to, "gCMatrix")) res@i <- as.integer(fact) - 1L # 0-based res@p <- 0:n res@Dim <- c(length(levs), n) res@Dimnames <- list(levs, NULL) if(to != "n") res@x <- rep.int(switch(to, "d" = 1., "i" = 1L, "l" = TRUE, "z" = 1+0i), n) res } ## This version can deal with NA's [maybe slightly less efficient (how much?)] : fac2sparse <- function(from, to = c("d","i","l","n","z"), drop.unused.levels = TRUE, repr = c("C","T","R"), giveCsparse) { ## factor(-like) --> sparseMatrix {also works for integer, character} fact <- if (drop.unused.levels) factor(from) else as.factor(from) levs <- levels(fact) n <- length(fact) to <- match.arg(to) i <- as.integer(fact) - 1L ## 0-based indices df <- data.frame(i = i, j = if(n) 0:(n-1L) else integer())[!is.na(i),] if(to != "n") df$x <- rep.int(switch(to, "d" = 1., "i" = 1L, "l" = TRUE, "z" = 1+0i), nrow(df)) T <- do.call(new, c(list(Class = paste0(to, "gTMatrix"), Dim = c(length(levs), n), Dimnames = list(levs, names(fact))), df)) ## silent, back compatible (not yet warning about 'giveCsparse' deprecation): repr <- if(missing(repr) && !missing(giveCsparse)) if(giveCsparse) "C" else "T" else match.arg(repr) switch(repr, "C" = .Call(Tsparse_to_Csparse, T, FALSE), "T" = T,# TsparseMatrix "R" = as(T, "RsparseMatrix")) } setAs("factor", "sparseMatrix", function(from) fac2sparse(from, to = "d")) ##' fac2Sparse() := fac2sparse w/ contrasts ##' ##' @param from factor of which we want the "contrasted" (indicator) ##' design matrix ##' @param to character string specifying the response type ##' @param drop.unused.level logical indicating if non-present factor ##' levels should be dropped, via factor(from) ##' @param factorPatt12 logical vector fp[] of length 2 ##' fp[1] : give contrasted t(X); fp[2] : give "dummy" t(X) [=fac2sparse()] ##' @param contrasts.arg character string or NULL or (coercable to) ##' sparseMatrix, specifying the contrast ##' ##' @return a list of length two, each with the corresponding t(model matrix), ##' when the corresponding factorPatt12 is true. fac2Sparse <- function(from, to = c("d","i","l","n","z"), drop.unused.levels = TRUE, repr = c("C","T","R"), giveCsparse, factorPatt12, contrasts.arg = NULL) { stopifnot(is.logical(factorPatt12), length(factorPatt12) == 2) if(any(factorPatt12)) m <- fac2sparse(from, to=to, drop.unused.levels=drop.unused.levels, repr=repr, giveCsparse=giveCsparse) ## ## code '2' : keep dummy, i.e. no contrasts : ans <- list(NULL, if(factorPatt12[2]) m) ## if(factorPatt12[1]) { ## *do* use contrasts.arg if(is.null(contrasts.arg)) contrasts.arg <- getOption("contrasts")[if(is.ordered(from)) "ordered" else "unordered"] ans[[1]] <- crossprod(if(is.character(contrasts.arg)) { stopifnot(is.function(FUN <- get(contrasts.arg))) ## calling contr.*() with correct level names directly : FUN(rownames(m), sparse = TRUE) } else as(contrasts.arg, "sparseMatrix"), m) } ans } ## "Sparse model.matrix()" ## model.matrix(object, data = environment(object), ## contrasts.arg = NULL, xlev = NULL, ...) ## ## Originally: Cut'n'paste from model.matrix() ... just replacing small part at end: sparse.model.matrix <- function(object, data = environment(object), contrasts.arg = NULL, xlev = NULL, transpose = FALSE, drop.unused.levels = FALSE, row.names = TRUE , sep = "" , verbose = FALSE, ...) { t <- if(missing(data)) terms(object) else terms(object, data=data) if (is.null(attr(data, "terms"))) data <- model.frame(object, data, xlev=xlev) else { reorder <- match(sapply(attr(t,"variables"),deparse, width.cutoff=500)[-1L], names(data)) if (anyNA(reorder)) stop("model frame and formula mismatch in model.matrix()") if(!isSeq(reorder, ncol(data), Ostart=FALSE)) data <- data[,reorder, drop=FALSE] } int <- attr(t, "response") if(length(data)) { # otherwise no rhs terms, so skip all this contr.funs <- as.character(getOption("contrasts")) namD <- names(data) ## turn any character columns into factors for(i in namD) if(is.character(data[[i]])) data[[i]] <- factor(data[[i]]) isF <- vapply(data, function(x) is.factor(x) || is.logical(x), NA) isF[int] <- FALSE isOF <- vapply(data, is.ordered, NA) for(nn in namD[isF]) # drop response if(is.null(attr(data[[nn]], "contrasts"))) contrasts(data[[nn]]) <- contr.funs[1 + isOF[nn]] ## it might be safer to have numerical contrasts: ## get(contr.funs[1 + isOF[nn]])(nlevels(data[[nn]])) if (!is.null(contrasts.arg) && is.list(contrasts.arg)) { if (is.null(namC <- names(contrasts.arg))) stop("invalid 'contrasts.arg' argument") for (nn in namC) { if (is.na(ni <- match(nn, namD))) warning(gettextf("variable '%s' is absent, its contrast will be ignored", nn), domain = NA) else { ca <- contrasts.arg[[nn]] ## for R >= 4.2 or so, simply contrasts(*, ncol(.)) <- ca if(is.matrix(ca) || inherits(ca, "Matrix")) contrasts(data[[ni]], ncol(ca)) <- ca else # function | string contrasts(data[[ni]]) <- ca } } } } else { # internal model.matrix needs some variable isF <- FALSE data <- cbind(data, x = 0) } ## src/library/stats/R/models.R has ## ans <- .Internal(model.matrix(t, data)) if(verbose) { cat("model.spmatrix(t, data, ..) with t =\n"); str(t,give.attr=FALSE) } ans <- model.spmatrix(t, data, transpose=transpose, ## ============== drop.unused.levels=drop.unused.levels, row.names=row.names, sep=sep, verbose=verbose) ## attr(ans, "contrasts") <- lapply(data[isF], function(x) attr(x, "contrasts")) ans } ## {sparse.model.matrix} ##' Produce the t(Z); Z = "design matrix" of (X : Y), where ##' --- t(Z) : aka rowwise -version : "r" ##' ##' @title sparse model matrix for 2-way interaction ##' @param X and Y either are numeric matrices {maybe 1-column} ##' @param Y or "as(, sparseM)" ##' @param do.names logical ##' @param forceSparse logical ##' @return ##' @author Martin Maechler sparse2int <- function(X, Y, do.names = TRUE, forceSparse = FALSE, verbose = FALSE) { ### FIXME -- the X[rep(..), ] * Y[rep(..), ] construct can become HUGE, even for sparse X[],Y[] ### ----- --> Matrix bug #1330 and ~/R/MM/Pkg-ex/Matrix/sparse-matrix-fix.R if(do.names) { dnx <- dimnames(X) dny <- dimnames(Y) } dimnames(Y) <- dimnames(X) <- list(NULL,NULL) nx <- nrow(X) ny <- nrow(Y) r <- if((nX <- is.numeric(X)) | (nY <- is.numeric(Y))) { if(nX) { if (nY || nx > 1) { # both numeric, or X >=2 "columns" F <- if(forceSparse) function(m) .Call(dense_to_Csparse, m) else identity F((if(ny == 1) X else X[rep.int(seq_len(nx), ny) , ]) * (if(nx == 1) Y else Y[rep (seq_len(ny),each=nx), ])) } else { ## numeric X (1 "column"), sparseMatrix Y r <- Y dp <- Y@p[-1] - Y@p[-(Y@Dim[2]+1L)] ## stopifnot(all(dp %in% 0:1)) ## if(nx == 1) ## FIXME: similar trick would be applicable for nx > 2 r@x <- X[dp == 1L] * Y@x r } } else { ## sparseMatrix X, numeric Y if(ny == 1) { ## FIXME: similar trick would be applicable for ny > 2 r <- X dp <- X@p[-1] - X@p[-(X@Dim[2]+1L)] ## stopifnot(all(dp %in% 0:1)) r@x <- Y[dp == 1L] * X@x r } else { ## ny > 1 -- *larger* matrix X[rep.int(seq_len(nx), ny) , ] * (if(nx == 1) Y else Y[rep(seq_len(ny),each=nx), ]) } } } else { ## X & Y are both sparseMatrix (if(ny == 1) X else X[rep.int(seq_len(nx), ny) , ]) * (if(nx == 1) Y else Y[rep (seq_len(ny),each=nx) , ]) } if(verbose) cat(sprintf(" sp..2int(%s[%d],%s[%d]) ", if(nX)"" else "", nx, if(nY)"" else "", ny)) if(do.names) { ## FIXME: This names business needs a good solution.. ## but maybe "up in the caller" if(!is.null(dim(r)) && !is.null(nX <- dnx[[1]]) && !is.null(nY <- dny[[1]])) rownames(r) <- outer(nX, nY, paste, sep = ":") } r } ##' Sparse Model Matrix for a (high order) interaction term A:B:x:C ##' ##' @param rList list(.) of (transposed) single-factor model matrices, ##' belonging to, say, factors a, b, c,... ##' @param do.names ##' @param forceSparse ##' @param verbose ##' @return the model matrix corresponding to a:b:... sparseInt.r <- function(rList, do.names = TRUE, forceSparse = FALSE, verbose=FALSE) { nl <- length(rList) if(forceSparse) F <- function(m) if(is.matrix(m) || is(m, "denseMatrix")) .Call(dense_to_Csparse, m) else m if(verbose) cat("sparseInt.r([1:",nl,"], f.Sp=",forceSparse,"): is.mat()= (", paste(symnum(vapply(rList, is.matrix, NA)), collapse=""), ")\n", sep="") if(nl == 1) { if(forceSparse) F(rList[[1]]) else rList[[1]] } else { ## 'recursion' free: r <- rList[[1]] for(j in 2:nl) r <- sparse2int(r, rList[[j]], forceSparse=forceSparse, do.names=do.names, verbose=verbose) if(forceSparse) F(r) else r } } ## not used currently is.model.frame <- function(x) { ## Purpose: check if x is a "valid" model.frame ## ------------------------------------------------------------ ## Author: Martin Maechler, Date: 3 Jul 2009 is.data.frame(x) && !is.null(tms <- attr(x, "terms")) && inherits(tms, "terms") && ## is.terms() would be better inherits(tms, "formula") && is.matrix(attr(tms, "factors")) && is.language(vv <- attr(tms, "variables")) && vv[[1]] == as.symbol("list") && all(vapply(as.list(vv[-1]), as.character, "") %in% colnames(x)) ## all((vars <- sapply(as.list(vv[-1]), as.character)) %in% colnames(x)) ## and we could go on testing vars } ##' Create a sparse model matrix from a model frame. ##' ##' @title Sparse Model Matrix from Model Frame ##' @param trms a "terms" object ##' @param mf a data frame, typically resulting from model.frame() ##' @param transpose logical indicating if X' = t(X) {is faster!} ##' or X should be returned ##' @param drop.unused.levels logical indicating if unused factor ##' levels should be dropped ##' @param row.names ##' @return sparse matrix (class "dgCMatrix") ##' @author Martin Maechler model.spmatrix <- function(trms, mf, transpose=FALSE, drop.unused.levels = FALSE, row.names=TRUE, sep="", verbose=FALSE) { ## Author: Martin Maechler, Date: 7 Jul 2009 ## mf is a model frame or a "simple" data.frame [after reorder !] stopifnot(is.data.frame(mf)) n <- nrow(mf) if(row.names) rnames <- row.names(mf) ## mf: make into list, dropping all attributes (but the names) ### FIXME: for poly(., 5) mf has a 5-column matrix as "one column" => looses names here fnames <- names(mf <- unclass(mf)) attributes(mf) <- list(names = fnames) if(length(factorPattern <- attr(trms, "factors"))) { d <- dim(factorPattern) nVar <- d[1] nTrm <- d[2] n.fP <- dimnames(factorPattern) fnames <- n.fP[[1]] # == names of variables {incl. "F(var)"} in the model Names <- n.fP[[2]] # == colnames == names of terms: "a", "b:c", ... } else { ## degenerate, e.g. 'Y ~ 1' nVar <- nTrm <- 0L fnames <- Names <- character(0) } ## all the "variables in the model" are also in "mf", including "sin(x)"; ## actually, ..../src/main/model.c even assumes stopifnot((m <- length(mf)) >= nVar) if(verbose) cat(sprintf("model.spm..(): (n=%d, nVar=%d (m=%d), nTrm=%d)\n", n, nVar,m, nTrm)) if(m > nVar) mf <- mf[seq_len(nVar)] stopifnot(fnames == names(mf), allow.logical0 = TRUE) noVar <- nVar == 0 ##>> this seems wrong; we use 1:nVar for indexing mf[] below .. ##>> if(noVar) nVar <- 1L # (as in ~/R/D/r-devel/R/src/main/model.c) ## Note: "character" variables have been changed to factor in the caller; ## hence: both factor and *logical* should be dealt as factor : is.f <- if(noVar) logical(0) else vapply(mf, function(.) is.factor(.) | is.logical(.), NA) indF <- which(is.f) if(verbose) { cat(" --> indF =\n"); print(indF) } hasInt <- attr(trms, "intercept") == 1 ## the degree of interaction: ## intOrder <- attr(trms, "order") ## if(!hasInt && length(indF)) { ## change the '1' of the first factor into a '2' : if(any(i1 <- factorPattern[indF, ] == 1)) ## replace at the first '1' location: factorPattern[indF,][which.max(i1)] <- 2L else {} ## nothing to do } ## Convert "factors" to "Rowwise- sparseMatrix ("dummy"-matrix) ----------- ## Result: a list of sparse model matrices for the "factor"s : f.matr <- structure(vector("list", length = length(indF)), names = fnames[indF]) i.f <- 0 ## ---- For each variable in the model ------------------- for(i in seq_len(nVar)) { nam <- fnames[i] f <- mf[[i]] if(is.f[i]) { fp <- factorPattern[i,] ## == factorPattern[nam,] contr <- attr(f, "contrasts") f.matr[[(i.f <- i.f + 1)]] <- # a list of 2 lapply(fac2Sparse(f, to = "d", drop.unused.levels=drop.unused.levels, factorPatt12 = 1:2 %in% fp, contrasts.arg = contr), function(s) { if(is.null(s)) return(s) ## else rownames(s) <- ## for some contr.*(), have lost rownames; hmm.. paste(nam, rownames(s) %||% seq_len(nrow(s)), sep=sep) s }) } else { ## continuous variable --> "matrix" - for all of them if(any(iA <- (cl <- class(f)) == "AsIs")) # drop "AsIs" class class(f) <- if(length(cl) > 1L) cl[!iA] nr <- if(is.matrix(f)) nrow(f <- t(f)) else (dim(f) <- c(1L, length(f)))[1] if(is.null(rownames(f))) rownames(f) <- if(nr == 1) nam else paste(nam, seq_len(nr), sep=sep) mf[[i]] <- f } } if(verbose) { cat(" ---> f.matr list :\n") str(f.matr, max = as.integer(verbose)) fNms <- format(dQuote(Names)) dim.string <- gsub('5', as.character(floor(1+log10(n))), " -- concatenating (r, rj): dim = (%5d,%5d) | (%5d,%5d)\n") } ## FIXME: do all this in C -- getR <- function(N) # using 'nm' if(!is.null(r <- f.matr[[N]])) r[[factorPattern[N, nm]]] else mf[[N]] vNms <- "(Intercept)"[hasInt] counts <- integer(nTrm) r <- if(hasInt) ## column of 1's - as sparse new("dgCMatrix", i = 0:(n-1L), p = c(0L, n), Dim = c(n, 1L), x = rep.int(1, n)) else new("dgCMatrix", Dim = c(n, 0L)) if(transpose) r <- t(r) iTrm <- seq_len(nTrm) for(j in iTrm) { ## j-th term nm <- Names[j] if(verbose) cat(sprintf("term[%2d] %s .. ", j, fNms[j])) nmSplits <- strsplit(nm, ":", fixed=TRUE)[[1]] ## NOTA BENE: This can be very slow when many terms are involved ## FIXME ??? why does it use *much* memory in those cases ?? rj <- sparseInt.r(lapply(nmSplits, getR), do.names=TRUE, forceSparse = TRUE, verbose=verbose)# or just (verbose >= 2)) if(verbose) cat(sprintf(dim.string, nrow(r), ncol(r), nrow(rj),ncol(rj))) ## fast version of cbind2() / rbind2(), w/o checks, dimnames, etc r <- if(transpose) .Call(Csparse_vertcat, r, rj) else .Call(Csparse_horzcat, r, t(rj)) ## if(verbose) cat(" [Ok]\n") vNms <- c(vNms, dimnames(rj)[[1]]) counts[j] <- nrow(rj) } rns <- if(row.names) rnames dimnames(r) <- if(transpose) list(vNms, rns) else list(rns, vNms) attr(r, "assign") <- c(if(hasInt) 0L, rep(iTrm, counts)) r } ## model.spmatrix() Matrix/R/rankMatrix.R0000644000176200001440000001453013771034654014177 0ustar liggesusers#### Determine *the* rank of a matrix #### -------------------------------- ## ## As this is not such a well-defined problem as people think, ## we provide *some* possibilities here, including the Matlab one. ## ## Ideas by Martin Maechler (April 2007) and Ravi Varadhan (October 2007) qr2rankMatrix <- function(qr, tol = NULL, isBqr = is.qr(qr), do.warn=TRUE) { ## NB: 1) base::qr(*, LAPACK = TRUE/FALSE) differ via attr(.,"useLAPACK") ## 2) if LAPACK=TRUE, .$rank is useless (always = full rank) ## ## return ( . ) : if(isBqr && !isTRUE(attr(qr, "useLAPACK"))) qr$rank else { diagR <- if(isBqr) # hence "useLAPACK" here diag(qr$qr) # faster than, but equivalent to diag(qr.R(q.r)) else ## ==> assume Matrix::qr() i.e., currently "sparseQR" ## FIXME: Here, we could be quite a bit faster, ## by not returning the full sparseQR, but just ## doing the following in C, and return the rank. diag(qr@R) if(anyNA(diagR) || !all(is.finite(diagR))) { if(do.warn) { ifi <- is.finite(diagR) warning(gettextf( "qr2rankMatrix(.): QR with only %d out of %d finite diag(R) entries", sum(ifi), length(ifi))) } ## return NA_integer_ ## alternative: gives *too* small rank in typical cases ## reduce the maximal rank by omitting all non-finite entries: ## diagR <- diagR[is.finite(diagR)] ## if(length(diagR) == 0) ## return(NA_integer_) } else { if(isBqr) diagR <- abs(diagR) # in base qr(), sign( diag(R) ) are *not* coerced to positive else if(do.warn && any(diagR < 0)) warning(gettextf("qr2rankMatrix(.): QR has negative diag(R) entries")) ## declare those entries to be zero that are < tol*max(.) if((mdi <- max(diagR, na.rm=TRUE)) > 0) { if(!is.numeric(tol)) { ## d := dim(x) extracted from qr, in both (dense and sparse) qr() cases d <- dim(if(isBqr) qr$qr else qr) tol <- max(d) * .Machine$double.eps } sum(diagR >= tol * mdi) ## was sum(diag(q.r@R) != 0) } else 0L # for 0-matrix or all NaN or negative diagR[] } } ## else {Lapack or sparseQR} } rankMatrix <- function(x, tol = NULL, method = c("tolNorm2", "qr.R", "qrLINPACK", "qr", "useGrad", "maybeGrad"), sval = svd(x, 0,0)$d, warn.t = TRUE, warn.qr = TRUE) { ## Purpose: rank of a matrix ``as Matlab'' or "according to Ravi V" ## ---------------------------------------------------------------------- ## Arguments: x: a numerical matrix, maybe non-square ## tol: numerical tolerance (compared to singular values) ## sval: vector of non-increasing singular values of x ## (pass as argument if already known) ## ---------------------------------------------------------------------- ## Author: Martin Maechler, Date: 7 Apr 2007, 16:16 ## ---------------------------------------------------------------------- ## ## maybeGrad (Ravi V.): This algorithm determines the rank based on the ## "gradient" of the ## absolute, singular values, rather than enforcing a rigid ## tolerance criterion, ## ## Author: Ravi Varadhan, Date: 22 October 2007 // Tweaks: MM, Oct.23 ## ---------------------------------------------------------------------- stopifnot(length(d <- dim(x)) == 2) p <- min(d) ## miss.meth <- missing(method) method <- match.arg(method) if(useGrad <- (method %in% c("useGrad", "maybeGrad"))) { stopifnot(length(sval) == p) if(p > 1) stopifnot(diff(sval) <= 0) # must be sorted non-increasingly: max = s..[1] if(sval[1] == 0) { ## <==> all singular values are zero <==> Matrix = 0 <==> rank = 0 useGrad <- FALSE method <- eval(formals()[["method"]])[[1]] } else { ln.av <- log(abs(sval)) if(any(s0 <- sval == 0)) ln.av[s0] <- - .Machine$double.xmax # so we get diff() == 0 diff1 <- diff(ln.av) if(method == "maybeGrad") { grad <- (min(ln.av) - max(ln.av)) / p useGrad <- !is.na(grad) && p > 1 && min(diff1) <= min(-3, 10 * grad) }# ------- } } if(!useGrad) { x.dense <- is.numeric(x) || is(x,"denseMatrix") ## "qr" is allowed for backcompatibility [change @ 2013-11-24] if((Meth <- method) == "qr") method <- if(x.dense) "qrLINPACK" else "qr.R" else Meth <- substr(method, 1,2) if(Meth == "qr") { if(is.null(tol)) tol <- max(d) * .Machine$double.eps } else { ## (Meth != "qr"), i.e. "tolNorm2" if(is.null(tol)) { if(!x.dense && missing(sval) && prod(d) >= 100000L) warning(gettextf( "rankMatrix(, method = '%s') coerces to dense matrix. Probably should rather use method = 'qr' !?", method), immediate.=TRUE, domain=NA) ## the "Matlab" default: if(p > 1) stopifnot(diff(sval) <= 0) #=> sval[1]= max(sval) tol <- max(d) * .Machine$double.eps } else stopifnot((tol <- as.numeric(tol)[[1]]) >= 0) } } structure(## rank : if(useGrad) which.min(diff1) else if(Meth == "qr") { if((do.t <- (d[1L] < d[2L])) && warn.t) warning(gettextf( "rankMatrix(x, method='qr'): computing t(x) as nrow(x) < ncol(x)")) q.r <- qr(if(do.t) t(x) else x, tol=tol, LAPACK = method != "qrLINPACK") qr2rankMatrix(q.r, tol=tol, isBqr = x.dense, do.warn = warn.qr) } else if(sval[1] > 0) sum(sval >= tol * sval[1]) else 0L, ## "tolNorm2" "method" = method, "useGrad" = useGrad, "tol" = if(useGrad) NA else tol) } ## Ravi's plot of the absolute singular values: if(FALSE) { ## if (plot.eigen) { plot(abs(sval), type = "b", xlab = "Index", xaxt = "n", log = "y", ylab = "|singular value| [log scaled]") axis(1, at = unique(c(axTicks(1), rank, p))) abline(v = rank, lty = 3) mtext(sprintf("rank = %d (used %s (%g))", rank, if(use.grad)"'gradient'" else "fixed tol.", if(use.grad) min(diff1) else tol)) } Matrix/R/LU.R0000644000176200001440000000101411054545144012361 0ustar liggesuserssetMethod("expand", signature(x = "denseLU"), function(x, ...) .Call(LU_expand, x)) setMethod("solve", signature(a = "denseLU", b = "missing"), function(a, b, ...) { ll <- expand(a) #-> list(L, U, P); orig x = P %*% L %*% U ## too expensive: with(lapply(ll, solve), U %*% L %*% P) solve(ll$U, solve(ll$L, ll$P)) }) setMethod("expand", signature(x = "sparseLU"), function(x, ...) list(P = as(x@p + 1L, "pMatrix"), L = x@L, U = x@U, Q = as(x@q + 1L, "pMatrix"))) Matrix/R/lgCMatrix.R0000644000176200001440000000226013253131430013727 0ustar liggesusers#### Logical Sparse Matrices in Compressed column-oriented format ### contains = "lsparseMatrix" ## Can use CsparseMatrix methods for all of these ## setMethod("t", signature(x = "lgCMatrix"), ## function(x) .Call(lgCMatrix_trans, x), ## valueClass = "lgCMatrix") ## setMethod("diag", signature(x = "lgCMatrix"), ## function(x, nrow, ncol) .Call(lgCMatrix_diag, x)) setAs("lgCMatrix", "dgCMatrix", function(from) new("dgCMatrix", i = from@i, p = from@p, x = as.double(from@x), Dim = from@Dim, Dimnames = from@Dimnames)) setAs("lgCMatrix", "lgTMatrix", function(from) new("lgTMatrix", i = from@i, x = from@x, j = .Call(Matrix_expand_pointers, from@p), Dim = from@Dim, Dimnames = from@Dimnames)) setAs("lgCMatrix", "lgeMatrix", function(from) new("lgeMatrix", x = c(as(from, "matrix")), # is fast, Dim = from@Dim, Dimnames = from@Dimnames)) setAs("lgCMatrix", "matrix", function(from) .Call(lgC_to_matrix, from)) ## not this: .Call(Csparse_to_matrix, from)), since it goes via dense -> double precision setAs("matrix", "lgCMatrix", .m2lgC) Matrix/R/KhatriRao.R0000644000176200001440000000410412760263240013727 0ustar liggesusers# Efficient Khatri-Rao product for large sparse matrices # Assumes two matrices in CsparseMatrix format # Written by Michael Cysouw ## MM: there's a "public" Matlab version, at ## http://www.mathworks.com/matlabcentral/fileexchange/28872-khatri-rao-product/content/kr.m ## with documentation ## ## % Khatri-Rao product. ## ## % kr(A,B) returns the Khatri-Rao product of two matrices A and B, of ## % dimensions I-by-K and J-by-K respectively. The result is an I*J-by-K ## % matrix formed by the matching columnwise Kronecker products, i.e. ## % the k-th column of the Khatri-Rao product is defined as ## % kron(A(:,k),B(:,k)). KhatriRao <- function(X, Y = X, FUN = "*", make.dimnames = FALSE) { stopifnot((p <- ncol(X)) == ncol(Y)) X <- as(X,"CsparseMatrix") Y <- as(Y,"CsparseMatrix") is.n <- (nX <- is(X, "nMatrix")) & (nY <- is(Y, "nMatrix")) xn <- diff( X@p) yn <- diff(yp <- Y@p) ## both of length p newp <- as.integer(diffinv(xn*yn)) rep.yn <- rep.int(yn,xn) xn.yp <- xn[ as.logical(yn) ] # xn "where" Y is present non0 <- length(xn.yp) > 0L && any(xn.yp != 0L) i1 <- rep.int(X@i, rep.yn) i2 <- if(non0) { yj <- .Call(Matrix_expand_pointers, yp)## as(Y,"TsparseMatrix")@j yj <- factor(yj) # for 2x split() below unlist(rep(split.default(Y@i,yj), xn.yp)) } else integer() n1 <- nrow(X); n2 <- nrow(Y) newi <- i1*n2 + i2 dim <- as.integer(c(n1*n2, p)) dns <- if (make.dimnames) { ## this is not good enough: dnx, dny may be NULL list(as.vector(outer(rownames(Y),rownames(X), FUN = "paste", sep = ":")), colnames(X)) } else list(NULL,NULL) if(is.n) new("ngCMatrix", Dim=dim, Dimnames=dns, i = newi, p = newp) else { ## at least one of 'X' and 'Y' has an "x" slot: if(nX) X <- as(X, "lgCMatrix") x1 <- rep.int(X@x, rep.yn) x2 <- if(non0) { if(nY) Y <- as(Y, "lgCMatrix") unlist(rep(split.default(Y@x,yj), xn.yp)) } else if(nY) logical() else Y@x[0] new("dgCMatrix", Dim=dim, Dimnames=dns, i = newi, p = newp, x = match.fun(FUN) (x1,x2)) } } Matrix/R/nsTMatrix.R0000644000176200001440000000151612501023016013764 0ustar liggesusers#### Sparse Symmetric non-zero pattern Matrices in Triplet format ### contains = "nsparseMatrix" setAs("nsTMatrix", "matrix", function(from) as(as(from, "ngTMatrix"), "matrix")) setAs("nsTMatrix", "ngCMatrix", # for diag function(from) as(as(from, "nsCMatrix"), "ngCMatrix")) setAs("nsTMatrix", "ngTMatrix", function(from) .Call(nsTMatrix_as_ngTMatrix, from)) setAs("nsTMatrix", "dsTMatrix", function(from) new("dsTMatrix", i = from@i, j = from@j, uplo = from@uplo, x = rep.int(1., length(from@i)), Dim = from@Dim, Dimnames = from@Dimnames)) setAs("nsTMatrix", "nsyMatrix", function(from) .Call(nsTMatrix_as_nsyMatrix, from)) setMethod("t", "nsTMatrix", function(x) new("nsTMatrix", Dim = x@Dim, Dimnames = x@Dimnames[2:1], i = x@j, j = x@i, uplo = if (x@uplo == "U") "L" else "U")) Matrix/R/Summary.R0000644000176200001440000002737613556074235013530 0ustar liggesusers####--- All "Summary" group methods for all Matrix classes (incl sparseVector) ------ #### ======= but diagonalMatrix -> ./diagMatrix.R and abIndex.R #### ~~~~~~~~~~~~ ~~~~~~~~~ ## M-x grep -E -e 'Method\("(Summary|max|min|range|all|any|prod|sum)"' *.R ## ---- sG <- getGroupMembers("Summary") if(FALSE) sG ## "max" "min" "range" "prod" "sum" "any" "all" ## w/o "prod" & "sum": summGener1 <- sG[match(sG, c("prod","sum"), 0) == 0] rm(sG) ###---------- dMatrix setMethod("Summary", "ddenseMatrix", function(x, ..., na.rm) { d <- x@Dim if(any(d == 0)) return(callGeneric(numeric(0), ..., na.rm=na.rm)) clx <- getClassDef(class(x)) if(extends(clx, "generalMatrix")) callGeneric(x@x, ..., na.rm = na.rm) else if(extends(clx, "symmetricMatrix")) { # incl packed, pos.def. if(.Generic %in% summGener1) { callGeneric(if (length(x@x) < prod(d)) x@x else x@x[indTri(d[1], upper= x@uplo == "U", diag= TRUE)], ..., na.rm = na.rm) } else callGeneric(..2dge(x)@x, ..., na.rm = na.rm) } else { ## triangular , possibly packed if(.Generic %in% summGener1) { if(.Generic %in% c("any","all")) { Zero <- FALSE; One <- TRUE; xx <- as.logical(x@x) } else { Zero <- 0; One <- 1; xx <- x@x } callGeneric(if (length(xx) < prod(d)) xx ## <- 'packed' else xx[indTri(d[1], upper= x@uplo == "U", diag= TRUE)], if(d[1] >= 2) Zero, if(x@diag == "U") One, ..., na.rm = na.rm) } else callGeneric(..2dge(x)@x, ..., na.rm = na.rm) } }) setMethod("Summary", "dsparseMatrix", function(x, ..., na.rm) { ne <- prod(d <- dim(x)) if(ne == 0) return(callGeneric(numeric(0), ..., na.rm=na.rm)) n <- d[1] clx <- getClassDef(class(x)) isTri <- extends(clx, "triangularMatrix") if(extends(clx, "TsparseMatrix") && anyDuplicatedT(x, di = d)) x <- .Call(Tsparse_to_Csparse, x, isTri)# = as(x, "Csparsematrix") l.x <- length(x@x) if(l.x == ne) ## fully non-zero (and "general") - very rare but quick return( callGeneric(x@x, ..., na.rm = na.rm) ) ## else l.x < ne isSym <- !isTri && extends(clx, "symmetricMatrix") isU.tri <- isTri && x@diag == "U" ## "full": has *no* structural zero : very rare, but need to catch : full.x <- ((isSym && l.x == choose(n+1, 2)) || (n == 1 && (isU.tri || l.x == 1))) isGener1 <- .Generic %in% summGener1 if(isGener1) { ## not prod() or sum() -> no need check for symmetric ## we rely on (x, NULL, y, ..) :== (x, y, ..): if(any(.Generic == c("any","all"))) ## logic: callGeneric(as.logical(x@x), if(!full.x) FALSE, if(isU.tri) TRUE, ..., na.rm = na.rm) else callGeneric(x@x, if(!full.x) 0, if(isU.tri) 1, ..., na.rm = na.rm) } else { ## prod() or sum() : care for "symmetric" and U2N if(!full.x && .Generic == "prod") { if(anyNA(x@x)) NaN else 0 } else callGeneric((if(isSym) as(x, "generalMatrix") else x)@x, if(!full.x) 0, # one 0 <==> many 0's if(isU.tri) rep.int(1, n), ..., na.rm = na.rm) } }) ###---------- ldenseMatrix if(FALSE) # not correct (@x may contain "wrong" in "other" triangel setMethod("all", "lsyMatrix", function(x, ..., na.rm = FALSE) all(x@x, ..., na.rm = na.rm)) if(FALSE) # replaced by "Summary" below ## Note: the above "lsy*" method is needed [case below can be wrong] setMethod("all", "ldenseMatrix", function(x, ..., na.rm = FALSE) { if(prod(dim(x)) >= 1) (!is(x, "triangularMatrix") && !is(x, "diagonalMatrix") && all(x@x, ..., na.rm = na.rm)) else all(x@x, ..., na.rm = na.rm) }) ## almost copy_paste from "ddenseMatrix" above Summ.ln.dense <- function(x, ..., na.rm) { d <- x@Dim if(any(d == 0)) return(callGeneric(logical(0), ..., na.rm=na.rm)) ext <- extends(getClassDef(class(x))) if(any("generalMatrix" == ext)) callGeneric(x@x, ..., na.rm = na.rm) else if(any("symmetricMatrix" == ext)) { # incl packed, pos.def. if(.Generic != "sum") { ## i.e., %in% summGener1 callGeneric(if (length(x@x) < prod(d)) x@x else x@x[indTri(d[1], upper= x@uplo == "U", diag= TRUE)], ..., na.rm = na.rm) } else ## sum() -- FIXME-faster: use x@x[indTri(...)] similar to above callGeneric(as(x, paste0(if(any("ldenseMatrix" == ext)) "l" else "n", "geMatrix"))@x, ..., na.rm = na.rm) } else { ## triangular , possibly packed if(.Generic != "sum") ## incl. prod() ! callGeneric(x@x, if(d[1] >= 2) FALSE, if(x@diag == "U") TRUE, ..., na.rm = na.rm) else ## sum() -- FIXME-faster: using indTri()..; in unit-diag. case: plus n x TRUE = d[1] ## if packed: sum(x@x, if(x@diag == "U") d[1], ..., na.rm = na.rm) callGeneric(as(x, paste0(if(any("ldenseMatrix" == ext)) "l" else "n", "geMatrix"))@x, ..., na.rm = na.rm) } } setMethod("Summary", "ldenseMatrix", Summ.ln.dense) setMethod("Summary", "ndenseMatrix", Summ.ln.dense) ###---------- lMatrix setMethod("any", "lMatrix", function(x, ..., na.rm = FALSE) ## logical unit-triangular has TRUE diagonal: (prod(dim(x)) >= 1 && is(x, "triangularMatrix") && x@diag == "U") || any(x@x, ..., na.rm = na.rm)) ###---------- lsparseMatrix ##------- Work via as(*, lgC) : ------------ setMethod("all", "lsparseMatrix", function(x, ..., na.rm = FALSE) { d <- x@Dim l.x <- length(x@x) if(l.x == prod(d)) ## fully non-zero all(x@x, ..., na.rm = na.rm) else if(is(x, "symmetricMatrix") && l.x == choose(d[1]+1, 2)) { if(.Generic %in% summGener1) all(x@x, ..., na.rm = na.rm) else all(as(x, "generalMatrix")@x, ..., na.rm = na.rm) } else FALSE ## has at least one structural 0 }) ###---------- Matrix ## For all other Matrix objects {and note that "all" and "any" have their own}: setMethod("all", "Matrix", function(x, ..., na.rm) callGeneric(as(x, "lMatrix"), ..., na.rm=na.rm)) setMethod("any", "Matrix", function(x, ..., na.rm) callGeneric(as(x, "lMatrix"), ..., na.rm=na.rm)) setMethod("Summary", "Matrix", ## FIXME (too cheap): all() should not go via dMatrix!! function(x, ..., na.rm) callGeneric(as(x,"dMatrix"), ..., na.rm = na.rm)) ## Try to make min(1, ) work, i.e., not dispatch on first arg to .Primitive ## This for(..) gives {during installation} ## Error in setGeneric(F, signature = "...") : ## ‘max’ is a primitive function; methods can be defined, but the generic function is implicit, and cannot be changed. if(FALSE) for(F in c("max", "min", "range", "prod", "sum", "any", "all")) { setGeneric(F, signature = "...") } ## try on "min" for now --- ~/R/Pkgs/Rmpfr/R/mpfr.R is the example (for "pmin") if(FALSE)## This gives error message that the "ANY" is method is sealed ... setMethod("min", "ANY", function(..., na.rm = FALSE) { args <- list(...) if(all(isAtm <- vapply(args, is.atomic, NA))) return( base::min(..., na.rm = na.rm) ) ## else try to dispatch on an argument which is a Matrix.. or in a if(any(isM <- vapply(args, is, NA, class2="Matrix"))) { ## swap the Matrix with the first argument i <- which.max(isM)# the first "Matrix" if(i == 1) stop("programming error: min() should have dispatched w/ 1st arg much earlier") } else { ## if no "Matrix", take the first non-atomic argument ## (FIXME: should take the first for which there is a method !) i <- which.max(!isAtm) } ii <- seq_along(args) ii[c(1,i)] <- c(i,1) do.call(min, c(args[ii], list(na.rm=na.rm))) }) if(FALSE) { ## FIXME: it does *not* solve the problem anyway .. ## ## (m <- Matrix(c(0,0,2:0), 3,5)) ## min(1,m) ##-> error, as it calls the .Primitive min() and that does *not* dispatch on 2nd arg ## setMethod("Summary", "ANY", function(x, ..., na.rm) { if(!length(a <- list(...))) (get(.Generic, envir=baseenv()))(x, na.rm=na.rm) else { if(!is.null(v <- getOption("Matrix.verbose")) && v >= 1) if(length(a) > 1) message(gettextf("in Summary(, .): %s(<%s>, <%s>,...)\n", .Generic, class(x), class(a[[1]])), domain = NA) else message(gettextf("in Summary(, .): %s(<%s>, <%s>)\n", .Generic, class(x), class(a[[1]])), domain = NA) do.call(.Generic, c(x, a, list(na.rm=na.rm))) }}) }## {does not help --> not used} Summary.l <- function(x, ..., na.rm) { ## must be method directly if(.Generic %in% c("all", "any")) callGeneric(x@x, ..., na.rm = na.rm) else { r <- callGeneric(as(x,"dMatrix"), ..., na.rm = na.rm) if(.Generic != "prod" && !any(is.infinite(r))) as.integer(r) else r } } ## almost identical: Summary.np <- function(x, ..., na.rm) { if(.Generic %in% c("all", "any")) callGeneric(as(x, "lMatrix"), ..., na.rm = na.rm) else { r <- callGeneric(as(x,"dMatrix"), ..., na.rm = na.rm) if(.Generic != "prod" && !any(is.infinite(r))) as.integer(r) else r } } ## setMethod("Summary", "lMatrix", Summary.l) setMethod("Summary", "nMatrix", Summary.np) setMethod("Summary", "indMatrix", Summary.np) ###---------- nsparseMatrix setMethod("all", "nsparseMatrix", function(x, ..., na.rm = FALSE) { pd <- prod(d <- dim(x)) if(pd == 0) return(TRUE) cld <- getClassDef(class(x)) if(extends(cld, "triangularMatrix")) return(FALSE) ## else if(extends(cld, "TsparseMatrix")) cld <- getClassDef(class(x <- as(x, "CsparseMatrix"))) ## now have Csparse or Rsparse: length of index slot = no.{TRUE} l.x <- length(if(extends(cld, "CsparseMatrix")) x@i else x@j) (l.x == pd) || ## fully non-zero (extends(cld, "symmetricMatrix") && l.x == choose(d[1]+1, 2)) ## else FALSE }) setMethod("any", "nsparseMatrix", function(x, ..., na.rm = FALSE) { if(any(dim(x) == 0)) return(FALSE) cld <- getClassDef(class(x)) if(extends(cld, "triangularMatrix") && x@diag == "U") TRUE # unit-diagonal else if(extends1of(cld, c("CsparseMatrix", "TsparseMatrix"))) length(x@i) > 0 else # RsparseMatrix length(x@j) > 0 }) ###---------- sparseVector setMethod("Summary", "nsparseVector", function(x, ..., na.rm) { ## no 'x' slot, no NA's .. n <- x@length l.x <- length(x@i) if(l.x == n) callGeneric(rep.int(TRUE, n), ..., na.rm = na.rm) else ## l.x < n : has some FALSE entries switch(.Generic, "prod" = 0, "min" = 0L, "all" = FALSE, "any" = l.x > 0, "sum" = l.x, "max" = as.integer(l.x > 0), "range" = c(0L, as.integer(l.x > 0))) }) ## The "other" "sparseVector"s ("d", "l", "i" ..): all have an 'x' slot : setMethod("Summary", "sparseVector", function(x, ..., na.rm) { n <- x@length l.x <- length(x@x) if(l.x == n) ## fully non-zero (and "general") - very rare but quick callGeneric(x@x, ..., na.rm = na.rm) else if(.Generic != "prod") { ## we rely on (x, NULL, y, ..) :== (x, y, ..): if(any(.Generic == c("any","all"))) ## logic: callGeneric(as.logical(x@x), FALSE, ..., na.rm = na.rm) else # "numeric" callGeneric(x@x, 0, ..., na.rm = na.rm) } else { ## prod() if(anyNA(x@x)) NaN else 0 } }) ## help( pmin ) in R : ## ----- ## ‘pmax’ and ‘pmin’ will also work on classed objects with appropriate methods ## for comparison, ‘is.na’ and ‘rep’ (if recycling of arguments is needed). ## ##--> and that now *does* work, in 'R 3.3.1 patched' and newer Matrix/R/eigen.R0000644000176200001440000001126513141330160013126 0ustar liggesusers#### eigen() , Schur() etc #### ===== ===== ## eigen() is not even generic, and we haven't any C code, ## NOTE base::eigen() "magically" can work via as.matrix() if(.Matrix.avoiding.as.matrix) { ## ---- IFF as.matrix(.) <==> as(., "matrix") [which we consider _deprecating_] ## FIXME: Code for *sparse* !! [RcppEigen ~??~] setMethod("eigen", signature(x = "Matrix", only.values = "missing"), function(x, symmetric, only.values, EISPACK) # << must match generic base::eigen(as(x,"matrix"), symmetric, FALSE)) setMethod("eigen", signature(x = "Matrix", only.values = "logical"), function(x, symmetric, only.values, EISPACK) base::eigen(as(x,"matrix"), symmetric, only.values)) ## base::svd() using as.matrix() := asRbasematrix() if(getRversion() < "3.5.0") # svd not yet implicit generic setGeneric("svd", function(x, ...) base::svd(x, ...)) setMethod("svd", "Matrix", function (x, ...) base::svd(as(x,"matrix"), ...)) } .dgeSchur <- function(x, vectors, ...) { cl <- .Call(dgeMatrix_Schur, x, TRUE, TRUE) realEV <- all(cl$WI == 0) ## TODO: do all this in C new("Schur", Dim = x@Dim, Q = as(cl$Z, "dgeMatrix"), T = as(cl$T, if(realEV)"dtrMatrix" else "dgeMatrix"), EValues = if(realEV) cl$WR else complex(real = cl$WR, imaginary = cl$WI)) } setMethod("Schur", signature(x = "dgeMatrix", vectors = "missing"), .dgeSchur) setMethod("Schur", signature(x = "dgeMatrix", vectors = "logical"), function(x, vectors, ...) { if(vectors) .dgeSchur(x) else { cl <- .Call(dgeMatrix_Schur, x, FALSE, TRUE) realEV <- all(cl$WI == 0) list(T = as(cl$T, if(realEV) "dtrMatrix" else "dgeMatrix"), EValues = if(realEV) cl$WR else complex(real = cl$WR, imaginary = cl$WI)) }}) ## Ok, for the faint of heart, also provide "matrix" methods : .mSchur <- function(x, vectors, ...) { cl <- .Call(dgeMatrix_Schur, x, TRUE, FALSE) list(Q = cl$Z, T = cl$T, EValues = if(all(cl$WI == 0)) cl$WR else complex(real = cl$WR, imaginary = cl$WI)) } setMethod("Schur", signature(x = "matrix", vectors = "missing"), .mSchur) setMethod("Schur", signature(x = "matrix", vectors = "logical"), function(x, vectors, ...) { if(vectors) .mSchur(x) else { cl <- .Call(dgeMatrix_Schur, x, FALSE, FALSE) EV <- if(all(cl$WI == 0)) cl$WR else complex(real = cl$WR, imaginary = cl$WI) cl$WR <- cl$WI <- NULL cl$EValues <- EV cl }}) Schur.dsy <- function(x, vectors, ...) { if(missing(vectors)) vectors <- TRUE ## TODO: do all this in C ## Should directly call LAPACK dsyev() evl <- eigen(x, only.values = !vectors) eVals <- evl$values if(vectors) new("Schur", Dim = x@Dim, Q = as(evl$vectors, "dgeMatrix"), T = Diagonal(x = eVals), EValues = eVals) else list(T = Diagonal(x = eVals), EValues = eVals) } setMethod("Schur", signature(x = "dsyMatrix", vectors = "ANY"), Schur.dsy) ## FIXME(?) these coerce from sparse to *dense* setMethod("Schur", signature(x = "generalMatrix", vectors = "missing"), function(x, vectors, ...) callGeneric(as(x, "dgeMatrix"))) setMethod("Schur", signature(x = "generalMatrix", vectors = "logical"), function(x, vectors, ...) callGeneric(as(x, "dgeMatrix"), vectors)) setMethod("Schur", signature(x = "symmetricMatrix", vectors = "missing"), function(x, vectors, ...) Schur.dsy(as(x, "dsyMatrix"))) setMethod("Schur", signature(x = "symmetricMatrix", vectors = "logical"), function(x, vectors, ...) Schur.dsy(as(x, "dsyMatrix"), vectors)) ## Schur() : {Note that the Schur decomposition is not unique here} .simpleSchur <- function(x, vectors, ...) { x <- as(x, "dMatrix") d <- dim(x) new("Schur", Dim = d, Q = Diagonal(d[1]), T = x, EValues = diag(x)) } setMethod("Schur", signature(x = "diagonalMatrix", vectors = "missing"), .simpleSchur) setMethod("Schur", signature(x = "diagonalMatrix", vectors = "logical"), function(x, vectors, ...) { if(vectors) .simpleSchur(x) else { x <- as(x, "dMatrix") list(T = x, EValues = x@x) }}) .triSchur <- function(x, vectors, ...) { x <- as(x, "dMatrix") d <- dim(x) n <- d[1] if(x@uplo == "U" || n == 0) new("Schur", Dim = d, Q = Diagonal(n), T = x, EValues = diag(x)) else { i <- n:1 new("Schur", Dim = d, Q = as(i, "pMatrix"), T = t(t(x)[i,i]), EValues = diag(x)[i]) } } setMethod("Schur", signature(x = "triangularMatrix", vectors = "missing"), .triSchur) setMethod("Schur", signature(x = "triangularMatrix", vectors = "logical"), function(x, vectors, ...) { if(vectors) .triSchur(x) else { x <- as(x, "dMatrix") list(T = x, EValues = x@x) }}) Matrix/R/denseMatrix.R0000644000176200001440000002337513507406216014343 0ustar liggesusers### Simple fallback methods for all dense matrices ### These are "cheap" to program, but potentially far from efficient; ### Methods for specific subclasses will overwrite these: setAs("ANY", "denseMatrix", function(from) Matrix(from, sparse=FALSE, doDiag=FALSE)) ## Conceivably, could write ## setAs("matrix", "denseMatrix", ....) which was slightly more efficient than ## Matrix(.) but would have many things in common setAs("denseMatrix", "generalMatrix", as_geSimpl) ## dense to sparse: ## : if we do this, do it "right", i.e. preserve symmetric/triangular! ## setAs("denseMatrix", "dsparseMatrix", ## ## MM thought that as() will take the ``closest'' match; but that fails! ## ## function(from) as(as(from, "dgeMatrix"), "dsparseMatrix")) ## function(from) as(as(from, "dgeMatrix"), "dgCMatrix")) .dense2C <- function(from, kind = NA, uplo = "U", symDimnames = FALSE) { useK <- is.character(kind) && length(kind) == 1 && kind %in% c("gen", "sym", "tri") if(!useK) { cl <- class(from) cld <- getClassDef(cl) ## get it once (speedup) } r <- .Call(dense_to_Csparse, from)# goes via "generalMatrix" ## FIXME: for symmetric / triangular matrices, this is a waste, notably if packed if (useK && kind == "gen" || !useK && extends(cld, "generalMatrix")) r else if(useK && kind == "sym" || !useK && extends(cld, "symmetricMatrix")) forceCspSymmetric(r, uplo, isTri = FALSE, symDimnames=symDimnames) else if(!useK && extends(cld, "diagonalMatrix")) stop("diagonalMatrix in .dense2C() -- should never happen, please report!") else { ## we have "triangular" : if(useK) { cl <- class(from) cld <- getClassDef(cl) ## get it once (speedup) } if (extends(cld,"dMatrix")) as(r, "dtCMatrix") else if (extends(cld,"lMatrix")) as(r, "ltCMatrix") else if (extends(cld,"nMatrix")) as(r, "ntCMatrix") else if (extends(cld,"zMatrix")) as(r, "ztCMatrix") else stop(gettextf("undefined method for class %s", dQuote(cl)), domain=NA) } } setAs("denseMatrix", "CsparseMatrix", function(from) .dense2C(from)) ## This sometimes fails (eg. for "lsyMatrix"), and we really want to ## use the generic ``go via Csparse'' (top of ./sparseMatrix.R) instead ## setAs("denseMatrix", "sparseMatrix", ## function(from) { ## cl <- class(from) ## cld <- getClassDef(cl) ## if (extends(cld, "generalMatrix")) ## .Call(dense_to_Csparse, from) ## else ## i.e. triangular | symmetric ## as_Csparse(from, cld) ## }) setAs("denseMatrix", "TsparseMatrix", function(from) as(.dense2C(from), "TsparseMatrix")) setMethod("show", signature(object = "denseMatrix"), function(object) prMatrix(object)) ##- ## FIXME: The following is only for the "dMatrix" objects that are not ##- ## "dense" nor "sparse" -- i.e. "packed" ones : ##- ## But these could be printed better -- "." for structural zeros. ##- setMethod("show", signature(object = "dMatrix"), prMatrix) ##- ## and improve this as well: ##- setMethod("show", signature(object = "pMatrix"), prMatrix) ##- ## this should now be superfluous [keep for safety for the moment]: setMethod("dim<-", signature(x = "denseMatrix", value = "ANY"), function(x, value) { if(!is.numeric(value) || length(value) != 2) stop("dim(.) value must be numeric of length 2") if(prod(dim(x)) != prod(value <- as.integer(value))) stop("dimensions don't match the number of cells") clx <- as.character(MatrixClass(class(x))) # as.*(): drop attr if(substring(clx,2) == "geMatrix") { x@Dim <- value if(length(x@factors) > 0) x@factors <- list() x } else { ## other "denseMatrix" x <- as_geSimpl2(x, clx) dim(x) <- value x } }) ## Using "index" for indices should allow ## integer (numeric), logical, or character (names!) indices : ## use geClass() when 'i' or 'j' are missing: ## since symmetric, triangular, .. will not be preserved anyway: setMethod("[", signature(x = "denseMatrix", i = "index", j = "missing", drop = "logical"), function (x, i, j, ..., drop) { if((na <- nargs()) == 3) r <- as(x, "matrix")[i, drop=drop] else if(na == 4) r <- as(x, "matrix")[i, , drop=drop] else stop(gettextf("invalid nargs()= %d", na), domain=NA) if(is.null(dim(r))) r else as(r, geClass(x)) }) setMethod("[", signature(x = "denseMatrix", i = "missing", j = "index", drop = "logical"), function (x, i, j, ..., drop) { r <- as(x, "matrix")[, j, drop=drop] if(is.null(dim(r))) r else as(r, geClass(x)) }) setMethod("[", signature(x = "denseMatrix", i = "index", j = "index", drop = "logical"), function (x, i, j, ..., drop) { r <- callGeneric(x = as(x, "matrix"), i=i, j=j, drop=drop) if(is.null(dim(r))) r else { cld <- getClassDef(cl <- class(x)) if(extends(cld, "symmetricMatrix") && length(i) == length(j) && isTRUE(all(i == j))) ## keep original symmetric class (but not "dpo") as(r, class2(cl, .M.kindC(cld))) else as_smartClass(r, cl) } }) .dense.sub.i.2col <- function(x, i, j, ..., drop) { r <- as(x, "matrix")[ i ] if(is.null(dim(r))) r else as(r, geClass(x)) } setMethod("[", signature(x = "denseMatrix", i = "matrix", j = "missing"),#drop="ANY" .dense.sub.i.2col) setMethod("[", signature(x = "denseMatrix", i = "matrix", j = "missing", drop="missing"), .dense.sub.i.2col) ## Now the "[<-" ones --- see also those in ./Matrix.R ## It's recommended to use setReplaceMethod() rather than setMethod("[<-",.) ## even though the former is currently just a wrapper for the latter ## x[] <- value : setReplaceMethod("[", signature(x = "denseMatrix", i = "missing", j = "missing", value = "ANY"),## double/logical/... function (x, value) { x <- as(x, "generalMatrix") x@x[] <- value validObject(x)# check if type and lengths above match x }) ## FIXME: 1) These are far from efficient ## ----- setReplaceMethod("[", signature(x = "denseMatrix", i = "index", j = "missing", value = "replValue"), function (x, i, j, ..., value) { r <- as(x, "matrix") ## message("`[<-` with nargs()= ",nargs()) if((na <- nargs()) == 3) r[i] <- value else if(na == 4) r[i, ] <- value else stop(gettextf("invalid nargs()= %d", na), domain=NA) as(r, geClass(x)) }) setReplaceMethod("[", signature(x = "denseMatrix", i = "missing", j = "index", value = "replValue"), function (x, i, j, ..., value) { r <- as(x, "matrix") r[, j] <- value as(r, geClass(x)) }) setReplaceMethod("[", signature(x = "denseMatrix", i = "index", j = "index", value = "replValue"), function (x, i, j, ..., value) { r <- as(x, "matrix") r[i, j] <- value as_smartClass(r, class(x)) ## was as(r, class(x)) }) setReplaceMethod("[", signature(x = "denseMatrix", i = "matrix", # 2-col.matrix j = "missing", value = "replValue"), function(x, i, j, ..., value) { r <- as(x, "matrix") r[ i ] <- value as(r, geClass(x)) }) setMethod("isSymmetric", signature(object = "denseMatrix"), function(object, tol = 100*.Machine$double.eps, tol1 = 8*tol, ...) { ## pretest: is it square? d <- dim(object) if((n <- d[1L]) != d[2L]) return(FALSE) if(n <= 1L) return(TRUE) ## else: square (n x n) matrix, n >= 2 : is.z <- is(object, "zMatrix") ## initial tests, fast for large non-symmetric: if(length(tol1)) { ## initial pre-tests, fast for large non-symmetric: Cj <- if(is.z) Conj else identity for(i in unique(c(1L, 2L, n-1L, n))) if(is.character(all.equal(object[i, ], Cj(object[, i]), tolerance = tol1, ...))) return(FALSE) } ## else slower test if (is(object,"dMatrix")) isTRUE(all.equal(as( object, "dgeMatrix"), as(t(object), "dgeMatrix"), tolerance = tol, ...)) else if (is(object, "nMatrix")) identical(as( object, "ngeMatrix"), as(t(object), "ngeMatrix")) else if (is(object, "lMatrix"))# not possible currently ## test for exact equality; FIXME(?): identical() too strict? identical(as( object, "lgeMatrix"), as(t(object), "lgeMatrix")) else if (is.z) ## will error out here isTRUE(all.equal(as( object, "zgeMatrix"), as(Conj(t(object)), "zgeMatrix"), tolerance = tol, ...)) else if (is(object, "iMatrix")) ## will error out here identical(as(object, "igeMatrix"), as(t(object), "igeMatrix")) }) ## rather methods in ./triangularMatrix.R ## setMethod("isTriangular", signature(object = "triangularMatrix"), ## function(object, ...) TRUE) setMethod("isTriangular", signature(object = "denseMatrix"), isTriMat) setMethod("isDiagonal", signature(object = "denseMatrix"), .is.diagonal) setMethod("rcond", signature(x = "denseMatrix", norm = "character"), function(x, norm, ...) rcond(as(as(x, "dMatrix"), "dgeMatrix"), norm=norm, ...)) setMethod("symmpart", signature(x = "denseMatrix"), function(x) symmpart(as(x, "dMatrix"))) setMethod("skewpart", signature(x = "denseMatrix"), function(x) skewpart(as(x, "dMatrix"))) setMethod("is.na", signature(x = "denseMatrix"), function(x) { if(any((inax <- is.na(x@x)))) { r <- as(x, "lMatrix")#-> logical x-slot r@x <- inax as(r, "nMatrix") } else { d <- x@Dim new("ngCMatrix", Dim = d, Dimnames = dimnames(x), i = integer(0), p = rep.int(0L, d[2]+1L)) } }) if(.Matrix.avoiding.as.matrix) { setMethod("qr", signature(x = "ddenseMatrix"), function(x, ...) qr.default(ge2mat(..2dge(x)), ...)) setMethod("qr", signature(x = "denseMatrix"), function(x, ...) qr(as(x, "ddenseMatrix"), ...)) } Matrix/R/diagMatrix.R0000644000176200001440000014370214154106403014140 0ustar liggesusers#### All methods for "diagonalMatrix" and its subclasses, #### currently "ddiMatrix", "ldiMatrix" ## Purpose: Constructor of diagonal matrices -- ~= diag() , ## but *not* diag() extractor! Diagonal <- function(n, x = NULL) { ## Allow Diagonal(4), Diagonal(x=1:5), and Diagonal(4, TRUE) n <- if(missing(n)) length(x) else { stopifnot(length(n) == 1, n == as.integer(n), n >= 0) as.integer(n) } if(missing(x)) ## unit diagonal matrix new("ddiMatrix", Dim = c(n,n), diag = "U") else { lx <- length(x) lx.1 <- lx == 1L stopifnot(lx.1 || lx == n) # but keep 'x' short for now if(is.logical(x)) cl <- "ldiMatrix" else if(is.numeric(x)) { cl <- "ddiMatrix" x <- as.numeric(x) } else if(is.complex(x)) { cl <- "zdiMatrix" # will not yet work } else stop("'x' has invalid data type") if(lx.1 && !is.na(x) && x == 1) # cheap check for uni-diagonal.. new(cl, Dim = c(n,n), diag = "U") else new(cl, Dim = c(n,n), diag = "N", x = if(lx.1) rep.int(x,n) else x) } } .sparseDiagonal <- function(n, x = 1, uplo = "U", shape = if(missing(cols)) "t" else "g", unitri, kind, cols = if(n) 0:(n - 1L) else integer(0)) { n <- if (missing(n)) length(x) else { stopifnot(length(n) == 1, n == as.integer(n), n >= 0) as.integer(n) } if(!(mcols <- missing(cols))) stopifnot(0 <= (cols <- as.integer(cols)), cols < n) m <- length(cols) if(missing(kind)) kind <- if(is.double(x)) "d" else if(is.logical(x)) "l" else { ## for now storage.mode(x) <- "double" "d" } else stopifnot(any(kind == c("d","l","n"))) stopifnot(is.character(shape), nchar(shape) == 1, any(shape == c("t","s","g"))) # triangular / symmetric / general if((missing(unitri) || unitri) && shape == "t" && (mcols || cols == 0:(n-1L)) && ((any(kind == c("l", "n")) && allTrue(x)) || ( kind == "d" && allTrue(x == 1)))) { ## uni-triangular new(paste0(kind,"tCMatrix"), Dim = c(n,n), uplo = uplo, diag = "U", p = rep.int(0L, n+1L)) } else if(kind == "n") { if(shape == "g") new("ngCMatrix", Dim = c(n,m), i = cols, p = 0:m) else new(paste0("n", shape, "CMatrix"), Dim = c(n,m), uplo = uplo, i = cols, p = 0:m) } else { ## kind != "n" -- have x slot : if((lx <- length(x)) == 1) x <- rep.int(x, m) else if(lx != m) stop("length(x) must be either 1 or #{cols}") if(shape == "g") new(paste0(kind, "gCMatrix"), Dim = c(n,m), x = x, i = cols, p = 0:m) else new(paste0(kind, shape, "CMatrix"), Dim = c(n,m), uplo = uplo, x = x, i = cols, p = 0:m) } } ## Pkg 'spdep' had (relatively slow) versions of this as_dsCMatrix_I() .symDiagonal <- function(n, x = rep.int(1,n), uplo = "U", kind) .sparseDiagonal(n, x, uplo, shape = "s", kind = kind) ## NOTA BENE: .triDiagonal() would be misleading (<=> banded tri-diagonal matrix !) # instead of diagU2N(as(Diagonal(n), "CsparseMatrix")), diag = "N" in any case: .trDiagonal <- function(n, x = 1, uplo = "U", unitri = TRUE, kind) .sparseDiagonal(n, x, uplo, shape = "t", unitri=unitri, kind=kind) ## This is modified from a post of Bert Gunter to R-help on 1 Sep 2005. ## Bert's code built on a post by Andy Liaw who most probably was influenced ## by earlier posts, notably one by Scott Chasalow on S-news, 16 Jan 2002 ## who posted his bdiag() function written in December 1995. if(FALSE)##--- no longer used: .bdiag <- function(lst) { ## block-diagonal matrix [a dgTMatrix] from list of matrices stopifnot(is.list(lst), length(lst) >= 1) dims <- vapply(lst, dim, 1L, USE.NAMES=FALSE) ## make sure we had all matrices: if(!(is.matrix(dims) && nrow(dims) == 2)) stop("some arguments are not matrices") csdim <- rbind(rep.int(0L, 2), apply(dims, 1, cumsum)) r <- new("dgTMatrix") r@Dim <- as.integer(csdim[nrow(csdim),]) add1 <- matrix(1:0, 2,2) for(i in seq_along(lst)) { indx <- apply(csdim[i:(i+1),] + add1, 2, function(n) n[1]:n[2]) if(is.null(dim(indx))) ## non-square matrix r[indx[[1]],indx[[2]]] <- lst[[i]] else ## square matrix r[indx[,1], indx[,2]] <- lst[[i]] } r } ## expand() needed something like bdiag() for lower-triangular ## (Tsparse) Matrices; hence Doug Bates provided a much more efficient ## implementation for those; now extended and generalized: .bdiag <- function(lst) { ## block-diagonal matrix [a dgTMatrix] from list of matrices stopifnot(is.list(lst), (nl <- length(lst)) >= 1) ### FIXME: next line is *slow* when lst = list of 75'000 dense 3x3 matrices Tlst <- lapply(lapply(lst, as_Csp2), # includes "diagU2N" as, "TsparseMatrix") if(nl == 1) return(Tlst[[1]]) ## else i_off <- c(0L, cumsum(vapply(Tlst, nrow, 1L))) j_off <- c(0L, cumsum(vapply(Tlst, ncol, 1L))) clss <- vapply(Tlst, class, "") ## NB ("FIXME"): this requires the component classes to be *called* ## -- "dgTMatrix" | "dnTMatrix" etc (and not just *extend* those)! typ <- substr(clss, 2, 2) knd <- substr(clss, 1, 1) sym <- typ == "s" # symmetric ones tri <- typ == "t" # triangular ones use.n <- any(is.n <- knd == "n") if(use.n && !(use.n <- all(is.n))) { Tlst[is.n] <- lapply(Tlst[is.n], as, "lMatrix") knd [is.n] <- "l" } use.l <- !use.n && all(knd == "l") if(all(sym)) { ## result should be *symmetric* uplos <- vapply(Tlst, slot, ".", "uplo") ## either "U" or "L" tLU <- table(uplos)# of length 1 or 2 .. if(length(tLU) == 1) { ## all "U" or all "L" useU <- uplos[1] == "U" } else { ## length(tLU) == 2, counting "L" and "U" useU <- diff(tLU) >= 0 if(useU && (hasL <- tLU[1] > 0)) Tlst[hasL] <- lapply(Tlst[hasL], t) else if(!useU && (hasU <- tLU[2] > 0)) Tlst[hasU] <- lapply(Tlst[hasU], t) } if(use.n) { ## return nsparseMatrix : r <- new("nsTMatrix") } else { r <- new(paste0(if(use.l) "l" else "d", "sTMatrix")) r@x <- unlist(lapply(Tlst, slot, "x")) } r@uplo <- if(useU) "U" else "L" } else if(all(tri) && { ULs <- vapply(Tlst, slot, ".", "uplo")## "U" or "L" all(ULs[1L] == ULs[-1L]) } ## all upper or all lower ){ ## *triangular* result if(use.n) { ## return nsparseMatrix : r <- new("ntTMatrix") } else { r <- new(paste0(if(use.l) "l" else "d", "tTMatrix")) r@x <- unlist(lapply(Tlst, slot, "x")) } r@uplo <- ULs[1L] } else { if(any(sym)) Tlst[sym] <- lapply(Tlst[sym], as, "generalMatrix") if(use.n) { ## return nsparseMatrix : r <- new("ngTMatrix") } else { r <- new(paste0(if(use.l) "l" else "d", "gTMatrix")) r@x <- unlist(lapply(Tlst, slot, "x")) } } r@Dim <- c(i_off[nl+1], j_off[nl + 1]) r@i <- unlist(lapply(1:nl, function(k) Tlst[[k]]@i + i_off[k])) r@j <- unlist(lapply(1:nl, function(k) Tlst[[k]]@j + j_off[k])) r } bdiag <- function(...) { if((nA <- nargs()) == 0) return(new("dgCMatrix")) if(nA == 1 && !is.list(...)) return(as(..., "CsparseMatrix")) alis <- if(nA == 1 && is.list(..1)) ..1 else list(...) if(length(alis) == 1) return(as(alis[[1]], "CsparseMatrix")) ## else : two or more arguments as(.bdiag(alis), "CsparseMatrix") } setMethod("tril", "diagonalMatrix", function(x, k = 0, ...) if(k >= 0) x else .setZero(x, paste0(.M.kind(x), "tCMatrix"))) setMethod("triu", "diagonalMatrix", function(x, k = 0, ...) if(k <= 0) x else .setZero(x, paste0(.M.kind(x), "tCMatrix"))) .diag2tT <- function(from, uplo = "U", kind = .M.kind(from), drop0 = TRUE) { ## to triangular Tsparse x <- from@x i <- if(from@diag == "U") integer(0L) else if(drop0 & any0(x)) { ii <- which(isN0(x)) x <- x[ii] ii - 1L } else seq_len(from@Dim[1]) - 1L new(paste0(kind, "tTMatrix"), diag = from@diag, Dim = from@Dim, Dimnames = from@Dimnames, uplo = uplo, x = x, # <- ok for diag = "U" and "N" (!) i = i, j = i) } .diag2sT <- function(from, uplo = "U", kind = .M.kind(from)) { ## to symmetric Tsparse n <- from@Dim[1] i <- seq_len(n) - 1L new(paste0(kind, "sTMatrix"), Dim = from@Dim, Dimnames = from@Dimnames, i = i, j = i, uplo = uplo, x = if(from@diag == "N") from@x else ## "U"-diag rep.int(switch(kind, "d" = 1., "l" =, "n" = TRUE, ## otherwise stop(gettextf("%s kind not yet implemented", sQuote(kind)), domain=NA)), n)) } ## diagonal -> triangular, upper / lower depending on "partner" 'x': diag2tT.u <- function(d, x, kind = .M.kind(d), drop0 = TRUE) .diag2tT(d, uplo = if(is(x,"triangularMatrix")) x@uplo else "U", kind, drop0) ## diagonal -> sparse {triangular OR symmetric} (upper / lower) depending on "partner": diag2Tsmart <- function(d, x, kind = .M.kind(d)) { clx <- getClassDef(class(x)) if(extends(clx, "symmetricMatrix")) .diag2sT(d, uplo = x@uplo, kind) else .diag2tT(d, uplo = if(extends(clx,"triangularMatrix")) x@uplo else "U", kind) } ## FIXME: should not be needed {when ddi* is dsparse* etc}: setMethod("is.finite", signature(x = "diagonalMatrix"), function(x) is.finite(.diag2tT(x))) setMethod("is.infinite", signature(x = "diagonalMatrix"), function(x) is.infinite(.diag2tT(x))) ## In order to evade method dispatch ambiguity warnings, ## and because we can save a .M.kind() call, we use this explicit ## "hack" instead of signature x = "diagonalMatrix" : ## ## ddi*: di2tT <- function(from) .diag2tT(from, "U", "d") setAs("ddiMatrix", "triangularMatrix", di2tT) ##_no_longer_ setAs("ddiMatrix", "sparseMatrix", di2tT) ## needed too (otherwise -> Tsparse is taken): setAs("ddiMatrix", "TsparseMatrix", di2tT) setAs("ddiMatrix", "dsparseMatrix", di2tT) ddi2Csp <- function(from) .T2Cmat(.diag2tT(from, "U", "d"), isTri=TRUE) #-> dtC* setAs("ddiMatrix", "dtCMatrix", ddi2Csp) setAs("ddiMatrix", "CsparseMatrix", ddi2Csp) ## Such that as(Matrix(0, d,d), "dgCMatrix") continues working: setAs("ddiMatrix", "dgCMatrix", function(from) .dtC2g(ddi2Csp(from))) setAs("ddiMatrix", "symmetricMatrix", function(from) .diag2sT(from, "U", "d")) ## ## ldi*: ldi2tT <- function(from) .diag2tT(from, "U", "l") setAs("ldiMatrix", "triangularMatrix", ldi2tT) ##_no_longer_ setAs("ldiMatrix", "sparseMatrix", di2tT) ## needed too (otherwise -> Tsparse is taken): setAs("ldiMatrix", "TsparseMatrix", ldi2tT) setAs("ldiMatrix", "lsparseMatrix", ldi2tT) setAs("ldiMatrix", "CsparseMatrix", function(from) .T2Cmat(.diag2tT(from, "U", "l"), isTri=TRUE)) setAs("ldiMatrix", "symmetricMatrix", function(from) .diag2sT(from, "U", "l")) rm(ldi2tT) setAs("diagonalMatrix", "nMatrix", di2nMat <- function(from) { i <- if(from@diag == "U") integer(0) else which(isN0(from@x)) - 1L new("ntTMatrix", i = i, j = i, diag = from@diag, Dim = from@Dim, Dimnames = from@Dimnames) }) setAs("diagonalMatrix", "nsparseMatrix", function(from) as(from, "nMatrix")) ##' A version of diag(x,n) which *does* preserve the mode of x, where diag() "fails" mkDiag <- function(x, n) { y <- matrix(as0(mod=mode(x)), n,n) if (n > 0) y[1L + 0:(n - 1L) * (n + 1)] <- x y } ## NB: diag(x,n) is really faster for n >= 20, and even more for large n ## --> using diag() where possible, ==> .ddi2mat() .diag2mat <- function(from) ## want "ldiMatrix" -> "matrix" (but integer -> for now) mkDiag(if(from@diag == "U") as1(from@x) else from@x, n = from@Dim[1]) .ddi2mat <- function(from) `dimnames<-`(base::diag(if(from@diag == "U") as1(from@x) else from@x, nrow = from@Dim[1]), from@Dimnames) setAs("ddiMatrix", "matrix", .ddi2mat) ## the non-ddi diagonalMatrix -- only "ldiMatrix" currently: setAs("diagonalMatrix", "matrix", .diag2mat) setMethod("as.vector", "diagonalMatrix", function(x, mode) { n <- x@Dim[1] mod.x <- mode(x@x) r <- vector(mod.x, length = n^2) if(n) r[1 + 0:(n - 1L) * (n + 1)] <- if(x@diag == "U") as1(mod=mod.x) else x@x as.vector(r, mode) }) setAs("diagonalMatrix", "generalMatrix", # prefer sparse: function(from) as(as(from, "CsparseMatrix"), "generalMatrix")) setAs("diagonalMatrix", "denseMatrix", function(from) as(as(from, "CsparseMatrix"), "denseMatrix")) ..diag.x <- function(m) rep.int(as1(m@x), m@Dim[1]) .diag.x <- function(m) if(m@diag == "U") rep.int(as1(m@x), m@Dim[1]) else m@x .diag.2N <- function(m) { if(m@diag == "U") m@diag <- "N" m } setAs("ddiMatrix", "dgeMatrix", ..2dge) setAs("ddiMatrix", "ddenseMatrix", #-> "dtr" function(from) as(as(from, "triangularMatrix"),"denseMatrix")) setAs("ldiMatrix", "ldenseMatrix", #-> "ltr" function(from) as(as(from, "triangularMatrix"),"denseMatrix")) setAs("matrix", "diagonalMatrix", function(from) { d <- dim(from) if(d[1] != (n <- d[2])) stop("non-square matrix") if(any(from[row(from) != col(from)] != 0)) stop("matrix with non-zero off-diagonals cannot be coerced to \"diagonalMatrix\"") x <- diag(from); names(x) <- NULL # don't want them in 'x' slot if(is.logical(x)) { cl <- "ldiMatrix" uni <- allTrue(x) ## uni := {is it unit-diagonal ?} } else { cl <- "ddiMatrix" uni <- allTrue(x == 1) storage.mode(x) <- "double" } ## TODO: complex new(cl, Dim = c(n,n), diag = if(uni) "U" else "N", x = if(uni) x[FALSE] else x, Dimnames = .M.DN(from)) }) ## ``generic'' coercion to diagonalMatrix : build on isDiagonal() and diag() setAs("Matrix", "diagonalMatrix", function(from) { d <- dim(from) if(d[1] != (n <- d[2])) stop("non-square matrix") if(!isDiagonal(from)) stop("matrix is not diagonal") ## else: x <- diag(from); names(x) <- NULL # don't want them in 'x' slot if(is.logical(x)) { cl <- "ldiMatrix" uni <- allTrue(x) } else { cl <- "ddiMatrix" uni <- allTrue(x == 1) storage.mode(x) <- "double" } ## TODO: complex new(cl, Dim = c(n,n), diag = if(uni) "U" else "N", x = if(uni) x[FALSE] else x, Dimnames = from@Dimnames) }) setMethod("diag", signature(x = "diagonalMatrix"), function(x = 1, nrow, ncol) .diag.x(x)) subDiag <- function(x, i, j, ..., drop) { x <- as(x, "CsparseMatrix") ## << was "TsparseMatrix" (Csparse is faster now) x <- if(missing(i)) x[, j, drop=drop] else if(missing(j)) if(nargs() == 4) x[i, , drop=drop] else x[i, drop=drop] else x[i,j, drop=drop] if(isS4(x) && isDiagonal(x)) as(x, "diagonalMatrix") else x } setMethod("[", signature(x = "diagonalMatrix", i = "index", j = "index", drop = "logical"), subDiag) setMethod("[", signature(x = "diagonalMatrix", i = "index", j = "missing", drop = "logical"), function(x, i, j, ..., drop) { na <- nargs() Matrix.msg("diag[i,m,l] : nargs()=", na, .M.level = 2) if(na == 4) subDiag(x, i=i, , drop=drop) else subDiag(x, i=i, drop=drop) }) setMethod("[", signature(x = "diagonalMatrix", i = "missing", j = "index", drop = "logical"), function(x, i, j, ..., drop) subDiag(x, j=j, drop=drop)) ## When you assign to a diagonalMatrix, the result should be ## diagonal or sparse --- replDiag <- function(x, i, j, ..., value) { ## FIXME: if (i == j) && isSymmetric(value) then -- want symmetricMatrix result! -- or diagMatrix x <- as(x, "CsparseMatrix")# was "Tsparse.." till 2012-07 if(missing(i)) x[, j] <- value else if(missing(j)) { ## x[i , ] <- v *OR* x[i] <- v na <- nargs() ## message("diagnosing replDiag() -- nargs()= ", na) if(na == 4) x[i, ] <- value else if(na == 3) x[i] <- value else stop(gettextf("Internal bug: nargs()=%d; please report", na), domain=NA) } else x[i,j] <- value ## TODO: the following is a bit expensive; have cases above e.g. [i,] where ## ----- we could check *much* faster : if(isDiagonal(x)) as(x, "diagonalMatrix") else if(isTriangular(x)) as(x, "triangularMatrix") else if(isSymmetric(x)) as(x, "symmetricMatrix") else x } setReplaceMethod("[", signature(x = "diagonalMatrix", i = "index", j = "index", value = "replValue"), replDiag) setReplaceMethod("[", signature(x = "diagonalMatrix", i = "index", j = "missing", value = "replValue"), function(x,i,j, ..., value) { ## message("before replDiag() -- nargs()= ", nargs()) if(nargs() == 3) replDiag(x, i=i, value=value) else ## nargs() == 4 : replDiag(x, i=i, , value=value) }) setReplaceMethod("[", signature(x = "diagonalMatrix", i = "missing", j = "index", value = "replValue"), function(x,i,j, ..., value) replDiag(x, j=j, value=value)) ## x[] <- value : setReplaceMethod("[", signature(x = "diagonalMatrix", i = "missing", j = "missing", value = "ANY"), function(x,i,j, ..., value) { if(all0(value)) { # be faster r <- new(paste0(.M.kindC(getClassDef(class(x))),"tTMatrix"))# of all "0" r@Dim <- x@Dim r@Dimnames <- x@Dimnames r } else { ## typically non-sense: assigning to full sparseMatrix x[TRUE] <- value x } }) setReplaceMethod("[", signature(x = "diagonalMatrix", i = "matrix", # 2-col.matrix j = "missing", value = "replValue"), function(x,i,j, ..., value) { if(ncol(i) == 2) { if(all((ii <- i[,1]) == i[,2])) { # replace in diagonal only if(x@diag == "U") { one <- as1(x@x) if(any(value != one | is.na(value))) { x@diag <- "N" x@x <- rep.int(one, x@Dim[1]) } else return(x) } x@x[ii] <- value x } else { ## no longer diagonal, but remain sparse: ### FIXME: use uplo="U" or uplo="L" (or *not* "triangularMatrix") depending on LE <- i <= j ### all(LE) // all(!LE) // remaining cases ## --> use .diag2tT(from, uplo = "U", kind = .M.kind(from)) x <- as(x, "triangularMatrix") # was "TsparseMatrix" x[i] <- value x } } else { # behave as "base R": use as if vector x <- as(x, "matrix") x[i] <- value Matrix(x) } }) ## value = "sparseMatrix": setReplaceMethod("[", signature(x = "diagonalMatrix", i = "missing", j = "index", value = "sparseMatrix"), function (x, i, j, ..., value) callGeneric(x=x, , j=j, value = as(value, "sparseVector"))) setReplaceMethod("[", signature(x = "diagonalMatrix", i = "index", j = "missing", value = "sparseMatrix"), function (x, i, j, ..., value) callGeneric(x=x, i=i, , value = as(value, "sparseVector"))) setReplaceMethod("[", signature(x = "diagonalMatrix", i = "index", j = "index", value = "sparseMatrix"), function (x, i, j, ..., value) callGeneric(x=x, i=i, j=j, value = as(value, "sparseVector"))) ## value = "sparseVector": setReplaceMethod("[", signature(x = "diagonalMatrix", i = "missing", j = "index", value = "sparseVector"), replDiag) setReplaceMethod("[", signature(x = "diagonalMatrix", i = "index", j = "missing", value = "sparseVector"), replDiag) setReplaceMethod("[", signature(x = "diagonalMatrix", i = "index", j = "index", value = "sparseVector"), replDiag) setMethod("t", signature(x = "diagonalMatrix"), function(x) { x@Dimnames <- x@Dimnames[2:1] ; x }) setMethod("isDiagonal", "diagonalMatrix", function(object) TRUE) setMethod("isTriangular", "diagonalMatrix", function(object, upper=NA, ...) TRUE) setMethod("isSymmetric", "diagonalMatrix", function(object, ...) TRUE) setMethod("symmpart", signature(x = "diagonalMatrix"), function(x) x) setMethod("skewpart", signature(x = "diagonalMatrix"), function(x) .setZero(x)) cholDiag <- function(x, pivot, ...) { ## x : typically "ddiMatrix" if(x@diag == "U") return(x) ## else if(any(x@x < 0)) stop("chol() is undefined for diagonal matrix with negative entries") x@x <- sqrt(x@x) x } setMethod("chol", signature(x = "ddiMatrix"), cholDiag) ## chol(L) is L for logical diagonal: setMethod("chol", signature(x = "ldiMatrix"), function(x, pivot, ...) x) setMethod("determinant", signature(x = "diagonalMatrix", logarithm = "logical"), function(x, logarithm, ...) mkDet(.diag.x(x), logarithm)) setMethod("norm", signature(x = "diagonalMatrix", type = "character"), function(x, type, ...) { if((n <- x@Dim[1]) == 0) return(0) # as for "sparseMatrix" type <- toupper(substr(type[1], 1, 1)) isU <- (x@diag == "U") # unit-diagonal if(type == "F") sqrt(if(isU) n else sum(x@x^2)) else { ## norm == "I","1","O","M","2" : if(isU) 1 else max(abs(x@x)) } }) ## Basic Matrix Multiplication {many more to add} ## --------------------- ## Note that "ldi" logical are treated as numeric diagdiagprod <- function(x, y) { dimCheck(x,y) if(x@diag != "U") { if(y@diag != "U") { nx <- x@x * y@x if(is.numeric(nx) && !is.numeric(x@x)) x <- as(x, "dMatrix") x@x <- as.numeric(nx) } x } else ## x is unit diagonal y } ##' Boolean Algebra/Arithmetic Product of Diagonal Matrices ##' %&% diagdiagprodBool <- function(x, y) { dimCheck(x,y) if(x@diag != "U") { if(!is.logical(x@x)) x <- as(x, "lMatrix") if(y@diag != "U") { nx <- x@x & y@x x@x <- as.logical(nx) } x } else { ## x is unit diagonal: return y if(!is.logical(y@x)) y <- as(y, "lMatrix") y } } setMethod("%*%", signature(x = "diagonalMatrix", y = "diagonalMatrix"), diagdiagprod, valueClass = "ddiMatrix") setMethod("%&%", signature(x = "diagonalMatrix", y = "diagonalMatrix"), diagdiagprodBool, valueClass = "ldiMatrix")# do *not* have "ndiMatrix" ! ##' Both Numeric or Boolean Algebra/Arithmetic Product of Diagonal Matrices diagdiagprodFlexi <- function(x, y=NULL, boolArith = NA, ...) { dimCheck(x,y) bool <- isTRUE(boolArith) if(x@diag != "U") { if(bool && !is.logical(x@x)) x <- as(x, "lMatrix") if(y@diag != "U") { if(bool) { nx <- x@x & y@x x@x <- as.logical(nx) } else { ## boolArith is NA or FALSE: ==> numeric, as have *no* "diagMatrix" patter[n]: nx <- x@x * y@x if(is.numeric(nx) && !is.numeric(x@x)) x <- as(x, "dMatrix") x@x <- as.numeric(nx) } } x } else { ## x is unit diagonal: return y if(bool && !is.logical(y@x)) y <- as(y, "lMatrix") y } } setMethod("crossprod", signature(x = "diagonalMatrix", y = "diagonalMatrix"), diagdiagprodFlexi) setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "diagonalMatrix"), diagdiagprodFlexi) ##' crossprod(x) := x'x diagprod <- function(x, y = NULL, boolArith = NA, ...) { bool <- isTRUE(boolArith) if(bool && !is.logical(x@x)) x <- as(x, "lMatrix") if(x@diag != "U") { if(bool) { nx <- x@x & y@x x@x <- as.logical(nx) } else { ## boolArith is NA or FALSE: ==> numeric, as have *no* "diagMatrix" patter[n]: nx <- x@x * x@x if(is.numeric(nx) && !is.numeric(x@x)) x <- as(x, "dMatrix") x@x <- as.numeric(nx) } } x } setMethod( "crossprod", signature(x = "diagonalMatrix", y = "missing"), diagprod) setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "missing"), diagprod) ## analogous to matdiagprod() below: diagmatprod <- function(x, y) { ## x is diagonalMatrix dy <- dim(y) if(x@Dim[2L] != dy[1L]) stop("non-matching dimensions") if(prod(dy)) Matrix(if(x@diag == "U") y else x@x * y) else Matrix(if(x@diag == "U") y else x@x * y, nrow=dy[1L], ncol=dy[2L]) } setMethod("%*%", signature(x = "diagonalMatrix", y = "matrix"), diagmatprod) ##formals(diagmatprod) <- alist(x=, y=NULL, boolArith = NA, ...=) ## FIXME boolArith diagmatprod2 <- function(x, y=NULL, boolArith = NA, ...) { ## x is diagonalMatrix dy <- dim(y) if(x@Dim[2L] != dy[1L]) stop("non-matching dimensions") if(prod(dy)) Matrix(if(x@diag == "U") y else x@x * y) else Matrix(if(x@diag == "U") y else x@x * y, nrow=dy[1L], ncol=dy[2L]) } setMethod("crossprod", signature(x = "diagonalMatrix", y = "matrix"), diagmatprod2) diagGeprod <- function(x, y) { if(x@Dim[2L] != y@Dim[1L]) stop("non-matching dimensions") if(x@diag != "U") { if(!is.numeric(y@x)) y <- as(y, "dMatrix") y@x <- x@x * y@x } y } setMethod("%*%", signature(x= "diagonalMatrix", y= "dgeMatrix"), diagGeprod) setMethod("%*%", signature(x= "diagonalMatrix", y= "lgeMatrix"), diagGeprod) diagGeprodBool <- function(x, y) { if(x@Dim[2L] != y@Dim[1L]) stop("non-matching dimensions") if(!is.logical(y@x)) y <- as(y, "lMatrix") if(x@diag != "U") y@x <- x@x & y@x y } setMethod("%&%", signature(x= "diagonalMatrix", y= "geMatrix"), diagGeprodBool) diagGeprod2 <- function(x, y=NULL, boolArith = NA, ...) { if(x@Dim[2L] != y@Dim[1L]) stop("non-matching dimensions") bool <- isTRUE(boolArith) if(bool && !is.logical(y@x)) y <- as(y, "lMatrix") else if(!bool && !is.numeric(y@x)) y <- as(y, "dMatrix") if(x@diag != "U") y@x <- if(bool) x@x & y@x else x@x * y@x y } setMethod("crossprod", signature(x = "diagonalMatrix", y = "dgeMatrix"), diagGeprod2) setMethod("crossprod", signature(x = "diagonalMatrix", y = "lgeMatrix"), diagGeprod2) ## analogous to diagmatprod() above: matdiagprod <- function(x, y) { dx <- dim(x) if(dx[2L] != y@Dim[1L]) stop("non-matching dimensions") Matrix(if(y@diag == "U") x else x * rep(y@x, each = dx[1L])) } setMethod("%*%", signature(x = "matrix", y = "diagonalMatrix"), matdiagprod) gediagprod <- function(x, y) { dx <- dim(x) if(dx[2L] != y@Dim[1L]) stop("non-matching dimensions") if(y@diag == "N") { if(!is.numeric(x@x)) x <- as(x, "dMatrix") x@x <- x@x * rep(y@x, each = dx[1L]) } x } setMethod("%*%", signature(x= "dgeMatrix", y= "diagonalMatrix"), gediagprod) setMethod("%*%", signature(x= "lgeMatrix", y= "diagonalMatrix"), gediagprod) gediagprodBool <- function(x, y) { dx <- dim(x) if(dx[2L] != y@Dim[1L]) stop("non-matching dimensions") if(!is.logical(x@x)) x <- as(x, "lMatrix") if(y@diag == "N") x@x <- x@x & rep(y@x, each = dx[1L]) x } setMethod("%&%", signature(x= "geMatrix", y= "diagonalMatrix"), gediagprodBool) setMethod("tcrossprod",signature(x = "matrix", y = "diagonalMatrix"), function(x, y=NULL, boolArith = NA, ...) { dx <- dim(x) if(dx[2L] != y@Dim[1L]) stop("non-matching dimensions") bool <- isTRUE(boolArith) if(bool && !is.logical(y@x)) y <- as(y, "lMatrix") Matrix(if(y@diag == "U") x else if(bool) x & rep(y@x, each = dx[1L]) else x * rep(y@x, each = dx[1L])) }) setMethod("crossprod", signature(x = "matrix", y = "diagonalMatrix"), function(x, y=NULL, boolArith = NA, ...) { dx <- dim(x) if(dx[1L] != y@Dim[1L]) stop("non-matching dimensions") bool <- isTRUE(boolArith) if(bool && !is.logical(y@x)) y <- as(y, "lMatrix") Matrix(if(y@diag == "U") t(x) else if(bool) t(rep.int(y@x, dx[2L]) & x) else t(rep.int(y@x, dx[2L]) * x)) }) gediagprod2 <- function(x, y=NULL, boolArith = NA, ...) { dx <- dim(x) if(dx[2L] != y@Dim[1L]) stop("non-matching dimensions") bool <- isTRUE(boolArith) if(bool && !is.logical(x@x)) x <- as(x, "lMatrix") else if(!bool && !is.numeric(x@x)) x <- as(x, "dMatrix") if(y@diag == "N") x@x <- if(bool) x@x & rep(y@x, each = dx[1L]) else x@x * rep(y@x, each = dx[1L]) x } setMethod("tcrossprod", signature(x = "dgeMatrix", y = "diagonalMatrix"), gediagprod2) setMethod("tcrossprod", signature(x = "lgeMatrix", y = "diagonalMatrix"), gediagprod2) ## crossprod {more of these} ## tcrossprod --- all are not yet there: do the dense ones here: setMethod("%*%", signature(x = "diagonalMatrix", y = "denseMatrix"), function(x, y) if(x@diag == "U") y else x %*% as(y, "generalMatrix")) setMethod("%*%", signature(x = "denseMatrix", y = "diagonalMatrix"), function(x, y) if(y@diag == "U") x else as(x, "generalMatrix") %*% y) ## FIXME: ## setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "denseMatrix"), ## function(x, y = NULL) { ## }) ##' @param x CsparseMatrix ##' @param y diagonalMatrix ##' @return x %*% y Cspdiagprod <- function(x, y, boolArith = NA, ...) { if((m <- ncol(x)) != y@Dim[1L]) stop("non-matching dimensions") if(y@diag == "N") { ## otherwise: y == Diagonal(n) : multiplication is identity x <- .Call(Csparse_diagU2N, x) cx <- getClass(class(x)) if(!all(y@x[1L] == y@x[-1L]) && extends(cx, "symmetricMatrix")) x <- as(x, "generalMatrix") ind <- rep.int(seq_len(m), x@p[-1] - x@p[-m-1L]) if(isTRUE(boolArith)) { if(extends(cx, "nMatrix")) x <- as(x, "lMatrix") # so, has y@x x@x <- r <- x@x & y@x[x@i + 1L] if(!anyNA(r) && !extends(cx, "diagonalMatrix")) x <- as(drop0(x), "nMatrix") } else { if(!extends(cx, "dMatrix")) x <- as(x, "dMatrix") # <- FIXME if we have zMatrix x@x <- x@x * y@x[ind] } if(.hasSlot(x, "factors") && length(x@factors)) {# drop cashed ones ## instead of dropping all factors, be smart about some ## TODO ...... x@factors <- list() } x } else { # y is unit-diagonal ==> "return x" cx <- getClass(class(x)) if(isTRUE(boolArith)) { is.l <- if(extends(cx, "dMatrix")) { ## <- FIXME: extend once we have iMatrix, zMatrix x <- as(x, "lMatrix"); TRUE } else extends(cx, "lMatrix") if(is.l && !anyNA(x@x)) as(drop0(x), "nMatrix") else if(is.l) x else # defensive: as(x, "lMatrix") } else { ## else boolArith is NA or FALSE {which are equivalent here, das diagonal = "numLike"} if(extends1of(cx, c("nMatrix", "lMatrix"))) as(x, "dMatrix") else x } } } ##' @param x diagonalMatrix ##' @param y CsparseMatrix ##' @return x %*% y diagCspprod <- function(x, y, boolArith = NA, ...) { if(x@Dim[2L] != y@Dim[1L]) stop("non-matching dimensions") if(x@diag == "N") { y <- .Call(Csparse_diagU2N, y) cy <- getClass(class(y)) if(!all(x@x[1L] == x@x[-1L]) && extends(cy, "symmetricMatrix")) y <- as(y, "generalMatrix") if(isTRUE(boolArith)) { if(extends(cy, "nMatrix")) y <- as(y, "lMatrix") # so, has y@x y@x <- r <- y@x & x@x[y@i + 1L] if(!anyNA(r) && !extends(cy, "diagonalMatrix")) y <- as(drop0(y), "nMatrix") } else { if(!extends(cy, "dMatrix")) y <- as(y, "dMatrix") # <- FIXME if we have zMatrix y@x <- y@x * x@x[y@i + 1L] } if(.hasSlot(y, "factors") && length(y@factors)) { ## if(.hasSlot(y, "factors") && length(yf <- y@factors)) { ## -- TODO? -- ## instead of dropping all factors, be smart about some ## keep <- character() ## if(any(names(yf) == "LU")) { ## <- not easy: y = P'LUQ, x y = xP'LUQ => LU ??? ## keep <- "LU" ## } ## y@factors <- yf[keep] y@factors <- list() } y } else { ## x @ diag == "U" cy <- getClass(class(y)) if(isTRUE(boolArith)) { is.l <- if(extends(cy, "dMatrix")) { ## <- FIXME: extend once we have iMatrix, zMatrix y <- as(y, "lMatrix"); TRUE } else extends(cy, "lMatrix") if(is.l && !anyNA(y@x)) as(drop0(y), "nMatrix") else if(is.l) y else # defensive: as(y, "lMatrix") } else { ## else boolArith is NA or FALSE {which are equivalent here, das diagonal = "numLike"} if(extends1of(cy, c("nMatrix", "lMatrix"))) as(y, "dMatrix") else y } } } ## + 'boolArith' argument { ==> .local() is used in any case; keep formals simple :} setMethod("crossprod", signature(x = "diagonalMatrix", y = "CsparseMatrix"), function(x, y=NULL, boolArith=NA, ...) diagCspprod(x, y, boolArith=boolArith)) setMethod("crossprod", signature(x = "diagonalMatrix", y = "sparseMatrix"), function(x, y=NULL, boolArith=NA, ...) diagCspprod(x, as(y, "CsparseMatrix"), boolArith=boolArith)) ## Prefer calling diagCspprod to Cspdiagprod if going to transpose anyway ## x'y == (y'x)' setMethod("crossprod", signature(x = "CsparseMatrix", y = "diagonalMatrix"), function(x, y=NULL, boolArith=NA, ...) t(diagCspprod(y, x, boolArith=boolArith))) setMethod("crossprod", signature(x = "sparseMatrix", y = "diagonalMatrix"), function(x, y=NULL, boolArith=NA, ...) t(diagCspprod(y, as(x, "Csparsematrix"), boolArith=boolArith))) setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "CsparseMatrix"), function(x, y=NULL, boolArith=NA, ...) diagCspprod(x, t(y), boolArith=boolArith)) setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "sparseMatrix"), function(x, y=NULL, boolArith=NA, ...) diagCspprod(x, t(as(y, "CsparseMatrix")), boolArith=boolArith)) setMethod("tcrossprod", signature(x = "CsparseMatrix", y = "diagonalMatrix"), function(x, y=NULL, boolArith=NA, ...) Cspdiagprod(x, y, boolArith=boolArith)) setMethod("tcrossprod", signature(x = "sparseMatrix", y = "diagonalMatrix"), function(x, y=NULL, boolArith=NA, ...) Cspdiagprod(as(x, "CsparseMatrix"), y, boolArith=boolArith)) setMethod("%*%", signature(x = "diagonalMatrix", y = "CsparseMatrix"), function(x, y) diagCspprod(x, y, boolArith=NA)) setMethod("%&%", signature(x = "diagonalMatrix", y = "CsparseMatrix"), function(x, y) diagCspprod(x, y, boolArith=TRUE)) ## instead of "sparseMatrix", use: [RT]sparse.. ("closer" in method dispatch) for(cl in c("TsparseMatrix", "RsparseMatrix")) { setMethod("%*%", signature(x = "diagonalMatrix", y = "sparseMatrix"), function(x, y) diagCspprod(as(x, "CsparseMatrix"), y, boolArith=NA)) setMethod("%*%", signature(x = "sparseMatrix", y = "diagonalMatrix"), function(x, y) Cspdiagprod(as(x, "CsparseMatrix"), y, boolArith=NA)) setMethod("%&%", signature(x = "diagonalMatrix", y = "sparseMatrix"), function(x, y) diagCspprod(as(x, "CsparseMatrix"), y, boolArith=TRUE)) setMethod("%&%", signature(x = "sparseMatrix", y = "diagonalMatrix"), function(x, y) Cspdiagprod(as(x, "CsparseMatrix"), y, boolArith=TRUE)) } setMethod("%*%", signature(x = "CsparseMatrix", y = "diagonalMatrix"), function(x, y) Cspdiagprod(x, y, boolArith=NA)) setMethod("%&%", signature(x = "CsparseMatrix", y = "diagonalMatrix"), function(x, y) Cspdiagprod(x, y, boolArith=TRUE)) ## TODO: Write tests in ./tests/ which ensure that many "ops" with diagonal* ## do indeed work by going through sparse (and *not* ddense)! setMethod("solve", signature(a = "diagonalMatrix", b = "missing"), function(a, b, ...) { a@x <- 1/ a@x a@Dimnames <- a@Dimnames[2:1] a }) solveDiag <- function(a, b, ...) { if(a@Dim[1L] != nrow(b)) stop("incompatible matrix dimensions") ## trivially invert a 'in place' and multiply: a@x <- 1/ a@x a@Dimnames <- a@Dimnames[2:1] a %*% b } setMethod("solve", signature(a = "diagonalMatrix", b = "matrix"), solveDiag) setMethod("solve", signature(a = "diagonalMatrix", b = "Matrix"), solveDiag) ## Schur() ---> ./eigen.R ###---------------- (, , ) ---------------------- ## Use as S4 method for several signatures ==> using callGeneric() diagOdiag <- function(e1,e2) { ## result should also be diagonal _ if possible _ r <- callGeneric(.diag.x(e1), .diag.x(e2)) # error if not "compatible" ## Check what happens with non-diagonals, i.e. (0 o 0), (FALSE o 0), ...: r00 <- callGeneric(if(is.numeric(e1@x)) 0 else FALSE, if(is.numeric(e2@x)) 0 else FALSE) if(is0(r00)) { ## r00 == 0 or FALSE --- result *is* diagonal if(is.numeric(r)) { # "double" *or* "integer" if(is.numeric(e2@x)) { e2@x <- r; return(.diag.2N(e2)) } if(!is.numeric(e1@x)) ## e.g. e1, e2 are logical; e1 <- as(e1, "dMatrix") if(!is.double(r)) r <- as.double(r) } else if(is.logical(r)) e1 <- as(e1, "lMatrix") else stop(gettextf("intermediate 'r' is of type %s", typeof(r)), domain=NA) e1@x <- r .diag.2N(e1) } else { ## result not diagonal, but at least symmetric: ## e.g., m == m isNum <- (is.numeric(r) || is.numeric(r00)) isLog <- (is.logical(r) || is.logical(r00)) Matrix.msg("exploding o into dense matrix", .M.level = 2) d <- e1@Dim n <- d[1L] stopifnot(length(r) == n) if(isNum && !is.double(r)) r <- as.double(r) ## faster (?) than m <- matrix(r00,n,n); diag(m) <- r ; as.vector(m) xx <- rbind(r, matrix(r00,n,n), deparse.level=0L)[seq_len(n*n)] newcl <- paste0(if(isNum) "d" else if(isLog) { if(!anyNA(r) && !anyNA(r00)) "n" else "l" } else stop("not yet implemented .. please report"), "syMatrix") new(newcl, Dim = e1@Dim, Dimnames = e1@Dimnames, x = xx) } } ### This would be *the* way, but we get tons of "ambiguous method dispatch" ## we use this hack instead of signature x = "diagonalMatrix" : diCls <- names(getClass("diagonalMatrix")@subclasses) if(FALSE) { setMethod("Ops", signature(e1 = "diagonalMatrix", e2 = "diagonalMatrix"), diagOdiag) } else { ## These are just for method disambiguation: for(c1 in diCls) for(c2 in diCls) setMethod("Ops", signature(e1 = c1, e2 = c2), diagOdiag) } ## diagonal o triangular |--> triangular ## diagonal o symmetric |--> symmetric ## {also when other is sparse: do these "here" -- ## before conversion to sparse, since that loses "diagonality"} diagOtri <- function(e1,e2) { ## result must be triangular r <- callGeneric(d1 <- .diag.x(e1), diag(e2)) # error if not "compatible" ## Check what happens with non-diagonals, i.e. (0 o 0), (FALSE o 0), ...: e1.0 <- if(is.numeric(d1)) 0 else FALSE r00 <- callGeneric(e1.0, if(.n2 <- is.numeric(e2[0L])) 0 else FALSE) if(is0(r00)) { ## r00 == 0 or FALSE --- result *is* triangular diag(e2) <- r ## check what happens "in the triangle" e2.2 <- if(.n2) 2 else TRUE if(!callGeneric(e1.0, e2.2) == e2.2) { # values "in triangle" can change: n <- dim(e2)[1L] it <- indTri(n, upper = (e2@uplo == "U")) e2[it] <- callGeneric(e1.0, e2[it]) } e2 } else { ## result not triangular ---> general rr <- as(e2, "generalMatrix") diag(rr) <- r rr } } setMethod("Ops", signature(e1 = "diagonalMatrix", e2 = "triangularMatrix"), diagOtri) ## For the reverse, Ops == "Arith" | "Compare" | "Logic" ## 'Arith' := '"+"', '"-"', '"*"', '"^"', '"%%"', '"%/%"', '"/"' setMethod("Arith", signature(e1 = "triangularMatrix", e2 = "diagonalMatrix"), function(e1,e2) { ## this must only trigger for *dense* e1 switch(.Generic, "+" = .Call(dtrMatrix_addDiag, as(e1,"dtrMatrix"), .diag.x(e2)), "-" = .Call(dtrMatrix_addDiag, as(e1,"dtrMatrix"), - .diag.x(e2)), "*" = { n <- e2@Dim[1L] d2 <- if(e2@diag == "U") { # unit-diagonal d <- rep.int(as1(e2@x), n) e2@x <- d e2@diag <- "N" d } else e2@x e2@x <- diag(e1) * d2 e2 }, "^" = { ## will be dense ( as ^ 0 == 1 ): e1 ^ as(e2, "denseMatrix") }, ## otherwise: callGeneric(e1, diag2Tsmart(e2,e1))) }) ## Compare --> 'swap' (e.g. e1 < e2 <==> e2 > e1 ): setMethod("Compare", signature(e1 = "triangularMatrix", e2 = "diagonalMatrix"), .Cmp.swap) ## '&' and "|' are commutative: setMethod("Logic", signature(e1 = "triangularMatrix", e2 = "diagonalMatrix"), function(e1,e2) callGeneric(e2, e1)) ## For almost everything else, diag* shall be treated "as sparse" : ## These are cheap implementations via coercion ## For disambiguation --- define this for "sparseMatrix" , then for "ANY"; ## and because we can save an .M.kind() call, we use this explicit ## "hack" for all diagonalMatrix *subclasses* instead of just "diagonalMatrix" : ## ## ddi*: setMethod("Ops", signature(e1 = "ddiMatrix", e2 = "sparseMatrix"), function(e1,e2) callGeneric(diag2Tsmart(e1,e2, "d"), e2)) setMethod("Ops", signature(e1 = "sparseMatrix", e2 = "ddiMatrix"), function(e1,e2) callGeneric(e1, diag2Tsmart(e2,e1, "d"))) ## ldi* setMethod("Ops", signature(e1 = "ldiMatrix", e2 = "sparseMatrix"), function(e1,e2) callGeneric(diag2Tsmart(e1,e2, "l"), e2)) setMethod("Ops", signature(e1 = "sparseMatrix", e2 = "ldiMatrix"), function(e1,e2) callGeneric(e1, diag2Tsmart(e2,e1, "l"))) ## Ops: Arith --> numeric : "dMatrix" ## Compare --> logical ## Logic --> logical: "lMatrix" ## Other = "numeric" : stay diagonal if possible ## ddi*: Arith: result numeric, potentially ddiMatrix for(arg2 in c("numeric","logical")) setMethod("Arith", signature(e1 = "ddiMatrix", e2 = arg2), function(e1,e2) { n <- e1@Dim[1L] if(length(e2) == 0L) return(if(n) numeric() else e1) f0 <- callGeneric(0, e2) if(all0(f0)) { # remain diagonal L1 <- (le <- length(e2)) == 1L if(e1@diag == "U") { if(any((r <- callGeneric(1, e2)) != 1)) { e1@diag <- "N" e1@x[seq_len(n)] <- r # possibly recycling r } ## else: result = e1 (is "U" diag) } else { r <- callGeneric(e1@x, e2) ## "future fixme": if we have idiMatrix, and r is 'integer', use idiMatrix e1@x[] <- if(L1) r else r[1L + ((n+1)*(0:(n-1L))) %% le] } e1 } else callGeneric(diag2tT.u(e1,e2, "d"), e2) }) for(arg1 in c("numeric","logical")) setMethod("Arith", signature(e1 = arg1, e2 = "ddiMatrix"), function(e1,e2) { n <- e2@Dim[1L] if(length(e1) == 0L) return(if(n) numeric() else e2) f0 <- callGeneric(e1, 0) if(all0(f0)) { # remain diagonal L1 <- (le <- length(e1)) == 1L if(e2@diag == "U") { if(any((r <- callGeneric(e1, 1)) != 1)) { e2@diag <- "N" e2@x[seq_len(n)] <- r # possibly recycling r } ## else: result = e2 (is "U" diag) } else { r <- callGeneric(e1, e2@x) ## "future fixme": if we have idiMatrix, and r is 'integer', use idiMatrix e2@x[] <- if(L1) r else r[1L + ((n+1)*(0:(n-1L))) %% le] } e2 } else callGeneric(e1, diag2tT.u(e2,e1, "d")) }) ## ldi* Arith --> result numeric, potentially ddiMatrix for(arg2 in c("numeric","logical")) setMethod("Arith", signature(e1 = "ldiMatrix", e2 = arg2), function(e1,e2) { n <- e1@Dim[1L] if(length(e2) == 0L) return(if(n) numeric() else copyClass(e1, "ddiMatrix", c("diag", "Dim", "Dimnames"), check=FALSE)) f0 <- callGeneric(0, e2) if(all0(f0)) { # remain diagonal L1 <- (le <- length(e2)) == 1L E <- copyClass(e1, "ddiMatrix", c("diag", "Dim", "Dimnames"), check=FALSE) ## storage.mode(E@x) <- "double" if(e1@diag == "U") { if(any((r <- callGeneric(1, e2)) != 1)) { E@diag <- "N" E@x[seq_len(n)] <- r # possibly recycling r } ## else: result = E (is "U" diag) } else { r <- callGeneric(e1@x, e2) ## "future fixme": if we have idiMatrix, and r is 'integer', use idiMatrix E@x[seq_len(n)] <- if(L1) r else r[1L + ((n+1)*(0:(n-1L))) %% le] } E } else callGeneric(diag2tT.u(e1,e2, "l"), e2) }) for(arg1 in c("numeric","logical")) setMethod("Arith", signature(e1 = arg1, e2 = "ldiMatrix"), function(e1,e2) { n <- e2@Dim[1L] if(length(e1) == 0L) return(if(n) numeric() else copyClass(e2, "ddiMatrix", c("diag", "Dim", "Dimnames"), check=FALSE)) f0 <- callGeneric(e1, 0) if(all0(f0)) { # remain diagonal L1 <- (le <- length(e1)) == 1L E <- copyClass(e2, "ddiMatrix", c("diag", "Dim", "Dimnames"), check=FALSE) ## storage.mode(E@x) <- "double" if(e2@diag == "U") { if(any((r <- callGeneric(e1, 1)) != 1)) { E@diag <- "N" E@x[seq_len(n)] <- r # possibly recycling r } ## else: result = E (is "U" diag) } else { r <- callGeneric(e1, e2@x) ## "future fixme": if we have idiMatrix, and r is 'integer', use idiMatrix E@x[seq_len(n)] <- if(L1) r else r[1L + ((n+1)*(0:(n-1L))) %% le] } E } else callGeneric(e1, diag2tT.u(e2,e1, "l")) }) ## ddi*: for "Ops" without "Arith": or --> result logical, potentially ldi ## ## Note that ("numeric", "ddiMatrix") is simply swapped, e.g., if(FALSE) { selectMethod("<", c("numeric","lMatrix"))# Compare selectMethod("&", c("numeric","lMatrix"))# Logic } ## so we don't need to define a method here : for(arg2 in c("numeric","logical")) setMethod("Ops", signature(e1 = "ddiMatrix", e2 = arg2), function(e1,e2) { n <- e1@Dim[1L] if(length(e2) == 0L) return(if(n) logical() else copyClass(e1, "ldiMatrix", c("diag", "Dim", "Dimnames"), check=FALSE)) f0 <- callGeneric(0, e2) if(all0(f0)) { # remain diagonal L1 <- (le <- length(e2)) == 1L E <- copyClass(e1, "ldiMatrix", c("diag", "Dim", "Dimnames"), check=FALSE) ## storage.mode(E@x) <- "logical" if(e1@diag == "U") { if(any((r <- callGeneric(1, e2)) != 1)) { E@diag <- "N" E@x[seq_len(n)] <- r # possibly recycling r } ## else: result = E (is "U" diag) } else { r <- callGeneric(e1@x, e2) ## "future fixme": if we have idiMatrix, and r is 'integer', use idiMatrix E@x[seq_len(n)] <- if(L1) r else r[1L + ((n+1)*(0:(n-1L))) %% le] } E } else callGeneric(diag2tT.u(e1,e2, "d"), e2) }) ## ldi*: for "Ops" without "Arith": or --> result logical, potentially ldi for(arg2 in c("numeric","logical")) setMethod("Ops", signature(e1 = "ldiMatrix", e2 = arg2), function(e1,e2) { n <- e1@Dim[1L] if(length(e2) == 0L) return(if(n) logical() else e1) f0 <- callGeneric(FALSE, e2) if(all0(f0)) { # remain diagonal L1 <- (le <- length(e2)) == 1L if(e1@diag == "U") { if(any((r <- callGeneric(TRUE, e2)) != 1)) { e1@diag <- "N" e1@x[seq_len(n)] <- r # possibly recycling r } ## else: result = e1 (is "U" diag) } else { r <- callGeneric(e1@x, e2) ## "future fixme": if we have idiMatrix, and r is 'integer', use idiMatrix e1@x[] <- if(L1) r else r[1L + ((n+1)*(0:(n-1L))) %% le] } e1 } else callGeneric(diag2tT.u(e1,e2, "l"), e2) }) ## Not {"sparseMatrix", "numeric} : {"denseMatrix", "matrix", ... } for(other in c("ANY", "Matrix", "dMatrix")) { ## ddi*: setMethod("Ops", signature(e1 = "ddiMatrix", e2 = other), function(e1,e2) callGeneric(diag2Tsmart(e1,e2, "d"), e2)) setMethod("Ops", signature(e1 = other, e2 = "ddiMatrix"), function(e1,e2) callGeneric(e1, diag2Tsmart(e2,e1, "d"))) ## ldi*: setMethod("Ops", signature(e1 = "ldiMatrix", e2 = other), function(e1,e2) callGeneric(diag2Tsmart(e1,e2, "l"), e2)) setMethod("Ops", signature(e1 = other, e2 = "ldiMatrix"), function(e1,e2) callGeneric(e1, diag2Tsmart(e2,e1, "l"))) } ## Direct subclasses of "denseMatrix": currently ddenseMatrix, ldense... : if(FALSE) # now also contains "geMatrix" dense.subCl <- local({ dM.scl <- getClass("denseMatrix")@subclasses names(dM.scl)[vapply(dM.scl, slot, 0, "distance") == 1] }) dense.subCl <- paste0(c("d","l","n"), "denseMatrix") for(DI in diCls) { dMeth <- if(extends(DI, "dMatrix")) function(e1,e2) callGeneric(diag2Tsmart(e1,e2, "d"), e2) else # "lMatrix", the only other kind for now function(e1,e2) callGeneric(diag2Tsmart(e1,e2, "l"), e2) for(c2 in c(dense.subCl, "Matrix")) { for(Fun in c("*", "&")) { setMethod(Fun, signature(e1 = DI, e2 = c2), function(e1,e2) callGeneric(e1, Diagonal(x = diag(e2)))) setMethod(Fun, signature(e1 = c2, e2 = DI), function(e1,e2) callGeneric(Diagonal(x = diag(e1)), e2)) } setMethod("^", signature(e1 = c2, e2 = DI), function(e1,e2) callGeneric(Diagonal(x = diag(e1)), e2)) for(Fun in c("%%", "%/%", "/")) ## 0 0 |--> NaN for these. setMethod(Fun, signature(e1 = DI, e2 = c2), dMeth) } } ## Group methods "Math", "Math2" in --> ./Math.R ### "Summary" : "max" "min" "range" "prod" "sum" "any" "all" ### ---------- the last 4: separately here for(cl in diCls) { setMethod("any", cl, function (x, ..., na.rm) { if(any(x@Dim == 0)) FALSE else if(x@diag == "U") TRUE else any(x@x, ..., na.rm = na.rm) }) setMethod("all", cl, function (x, ..., na.rm) { n <- x@Dim[1L] if(n >= 2) FALSE else if(n == 0 || x@diag == "U") TRUE else all(x@x, ..., na.rm = na.rm) }) setMethod("prod", cl, function (x, ..., na.rm) { n <- x@Dim[1L] if(n >= 2) 0 else if(n == 0 || x@diag == "U") 1 else ## n == 1, diag = "N" : prod(x@x, ..., na.rm = na.rm) }) setMethod("sum", cl, function(x, ..., na.rm) { r <- sum(x@x, ..., na.rm = na.rm)# double or integer, correctly if(x@diag == "U" && !is.na(r)) r + x@Dim[1L] else r }) } ## The remaining ones are max, min, range : setMethod("Summary", "ddiMatrix", function(x, ..., na.rm) { if(any(x@Dim == 0)) callGeneric(numeric(0), ..., na.rm=na.rm) else if(x@diag == "U") callGeneric(x@x, 0, 1, ..., na.rm=na.rm) else callGeneric(x@x, 0, ..., na.rm=na.rm) }) setMethod("Summary", "ldiMatrix", function(x, ..., na.rm) { if(any(x@Dim == 0)) callGeneric(logical(0), ..., na.rm=na.rm) else if(x@diag == "U") callGeneric(x@x, FALSE, TRUE, ..., na.rm=na.rm) else callGeneric(x@x, FALSE, ..., na.rm=na.rm) }) ## similar to prTriang() in ./Auxiliaries.R : prDiag <- function(x, digits = getOption("digits"), justify = "none", right = TRUE) { cf <- array(".", dim = x@Dim, dimnames = x@Dimnames) cf[row(cf) == col(cf)] <- vapply(diag(x), format, "", digits = digits, justify = justify) print(cf, quote = FALSE, right = right) invisible(x) } ## somewhat consistent with "print" for sparseMatrix : setMethod("print", signature(x = "diagonalMatrix"), prDiag) setMethod("show", signature(object = "diagonalMatrix"), function(object) { d <- dim(object) cl <- class(object) cat(sprintf('%d x %d diagonal matrix of class "%s"', d[1L], d[2L], cl)) if(d[1L] < 50) { cat("\n") prDiag(object) } else { cat(", with diagonal entries\n") show(diag(object)) invisible(object) } }) rm(arg1, arg2, other, DI, Fun, cl, c1, c2, dense.subCl, diCls)# not used elsewhere setMethod("summary", signature(object = "diagonalMatrix"), function(object, ...) { d <- dim(object) r <- summary(object@x, ...) attr(r, "header") <- sprintf('%d x %d diagonal Matrix of class "%s"', d[1L], d[2L], class(object)) ## use ole' S3 technology for such a simple case class(r) <- c("diagSummary", class(r)) r }) print.diagSummary <- function (x, ...) { cat(attr(x, "header"),"\n") class(x) <- class(x)[-1] print(x, ...) invisible(x) } Matrix/R/dppMatrix.R0000644000176200001440000000564513141330160014014 0ustar liggesusers#### Positive-definite Symmetric Packed Matrices -- Coercion and Methods setAs("dppMatrix", "dpoMatrix", function(from) copyClass(.Call(dspMatrix_as_dsyMatrix, from), "dpoMatrix", sNames = c("x", "Dim", "Dimnames", "uplo", "factors")))#FIXME , check=FALSE dpp2sC <- function(from) as(.Call(dspMatrix_as_dsyMatrix, from), "dsCMatrix") ## setAs("dppMatrix", "dsCMatrix", dpp2sC) setAs("dppMatrix", "CsparseMatrix", dpp2sC) setAs("dppMatrix", "sparseMatrix", dpp2sC) setAs("dppMatrix", "lMatrix", function(from) as(as(from, "dsyMatrix"), "lMatrix")) setAs("dppMatrix", "nMatrix", function(from) as(as(from, "dsyMatrix"), "nMatrix")) to_dpp <- function(from) as(as(as(as(from, "symmetricMatrix"), "dMatrix"), "dpoMatrix"), "dppMatrix") setAs("Matrix", "dppMatrix", to_dpp)# some may fail, but this tries setAs("matrix", "dppMatrix", to_dpp) setAs("dspMatrix", "dppMatrix", function(from){ if(is.null(tryCatch(.Call(dppMatrix_chol, from), error = function(e) NULL))) stop("not a positive definite matrix") ## else copyClass(from, "dppMatrix", sNames = c("x", "Dim", "Dimnames", "uplo", "factors"))#FIXME , check=FALSE }) setMethod("chol", signature(x = "dppMatrix"), function(x, pivot, LINPACK) .Call(dppMatrix_chol, x)) setMethod("determinant", signature(x = "dppMatrix", logarithm = "logical"), mkDet.via.chol) setMethod("determinant", signature(x = "dppMatrix", logarithm = "missing"), function(x, logarithm, ...) mkDet.via.chol(x, logarithm=TRUE)) setMethod("rcond", signature(x = "dppMatrix", norm = "character"), function(x, norm, ...) .Call(dppMatrix_rcond, x, norm), valueClass = "numeric") setMethod("rcond", signature(x = "dppMatrix", norm = "missing"), function(x, norm, ...) .Call(dppMatrix_rcond, x, "O"), valueClass = "numeric") setMethod("solve", signature(a = "dppMatrix", b = "missing"), function(a, b, ...) .Call(dppMatrix_solve, a), valueClass = "dppMatrix") setMethod("solve", signature(a = "dppMatrix", b = "dgeMatrix"), function(a, b, ...) .Call(dppMatrix_matrix_solve, a, b), valueClass = "dgeMatrix") setMethod("solve", signature(a = "dppMatrix", b = "matrix"), function(a, b, ...) .Call(dppMatrix_matrix_solve, a, b), valueClass = "dgeMatrix") ##setMethod("solve", signature(a = "dppMatrix", b = "numeric"), ## function(a, b, ...) ## .Call(dppMatrix_matrix_solve, a, as.matrix(b)), ## valueClass = "dgeMatrix") setMethod("solve", signature(a = "dppMatrix", b = "integer"), function(a, b, ...) { storage.mode(b) <- "double" .Call(dppMatrix_matrix_solve, a, cbind(b, deparse.level=0L)) }, valueClass = "dgeMatrix") setMethod("t", signature(x = "dppMatrix"), function(x) as(t(as(x, "dspMatrix")), "dppMatrix"), valueClass = "dppMatrix") Matrix/R/ldenseMatrix.R0000644000176200001440000001511713047113565014513 0ustar liggesusers#### "ldenseMatrix" - virtual class of logical dense matrices #### ------------ #### Contains lge*; ltr*, ltp*; lsy*, lsp*; ldi* ### NOTA BENE: Much of this is *very* parallel to ./ndenseMatrix.R ### ~~~~~~~~~~~~~~~~ ## packed <-> non-packed : setAs("lspMatrix", "lsyMatrix", ## vv for "l*", 1L for "n*" lsp2lsy <- function(from) .Call(lspMatrix_as_lsyMatrix, from, 0L)) setAs("lsyMatrix", "lspMatrix", lsy2lsp <- function(from) .Call(lsyMatrix_as_lspMatrix, from, 0L)) setAs("ltpMatrix", "ltrMatrix", ltp2ltr <- function(from) .Call(ltpMatrix_as_ltrMatrix, from, 0L)) setAs("ltrMatrix", "ltpMatrix", ltr2ltp <- function(from) .Call(ltrMatrix_as_ltpMatrix, from, 0L)) ## Logical -> Double {of same structure}: setAs("lgeMatrix", "dgeMatrix", function(from) l2d_Matrix(from, "lgeMatrix")) setAs("lsyMatrix", "dsyMatrix", function(from) l2d_Matrix(from, "lsyMatrix")) setAs("lspMatrix", "dspMatrix", function(from) l2d_Matrix(from, "lspMatrix")) setAs("ltrMatrix", "dtrMatrix", function(from) l2d_Matrix(from, "ltrMatrix")) setAs("ltpMatrix", "dtpMatrix", function(from) l2d_Matrix(from, "ltpMatrix")) ## all need be coercable to "lgeMatrix": setAs("lsyMatrix", "lgeMatrix", lsy2lge <- function(from) .Call(lsyMatrix_as_lgeMatrix, from, 0L)) setAs("ltrMatrix", "lgeMatrix", ltr2lge <- function(from) .Call(ltrMatrix_as_lgeMatrix, from, 0L)) setAs("ltpMatrix", "lgeMatrix", function(from) ltr2lge(ltp2ltr(from))) setAs("lspMatrix", "lgeMatrix", function(from) lsy2lge(lsp2lsy(from))) ## and the reverse setAs("lgeMatrix", "ltpMatrix", function(from) ltr2ltp(as(from, "ltrMatrix"))) setAs("lgeMatrix", "lspMatrix", function(from) lsy2lsp(as(from, "lsyMatrix"))) ### -> symmetric : setAs("lgeMatrix", "lsyMatrix", function(from) { if(isSymmetric(from)) new("lsyMatrix", x = from@x, Dim = from@Dim, Dimnames = from@Dimnames, factors = from@factors) else stop("not a symmetric matrix; consider forceSymmetric() or symmpart()") }) setAs("lgeMatrix", "ltrMatrix", function(from) { if(isT <- isTriangular(from)) new("ltrMatrix", x = from@x, Dim = from@Dim, Dimnames = from@Dimnames, uplo = attr(isT, "kind") %||% "U") ## TODO: also check 'diag' else stop("not a triangular matrix") }) ### ldense* <-> "matrix" : ## 1) "lge* : setAs("lgeMatrix", "matrix", ge2mat) setAs("matrix", "lgeMatrix", function(from) { new("lgeMatrix", x = as.logical(from), Dim = as.integer(dim(from)), Dimnames = .M.DN(from)) }) ## 2) base others on "lge*": setAs("matrix", "lsyMatrix", function(from) as(as(from, "lgeMatrix"), "lsyMatrix")) setAs("matrix", "lspMatrix", function(from) lsy2lsp(as(from, "lsyMatrix"))) setAs("matrix", "ltrMatrix", function(from) as(as(from, "lgeMatrix"), "ltrMatrix")) setAs("matrix", "ltpMatrix", function(from) ltr2ltp(as(from, "ltrMatrix"))) ## Useful if this was called e.g. for as(*, "lsyMatrix"), but it isn't setAs("matrix", "ldenseMatrix", function(from) as(from, "lgeMatrix")) setAs("ldenseMatrix", "matrix", ## uses the above l*M. -> lgeM. function(from) as(as(from, "lgeMatrix"), "matrix")) ## dense |-> compressed : setAs("lgeMatrix", "lgTMatrix", function(from) as(.dense2C(from, kind = "gen"), "lgTMatrix")) setAs("lgeMatrix", "lgCMatrix", # TODO: need as(*, ..) ? function(from) as(.dense2C(from, kind = "gen"), "lgCMatrix")) setMethod("as.logical", signature(x = "ldenseMatrix"), function(x, ...) as(x, "lgeMatrix")@x) ###---------------------------------------------------------------------- setMethod("diag", signature(x = "lgeMatrix"), function(x, nrow, ncol) .Call(lgeMatrix_getDiag, x)) setMethod("diag", signature(x = "lsyMatrix"), function(x, nrow, ncol) .Call(lgeMatrix_getDiag, x)) setMethod("diag", signature(x = "lspMatrix"), function(x, nrow, ncol) .Call(lspMatrix_getDiag, x)) setMethod("diag", signature(x = "ltrMatrix"), function(x, nrow, ncol) .Call(ltrMatrix_getDiag, x)) setMethod("diag", signature(x = "ltpMatrix"), function(x, nrow, ncol) .Call(ltpMatrix_getDiag, x)) setMethod("diag", signature(x = "ndenseMatrix"),# << the "same" function(x, nrow, ncol) diag(as(x, "ldenseMatrix"))) ## --- *SETTING* of diagonal : diag(x) <- value --------- ## --- ===================== faster than default x[cbind[c(i,i)]] <- value setMethod("diag<-", signature(x = "lgeMatrix"), function(x, value) .Call(lgeMatrix_setDiag, x, value)) setMethod("diag<-", signature(x = "lsyMatrix"), function(x, value) .Call(lgeMatrix_setDiag, x, value)) setMethod("diag<-", signature(x = "lspMatrix"), function(x, value) .Call(lspMatrix_setDiag, x, value)) .diag.set.ltr <- function(x, value) { .Call(ltrMatrix_setDiag, if(x@diag == "U") .dense.diagU2N(x, "l", isPacked=FALSE) else x, value) } .diag.set.ltp <- function(x, value) { .Call(ltpMatrix_setDiag, if(x@diag == "U") .dense.diagU2N(x, "l", isPacked=TRUE) else x, value) } setMethod("diag<-", signature(x = "ltrMatrix"), .diag.set.ltr) setMethod("diag<-", signature(x = "ltpMatrix"), .diag.set.ltp) ## the *same* for the "ndenseMatrix" elements: setMethod("diag<-", signature(x = "ngeMatrix"), function(x, value) .Call(lgeMatrix_setDiag, x, value)) setMethod("diag<-", signature(x = "nsyMatrix"), function(x, value) .Call(lgeMatrix_setDiag, x, value)) setMethod("diag<-", signature(x = "nspMatrix"), function(x, value) .Call(lspMatrix_setDiag, x, value)) setMethod("diag<-", signature(x = "ntrMatrix"), .diag.set.ltr) setMethod("diag<-", signature(x = "ntpMatrix"), .diag.set.ltp) rm(.diag.set.ltr, .diag.set.ltp) setMethod("t", signature(x = "lgeMatrix"), t_geMatrix) setMethod("t", signature(x = "ltrMatrix"), t_trMatrix) setMethod("t", signature(x = "lsyMatrix"), t_trMatrix) setMethod("t", signature(x = "ltpMatrix"), function(x) as(t(as(x, "ltrMatrix")), "ltpMatrix")) setMethod("t", signature(x = "lspMatrix"), function(x) as(t(as(x, "lsyMatrix")), "lspMatrix")) ## NOTE: "&" and "|" are now in group "Logic" c "Ops" --> ./Ops.R ## "!" is in ./not.R setMethod("as.vector", "ldenseMatrix", function(x, mode) as.vector(as(x, "lgeMatrix")@x, mode)) setMethod("norm", signature(x = "ldenseMatrix", type = "character"), function(x, type, ...) if(identical("2", type)) norm2(x) else .Call(dgeMatrix_norm, as(as(x,"dMatrix"),"dgeMatrix"), type), valueClass = "numeric") .rcond_via_d <- function(x, norm, ...) rcond(as(as(x, "dMatrix"), "dgeMatrix"), norm=norm, ...) setMethod("rcond", signature(x = "ldenseMatrix", norm = "character"), .rcond_via_d, valueClass = "numeric") Matrix/R/dtCMatrix.R0000644000176200001440000001123113777276322013757 0ustar liggesusers#### Triangular Sparse Matrices in compressed column-oriented format setAs("dtCMatrix", "ltCMatrix", function(from) new("ltCMatrix", i = from@i, p = from@p, uplo = from@uplo, diag = from@diag, x = as.logical(from@x), ## FIXME?: use from@factors smartly Dim = from@Dim, Dimnames = from@Dimnames)) setAs("dtCMatrix", "ntCMatrix", # just drop 'x' slot: function(from) new("ntCMatrix", i = from@i, p = from@p, uplo = from@uplo, diag = from@diag, ## FIXME?: use from@factors smartly Dim = from@Dim, Dimnames = from@Dimnames)) setAs("matrix", "dtCMatrix", function(from) as(as(from, "dtTMatrix"), "dtCMatrix")) ##' dtC* |-> dgC* (provide for direct use in other coercions) : .dtC2g <- function(from) { if (from@diag == "U") from <- .Call(Csparse_diagU2N, from) ## new("dgCMatrix", .....) # ---> Rather faster, no checking: copyClass(from, "dgCMatrix", sNames = c("i", "p", "x", "Dim", "Dimnames"), check = FALSE) } setAs("dtCMatrix", "dgCMatrix", .dtC2g) setAs("dtCMatrix", "dsCMatrix", function(from) as(from, "symmetricMatrix")) setAs("dtCMatrix", "dgTMatrix", function(from) { if (from@diag == "U") from <- .Call(Csparse_diagU2N, from) ## ignore triangularity in conversion to TsparseMatrix .Call(Csparse_to_Tsparse, from, FALSE) }) ## FIXME: make more efficient ## ----- and as(., "triangularMatrix") is even worse via as_Sp() setAs("dgCMatrix", "dtCMatrix", # to triangular, needed for triu,.. function(from) as(.Call(Csparse_to_Tsparse, from, FALSE), "dtCMatrix")) setAs("dtCMatrix", "dgeMatrix", function(from) as(as(from, "dgTMatrix"), "dgeMatrix")) ## These are all needed because cholmod doesn't support triangular: ## (see end of ./Csparse.R ), e.g. for triu() setAs("dtCMatrix", "dtTMatrix", function(from) .Call(Csparse_to_Tsparse, from, TRUE)) ## {# and this is not elegant: ## x <- as(from, "dgTMatrix") ## if (from@diag == "U") { ## drop diagonal entries '1': ## i <- x@i; j <- x@j ## nonD <- i != j ## xx <- x@x[nonD] ; i <- i[nonD] ; j <- j[nonD] ## } else { ## xx <- x@x; i <- x@i; j <- x@j ## } ## new("dtTMatrix", x = xx, i = i, j = j, Dim = x@Dim, ## Dimnames = x@Dimnames, uplo = from@uplo, diag = from@diag) ## }) ## Now that we support triangular matrices use the inherited method. ## setAs("dtCMatrix", "TsparseMatrix", function(from) as(from, "dtTMatrix")) setAs("dtCMatrix", "dtrMatrix", function(from) as(as(from, "dtTMatrix"), "dtrMatrix")) setMethod("determinant", signature(x = "dtCMatrix", logarithm = "logical"), function(x, logarithm = TRUE, ...) { if(x@diag == "N") mkDet(diag(x), logarithm) else structure(list(modulus = structure(if (logarithm) 0 else 1, "logarithm" = logarithm), sign = 1L), class = "det") }) setMethod("solve", signature(a = "dtCMatrix", b = "missing"), function(a, b, ...) { stopifnot((n <- nrow(a)) == ncol(a)) as(.Call(dtCMatrix_sparse_solve, a, .trDiagonal(n, unitri=FALSE)), "dtCMatrix") }, valueClass = "dtCMatrix") setMethod("solve", signature(a = "dtCMatrix", b = "dgeMatrix"), function(a, b, ...) .Call(dtCMatrix_matrix_solve, a, b, TRUE), valueClass = "dgeMatrix") setMethod("solve", signature(a = "dtCMatrix", b = "CsparseMatrix"), function(a, b, ...) .sortCsparse(.Call(dtCMatrix_sparse_solve, a, b)), ## ------------ TODO: both in C code valueClass = "dgCMatrix") setMethod("solve", signature(a = "dtCMatrix", b = "matrix"), function(a, b, ...) { storage.mode(b) <- "double" .Call(dtCMatrix_matrix_solve, a, b, FALSE) }, valueClass = "dgeMatrix") ## Isn't this case handled by the method for (a = "Matrix', b = ## "numeric") in ./Matrix.R? Or is this method defined here for ## the as.double coercion? setMethod("solve", signature(a = "dtCMatrix", b = "numeric"), function(a, b, ...) .Call(dtCMatrix_matrix_solve, a, cbind(as.double(b), deparse.level=0L), FALSE), valueClass = "dgeMatrix") if(FALSE)## still not working setMethod("diag", "dtCMatrix", function(x, nrow, ncol) .Call(diag_tC, x, "diag")) ## no pivoting here, use L or U setMethod("lu", "dtCMatrix", function(x, ...) { n <- (d <- x@Dim)[1L] p <- 0:(n-1L) if(x@uplo == "U") new("sparseLU", L = .trDiagonal(n, uplo="L"), U = x, p = p, q = p, Dim = d) else { ## "L" : x = L = L I d <- diag(x) new("sparseLU", L = x %*% Diagonal(n, 1/d), U = .trDiagonal(n, x = d), p = p, q = p, Dim = d) } }) Matrix/R/Matrix.R0000644000176200001440000007252514036605236013326 0ustar liggesusers#### Toplevel ``virtual'' class "Matrix" ### Virtual coercions -- via smart "helpers" (-> ./Auxiliaries.R) setAs("Matrix", "sparseMatrix", function(from) as(from, "CsparseMatrix")) setAs("Matrix", "CsparseMatrix", function(from) as_Csparse(from)) setAs("Matrix", "denseMatrix", function(from) as_dense(from)) ## Maybe TODO: ## setAs("Matrix", "nMatrix", function(from) ....) ## Anything: we build on as.matrix(.) : ## --- authors can always provide their own specific setAs(*, "Matrix") setAs("ANY", "Matrix", function(from) Matrix(as.matrix(from))) ## Most of these work; this is a last resort: setAs("Matrix", "matrix", # do *not* call base::as.matrix() here: function(from) .bail.out.2("coerce", class(from), class(to))) setAs("matrix", "Matrix", function(from) Matrix(from)) ## ## probably not needed eventually: ## setAs(from = "ddenseMatrix", to = "matrix", ## function(from) { ## if(length(d <- dim(from)) != 2) stop("dim(.) has not length 2") ## array(from@x, dim = d, dimnames = dimnames(from)) ## }) .asmatrix <- function(x) as(x, "matrix") # not better; just for those hating typing ## Such that also base functions dispatch properly on our classes: if(.Matrix.avoiding.as.matrix) { as.matrix.Matrix <- function(x, ...) { if(nonTRUEoption("Matrix.quiet.as.matrix") && nonTRUEoption("Matrix.quiet")) warning("as.matrix() is deprecated (to become a no-op in the future). Use as(x, \"matrix\") or .asmatrix(x) instead.") as(x, "matrix") } as.array.Matrix <- function(x, ...) { warning("as.array() is deprecated. Use as(x, \"matrix\") or .asmatrix(x) instead.") as(x, "matrix") } } else { ## regularly -- documented since 2005 that this works as.array.Matrix <- as.matrix.Matrix <- function(x, ...) as(x, "matrix") } ## should propagate to all subclasses: setMethod("as.matrix", signature(x = "Matrix"), function(x, ...) as(x, "matrix")) ## for 'Matrix' objects, as.array() should be equivalent: setMethod("as.array", signature(x = "Matrix"), function(x, ...) as(x, "matrix")) ## head and tail apply to all Matrix objects for which subscripting is allowed: setMethod("head", signature(x = "Matrix"), utils::head.matrix) setMethod("tail", signature(x = "Matrix"), utils::tail.matrix) setMethod("drop", signature(x = "Matrix"), function(x) if(all(x@Dim != 1L)) x else drop(as(x, "matrix"))) ## slow "fall back" method {subclasses should have faster ones}: setMethod("as.vector", "Matrix", function(x, mode) as.vector(as(x, "matrix"), mode)) ## so base functions calling as.vector() work too: ## S3 dispatch works for base::as.vector(), but S4 dispatch does not as.vector.Matrix <- function(x, mode) as.vector(as(x, "matrix"), mode) if(FALSE) { ## still does not work for c(1, Matrix(2)) ## For the same reason (and just in case) also do both S3 and S4 here: c.Matrix <- function(...) unlist(lapply(list(...), as.vector)) ## NB: Must use signature '(x, ..., recursive = FALSE)' : setMethod("c", "Matrix", function(x, ..., recursive) c.Matrix(x, ...)) ## The above is not sufficient for c(NA, 3:2, , ) setMethod("c", "numMatrixLike", function(x, ..., recursive) c.Matrix(x, ...)) }# not yet setAs("Matrix", "vector", function(from) as.vector (as(from, "matrix"))) setAs("Matrix", "numeric", function(from) as.numeric(as(from, "matrix"))) setAs("Matrix", "logical", function(from) as.logical(as(from, "matrix"))) setAs("Matrix", "integer", function(from) as.integer(as(from, "matrix"))) setAs("Matrix", "complex", function(from) as.complex(as(from, "matrix"))) ## mainly need these for "dMatrix" or "lMatrix" respectively, but why not general: setMethod("as.numeric", signature(x = "Matrix"), function(x, ...) as.numeric(as.vector(x))) setMethod("as.logical", signature(x = "Matrix"), function(x, ...) as.logical(as.vector(x))) setMethod("mean", signature(x = "sparseMatrix"), function(x, ...) mean(as(x,"sparseVector"), ...)) setMethod("mean", signature(x = "sparseVector"), function(x, trim = 0, na.rm = FALSE, ...) { if (na.rm) # remove NAs such that new length() is ok x <- x[!is.na(x)] # remains sparse! if(is0(trim)) sum(x) / length(x) else { ## fast trimmed mean for sparseVector: ## ---> we'd need fast & sparse sort(). ## Normally this means to define a xtfrm() method; ## however, that plus x[order(x, ..)] will NOT be sparse ## TODO: sortSparseVector(.) warning("trimmed mean of 'sparseVector' -- suboptimally using as.numeric(.)") mean(as.numeric(x), trim=trim) } }) ## for the non-"sparseMatrix" ones: setMethod("mean", signature(x = "Matrix"), function(x, trim = 0, na.rm = FALSE, ...) { if (na.rm) x <- x[!is.na(x)] if(is0(trim)) sum(x) / length(x) else mean(as.numeric(x), trim=trim) }) ## for non-"sparseMatrix" : setMethod("cov2cor", signature(V = "Matrix"), function(V) { ## was as(cov2cor(as(V, "matrix")), "dpoMatrix")) r <- V p <- (d <- dim(V))[1] if(p != d[2]) stop("'V' is not a square matrix") Is <- sqrt(1/diag(V)) # diag( 1/sigma_i ) if(any(!is.finite(Is))) warning("diag(.) had 0 or NA entries; non-finite result is doubtful") Is <- Diagonal(x = Is) r <- Is %*% V %*% Is r[cbind(1:p,1:p)] <- 1 # exact in diagonal as(forceSymmetric(r), "dpoMatrix") }) ## "base" has an isSymmetric() S3-generic since R 2.3.0 setMethod("isSymmetric", signature(object = "symmetricMatrix"), function(object, ...) TRUE) setMethod("isSymmetric", signature(object = "triangularMatrix"), ## TRUE iff diagonal: function(object, ...) isDiagonal(object)) setMethod("isTriangular", signature(object = "matrix"), isTriMat) setMethod("isDiagonal", signature(object = "matrix"), .is.diagonal) ## The "catch all" methods -- far from optimal: setMethod("symmpart", signature(x = "Matrix"), function(x) as(symmetrizeDimnames(x + t(x))/2, "symmetricMatrix")) setMethod("skewpart", signature(x = "Matrix"), function(x) symmetrizeDimnames(x - t(x))/2) ## FIXME: do this (similarly as for "ddense.." in C setMethod("symmpart", signature(x = "matrix"), function(x) symmetrizeDimnames(x + t(x))/2) setMethod("skewpart", signature(x = "matrix"), function(x) symmetrizeDimnames(x - t(x))/2) if(getRversion() >= "3.1.0") ## NB: ./nsparseMatrix.R and ./sparseVector.R have extra methods setMethod("anyNA", signature(x = "xMatrix"), function(x) anyNA(x@x)) setMethod("dim", signature(x = "Matrix"), function(x) x@Dim, valueClass = "integer") setMethod("length", "Matrix", function(x) prod(dim(x))) setMethod("dimnames", signature(x = "Matrix"), function(x) x@Dimnames) ## not exported but used more than once for "dimnames<-" method : ## -- or do only once for all "Matrix" classes ?? dimnamesGets <- function (x, value) { d <- dim(x) if (!is.list(value) || length(value) != 2 || !(is.null(v1 <- value[[1]]) || length(v1) == d[1]) || !(is.null(v2 <- value[[2]]) || length(v2) == d[2])) stop(gettextf("invalid dimnames given for %s object", dQuote(class(x))), domain=NA) x@Dimnames <- .fixupDimnames(value) x } dimnamesGetsNULL <- function(x) { message("dimnames(.) <- NULL: translated to \ndimnames(.) <- list(NULL,NULL) <==> unname(.)") x@Dimnames <- list(NULL,NULL) x } setMethod("dimnames<-", signature(x = "compMatrix", value = "list"), function(x, value) { ## "compMatrix" have 'factors' slot if(length(x@factors)) x@factors <- list() dimnamesGets(x, value) }) setMethod("dimnames<-", signature(x = "Matrix", value = "list"), dimnamesGets) setMethod("dimnames<-", signature(x = "compMatrix", value = "NULL"), function(x, value) { ## "compMatrix" have 'factors' slot if(length(x@factors)) x@factors <- list() dimnamesGetsNULL(x) }) setMethod("dimnames<-", signature(x = "Matrix", value = "NULL"), function(x, value) dimnamesGetsNULL(x)) setMethod("unname", signature("Matrix", force="missing"), function(obj) { obj@Dimnames <- list(NULL,NULL); obj}) Matrix <- function (data = NA, nrow = 1, ncol = 1, byrow = FALSE, dimnames = NULL, sparse = NULL, doDiag = TRUE, forceCheck = FALSE) { i.M <- is(data, "Matrix") sM <- FALSE if(i.M) { if(is(data, "diagonalMatrix")) return(data) # in all cases sV <- FALSE } else if(inherits(data, "table")) # special treatment class(data) <- "matrix" # "matrix" first for S4 dispatch else if(is(data, "sparseVector")) { data <- spV2M(data, nrow, ncol, byrow=byrow) i.M <- sparse <- forceCheck <- sM <- sV <- TRUE } if(is.null(sparse) && (i.M || is(data, "matrix"))) sparse <- sparseDefault(data) doDN <- TRUE # by default if (i.M) { if (!sV) { if(!missing(nrow) || !missing(ncol)|| !missing(byrow)) warning("'nrow', 'ncol', etc, are disregarded when 'data' is \"Matrix\" already") sM <- is(data,"sparseMatrix") if(!forceCheck && ((sparse && sM) || (!sparse && !sM))) return(data) ## else : convert dense <-> sparse -> at end } } else if(!is.matrix(data)) { ## cut & paste from "base::matrix" : ## avoid copying to strip attributes in simple cases if (is.object(data) || !is.atomic(data)) data <- as.vector(data) if(length(data) == 1 && is0(data) && !identical(sparse, FALSE)) { ## Matrix(0, ...) : always sparse unless "sparse = FALSE": if(is.null(sparse)) sparse <- TRUE i.M <- sM <- TRUE if (missing(nrow)) nrow <- ceiling(1/ncol) else if (missing(ncol)) ncol <- ceiling(1/nrow) isSym <- nrow == ncol ## will be sparse: do NOT construct full matrix! data <- new(paste0(if(is.numeric(data)) "d" else if(is.logical(data)) "l" else stop("invalid 'data'"), if(isSym) "s" else "g", "CMatrix"), p = rep.int(0L, ncol+1L), Dim = as.integer(c(nrow,ncol)), Dimnames = if(is.null.DN(dimnames)) list(NULL,NULL) else dimnames) } else { ## normal case data <- .External(Mmatrix, data, nrow, ncol, byrow, dimnames, missing(nrow), missing(ncol)) if(is.null(sparse)) sparse <- sparseDefault(data) } doDN <- FALSE # .. set above } else if(!missing(nrow) || !missing(ncol)|| !missing(byrow)) ## i.m == is.matrix(.) warning("'nrow', 'ncol', etc, are disregarded for matrix 'data'") ## 'data' is now a "matrix" or "Matrix" if (doDN && !is.null(dimnames)) dimnames(data) <- dimnames ## check for symmetric / triangular / diagonal : isSym <- isSymmetric(data) if((isTri <- !isSym)) isTri <- isTriangular(data) isDiag <- isSym # cannot be diagonal if it isn't symmetric if(isDiag) isDiag <- doDiag && isDiagonal(data) ## try to coerce ``via'' virtual classes if(isDiag) { ## diagonal is preferred to sparse ! data <- as(data, "diagonalMatrix") isSym <- FALSE } else if(sparse && !sM) data <- as(data, "sparseMatrix") else if(!sparse) { if(i.M) { ## data is 'Matrix' if(!is(data, "denseMatrix")) data <- as(data, "denseMatrix") } else { ## data is "matrix" (and result "dense" -> go via "general" ctype <- typeof(data) if (ctype == "complex") stop("complex matrices not yet implemented in Matrix package") if (ctype == "integer") ## integer Matrices not yet implemented storage.mode(data) <- "double" data <- new(paste0(.M.kind(data), "geMatrix"), Dim = dim(data), Dimnames = .M.DN(data), x = c(data)) } } if(isTri && !is(data, "triangularMatrix")) { if(attr(isTri,"kind") == "L") tril(data) else triu(data) } else if(isSym && !is(data, "symmetricMatrix")) forceSymmetric(data) else data } ## Methods for operations where one argument is numeric ## maybe not 100% optimal, but elegant: setMethod("solve", signature(a = "Matrix", b = "missing"), function(a, b, ...) solve(a, Diagonal(nrow(a)))) setMethod("solve", signature(a = "Matrix", b = "numeric"), function(a, b, ...) callGeneric(a, Matrix(b))) setMethod("solve", signature(a = "Matrix", b = "matrix"), function(a, b, ...) callGeneric(a, Matrix(b))) setMethod("solve", signature(a = "matrix", b = "Matrix"), function(a, b, ...) callGeneric(Matrix(a), b)) setMethod("solve", signature(a = "Matrix", b = "diagonalMatrix"), function(a, b, ...) callGeneric(a, as(b,"CsparseMatrix"))) ## when no sub-class method is found, bail out setMethod("solve", signature(a = "Matrix", b = "ANY"), function(a, b, ...) .bail.out.2("solve", class(a), class(b))) setMethod("solve", signature(a = "ANY", b = "Matrix"), function(a, b, ...) .bail.out.2("solve", class(a), class(b))) setMethod("chol2inv", signature(x = "denseMatrix"), function (x, ...) chol2inv(as(as(x, "dMatrix"), "dtrMatrix"), ...)) setMethod("chol2inv", signature(x = "diagonalMatrix"), function (x, ...) { chk.s(..., which.call=-2) tcrossprod(solve(x)) }) setMethod("chol2inv", signature(x = "sparseMatrix"), function (x, ...) { chk.s(..., which.call=-2) ## for now: tcrossprod(solve(as(x,"triangularMatrix"))) }) ## There are special sparse methods in ./kronecker.R ; this is a "fall back": setMethod("kronecker", signature(X = "Matrix", Y = "ANY", FUN = "ANY", make.dimnames = "ANY"), function(X, Y, FUN, make.dimnames, ...) { if(is(X, "sparseMatrix")) warning("using slow kronecker() method") X <- as(X, "matrix") ; Matrix(callGeneric()) }) setMethod("kronecker", signature(X = "ANY", Y = "Matrix", FUN = "ANY", make.dimnames = "ANY"), function(X, Y, FUN, make.dimnames, ...) { if(is(Y, "sparseMatrix")) warning("using slow kronecker() method") Y <- as(Y, "matrix") ; Matrix(callGeneric()) }) setMethod("determinant", signature(x = "Matrix", logarithm = "missing"), function(x, logarithm, ...) determinant(x, logarithm = TRUE, ...)) ## The ``Right Thing'' to do : ## base::det() calls [base::]determinant(); ## our det() should call our determinant() : det <- base::det environment(det) <- environment()## == asNamespace("Matrix") setMethod("Cholesky", signature(A = "Matrix"), function(A, perm = TRUE, LDL = !super, super = FALSE, Imult = 0, ...) stop(gettextf("Cholesky(A) called for 'A' of class \"%s\";\n\t it is currently defined for sparseMatrix only; consider using chol() instead", class(A)), call. = FALSE, domain=NA)) ## FIXME: All of these should never be called setMethod("chol", signature(x = "Matrix"), function(x, pivot, ...) .bail.out.1("chol", class(x))) setMethod("determinant", signature(x = "Matrix", logarithm = "logical"), function(x, logarithm, ...) determinant(as(x,"dMatrix"), logarithm=logarithm, ...)) setMethod("diag", signature(x = "Matrix"), function(x, nrow, ncol) .bail.out.1("diag", class(x))) if(FALSE)## TODO: activate later setMethod("diag<-", signature(x = "Matrix"), function(x, value) .bail.out.1("diag", class(x))) setMethod("t", signature(x = "Matrix"), function(x) .bail.out.1(.Generic, class(x))) ## NB: "sparseMatrix" works via "sparseVector" setMethod("rep", "Matrix", function(x, ...) rep(as(x, "matrix"), ...)) setMethod("norm", signature(x = "Matrix", type = "character"), function(x, type, ...) .bail.out.1("norm", class(x))) setMethod("rcond", signature(x = "Matrix", norm = "character"), function(x, norm, ...) .bail.out.1("rcond", class(x))) ## for all : setMethod("norm", signature(x = "ANY", type = "missing"), function(x, type, ...) norm(x, type = "O", ...)) setMethod("rcond", signature(x = "ANY", norm = "missing"), function(x, norm, ...) rcond(x, norm = "O", ...)) setMethod("lu", "matrix", function(x, warnSing = TRUE, ...) lu(..2dge(x), warnSing=warnSing, ...)) ## We want to use all.equal.numeric() *and* make sure that uses ## not just base::as.vector but the generic with our methods: all.equal_num <- base::all.equal.numeric ## from /src/library/base/R/all.equal.R environment(all.equal_num) <- environment()## == as.environment("Matrix") all.equal_Mat <- function(target, current, check.attributes = TRUE, factorsCheck = FALSE, ...) { msg <- attr.all_Mat(target, current, check.attributes=check.attributes, factorsCheck=factorsCheck, ...) if(is.list(msg)) msg[[1]] else .a.e.comb(msg, all.equal_num(as.vector(target), as.vector(current), check.attributes=check.attributes, ...)) } ## The all.equal() methods for dense matrices (and fallback): setMethod("all.equal", c(target = "Matrix", current = "Matrix"), all.equal_Mat) setMethod("all.equal", c(target = "Matrix", current = "ANY"), all.equal_Mat) setMethod("all.equal", c(target = "ANY", current = "Matrix"), all.equal_Mat) ## -> ./sparseMatrix.R, ./sparseVector.R have specific methods ## MM: More or less "Cut & paste" from ## --- diff.default() from R/src/library/base/R/diff.R : setMethod("diff", signature(x = "Matrix"), function(x, lag = 1, differences = 1, ...) { if (length(lag) > 1 || length(differences) > 1 || lag < 1 || differences < 1) stop("'lag' and 'differences' must be integers >= 1") xlen <- nrow(x) if (lag * differences >= xlen) return(x[,FALSE][0]) # empty of proper mode i1 <- -1:-lag for (i in 1:differences) x <- x[i1, , drop = FALSE] - x[-nrow(x):-(nrow(x)-lag+1), , drop = FALSE] x }) setMethod("image", "Matrix", function(x, ...) { # coercing to sparse is not inefficient, ## since we need 'i' and 'j' for levelplot() x <- as(as(x, "sparseMatrix"), "dsparseMatrix") ## note that "ddiMatrix" is "sparse*" and "d*", but *not* dsparse callGeneric() }) ## Group Methods ## NOTE: "&" and "|" are now in group "Logic" c "Ops" --> ./Ops.R ## "!" is in ./not.R ## Further, see ./Ops.R ## ~~~~~ ### -------------------------------------------------------------------------- ### ### Subsetting "[" and ### SubAssign "[<-" : The "missing" cases can be dealt with here, "at the top": ## Using "index" for indices should allow ## integer (numeric), logical, or character (names!) indices : ## "x[]" *or* x[,] *or* x[, , drop=] setMethod("[", signature(x = "Matrix", i = "missing", j = "missing", drop = "missing"), function(x,i,j, ..., drop) { Matrix.msg("M[m,m,m] : nargs()=",nargs(), .M.level = 2) if(nargs() == 2) { ## M[] x } else { # nargs() = 3 callGeneric(x, , , drop=TRUE) } }) setMethod("[", signature(x = "Matrix", i = "missing", j = "missing", drop = "logical"), function (x, i, j, ..., drop) { Matrix.msg(sprintf("M[m,m, %s] : nargs()=%d", format(drop), nargs()), .M.level = 2) if(isTRUE(drop) && any(x@Dim == 1L)) drop(as(x, "matrix")) else x }) ## otherwise: drop is neither missing nor logical setMethod("[", signature(x = "Matrix", i = "missing", j = "missing", drop = "ANY"), function (x, i, j, ..., drop) stop("invalid 'drop' in Matrix subsetting")) ## missing 'drop' --> 'drop = TRUE' ## ----------- ## select rows __ or __ vector indexing: setMethod("[", signature(x = "Matrix", i = "index", j = "missing", drop = "missing"), function(x,i,j, ..., drop) { Matrix.msg("M[i,m,m] : nargs()=",nargs(), .M.level = 2) if(nargs() == 2) { ## e.g. M[0] , M[TRUE], M[1:2], M[-7] .M.vectorSub(x,i) } else { callGeneric(x, i=i, , drop=TRUE) ## ^^ } }) ## select columns setMethod("[", signature(x = "Matrix", i = "missing", j = "index", drop = "missing"), function(x,i,j, ..., drop) { Matrix.msg("M[m,i,m] : nargs()=",nargs(), .M.level = 2) callGeneric(x, , j=j, drop= TRUE) }) ## select both rows *and* columns setMethod("[", signature(x = "Matrix", i = "index", j = "index", drop = "missing"), function(x,i,j, ..., drop) { Matrix.msg("M[i,i,m] : nargs()=",nargs(), .M.level = 2) callGeneric(x, i=i, j=j, drop= TRUE) }) ## bail out if any of (i,j,drop) is "non-sense" setMethod("[", signature(x = "Matrix", i = "ANY", j = "ANY", drop = "ANY"), function(x,i,j, ..., drop) stop("invalid or not-yet-implemented 'Matrix' subsetting")) ## logical indexing, such as M[ M >= 7 ] *BUT* also M[ M[,1] >= 3,], ## The following is *both* for M [ ] ## and also for M [ , ] .M.sub.i.logical <- function (x, i, j, ..., drop) { nA <- nargs() # counts 'M[i]' as 2 arguments, 'M[i,]' as 3 Matrix.msg("M[logi,m,m] : nargs()=", nA, .M.level = 2) if(nA == 2) { ## M [ M >= 7 ] ## FIXME: when both 'x' and 'i' are sparse, this can be very inefficient if(is(x, "sparseMatrix")) message("[ ] : .M.sub.i.logical() maybe inefficient") toC <- geClass(x) if(canCoerce(x, toC)) as(x, toC)@x[as.vector(i)] else as(as(as(x, "generalMatrix"), "denseMatrix"), toC)@x[as.vector(i)] ## -> error when lengths don't match } else if(nA == 3) { ## M[ , ] e.g., M [ M[,1, drop=FALSE] >= 7, ] or M[TRUE,] if(length(i) && x@Dim[1L] && !anyNA(i) && all(i)) ## select everything x else ## not selecting all -> result is *NOT* diagonal/triangular/symmetric/.. ## keep j missing, but drop = "logical" callGeneric(as(x,"generalMatrix"), i = i, , drop = TRUE) } else stop(gettextf( "nargs() = %d. Extraneous illegal arguments inside '[ .. ]' (i.logical)?", nA), domain=NA) } ## instead of using 'drop = "ANY"' {against ambiguity notices}: for(ii in c("lMatrix", "logical")) setMethod("[", signature(x = "Matrix", i = ii, j = "missing", drop = "missing"), .M.sub.i.logical) rm(ii) ##' x[ ij ] where ij is (i,j) 2-column matrix ##' @note only called from .M.sub.i.2col(x, i) below subset.ij <- function(x, ij) { m <- nrow(ij) if(m > 3) { cld <- getClassDef(class(x)) sym.x <- extends(cld, "symmetricMatrix") if(sym.x) { W <- if(x@uplo == "U") # stored only [i,j] with i <= j ij[,1] > ij[,2] else ij[,1] < ij[,2] if(any(W)) ij[W,] <- ij[W, 2:1] } if(extends(cld, "sparseMatrix")) { ## do something smarter: di <- dim(x) if(!extends(cld, "CsparseMatrix")) { x <- as(x, "CsparseMatrix") # simpler; our standard cld <- getClassDef(class(x)) } tri.x <- extends(cld, "triangularMatrix") if(tri.x) { ## need these for the 'x' slot in any case if (x@diag == "U") x <- .Call(Csparse_diagU2N, x) ## slightly more efficient than non0.i() or non0ind(): ij.x <- .Call(compressed_non_0_ij, x, isC=TRUE) } else { ## symmetric / general : for symmetric, only "existing" part ij.x <- non0.i(x, cld) } m1 <- .Call(m_encodeInd, ij.x, di, orig1=FALSE, checkBounds=FALSE) m2 <- .Call(m_encodeInd, ij, di, orig1= TRUE, checkBounds= TRUE) mi <- match(m2, m1, nomatch=0) mmi <- mi != 0L ## == (m2 %in% m1) ## Result: all FALSE or 0 apart from where we match non-zero entries ans <- vector(mode = .type.kind[.M.kindC(cld)], length = m) ## those that are *not* zero: ans[mmi] <- if(extends(cld, "nsparseMatrix")) TRUE else x@x[mi[mmi]] if(any(ina <- is.na(m2))) # has one or two NA in that (i,j) row is.na(ans) <- ina ans } else { ## non-sparse : dense ##---- NEVER happens: 'denseMatrix' has its own setMethod(.) ! message("m[]: inefficiently indexing single elements - should not happen, please report!") i1 <- ij[,1] i2 <- ij[,2] ## very inefficient for large m unlist(lapply(seq_len(m), function(j) x[i1[j], i2[j]])) } } else { # 1 <= m <= 3 i1 <- ij[,1] i2 <- ij[,2] unlist(lapply(seq_len(m), function(j) x[i1[j], i2[j]])) } } ## A[ ij ] where ij is (i,j) 2-column matrix -- but also when that is logical mat! .M.sub.i.2col <- function (x, i, j, ..., drop) { nA <- nargs() if(nA != 2) stop(domain=NA, gettextf( "nargs() = %d. Extraneous illegal arguments inside '[ .. ]' (i.2col)?", nA)) ## else: (nA == 2): M [ cbind(ii,jj) ] or M [ ] if(!is.integer(nc <- ncol(i))) stop(".M.sub.i.2col(): 'i' has no integer column number;\n should never happen; please report") if(is.logical(i)) return(.M.sub.i.logical(x, i=i)) # call with 2 args! else if(!is.numeric(i) || nc != 2) stop("such indexing must be by logical or 2-column numeric matrix") if(!nrow(i)) return(vector(mode = .type.kind[.M.kind(x)])) ## else subset.ij(x, i) } setMethod("[", signature(x = "Matrix", i = "matrix", j = "missing"),# drop="ANY" .M.sub.i.2col) ## just against ambiguity notices : setMethod("[", signature(x = "Matrix", i = "matrix", j = "missing", drop="missing"), .M.sub.i.2col) ### "[<-" : ----------------- ## A[ ij ] <- value, where ij is (i,j) 2-column matrix : ## ---------------- ## The cheap general method, now only used for "pMatrix","indMatrix" ## sparse all use .TM.repl.i.mat() ## NOTE: need '...' below such that setMethod() does ## not use .local() such that nargs() will work correctly: .M.repl.i.2col <- function (x, i, j, ..., value) { nA <- nargs() if(nA == 3) { ## M [ cbind(ii,jj) ] <- value or M [ Lmat ] <- value if(!is.integer(nc <- ncol(i))) stop(".M.repl.i.2col(): 'i' has no integer column number;\n should never happen; please report") else if(!is.numeric(i) || nc != 2) stop("such indexing must be by logical or 2-column numeric matrix") if(is.logical(i)) { message(".M.repl.i.2col(): drop 'matrix' case ...") ## c(i) : drop "matrix" to logical vector return( callGeneric(x, i=c(i), value=value) ) } if(!is.integer(i)) storage.mode(i) <- "integer" if(any(i < 0)) stop("negative values are not allowed in a matrix subscript") if(anyNA(i)) stop("NAs are not allowed in subscripted assignments") if(any(i0 <- (i == 0))) # remove them i <- i[ - which(i0, arr.ind = TRUE)[,"row"], ] ## now have integer i >= 1 m <- nrow(i) ## mod.x <- .type.kind[.M.kind(x)] if(length(value) > 0 && m %% length(value) != 0) warning("number of items to replace is not a multiple of replacement length") ## recycle: value <- rep_len(value, m) i1 <- i[,1] i2 <- i[,2] if(m > 2) message("m[ ] <- v: inefficiently treating single elements") ## inefficient -- FIXME -- (also loses "symmetry" unnecessarily) for(k in seq_len(m)) x[i1[k], i2[k]] <- value[k] x } else stop(gettextf( "nargs() = %d. Extraneous illegal arguments inside '[ .. ]' ?", nA), domain=NA) } setReplaceMethod("[", signature(x = "Matrix", i = "matrix", j = "missing", value = "replValue"), .M.repl.i.2col) ## Three catch-all methods ... would be very inefficient for sparse* ## --> extra methods in ./sparseMatrix.R setReplaceMethod("[", signature(x = "Matrix", i = "missing", j = "ANY", value = "Matrix"), function (x, i, j, ..., value) callGeneric(x=x, , j=j, value = as.vector(value))) setReplaceMethod("[", signature(x = "Matrix", i = "ANY", j = "missing", value = "Matrix"), function (x, i, j, ..., value) if(nargs() == 3) callGeneric(x=x, i=i, value = as.vector(value)) else callGeneric(x=x, i=i, , value = as.vector(value))) setReplaceMethod("[", signature(x = "Matrix", i = "ANY", j = "ANY", value = "Matrix"), function (x, i, j, ..., value) callGeneric(x=x, i=i, j=j, value = as.vector(value))) setReplaceMethod("[", signature(x = "Matrix", i = "missing", j = "ANY", value = "matrix"), function (x, i, j, ..., value) callGeneric(x=x, , j=j, value = c(value))) setReplaceMethod("[", signature(x = "Matrix", i = "ANY", j = "missing", value = "matrix"), function (x, i, j, ..., value) if(nargs() == 3) callGeneric(x=x, i=i, value = c(value)) else callGeneric(x=x, i=i, , value = c(value))) setReplaceMethod("[", signature(x = "Matrix", i = "ANY", j = "ANY", value = "matrix"), function (x, i, j, value) callGeneric(x=x, i=i, j=j, value = c(value))) ## M [ ] <- value; used notably for x = "CsparseMatrix" ------------------- .repl.i.lDMat <- function (x, i, j, ..., value) { ## nA <- nargs() ## if(nA != 3) stop(gettextf("nargs() = %d should never happen; please report.", nA), domain=NA) ## else: nA == 3 i.e., M [ Lmat ] <- value ## x[i] <- value ; return(x) `[<-`(x, i=which(as.vector(i)), value=value) } setReplaceMethod("[", signature(x = "Matrix", i = "ldenseMatrix", j = "missing", value = "replValue"), .repl.i.lDMat) setReplaceMethod("[", signature(x = "Matrix", i = "ndenseMatrix", j = "missing", value = "replValue"), .repl.i.lDMat) .repl.i.lSMat <- function (x, i, j, ..., value) { ## nA <- nargs() ## if(nA != 3) stop(gettextf("nargs() = %d should never happen; please report.", nA), domain=NA) ## else: nA == 3 i.e., M [ Lmat ] <- value ## x[i] <- value ; return(x) `[<-`(x, i=which(as(i, "sparseVector")), value=value) } setReplaceMethod("[", signature(x = "Matrix", i = "lsparseMatrix", j = "missing", value = "replValue"), .repl.i.lSMat) setReplaceMethod("[", signature(x = "Matrix", i = "nsparseMatrix", j = "missing", value = "replValue"), .repl.i.lSMat) ## (ANY,ANY,ANY) is used when no `real method' is implemented : setReplaceMethod("[", signature(x = "Matrix", i = "ANY", j = "ANY", value = "ANY"), function (x, i, j, value) { if(!is.atomic(value)) stop(gettextf( "RHS 'value' (class %s) matches 'ANY', but must match matrix class %s", class(value), class(x)), domain=NA) else stop("not-yet-implemented 'Matrix[<-' method") }) Matrix/R/dtTMatrix.R0000644000176200001440000000304011003616106013751 0ustar liggesusers### Coercion and Methods for Triangular Triplet Matrices setAs("dtTMatrix", "dgTMatrix", function(from) tT2gT(from, cl = "dtTMatrix", toClass = "dgTMatrix")) setAs("dtTMatrix", "generalMatrix", function(from) tT2gT(from, cl = "dtTMatrix", toClass = "dgTMatrix")) if(FALSE) ## needed in ../tests/Class+Meth.R -- replaced by .T.2.l() in ./Tsparse.R setAs("dtTMatrix", "ltTMatrix", function(from) new("ltTMatrix", i = from@i, j = from@j, x = as.logical(from@x), uplo = from@uplo, diag = from@diag, Dim = from@Dim, Dimnames = from@Dimnames)) if(FALSE) ## needed in ../tests/Class+Meth.R -- replaced by .T.2.n() in ./Tsparse.R setAs("dtTMatrix", "ntTMatrix", function(from) new("ntTMatrix", i = from@i, j = from@j, uplo = from@uplo, diag = from@diag, Dim = from@Dim, Dimnames = from@Dimnames)) ## Conversion to dense storage is first to a dtrMatrix setAs("dtTMatrix", "dtrMatrix", function(from) .Call(dtTMatrix_as_dtrMatrix, from)) setAs("dtTMatrix", "matrix", function(from) as(as(from, "dtrMatrix"), "matrix")) setAs("dtTMatrix", "dgeMatrix", function(from) as(as(from, "dtrMatrix"), "dgeMatrix")) setAs("matrix", "dtTMatrix", function(from) as(as(from, "dtpMatrix"), "dtTMatrix")) setMethod("t", "dtTMatrix", function(x) new("dtTMatrix", Dim = x@Dim[2:1], Dimnames = x@Dimnames[2:1], i = x@j, j = x@i, x = x@x, diag = x@diag, uplo = if (x@uplo == "U") "L" else "U")) Matrix/R/condest.R0000644000176200001440000003234112070371667013515 0ustar liggesusers#### This is a "translation" of GNU octave's #### ~/src/octave-3.2.4/scripts/linear-algebra/condest.m #### and ~/src/octave-3.2.4/scripts/linear-algebra/onenormest.m #### which have identical copyright and references (see below): #### ##__\begin{copyright clause}______________________________________________ ## Copyright (C) 2007, 2008, 2009 Regents of the University of California ## ## This file is part of Octave. ## ## 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 3 of the License, 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 Octave; see the file COPYING. If not, see ## . ## Code originally licensed under ## ## Copyright (c) 2007, Regents of the University of California ## All rights reserved. ## ## Redistribution and use in source and binary forms, with or without ## modification, are permitted provided that the following conditions ## are met: ## ## * Redistributions of source code must retain the above copyright ## notice, this list of conditions and the following disclaimer. ## ## * Redistributions in binary form must reproduce the above ## copyright notice, this list of conditions and the following ## disclaimer in the documentation and/or other materials provided ## with the distribution. ## ## * Neither the name of the University of California, Berkeley nor ## the names of its contributors may be used to endorse or promote ## products derived from this software without specific prior ## written permission. ## ## THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' ## AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ## TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ## PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS AND ## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, ## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT ## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF ## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, ## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT ## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF ## SUCH DAMAGE. ## Author: Jason Riedy ## Keywords: linear-algebra norm estimation ## Version: 0.2 ##__\end{copyright clause}________________________________________________ condest <- function(A, t = min (n, 5), normA = norm(A, "1"), silent = FALSE, quiet = TRUE) { ## Octave has further optional args and "calling sequences" ## may be implement at a later time point ## if(length(d <- dim(A)) != 2 || (n <- d[1]) != d[2]) stop("'A' must be a square matrix") luA <- lu(A) i.n <- seq_len(n) isSparse <- is(A, "sparseMatrix") if(isSparse) { ### FIXME: if A is not a Matrix, but already a "CHMfactor" as resulting from ### Cholesky() , then we can procede more efficiently , notably ### because of the solve(A, b, system = ".*") options ! ## luA = "sparseLU": slots (L, U, p,q, Dim); ## expand(luA) == list(P, L, U, Q) <----> A = P' L U Q ## where P A == A[p +1,] and A Q' == A[, q +1] ## <==> A^(-1) x = Q' U^-1 L^-1 P x = Q'y ## and A^(-T) x =(Q' U^-1 L^-1 P)' x = P' L^-T U^-T Q x = P'z q. <- q.i <- luA@q + 1L; q.i[q.i] <- i.n p. <- p.i <- luA@p + 1L; p.i[p.i] <- i.n ## q.i := inv(q.) & p.i := inv(p.), the inverse permutations Ut <- t(luA@U) Lt <- t(luA@L) f.solve <- function(x) solve(luA@U, solve(luA@L, x[p.,]))[q.i,] f.solve_t <- function(x) solve(Lt, solve(Ut, x[q.,]))[p.i,] ##Oct [L, U, P, Pc] = lu (A); ##Oct solve = @(x) Pc' * (U \ (L \ (P * x))); ##Oct solve_t = @(x) P' * (L' \ (U' \ (Pc * x))); } else { ## luA is "denseLU" : e.A <- expand(luA) ## == list(L, U, P), where A = PLU p. <- p.i <- luA@perm; p.i[p.i] <- i.n ## p.i := inv(p.), the inverse permutation Ut <- t(e.A$U) Lt <- t(e.A$L) ## A = PLU <--> A^{-1} x = U^-1 L^-1 P x ## A^{-T} x = (U^-1 L^-1 P)' x = P' L^-T U^-T x = P'z f.solve <- function(x) solve(e.A$U, solve(e.A$L, x[p.,])) f.solve_t <- function(x) solve(Lt, solve(Ut, x))[p.i,] ##Oct [L, U, P] = lu (A); ##Oct solve = @(x) U \ (L \ (P*x)); ##Oct solve_t = @(x) P' * (L' \ (U' \ x)); } n1.res <- ## onenormest (A^{-1}, t=t) -- of course,that's *NOT* what we want onenormest (A.x = f.solve, At.x = f.solve_t, t=t, n=n, quiet=quiet, silent=silent) ## [Ainv_norm, v, w] = onenormest (solve, solve_t, n, t); w <- n1.res[["w"]] list(est = normA * n1.res[["est"]], v = w / sum(abs(w))) # sum(|w|) = norm(w, "1") } ## %!demo ## %! N = 100; ## %! A = randn (N) + eye (N); ## %! condest (A) ## %! [L,U,P] = lu (A); ## %! condest (A, @(x) U\ (L\ (P*x)), @(x) P'*(L'\ (U'\x))) ## %! condest (@(x) A*x, @(x) A'*x, @(x) U\ (L\ (P*x)), @(x) P'*(L'\ (U'\x)), N) ## %! norm (inv (A), 1) * norm (A, 1) ### Yes, these test bounds are really loose. There's ### enough randomization to trigger odd cases with hilb(). ## %!test ## %! N = 6; ## %! A = hilb (N); ## %! cA = condest (A); ## %! cA_test = norm (inv (A), 1) * norm (A, 1); ## %! assert (cA, cA_test, -2^-8); ## %!test ## %! N = 6; ## %! A = hilb (N); ## %! solve = @(x) A\x; solve_t = @(x) A'\x; ## %! cA = condest (A, solve, solve_t); ## %! cA_test = norm (inv (A), 1) * norm (A, 1); ## %! assert (cA, cA_test, -2^-8); ## %!test ## %! N = 6; ## %! A = hilb (N); ## %! apply = @(x) A*x; apply_t = @(x) A'*x; ## %! solve = @(x) A\x; solve_t = @(x) A'\x; ## %! cA = condest (apply, apply_t, solve, solve_t, N); ## %! cA_test = norm (inv (A), 1) * norm (A, 1); ## %! assert (cA, cA_test, -2^-6); ## %!test ## %! N = 12; ## %! A = hilb (N); ## %! [rcondA, v] = condest (A); ## %! x = A*v; ## %! assert (norm(x, inf), 0, eps); ##------------ onenormest ------------------------------------------ onenormest <- function(A, t = min(n, 5), A.x, At.x, n, silent = FALSE, quiet = silent, iter.max = 10, eps = 4* .Machine$double.eps) { mi.A <- missing(A) mi.A.x <- missing(A.x) mi.At.x <- missing(At.x) no.A.x <- mi.A.x || !is.function(A.x) no.At.x <- mi.At.x || !is.function(At.x) if(mi.A && (no.A.x || no.At.x)) stop("must either specify 'A' or the functions 'A.x' and 'At.x'") if(!mi.A && (!mi.A.x || !mi.At.x)) warning("when 'A' is specified, 'A.x' and 'At.x' are disregarded") if(mi.A) { stopifnot(is.numeric(n), length(n) == 1, n == round(n), n >= 0) } else { ## using 'A' if(length(d <- dim(A)) != 2 || (n <- d[1]) != d[2]) stop("'A' must be a square matrix") rm(d) } stopifnot(is.numeric(t), length(t) == 1, t >= 1, iter.max >= 1) ## Initial test vectors X. X <- matrix(runif(n*t), n,t) # X = rand (n, t); ## scale X to have column sums == 1 : X <- X / rep(colSums(X), each=n) ## Track if a vertex has been visited. been_there <- logical(n) # zeros (n, 1); I.t <- diag(nrow = t) ## To check if the estimate has increased. est_old <- 0 ## Normalized vector of signs. S <- matrix(0, n, t) for(iter in 1:(iter.max + 1)) { Y <- if(mi.A) A.x(X) else A %*% X ## is n x t ## Find the initial estimate as the largest A*x. ## [est, imax] = max (sum (abs (Y), 1)) imax <- which.max(cY <- colSums(abs(Y))) est <- cY[imax] if (est > est_old || iter == 2) w <- Y[, imax] if (iter >= 2 && est < est_old) { ## No improvement, so stop. est <- est_old break } est_old <- est S_old <- S if (iter > iter.max) { ## Gone too far. Stop. if(!silent) warning(gettextf("not converged in %d iterations", iter.max), domain = NA) break } S <- sign (Y) ## n x t ## Test if any of S are approximately parallel to previous S ## vectors or current S vectors. If everything is parallel, ## stop. Otherwise, replace any parallel vectors with ## rand{-1,+1}. partest <- apply(abs(crossprod(S_old, S) - n) < eps*n, 2, any) if (all(partest)) { ## All the current vectors are parallel to old vectors. ## We've hit a cycle, so stop. if(!quiet) message("hit a cycle (1) -- stop iterations") break } if (any(partest)) { ## Some vectors are parallel to old ones and are cycling, ## but not all of them. Replace the parallel vectors with ## rand{-1,+1}. numpar <- sum (partest) replacements <- matrix(sample(c(-1,1), n*numpar,replace=TRUE), n, numpar) S[,partest] <- replacements } ## Now test for parallel vectors within S. partest <- apply(crossprod(S) - I.t == n, 2, any) if (any(partest)) { numpar <- sum(partest) replacements <- matrix(sample(c(-1,1), n*numpar,replace=TRUE), n, numpar) S[,partest] <- replacements } Z <- if(mi.A) At.x(S) else crossprod(A, S) ## -- n x t ## Now find the largest non-previously-visted index per vector. ## h = max(2, abs(Z)) ## -- n x t h <- pmax.int(2, as(abs(Z),"matrix")); dim(h) <- dim(Z) ## -- n x t ## [mh, mhi] = max (h) : for each column h[,j]: ## mh[j] = max(h[,j]); mhi = argmax(..) mhi <- apply(h, 2, which.max) ## mh <- h[cbind(mhi,1:t)] if (iter >= 2 && all(mhi == imax)) { ## (mhi == imax) : in octave this is only true when it's for all() ## Hit a cycle, stop. if(!quiet) message("hit a cycle (2) -- stop iterations") break } ## [h, ind] = sort (h, 'descend'): r <- apply(h, 2, sort.int, decreasing=TRUE, index.return=TRUE) #-> list h <- sapply(r, `[[`, "x") ind <- sapply(r, `[[`, "ix") #-> n x t {each column = permutation of 1:n} if (t > 1) { firstind <- ind[1:t] if (all (been_there[firstind])) { ## Visited all these before, so stop. break } ind <- ind[!been_there[ind]] ##-> now ind is a simple vector if(length(ind) < t) { ## There aren't enough new vectors, so we're practically ## in a cycle. Stop. if(!quiet) message("not enough new vecs -- stop iterations") break } } ## Visit the new indices. X <- matrix(0, n, t) X[cbind(ind[1:t], 1:t)] <- 1 ## for(zz in 1:t) X[ind[zz],zz] <- 1 been_there [ind[1:t]] <- TRUE } ## for(iter ...) ## The estimate est and vector w are set in the loop above. The ## vector v selects the imax column of A. v <- integer(n) v[imax] <- 1L list(est=est, v=v, w=w, iter=iter) }## {onenormest} ## %!demo ## %! N = 100; ## %! A = randn(N) + eye(N); ## %! [L,U,P] = lu(A); ## %! nm1inv = onenormest(@(x) U\(L\(P*x)), @(x) P'*(L'\(U'\x)), N, 30) ## %! norm(inv(A), 1) ## %!test ## %! N = 10; ## %! A = ones (N); ## %! [nm1, v1, w1] = onenormest (A); ## %! [nminf, vinf, winf] = onenormest (A', 6); ## %! assert (nm1, N, -2*eps); ## %! assert (nminf, N, -2*eps); ## %! assert (norm (w1, 1), nm1 * norm (v1, 1), -2*eps) ## %! assert (norm (winf, 1), nminf * norm (vinf, 1), -2*eps) ## %!test ## %! N = 10; ## %! A = ones (N); ## %! [nm1, v1, w1] = onenormest (@(x) A*x, @(x) A'*x, N, 3); ## %! [nminf, vinf, winf] = onenormest (@(x) A'*x, @(x) A*x, N, 3); ## %! assert (nm1, N, -2*eps); ## %! assert (nminf, N, -2*eps); ## %! assert (norm (w1, 1), nm1 * norm (v1, 1), -2*eps) ## %! assert (norm (winf, 1), nminf * norm (vinf, 1), -2*eps) ## %!test ## %! N = 5; ## %! A = hilb (N); ## %! [nm1, v1, w1] = onenormest (A); ## %! [nminf, vinf, winf] = onenormest (A', 6); ## %! assert (nm1, norm (A, 1), -2*eps); ## %! assert (nminf, norm (A, inf), -2*eps); ## %! assert (norm (w1, 1), nm1 * norm (v1, 1), -2*eps) ## %! assert (norm (winf, 1), nminf * norm (vinf, 1), -2*eps) ## ## Only likely to be within a factor of 10. ## %!test ## %! N = 100; ## %! A = rand (N); ## %! [nm1, v1, w1] = onenormest (A); ## %! [nminf, vinf, winf] = onenormest (A', 6); ## %! assert (nm1, norm (A, 1), -.1); ## %! assert (nminf, norm (A, inf), -.1); ## %! assert (norm (w1, 1), nm1 * norm (v1, 1), -2*eps) ## %! assert (norm (winf, 1), nminf * norm (vinf, 1), -2*eps) Matrix/R/pMatrix.R0000644000176200001440000000666012470400545013477 0ustar liggesusers#### Permutation Matrices -- Coercion and Methods ### NB "pMatrix" extends "indMatrix" and inherits methods --> indMatrix.R ## The typical 'constructor' : coerce from 'index' setAs("integer", "pMatrix", function(from) { nn <- names(from) new("pMatrix", Dim = rep.int(length(from), 2L), Dimnames = list(nn,nn), perm = from) }) setAs("numeric", "pMatrix", function(from) if(all(from == (i <- as.integer(from)))) as(i, "pMatrix") else stop("coercion to \"pMatrix\" only works from integer numeric")) setAs("nMatrix", "pMatrix", function(from) { from <- as(as(from, "TsparseMatrix"), "ngTMatrix") n <- (d <- from@Dim)[1] if(n != d[2]) stop("not a square matrix") if(length(i <- from@i) != n) stop("the number of non-zero entries differs from nrow(.)") if((need.sort <- is.unsorted(i))) { ii <- sort.list(i) i <- i[ii] } if(n >= 1 && !identical(i, 0:(n - 1))) stop("must have exactly one non-zero entry per row") new("pMatrix", ## validity checking checks the 'perm' slot: perm = 1L + if(need.sort) from@j[ii] else from@j, Dim = d, Dimnames = from@Dimnames) }) setAs("matrix", "pMatrix", function(from) as(as(from, "nMatrix"), "pMatrix")) setMethod("solve", signature(a = "pMatrix", b = "missing"), function(a, b, ...) { a@perm <- invPerm(a@perm) a@Dimnames <- a@Dimnames[2:1] a }) setMethod("solve", signature(a = "pMatrix", b = "Matrix"), function(a, b, ...) crossprod(a, b)) setMethod("solve", signature(a = "pMatrix", b = "matrix"), function(a, b, ...) crossprod(a, b)) setMethod("solve", signature(a = "Matrix", b = "pMatrix"), function(a, b, ...) ## Or alternatively solve(a, as(b, "CsparseMatrix")) solve(a)[, invPerm(b@perm)]) setMethod("determinant", signature(x = "pMatrix", logarithm = "logical"), function(x, logarithm, ...) { if(any(x@Dim == 0)) mkDet(numeric(0)) else mkDet(logarithm=logarithm, ldet = 0, sig = signPerm(x@perm)) }) ## t(pM) is == the inverse pM^(-1): setMethod("t", signature(x = "pMatrix"), function(x) solve(x)) setMethod("%*%", signature(x = "matrix", y = "pMatrix"), function(x, y) { mmultCheck(x,y); x[, invPerm(y@perm)] }) setMethod("%*%", signature(x = "Matrix", y = "pMatrix"), function(x, y) { mmultCheck(x,y); x[, invPerm(y@perm)] }) setMethod("%*%", signature(x = "pMatrix", y = "pMatrix"), function(x, y) { stopifnot(identical(x@Dim, y@Dim)) ## FIXME: dimnames dealing: as with S3 matrix's %*% x@perm <- x@perm[y@perm] x }) setMethod("crossprod", signature(x = "pMatrix", y = "matrix"), function(x, y) { mmultCheck(x,y, 2L); y[invPerm(x@perm) ,]}) setMethod("crossprod", signature(x = "pMatrix", y = "Matrix"), function(x, y) { mmultCheck(x,y, 2L); y[invPerm(x@perm) ,]}) setMethod("crossprod", signature(x = "pMatrix", y = "pMatrix"), function(x, y) { stopifnot(identical(x@Dim, y@Dim)) x@perm <- invPerm(x@perm)[y@perm] x }) setMethod("tcrossprod", signature(x = "pMatrix", y = "pMatrix"), function(x, y) { stopifnot(identical(x@Dim, y@Dim)) x@perm <- x@perm[invPerm(y@perm)] x }) setMethod("crossprod", signature(x = "pMatrix", y = "missing"), function(x, y=NULL) Diagonal(nrow(x))) setMethod("tcrossprod", signature(x = "pMatrix", y = "missing"), function(x, y=NULL) Diagonal(nrow(x))) Matrix/R/Ops.R0000644000176200001440000020134114043253007012602 0ustar liggesusers####--- All "Ops" group methods for all Matrix classes (incl sparseVector) ------ #### === but diagonalMatrix -> ./diagMatrix.R and abIndex.R #### ~~~~~~~~~~~~ ~~~~~~~~~ ### Note that the "Ops" group consists of ### sub-groups "Arith", "Compare", and "Logic" ### ----- ------- ----- ### where 'Arith' := '"+"', '"-"', '"*"', '"^"', '"%%"', '"%/%"', '"/"' ### 'Compare' := '"=="', '">"', '"<"', '"!="', '"<="', '">="' ### 'Logic' := '"&"', '"|"' ### but *not* '"!"' since that has only one argument : >>>>> ./not.R ## cache them [rather in package 'methods' ??] .ArithGenerics <- getGroupMembers("Arith") .CompareGenerics <- getGroupMembers("Compare") .LogicGenerics <- getGroupMembers("Logic") ## find them with M-x grep -E 'Method\("(Ops|Compare|Arith|Logic)"' *.R ## -------- ### Design decision for *sparseMatrix*: ### work via Csparse since Tsparse are not-unique (<-> slots not compatible) ### Dimnames: (partly) via dimNamesCheck() [ ./Auxiliaries.R ] ### -- 0 -- (not dense *or* sparse) ----------------------------------- ##-------- originally from ./Matrix.R -------------------- ## Some ``Univariate'' "Arith" (univariate := 2nd argument 'e2' is missing) setMethod("+", signature(e1 = "Matrix", e2 = "missing"), function(e1,e2) e1) ## "fallback": setMethod("-", signature(e1 = "Matrix", e2 = "missing"), function(e1, e2) { warning("inefficient method used for \"- e1\"") 0-e1 }) setMethod("-", signature(e1 = "denseMatrix", e2 = "missing"), function(e1, e2) { e1@x <- -e1@x; .empty.factors(e1); e1 }) ## "diagonalMatrix" -- only two cases -- easiest to do both setMethod("-", signature(e1 = "ddiMatrix", e2 = "missing"), function(e1, e2) { if(e1@diag == "U") { e1@x <- rep.int(-1., e1@Dim[1]) e1@diag <- "N" } else ## diag == "N" -> using 'x' slot e1@x <- -e1@x .empty.factors(e1) e1 }) setMethod("-", signature(e1 = "ldiMatrix", e2 = "missing"), function(e1, e2) { d <- e1@Dim new("ddiMatrix", Dim = d, Dimnames = e1@Dimnames, diag = "N", x = if(e1@diag == "U") rep.int(-1, d[1]) else -e1@x) }) ## old-style matrices are made into new ones setMethod("Ops", signature(e1 = "Matrix", e2 = "matrix"), function(e1, e2) callGeneric(e1, Matrix(e2))) setMethod("Ops", signature(e1 = "matrix", e2 = "Matrix"), function(e1, e2) callGeneric(Matrix(e1), e2)) ## Note: things like callGeneric(Matrix(e1, sparse=is(e2,"sparseMatrix")), e2)) ## may *not* be better: e.g. Matrix(.) can give *diagonal* instead of sparse ## NULL should be treated as logical(0) {which often will be coerced to numeric(0)}: setMethod("Ops", signature(e1 = "Matrix", e2 = "NULL"), function(e1, e2) callGeneric(e1, logical())) setMethod("Ops", signature(e1 = "NULL", e2 = "Matrix"), function(e1, e2) callGeneric(logical(), e2)) ## bail-outs -- on highest possible level, hence "Ops", not "Compare"/"Arith" : .bail.out.Ops <- function(e1, e2) { if(is(e1, "mMatrix") && is(e2, "mMatrix")) dimCheck(e1,e2) .bail.out.2(.Generic, class(e1), class(e2)) } setMethod("Ops", signature(e1 = "Matrix", e2 = "ANY"), function(e1, e2) { if(is(e1, "mMatrix") && is(e2, "mMatrix")) dimCheck(e1,e2) if(is.matrix(e2) && identical(e2, as.matrix(e2)) && is.object(e2) && !isS4(e2)) # e.g. for "table" callGeneric(e1, unclass(e2)) else .bail.out.2(.Generic, class(e1), class(e2)) }) setMethod("Ops", signature(e1 = "ANY", e2 = "Matrix"), function(e1, e2) { if(is(e1, "mMatrix") && is(e2, "mMatrix")) dimCheck(e1,e2) if(is.matrix(e1) && identical(e1, as.matrix(e1)) && is.object(e1) && !isS4(e1)) # e.g. for "table" callGeneric(unclass(e1), e2) else .bail.out.2(.Generic, class(e1), class(e2)) }) rm(.bail.out.Ops) ## "General principle" ## - - - - - - - - - ## For "Arith" it is sufficient (though not optimal, once we have "iMatrix"!) ## to define "dMatrix" methods and coerce all other "[nli]Matrix" to "dMatrix" setMethod("Arith", signature(e1 = "Matrix", e2 = "Matrix"), function(e1, e2) callGeneric(as(e1, "dMatrix"), as(e2, "dMatrix"))) ## For "Compare", this would be feasible too, but is clearly suboptimal, ## particularly for "==" and "!=" ## and for "lMatrix" and "nMatrix" should not coerce at all if(FALSE) setMethod("Compare", signature(e1 = "Matrix", e2 = "Matrix"), function(e1, e2) { if(is.na(match(.Generic, c("==", "!=")))) callGeneric(as(e1, "dMatrix"), as(e2, "dMatrix")) else { ## no coercion needed for "==" or "!=" ## ## what now ? <<<<<<<<<<< FIXME >>>>>>>>> .bail.out.2(.Generic, class(e1), class(e2)) } }) ## Working entirely on "matching" x slot: ## can be done for matching-dim "*geMatrix", and also ## matching-{dim + uplo} for *packed* (only!) symmetric+triangular .Ops.via.x <- function(e1,e2) { dimCheck(e1, e2) e1@x <- callGeneric(e1@x, e2@x) .empty.factors(e1) e1 } ###-------- originally from ./dMatrix.R -------------------- ## ## Note that there extra methods for o ! ## ## "Compare" -> returning logical Matrices; .Cmp.swap() is in ./Auxiliaries.R setMethod("Compare", signature(e1 = "numeric", e2 = "dMatrix"), .Cmp.swap) setMethod("Compare", signature(e1 = "logical", e2 = "dMatrix"), .Cmp.swap) setMethod("Compare", signature(e1 = "numeric", e2 = "lMatrix"), .Cmp.swap) setMethod("Compare", signature(e1 = "logical", e2 = "lMatrix"), .Cmp.swap) setMethod("Compare", signature(e1 = "numeric", e2 = "nMatrix"), .Cmp.swap) setMethod("Compare", signature(e1 = "logical", e2 = "nMatrix"), .Cmp.swap) ## This is parallel to Logic.Mat.atomic() below ---> __keep parallel__ ! Cmp.Mat.atomic <- function(e1, e2) { ## result will inherit from "lMatrix" n1 <- prod(d <- e1@Dim) cl <- class(e1) if((l2 <- length(e2)) == 0) return(if(n1 == 0) as(e1, class2(cl, "l"))# more expensive than (but working for "dgC*"): ## new(class2(cl, "l"), Dim = d, Dimnames = e1@Dimnames) else as.logical(e2)) ## else if(n1 && n1 < l2) stop(sprintf( "dim [product %d] do not match the length of object [%d]", n1, l2)) cl1 <- getClassDef(cl) slots1 <- names(cl1@slots) has.x <- any("x" == slots1)# *fast* check for "x" slot presence if(l2 > 1 && has.x) return(if(n1 == 0) new(class2(cl, "l"), x = callGeneric(e1@x, e2), Dim = d, Dimnames = e1@Dimnames) else ## e2 cannot simply be compared with e1@x --> use another method callGeneric(e1, Matrix(e2, nrow=d[1], ncol=d[2]))) ## else Udg <- extends(cl1, "triangularMatrix") && e1@diag == "U" r0 <- callGeneric(0, e2) ## Udg: append the diagonal at *end*, as diagU2N(): r <- callGeneric(if(Udg) c(e1@x,..diag.x(e1)) else if(has.x) e1@x else TRUE, e2) ## trivial case first (beware of NA) if(isTRUE(all(r0) && all(r))) { r <- new(if(d[1] == d[2]) "lsyMatrix" else "lgeMatrix") r@Dim <- d r@Dimnames <- e1@Dimnames r@x <- rep.int(TRUE, n1) } else if(extends(cl1, "denseMatrix")) { full <- !.isPacked(e1) # << both "dtr" and "dsy" are 'full' if(full || allFalse(r0) || extends(cl1, "symmetricMatrix")) { isTri <- extends(cl1, "triangularMatrix") if(isTri) { if(extends1of(cl1, c("Cholesky","BunchKaufman"))) cl1 <- getClassDef(cl <- class(e1 <- as(e1, "dtrMatrix"))) } ## FIXME? using copyClass() to copy "relevant" slots r <- new(class2(cl, "l"), x = r, Dim = d, Dimnames = e1@Dimnames) if(extends(cl1, "symmetricMatrix")) { r@uplo <- e1@uplo } else if(isTri) { r@uplo <- e1@uplo r@diag <- e1@diag } } else { ## packed matrix with structural 0 and r0 is not all FALSE: ##--> result cannot be packed anymore ## [dense & packed & not symmetric ] ==> must be "dtp*" : if(!extends(cl1, "dtpMatrix")) stop("internal bug in \"Compare\" method (Cmp.Mat.atomic); please report") rx <- rep_len(r0, n1) rx[indTri(d[1], upper = (e1@uplo == "U"), diag=TRUE)] <- r r <- new("lgeMatrix", x = rx, Dim = d, Dimnames = e1@Dimnames) } } else { ##---- e1 is(. , sparseMatrix) ----------------- ## FIXME: remove this test eventually if(extends(cl1, "diagonalMatrix")) stop("Cmp.Mat.atomic() should not be called for diagonalMatrix") remainSparse <- allFalse(r0) ## <==> things remain sparse if(Udg) { # e1 *is* unit-diagonal (triangular sparse) r1 <- callGeneric(1, e2) Udg <- all(r1) # maybe Unit-diagonal (sparse) result ## if(!remainSparse) we'll use non0ind() which *has* unit-diag. indices at end ## if(Udg && remainSparse) { } else { ## result will not be unit-diagonal sparse e1 <- .diagU2N(e1, cl = cl1) # otherwise, result is U-diag if(extends(cl1, "CsparseMatrix")) { ## repeat computation if e1 has changed r <- callGeneric(if(has.x) e1@x else TRUE, e2) } } } if(remainSparse) { if(!anyNA(r) && ((Ar <- all(r)) || !any(r))) { lClass <- class2(cl, "l") # is "lsparse*" r <- new(lClass) r@Dim <- d r@Dimnames <- e1@Dimnames if(Ar) { # 'TRUE' instead of 'x': same sparsity: for(n in intersect(c("i","j","p","uplo","diag"), slots1)) slot(r, n) <- slot(e1, n) n <- if(has.x) length(e1@x) else if(any("p" == slots1)) e1@p[d[2]+1L] else length(e1@i) r@x <- rep.int(TRUE, n) } else { ## !any(r): all FALSE: keep empty 'r' matrix ## but may need a valid 'pointer' slot: if(extends(lClass, "CsparseMatrix")) r@p <- rep.int(0L, 1+ncol(r)) else if(extends(lClass, "RsparseMatrix")) r@p <- rep.int(0L, 1+nrow(r)) } } else { # some TRUE, FALSE, NA : go via unique 'Tsparse' M <- asTuniq(e1) nCl <- class2(class(M), 'l') # logical Tsparse sN <- slotNames(nCl) ## copy "the other slots" (important for "tr"/"sym"): r <- copyClass(M, nCl, sNames = sN[is.na(match(sN, "x"))]) r@x <- callGeneric(if(has.x) M@x else 1, e2) if(extends(cl1, "CsparseMatrix")) r <- as(r, "CsparseMatrix") else if(extends(cl1, "RsparseMatrix")) r <- as(r, "RsparseMatrix") } } else { ## non sparse result; triangularity also gone, typically lClass <- if(extends(cl1, "symmetricMatrix")) "lsyMatrix" else "lgeMatrix" Matrix.msg(sprintf("sparse to dense (%s) coercion in '%s' -> %s", lClass, .Generic, "Cmp.Mat.atomic"), .M.level = 2) rx <- rep_len(r0, n1) ## Here, we assume that 'r' and the indices align (!) encI <- .Call(m_encodeInd, non0ind(e1, cl1, uniqT=FALSE, xtendSymm=FALSE), di = d, orig1=FALSE, checkBounds=FALSE) rx[1L + encI] <- r r <- new(lClass, x = rx, Dim = d, Dimnames = e1@Dimnames) } } r } setMethod("Compare", signature(e1 = "dMatrix", e2 = "numeric"), Cmp.Mat.atomic) setMethod("Compare", signature(e1 = "dMatrix", e2 = "logical"), Cmp.Mat.atomic) setMethod("Compare", signature(e1 = "lMatrix", e2 = "numeric"), Cmp.Mat.atomic) setMethod("Compare", signature(e1 = "lMatrix", e2 = "logical"), Cmp.Mat.atomic) setMethod("Compare", signature(e1 = "nMatrix", e2 = "numeric"), Cmp.Mat.atomic) setMethod("Compare", signature(e1 = "nMatrix", e2 = "logical"), Cmp.Mat.atomic) ## "xMatrix <-> work with 'x' slot {was originally just for "Compare"}: ## ------- {also used for "Arith"}: Ops.x.x <- function(e1, e2) { d <- dimCheck(e1,e2) if((dens1 <- extends(c1 <- class(e1), "denseMatrix"))) gen1 <- extends(c1, "generalMatrix") if((dens2 <- extends(c2 <- class(e2), "denseMatrix"))) gen2 <- extends(c2, "generalMatrix") if(dens1 && dens2) { ## both inherit from ddense* geM <- TRUE if(!gen1) { if(!gen2) { ## consider preserving "triangular" / "symmetric" geM <- FALSE le <- prod(d) isPacked <- function(x) length(x@x) < le Mclass <- if(extends(c1, "symmetricMatrix") && extends(c2, "symmetricMatrix")) { if(e1@uplo != e2@uplo) ## one is upper, one is lower e2 <- t(e2) if((p1 <- isPacked(e1)) | (p2 <- isPacked(e2))) { ## at least one is packed if(p1 != p2) { # one is not packed --> *do* pack it: pack.sy <- function(x) if(is.numeric(x@x)) .Call(dsyMatrix_as_dspMatrix, x) else .Call(lsyMatrix_as_lspMatrix, x, 0L) if(p1) e2 <- pack.sy(e2) else e1 <- pack.sy(e1) } "spMatrix" } else "syMatrix" } else if(extends(c1, "triangularMatrix") && extends(c2, "triangularMatrix")) { if(!(geM <- e1@uplo != e2@uplo || isN0(callGeneric(0,0)))) { p1 <- isPacked(e1) p2 <- isPacked(e2) if(e1@diag == "U") e1 <- .dense.diagU2N(e1, isPacked=p1) if(e2@diag == "U") e2 <- .dense.diagU2N(e2, isPacked=p2) if(p1 | p2) { ## at least one is packed if(p1 != p2) { # one is not packed --> *do* pack it: pack.tr <- function(x) if(is.numeric(x@x)) .Call(dtrMatrix_as_dtpMatrix, x) else .Call(ltrMatrix_as_ltpMatrix, x, 0L) if(p1) e2 <- pack.tr(e2) else e1 <- pack.tr(e1) } "tpMatrix" } else "trMatrix" } } else { ## not symmetric, not triangular ==> "general" geM <- TRUE } if(geM) e2 <- as(e2, "generalMatrix") } if(geM) e1 <- as(e1, "generalMatrix") # was "dgeMatrix" } else { ## gen1 if(!gen2) e2 <- as(e2, "generalMatrix") } ## now, in all cases @x should be matching & correct {only "uplo" part is used} r <- callGeneric(e1@x, e2@x) kr <- .M.kind(r) if(kr == "d" && !is.double(r)) ## as "igeMatrix" does not yet exist! r <- as.double(r) if(geM) new(paste0(kr, "geMatrix"), x = r, Dim = d, Dimnames = e1@Dimnames) else new(paste0(kr, Mclass), x = r, Dim = d, Dimnames = e1@Dimnames, uplo = e1@uplo) } else { r <- if(!dens1 && !dens2) ## both e1 _and_ e2 are sparse. ## Now (new method dispatch, 2009-01) *does* happen ## even though we have o methods callGeneric(as(e1, "CsparseMatrix"), as(e2, "CsparseMatrix")) else if(dens1 && !dens2) ## go to dense callGeneric(e1, as(e2, "denseMatrix")) else ## if(!dens1 && dens2) callGeneric(as(e1, "denseMatrix"), e2) ## criterion "2 * nnz(.) < ." as in sparseDefault() in Matrix() [./Matrix.R] : if(2 * nnzero(r, na.counted = TRUE) < prod(d)) as(r, "sparseMatrix") else r } } setMethod("Ops", signature(e1 = "dMatrix", e2 = "dMatrix"), Ops.x.x) setMethod("Ops", signature(e1 = "lMatrix", e2 = "lMatrix"), Ops.x.x) ## n*: for "Arith" go via dMatrix, for "Logic" via "lMatrix" setMethod("Compare", signature(e1 = "nMatrix", e2 = "nMatrix"), Ops.x.x) ## l o d : depends on *kind* of Ops -- but Ops.x.x works on slots - correctly: setMethod("Ops", signature(e1="lMatrix", e2="dMatrix"), Ops.x.x) setMethod("Ops", signature(e1="dMatrix", e2="lMatrix"), Ops.x.x) ## lMatrix & nMatrix ... probably should also just use "Matrix" ? ## ## Hmm, the coercion should differ, depending on subgroup ("Logic", "Arith",..) ## --> try to get rid of these setMethod("Ops", signature(e1="lMatrix", e2="numeric"), function(e1,e2) callGeneric(as(e1,"dMatrix"), e2)) setMethod("Ops", signature(e1="numeric", e2="lMatrix"), function(e1,e2) callGeneric(e1, as(e2,"dMatrix"))) setMethod("Ops", signature(e1="nMatrix", e2="numeric"), function(e1,e2) callGeneric(as(e1,"dMatrix"), e2)) setMethod("Ops", signature(e1="numeric", e2="nMatrix"), function(e1,e2) callGeneric(e1, as(e2,"dMatrix"))) ## setMethod("Ops", signature(e1="Matrix", e2="logical"), ## function(e1,e2) callGeneric(as(e1,"lMatrix"), e2)) ## setMethod("Ops", signature(e1="logical", e2="Matrix"), ## function(e1,e2) callGeneric(e1, as(e2,"lMatrix"))) ## "dpoMatrix" / "dppMatrix" : ## Positive-definiteness is lost with all "Ops" but some "Arith" cases for(cl in c("numeric", "logical")) { # "complex", "raw" : basically "replValue" setMethod("Arith", signature(e1 = cl, e2 = "dpoMatrix"), function(e1, e2) if(!(l1 <- length(e1))) numeric() else if(l1 == 1 && any(.Generic == c("*","/","+")) && (e1 > 0)) { e2@x <- callGeneric(e1, e2@x) ; .empty.factors(e2); e2 # remains "dpo" } else ## in all other cases callGeneric(e1, as(e2, "dsyMatrix"))) setMethod("Arith", signature(e1 = cl, e2 = "dppMatrix"), function(e1, e2) if(!(l1 <- length(e1))) numeric() else if(l1 == 1 && any(.Generic == c("*","/","+")) && (e1 > 0)) { e2@x <- callGeneric(e1, e2@x) ; .empty.factors(e2); e2 # remains "dpp" } else ## in all other cases callGeneric(e1, as(e2, "dspMatrix"))) setMethod("Arith", signature(e1 = "dpoMatrix", e2 = cl), function(e1, e2) if(!(l2 <- length(e2))) numeric() else if(l2 == 1 && any(.Generic == c("*","/","+")) && (e2 > 0)) { e1@x <- callGeneric(e1@x, e2) ; .empty.factors(e1); e1 # remains "dpo" } else ## in all other cases callGeneric(as(e1, "dsyMatrix"), e2)) setMethod("Arith", signature(e1 = "dppMatrix", e2 = cl), function(e1, e2) if(!(l2 <- length(e2))) numeric() else if(l2 == 1 && any(.Generic == c("*","/","+")) && (e2 > 0)) { e1@x <- callGeneric(e1@x, e2) ; .empty.factors(e1); e1 # remains "dpp" } else ## in all other cases callGeneric(as(e1, "dspMatrix"), e2)) setMethod("Ops", signature(e1 = cl, e2 = "dpoMatrix"), function(e1, e2) callGeneric(e1, as(e2, "dsyMatrix"))) setMethod("Ops", signature(e1 = cl, e2 = "dppMatrix"), function(e1, e2) callGeneric(e1, as(e2, "dspMatrix"))) setMethod("Ops", signature(e1 = "dpoMatrix", e2 = cl), function(e1, e2) callGeneric(as(e1, "dsyMatrix"), e2)) setMethod("Ops", signature(e1 = "dppMatrix", e2 = cl), function(e1, e2) callGeneric(as(e1, "dspMatrix"), e2)) }# for(cl...) ### -- I -- dense ----------------------------------------------------------- ##-------- originally from ./dgeMatrix.R -------------------- ## ----- only work with NAMESPACE importFrom(methods, ..) setMethod("Arith", signature(e1 = "dgeMatrix", e2 = "dgeMatrix"), ## "+", "-", "*", "^", "%%", "%/%", "/" function(e1, e2) { ## NB: triangular, symmetric, etc may need own method d1 <- e1@Dim d2 <- e2@Dim eqD <- d1 == d2 if (!eqD[1]) stop("Matrices must have same number of rows for arithmetic") same.dim <- eqD[2] x1 <- e1@x x2 <- e2@x if (same.dim) { d <- d1 dn <- dimNamesCheck(e1, e2) } else { # nrows differ ----> maybe recycling if(d2[2] %% d1[2] == 0) { # nrow(e2) is a multiple x1 <- rep.int(x1, d2[2] %/% d1[2]) d <- d2 dn <- e2@Dimnames } else if(d1[2] %% d2[2] == 0) { # nrow(e1) is a multiple x2 <- rep.int(x2, d1[2] %/% d2[2]) d <- d1 dn <- e1@Dimnames } else stop(gettextf("number of rows are not compatible for %s", .Generic), domain=NA) } new("dgeMatrix", Dim = d, Dimnames = dn, x = callGeneric(x1, x2)) }) A.M.n <- function(e1, e2) { d <- e1@Dim le <- length(e2) if(le == 0) if(prod(d) == 0) new(class2(class(e1), "d"), Dim = d, Dimnames = e1@Dimnames) else as.numeric(e2) else if(le == 1 || le == d[1] || any(prod(d) == c(le, 0L))) { # matching dim e1@x <- callGeneric(e1@x, as.vector(e2)) .empty.factors(e1) e1 } else stop ("length of 2nd arg does not match dimension of first") } setMethod("Arith", signature(e1 = "dgeMatrix", e2 = "numeric"), A.M.n) setMethod("Arith", signature(e1 = "dgeMatrix", e2 = "logical"), A.M.n) setMethod("Arith", signature(e1 = "dgeMatrix", e2 = "sparseVector"), A.M.n) A.n.M <- function(e1, e2) { d <- e2@Dim le <- length(e1) if(le == 0) if(prod(d) == 0) new(class2(class(e2), "d"), Dim = d, Dimnames = e2@Dimnames) else as.numeric(e1) else if(le == 1 || le == d[1] || any(prod(d) == c(le, 0L))) { # matching dim e2@x <- callGeneric(as.vector(e1), e2@x) .empty.factors(e2) e2 } else stop ("length of 1st arg does not match dimension of 2nd") } setMethod("Arith", signature(e1 = "numeric", e2 = "dgeMatrix"), A.n.M) setMethod("Arith", signature(e1 = "logical", e2 = "dgeMatrix"), A.n.M) setMethod("Arith", signature(e1 = "sparseVector", e2 = "dgeMatrix"), A.n.M) ## rm(A.M.n, A.n.M) ##-------- originally from ./ddenseMatrix.R -------------------- ## Cheap version: work via "dgeMatrix" and use the group methods there: if(FALSE)## preserve "symmetric", "triangular", --> rather use Ops.x.x setMethod("Arith", signature(e1 = "ddenseMatrix", e2 = "ddenseMatrix"), function(e1, e2) callGeneric(as(e1, "dgeMatrix"), as(e2, "dgeMatrix"))) .Arith.denseM.atom <- function(e1, e2) { ## since e1 = "dgeMatrix" has its own method, we have ## either symmetric or triangular ! n1 <- prod(d <- e1@Dim) le <- length(e2 <- as.vector(e2)) if(n1 && n1 < le) stop(sprintf( "dim [product %d] do not match the length of object [%d]", n1, le)) if(le == 0) if(prod(d) == 0) new(class2(class(e1), "d"), Dim = d, Dimnames = e1@Dimnames) else as.numeric(e2) else if(le == 1 || le == d[1] || any(prod(d) == c(le, 0L))) { # matching dim if(is(e1, "triangularMatrix")) { r0 <- callGeneric(0, e2) if(all0(r0)) { # result remains triangular if(e1@diag == "U" && !all(1 == callGeneric(1,e2))) e1 <- diagU2N(e1) e1@x <- callGeneric(e1@x, e2) .empty.factors(e1) e1 } else { ## result *general* callGeneric(as(e1,"dgeMatrix"), e2) } } else { ## symmetric if(le == 1) { ## result remains symmetric e1@x <- callGeneric(e1@x, e2) .empty.factors(e1) e1 } else { ## (le == d[1] || prod(d) == le) ## *might* remain symmetric, but 'x' may contain garbage ## *testing* for symmetry is also a bit expensive ==> simple: callGeneric(as(e1,"dgeMatrix"), e2) } } } else stop ("length of 2nd arg does not match dimension of first") } setMethod("Arith", signature(e1 = "ddenseMatrix", e2 = "numeric"), .Arith.denseM.atom) setMethod("Arith", signature(e1 = "ddenseMatrix", e2 = "logical"), .Arith.denseM.atom) setMethod("Arith", signature(e1 = "ddenseMatrix", e2 = "sparseVector"), .Arith.denseM.atom) .Arith.atom.denseM <- function(e1, e2) { d <- e2@Dim ## note that e2 is either symmetric or triangular here le <- length(e1 <- as.vector(e1)) if(le == 0) if(prod(d) == 0) new(class2(class(e2), "d"), Dim = d, Dimnames = e2@Dimnames) else as.numeric(e1) else if(le == 1 || le == d[1] || any(prod(d) == c(le, 0L))) { # matching dim if(is(e2, "triangularMatrix")) { r0 <- callGeneric(e1, 0) if(all0(r0)) { # result remains triangular if(e2@diag == "U" && !all(1 == callGeneric(e1,1))) e2 <- diagU2N(e2) e2@x <- callGeneric(e1, e2@x) .empty.factors(e2) e2 } else { # result *general* callGeneric(e1, as(e2,"dgeMatrix")) } } else { ## symmetric if(le == 1) { # result remains symmetric e2@x <- callGeneric(e1, e2@x) .empty.factors(e2) e2 } else { ## (le == d[1] || prod(d) == le) ## *might* remain symmetric, but 'x' may contain garbage ## *testing* for symmetry is also a bit expensive ==> simple: callGeneric(e1, as(e2,"dgeMatrix")) } } } else stop ("length of 1st arg does not match dimension of 2nd") } ## setMethod("Arith", signature(e1 = "numeric", e2 = "ddenseMatrix"), ## function(e1, e2) callGeneric(e1, as(e2, "dgeMatrix"))) setMethod("Arith", signature(e1 = "numeric", e2 = "ddenseMatrix"), .Arith.atom.denseM) setMethod("Arith", signature(e1 = "logical", e2 = "ddenseMatrix"), .Arith.atom.denseM) setMethod("Arith", signature(e1 = "sparseVector", e2 = "ddenseMatrix"), .Arith.atom.denseM) ## "Logic" ## ------- ##-------- originally from ./ldenseMatrix.R -------------------- ## These all had "Logic", now also for "Compare", ## but "Arith" differs: result will be "dgeMatrix' : .Ops2dge.via.x <- function(e1,e2) { dimCheck(e1, e2) r <- copyClass(e1, "dgeMatrix", sNames = c("Dim","Dimnames")) r@x <- as.numeric(callGeneric(e1@x, e2@x)) r } setMethod("Compare", signature(e1="lgeMatrix", e2="lgeMatrix"), .Ops.via.x) setMethod("Logic", signature(e1="lgeMatrix", e2="lgeMatrix"), .Ops.via.x) setMethod("Arith", signature(e1="lgeMatrix", e2="lgeMatrix"), .Ops2dge.via.x) setMethod("Compare", signature(e1="ngeMatrix", e2="ngeMatrix"), .Ops.via.x) setMethod("Logic", signature(e1="ngeMatrix", e2="ngeMatrix"), .Ops.via.x) setMethod("Arith", signature(e1="ngeMatrix", e2="ngeMatrix"), .Ops2dge.via.x) ## FIXME: These lose symmmetry & triangularity setMethod("Ops", signature(e1="ldenseMatrix", e2="ldenseMatrix"), function(e1,e2) { dimCheck(e1, e2) callGeneric(as(e1, "lgeMatrix"), as(e2, "lgeMatrix")) }) setMethod("Ops", signature(e1="ndenseMatrix", e2="ndenseMatrix"), function(e1,e2) { dimCheck(e1, e2) callGeneric(as(e1, "ngeMatrix"), as(e2, "ngeMatrix")) }) ## nMatrix -> lMatrix conversions when "the other" is not nMatrix ## Use Ops.x.x unless both are sparse setMethod("Ops", signature(e1="nMatrix", e2="lMatrix"), Ops.x.x) setMethod("Ops", signature(e1="lMatrix", e2="nMatrix"), Ops.x.x) setMethod("Ops", signature(e1="nMatrix", e2="dMatrix"), Ops.x.x) setMethod("Ops", signature(e1="dMatrix", e2="nMatrix"), Ops.x.x) ## ... both are sparse: cannot use Ops.x.x setMethod("Ops", signature(e1="nsparseMatrix", e2="lsparseMatrix"), function(e1,e2) callGeneric(as(e1,"lMatrix"), e2)) setMethod("Ops", signature(e1="lsparseMatrix", e2="nsparseMatrix"), function(e1,e2) callGeneric(e1, as(e2,"lMatrix"))) setMethod("Ops", signature(e1="nsparseMatrix", e2="dsparseMatrix"), function(e1,e2) callGeneric(as(e1,"lMatrix"), e2)) setMethod("Ops", signature(e1="dsparseMatrix", e2="nsparseMatrix"), function(e1,e2) callGeneric(e1, as(e2,"lMatrix"))) ## Have this for "Ops" already above ## setMethod("Logic", signature(e1 = "logical", e2 = "Matrix"), ## function(e1, e2) callGeneric(e1, as(e2, "lMatrix"))) ## setMethod("Logic", signature(e1 = "Matrix", e2 = "logical"), ## function(e1, e2) callGeneric(as(e1, "lMatrix"), e2)) .ll <- function(e1, e2) callGeneric(as(e1,"lMatrix"), as(e2, "lMatrix")) setMethod("Logic", signature(e1 = "nMatrix", e2 = "Matrix"), .ll) setMethod("Logic", signature(e1 = "Matrix", e2 = "nMatrix"), .ll) setMethod("Logic", signature(e1 = "nMatrix", e2 = "nMatrix"), .ll) rm(.ll) ### "ANY" here means "any non-Matrix" (since "Ops"(ANY) has already bailout above): setMethod("Logic", signature(e1 = "ANY", e2 = "Matrix"), function(e1, e2) callGeneric(as.logical(e1), as(e2, "lMatrix"))) setMethod("Logic", signature(e1 = "Matrix", e2 = "ANY"), function(e1, e2) callGeneric(as(e1, "lMatrix"), as.logical(e2))) ## "swap RHS and LHS" and use the method below -- can do this, since ## "Logic" := { "&" , "|" } and both are commutative for(Mcl in c("lMatrix","nMatrix","dMatrix")) for(cl in c("logical", "numeric", "sparseVector")) setMethod("Logic", signature(e1 = cl, e2 = Mcl), function(e1,e2) callGeneric(e2, e1)) ## conceivably "numeric" could use callGeneric(e2, as.logical(e1)) ## but that's not useful at the moment, since Logic.Mat.atomic() does as.logical() ## This is parallel to Cmp.Mat.atomic() above ---> __keep parallel__ ! Logic.Mat.atomic <- function(e1, e2) { ## result will typically be "like" e1: l2 <- length(e2 <- as.logical(e2)) n1 <- prod(d <- e1@Dim) if(n1 && n1 < l2) stop(sprintf( "dim [product %d] do not match the length of object [%d]", n1, l2)) if(.Generic == "&" && l2 && allTrue (e2)) return(as(e1, "lMatrix")) if(.Generic == "|" && l2 && allFalse(e2)) return(as(e1, "lMatrix")) cl <- class(e1) if(l2 == 0) return(if(n1 == 0) as(e1, class2(cl, "l"))# more expensive than (but working for "dgC*"): ## new(class2(cl, "l"), Dim = d, Dimnames = e1@Dimnames) else as.logical(e2)) ## else cl1 <- getClassDef(cl) slots1 <- names(cl1@slots) has.x <- any("x" == slots1)# *fast* check for "x" slot presence if(l2 > 1 && has.x) return(if(prod(d) == 0) new(class2(cl, "l"), x = callGeneric(e1@x, e2), Dim = d, Dimnames = e1@Dimnames) else ## e2 cannot simply be compared with e1@x --> use another method callGeneric(e1, Matrix(e2, nrow=d[1], ncol=d[2]))) ## else Udg <- extends(cl1, "triangularMatrix") && e1@diag == "U" r0 <- callGeneric(0, e2) ## Udg: append the diagonal at *end*, as diagU2N(): r <- callGeneric(if(Udg) c(e1@x,..diag.x(e1)) else if(has.x) e1@x else TRUE, e2) ## trivial case first (beware of NA) if(isTRUE(all(r0) && all(r))) { r <- new(if(d[1] == d[2]) "lsyMatrix" else "lgeMatrix") r@Dim <- d r@Dimnames <- e1@Dimnames r@x <- rep.int(TRUE, prod(d)) } else if(extends(cl1, "denseMatrix")) { full <- !.isPacked(e1) # << both "dtr" and "dsy" are 'full' if(full || allFalse(r0) || extends(cl1, "symmetricMatrix")) { isTri <- extends(cl1, "triangularMatrix") if(isTri) { if(extends1of(cl1, c("Cholesky","BunchKaufman"))) cl1 <- getClassDef(cl <- class(e1 <- as(e1, "dtrMatrix"))) } ## FIXME? using copyClass() to copy "relevant" slots r <- new(class2(cl, "l"), x = r, Dim = d, Dimnames = e1@Dimnames) if(extends(cl1, "symmetricMatrix")) { r@uplo <- e1@uplo } else if(isTri) { r@uplo <- e1@uplo r@diag <- e1@diag } } else { ## packed matrix with structural 0 and r0 is not all FALSE: ##--> result cannot be packed anymore ## [dense & packed & not symmetric ] ==> must be "ltp*" : if(!extends(cl1, "ltpMatrix")) stop("internal bug in \"Logic\" method (Logic.Mat.atomic); please report") rx <- rep_len(r0, prod(d)) rx[indTri(d[1], upper = (e1@uplo == "U"), diag=TRUE)] <- r r <- new("lgeMatrix", x = rx, Dim = d, Dimnames = e1@Dimnames) } } else { ##---- e1 is(. , sparseMatrix) ----------------- ## FIXME: remove this test eventually if(extends(cl1, "diagonalMatrix")) stop("Logic.Mat.atomic() should not be called for diagonalMatrix") remainSparse <- allFalse(r0) ## <==> things remain sparse if(Udg) { # e1 *is* unit-diagonal (triangular sparse) r1 <- callGeneric(1, e2) Udg <- all(r1) # maybe Unit-diagonal (sparse) result ## if(!remainSparse) we'll use non0ind() which *has* unit-diag. indices at end ## if(Udg && remainSparse) { } else { ## result will not be unit-diagonal sparse e1 <- .diagU2N(e1, cl = cl1) # otherwise, result is U-diag if(extends(cl1, "CsparseMatrix")) { ## repeat computation if e1 has changed r <- callGeneric(if(has.x) e1@x else TRUE, e2) } } } if(remainSparse) { if(!anyNA(r) && ((Ar <- all(r)) || !any(r))) { lClass <- class2(cl, "l") # is "lsparse*" r <- new(lClass) r@Dim <- d r@Dimnames <- e1@Dimnames if(Ar) { # 'TRUE' instead of 'x': same sparsity: for(n in intersect(c("i","j","p","uplo","diag"), slots1)) slot(r, n) <- slot(e1, n) n <- if(has.x) length(e1@x) else if(any("p" == slots1)) e1@p[d[2]+1L] else length(e1@i) r@x <- rep.int(TRUE, n) } else { ## !any(r): all FALSE: keep empty 'r' matrix ## but may need a valid 'pointer' slot: if(extends(lClass, "CsparseMatrix")) r@p <- rep.int(0L, 1+ncol(r)) else if(extends(lClass, "RsparseMatrix")) r@p <- rep.int(0L, 1+nrow(r)) } } else { # some TRUE, FALSE, NA : go via unique 'Tsparse' M <- asTuniq(e1) nCl <- class2(class(M), 'l') # logical Tsparse sN <- slotNames(nCl) ## copy "the other slots" (important for "tr"/"sym"): r <- copyClass(M, nCl, sNames = sN[is.na(match(sN, c("x","factors")))]) r@x <- callGeneric(if(has.x) M@x else TRUE, e2) if(extends(cl1, "CsparseMatrix")) r <- as(r, "CsparseMatrix") else if(extends(cl1, "RsparseMatrix")) r <- as(r, "RsparseMatrix") } } else { ## non sparse result lClass <- if(extends(cl1, "symmetricMatrix")) "lsyMatrix" else "lgeMatrix" Matrix.msg(sprintf("sparse to dense (%s) coercion in '%s' -> %s", lClass, .Generic, "Logic.Mat.atomic"), .M.level = 2) rx <- rep_len(r0, prod(d)) ## Here, we assume that 'r' and the indices align (!) encI <- .Call(m_encodeInd, non0ind(e1, cl1, uniqT=FALSE, xtendSymm=FALSE), di = d, orig1=FALSE, checkBounds=FALSE) rx[1L + encI] <- r r <- new(lClass, x = rx, Dim = d, Dimnames = e1@Dimnames) } } r } for(Mcl in c("lMatrix","nMatrix","dMatrix")) for(cl in c("logical", "numeric", "sparseVector")) setMethod("Logic", signature(e1 = Mcl, e2 = cl), Logic.Mat.atomic) ### -- II -- sparse ---------------------------------------------------------- ## Have lgC o lgC and then lgT o lgT Logic - quite similarly - ## also lsC o * and ltC o * : ## Here's the common functionality .do.Logic.lsparse <- function(e1,e2, d, dn, isOR, ij1, ij2) { ## NB non-diagonalMatrix := Union{ general, symmetric, triangular} gen1 <- extends(cD1 <- getClassDef(class(e1)), "generalMatrix") gen2 <- extends(cD2 <- getClassDef(class(e2)), "generalMatrix") sym1 <- !gen1 && extends(cD1, "symmetricMatrix") sym2 <- !gen2 && extends(cD2, "symmetricMatrix") tri1 <- !gen1 && !sym1 tri2 <- !gen2 && !sym2 G <- gen1 && gen2 S <- sym1 && sym2 && e1@uplo == e2@uplo T <- tri1 && tri2 && e1@uplo == e2@uplo if(T && e1@diag != e2@diag) { ## one is "U" the other "N" if(e1@diag == "U") e1 <- diagU2N(e1) else ## (e2@diag == "U" e2 <- diagU2N(e2) shape <- "t" } else if(!G && !S && !T) { ## e.g. one symmetric, one general ## coerce to generalMatrix and go : if(!gen1) e1 <- as(e1, "generalMatrix", strict = FALSE) if(!gen2) e2 <- as(e2, "generalMatrix", strict = FALSE) shape <- "g" } else { shape <- if(T) "t" else if(S) "s" else "g" } ii <- WhichintersectInd(ij1, ij2, di=d) I1 <- ii[[1]] ; has1 <- length(I1) > 0 I2 <- ii[[2]] ; has2 <- length(I2) > 0 ## 1) common indices i <- ij1[I1, 1] j <- ij1[I1, 2] if(isOR) { ## i.e. .Generic == "|" i.e. not "&" x <- e1@x[I1] | e2@x[I2] ## 2) "e1 o FALSE": x2 <- if(has1) e1@x[- I1] else e1@x # == callGeneric(e1@x[- I1], FALSE) ## 3) "0 o e1": x3 <- if(has2) e2@x[- I2] else e2@x # == callGeneric(FALSE, e2@x[- I2]) i <- c(i, if(has1) ij1[-I1, 1] else ij1[, 1], if(has2) ij2[-I2, 1] else ij2[, 1]) j <- c(j, if(has1) ij1[-I1, 2] else ij1[, 2], if(has2) ij2[-I2, 2] else ij2[, 2]) x <- c(x, x2, x3) } else { ## AND x <- e1@x[I1] & e2@x[I2] } if(any(!(x. <- x | is.na(x)))) { ## drop 'FALSE's i <- i[x.] j <- j[x.] x <- x[x.] } new(paste0("l",shape,"TMatrix"), Dim = d, Dimnames = dn, i = i, j = j, x = x) } Logic.lCMat <- function(e1, e2, isOR) { stopifnot(is.logical(isOR)) d <- dimCheck(e1, e2) dn <- dimNamesCheck(e1, e2) ## Very easy case first : if(identical(e1@i, e2@i) && identical(e1@p, e2@p)) { e1@x <- if(isOR) e1@x | e2@x else e1@x & e2@x .empty.factors(e1) return(e1) } ## else : .Call(Tsparse_to_Csparse, .do.Logic.lsparse(e1, e2, d = d, dn = dn, isOR = isOR, ij1 = .Call(compressed_non_0_ij, e1, TRUE), ij2 = .Call(compressed_non_0_ij, e2, TRUE)), FALSE) } m.Logic.lCMat <- function(e1, e2) Logic.lCMat(e1, e2, isOR = .Generic == "|") Logic.lTMat <- function(e1,e2) { d <- dimCheck(e1, e2) dn <- dimNamesCheck(e1, e2) ## Very easy case first : if(identical(e1@i, e2@i) && identical(e1@j, e2@j)) { e1@x <- callGeneric(e1@x, e2@x) .empty.factors(e1) return(e1) } ## else : cld <- getClassDef(class(e1)) .do.Logic.lsparse(e1, e2, d = d, dn = dn, isOR = .Generic == "|", ij1 = non0ind(e1, cld), ij2 = non0ind(e2, cld)) } setMethod("Logic", signature(e1="lgCMatrix", e2="lgCMatrix"), m.Logic.lCMat) setMethod("Logic", signature(e1="lgTMatrix", e2="lgTMatrix"), Logic.lTMat) setMethod("Logic", signature(e1 = "lsCMatrix", e2 = "lsCMatrix"), function(e1, e2) { if(e1@uplo == e2@uplo) Logic.lCMat(e1, e2, isOR = .Generic == "|") else Logic.lCMat(e1, t(e2), isOR = .Generic == "|") }) setMethod("Logic", signature(e1 = "ltCMatrix", e2 = "ltCMatrix"), function(e1, e2) { if(e1@uplo == e2@uplo) { if(e1@diag == e2@diag) ## both "N" or both "U" (!) Logic.lCMat(e1, e2, isOR = .Generic == "|") else if(e1@diag == "U") Logic.lCMat(diagU2N(e1), e2, isOR = .Generic == "|") else ## e1@diag == "N" *and* e2@diag == "U" Logic.lCMat(e1, diagU2N(e2), isOR = .Generic == "|") } else { d <- dimCheck(e1, e2) ## differing triangle (upper <-> lower): ## all will be FALSE apart from diagonal as(.diag2tT(new("ldiMatrix", Dim=d, x = get(.Generic)(diag(e1), diag(e2))), uplo = e1@uplo, kind = "l"), "dtCMatrix") } }) ## Now the other "Ops" for the "lgT" and "lgC" cases: setMethod("Arith", signature(e1="lgCMatrix", e2="lgCMatrix"), function(e1, e2) callGeneric(as(e1, "dgCMatrix"), as(e2, "dgCMatrix"))) setMethod("Arith", signature(e1="lgTMatrix", e2="lgTMatrix"), function(e1, e2) callGeneric(as(e1, "dgTMatrix"), as(e2, "dgTMatrix"))) ## More generally: Arith: l* and n* via d* setMethod("Arith", signature(e1="lsparseMatrix", e2="Matrix"), function(e1, e2) callGeneric(as(e1, "dMatrix"), as(e2,"dMatrix"))) setMethod("Arith", signature(e1="Matrix", e2="lsparseMatrix"), function(e1, e2) callGeneric(as(e1, "dMatrix"), as(e2,"dMatrix"))) setMethod("Arith", signature(e1="nsparseMatrix", e2="Matrix"), function(e1, e2) callGeneric(as(e1, "dMatrix"), as(e2,"dMatrix"))) setMethod("Arith", signature(e1="Matrix", e2="nsparseMatrix"), function(e1, e2) callGeneric(as(e1, "dMatrix"), as(e2,"dMatrix"))) ## for(cl in c("numeric", "logical")) # "complex", "raw" : basically "replValue" for(Mcl in c("lMatrix", "nMatrix")) { setMethod("Arith", signature(e1=Mcl, e2=cl), function(e1, e2) callGeneric(as(e1, "dMatrix"), e2)) setMethod("Arith", signature(e1=cl, e2=Mcl), function(e1, e2) callGeneric(e1, as(e2,"dMatrix"))) } rm(cl, Mcl) ## FIXME: These are really too cheap: currently almost all go via dgC*() : ## setMethod("Compare", signature(e1="lgCMatrix", e2="lgCMatrix"), ## setMethod("Compare", signature(e1="lgTMatrix", e2="lgTMatrix"), ## setMethod("Compare", signature(e1="lsparseMatrix", e2="lsparseMatrix"), ## function(e1, e2) callGeneric(as(e1, "dgCMatrix"), as(e2, "dgCMatrix"))) ##. Have "Ops" below which only goes *conditionally* via Csparse ##. setMethod("Compare", signature(e1="lsparseMatrix", e2="lsparseMatrix"), ##. function(e1, e2) callGeneric(as(e1, "CsparseMatrix"), ##. as(e2, "CsparseMatrix"))) ## setMethod("Compare", signature(e1="lgTMatrix", e2="lgTMatrix"), ## coerce to Csparse ## function(e1, e2) callGeneric(as(e1, "dgCMatrix"), as(e2, "dgCMatrix"))) ###--- Sparse ... ---------- setMethod("Ops", signature(e1="lsparseMatrix", e2="lsparseMatrix"), function(e1,e2) callGeneric(as(e1, "CsparseMatrix"), as(e2, "CsparseMatrix"))) setMethod("Logic", signature(e1="lsparseMatrix", e2="ldenseMatrix"), function(e1,e2) callGeneric(as(e1, "generalMatrix"), as(e2, "sparseMatrix"))) setMethod("Logic", signature(e1="ldenseMatrix", e2="lsparseMatrix"), function(e1,e2) callGeneric(as(e1, "sparseMatrix"), as(e2, "generalMatrix"))) setMethod("Logic", signature(e1="lsparseMatrix", e2="lsparseMatrix"), function(e1,e2) { if(!is(e1,"generalMatrix")) callGeneric(as(as(e1, "generalMatrix"), "CsparseMatrix"), e2) else if(!is(e2,"generalMatrix")) callGeneric(e1, as(as(e2, "generalMatrix"), "CsparseMatrix")) else callGeneric(as(e1, "lgCMatrix"), as(e2, "lgCMatrix")) }) ## FIXME: also want (symmetric o symmetric) , (triangular o triangular) ## ----- setMethod("Arith", signature(e1 = "dsCMatrix", e2 = "dsCMatrix"), function(e1, e2) { Matrix.msg("suboptimal 'Arith' implementation of 'dsC* o dsC*'") forceSymmetric(callGeneric(as(e1, "dgCMatrix"), as(e2, "dgCMatrix"))) }) ##-------- originally from ./dgCMatrix.R -------------------- .Arith.Csparse <- function(e1, e2, Generic, class., triangular = FALSE, check.dimnames = TRUE) { ## Generic is one of "+", "-", "*", "^", "%%", "%/%", "/" ## triangular: TRUE iff e1,e2 are triangular _and_ e1@uplo == e2@uplo d <- dimCheck(e1, e2) dn <- dimNamesCheck(e1, e2, check = check.dimnames) if(triangular) { ## need these for the 'x' slots in any case if (e1@diag == "U") e1 <- .Call(Csparse_diagU2N, e1) if (e2@diag == "U") e2 <- .Call(Csparse_diagU2N, e2) ## slightly more efficient than non0.i() or non0ind(): ij1 <- .Call(compressed_non_0_ij, e1, isC=TRUE) ij2 <- .Call(compressed_non_0_ij, e2, isC=TRUE) newTMat <- function(i,j,x) new("dtTMatrix", Dim = d, Dimnames = dn, i = i, j = j, x = x, uplo = e1@uplo) dmat <- "dtrMatrix" } else { cld <- getClassDef(class.) ij1 <- non0ind(e1, cld) ij2 <- non0ind(e2, cld) newTMat <- function(i,j,x) new("dgTMatrix", Dim = d, Dimnames = dn, i = i, j = j, x = x) dmat <- "dgeMatrix" } switch(Generic, "+" = , "-" = { ## care for over-allocated 'x' slot: nc1 <- d[2] + 1L if((nz <- e1@p[nc1]) < length(e1@x)) e1@x <- e1@x[seq_len(nz)] if((nz <- e2@p[nc1]) < length(e2@x)) e2@x <- e2@x[seq_len(nz)] ## special "T" convention: repeated entries are *summed* .Call(Tsparse_to_Csparse, newTMat(i = c(ij1[,1], ij2[,1]), j = c(ij1[,2], ij2[,2]), x = if(Generic == "+") c(e1@x, e2@x) else c(e1@x, - e2@x)), triangular) }, "*" = { ## X * 0 == 0 * X == 0 --> keep common non-0 ii <- WhichintersectInd(ij1, ij2, di=d) ij <- ij1[ii[[1]], , drop = FALSE] .Call(Tsparse_to_Csparse, newTMat(i = ij[,1], j = ij[,2], x = e1@x[ii[[1]]] * e2@x[ii[[2]]]), triangular) }, "^" = { ii <- WhichintersectInd(ij1, ij2, di=d) ## 3 cases: ## 1) X^0 := 1 (even for X=0) ==> dense ## 2) 0^Y := 0 for Y != 0 ===== ## 3) x^y : ## FIXME: dgeM[cbind(i,j)] <- V is not yet possible ## nor dgeM[ i_vect ] <- V ## r <- as(e2, "dgeMatrix") ## ... r <- as(e2, "matrix") Yis0 <- is0(r) r[complementInd(ij1, dim=d)] <- 0 ## 2) r[1L + ij2[ii[[2]], , drop=FALSE]] <- e1@x[ii[[1]]] ^ e2@x[ii[[2]]] ## 3) r[Yis0] <- 1 ## 1) as(r, dmat) }, "%%" = , "%/%" = , "/" = ## 0 op 0 |-> NaN => dense get(Generic)(as(e1, dmat), e2) )# end{switch(..)} } setMethod("Arith", signature(e1 = "dgCMatrix", e2 = "dgCMatrix"), function(e1,e2) .Arith.Csparse(e1,e2, .Generic, class.= "dgCMatrix")) setMethod("Arith", signature(e1 = "dtCMatrix", e2 = "dtCMatrix"), function(e1, e2) { U1 <- e1@uplo isTri <- U1 == e2@uplo && .Generic != "^" # will the result definitely be triangular? if(isTri) { .Arith.Csparse(e1,e2, .Generic, class. = "dtCMatrix", triangular = TRUE) } else { ## lowerTri o upperTri: |--> "all 0" {often} -- FIXME? .Arith.Csparse(as(e1, "dgCMatrix"), as(e2, "dgCMatrix"), .Generic, class.= "dgCMatrix") } }) ## TODO : Consider going a level up, and do this for all "Ops" ## ## NB: For "dgCMatrix" have special method ==> this is for dsC*, lgC*, ... ## now also for Tsparse etc {*must* as method directly: "callGeneric()"} .Arith.CM.atom <- function(e1, e2) { if(length(e2) == 1) { ## e.g., Mat ^ a f0 <- callGeneric(0, e2) if(is0(f0)) { ## remain sparse, symm., tri.,... e1 <- as(e1, "dMatrix") if(!extends(cld <- getClassDef(class(e1)), "CsparseMatrix")) cld <- getClassDef(class(e1 <- as(e1, "CsparseMatrix"))) if(extends(cld, "triangularMatrix") && e1@diag == "U" && !all(1 == callGeneric(1, e2))) e1 <- .diagU2N(e1, cld) e1@x <- callGeneric(e1@x, e2) .empty.factors(e1) # TODO be much smarter and e.g. update U of an LU-factorization return(e1) } } ## all other (potentially non-sparse) cases: give up symm, tri,.. callGeneric(as(as(as(e1, "dMatrix"), "CsparseMatrix"), "dgCMatrix"), e2) } ## The same, e1 <-> e2 : .Arith.atom.CM <- function(e1, e2) { if(length(e1) == 1) { f0 <- callGeneric(e1, 0) if(is0(f0)) { e2 <- as(e2, "dMatrix") if(!extends(cld <- getClassDef(class(e2)), "CsparseMatrix")) cld <- getClassDef(class(e2 <- as(e2, "CsparseMatrix"))) if(extends(cld, "triangularMatrix") && e2@diag == "U" && !all(1 == callGeneric(e1, 1))) e2 <- .diagU2N(e2, cld) e2@x <- callGeneric(e1, e2@x) .empty.factors(e2) # TODO: much smarter, e.g. update U of an LU-factorization return(e2) } } callGeneric(e1, as(as(as(e2, "dMatrix"), "CsparseMatrix"), "dgCMatrix")) } setMethod("Arith", signature(e1 = "CsparseMatrix", e2 = "numeric"), .Arith.CM.atom) setMethod("Arith", signature(e1 = "numeric", e2 = "CsparseMatrix"), .Arith.atom.CM) ##' compute indices for recycling of length 'len' to match sparseMatrix 'spM' .Ops.recycle.ind <- function(spM, len) { n <- prod(d <- dim(spM)) if(n && n < len) stop("vector too long in Matrix - vector operation") if(n %% len != 0) ## identical warning as in main/arithmetic.c warning("longer object length\n\tis not a multiple of shorter object length") ## TODO(speedup!): construction of [1L + in0 %%len] via one .Call() in0 <- .Call(m_encodeInd, .Call(compressed_non_0_ij, spM, TRUE), d, FALSE, FALSE) 1L + in0 %% len } A.M.n <- function(e1, e2) { if((l2 <- length(e2)) == 0) # return 0-vector of e1's kind, as matrix()+<0> return(if(length(e1)) vector(.type.kind[.M.kind(e1)]) else e1) is0f <- is0(f0 <- callGeneric(0, e2)) # if(all(is0f)) { ## result keeps sparseness structure of e1 if(l2 > 1) { # "recycle" e2 "carefully" e2 <- e2[.Ops.recycle.ind(e1, len = l2)] } e1@x <- callGeneric(e1@x, e2) .empty.factors(e1) # TODO: possibly rather *update* LU e1 } else if(mean(is0f) > 7/8) { ## remain sparse ['7/8' is *somewhat* arbitrary] if(l2 > 1) ## as not all callGeneric(0, e2) is 0, e2 is typically sparse callGeneric(e1, as(e2, "sparseVector")) else { ## l2 == 1: e2 is "scalar" e1@x <- callGeneric(e1@x, e2) .empty.factors(e1) e1 } } else { ## non-sparse, since '0 o e2' is not (all) 0 r <- as(e1, "matrix") if(l2 == 1) { r[] <- f0 r[non0ind(e1, getClassDef("dgCMatrix")) + 1L] <- callGeneric(e1@x, e2) ..2dge(r) } else { as(callGeneric(r, e2), "dgeMatrix") } } } setMethod("Arith", signature(e1 = "dgCMatrix", e2 = "numeric"), A.M.n) setMethod("Arith", signature(e1 = "dgCMatrix", e2 = "logical"), A.M.n) ## coercing to "general*" / "dgC*" would e.g. lose symmetry of 'S * 3' setMethod("Arith", signature(e1 = "dsparseMatrix", e2 = "numeric"), .Arith.CM.atom) setMethod("Arith", signature(e1 = "dsparseMatrix", e2 = "logical"), .Arith.CM.atom) A.n.M <- function(e1, e2) { if((l1 <- length(e1)) == 0) # return 0-vector of e2's kind, as <0> + matrix() return(if(length(e2)) vector(.type.kind[.M.kind(e2)]) else e2) is0f <- is0(f0 <- callGeneric(e1, 0)) if(all(is0f)) { ## result keeps sparseness structure of e2 if(l1 > 1) { # "recycle" e1 "carefully" e1 <- e1[.Ops.recycle.ind(e2, len = l1)] } e2@x <- callGeneric(e1, e2@x) .empty.factors(e2) e2 } else if(mean(is0f) > 7/8) { ## remain sparse ['7/8' is *somewhat* arbitrar if(l1 > 1) ## as not all callGeneric(e1, 0) is 0, e1 is typically sparse callGeneric(as(e1, "sparseVector"), e2) else { ## l1 == 1: e1 is "scalar" e2@x <- callGeneric(e1, e2@x) .empty.factors(e2) e2 } } else { ## non-sparse, since '0 o e2' is not (all) 0 r <- as(e2, "matrix") if(l1 == 1) { r[] <- f0 r[non0ind(e2, getClassDef("dgCMatrix")) + 1L] <- callGeneric(e1, e2@x) ..2dge(r) } else { as(callGeneric(e1, r), "dgeMatrix") } } } setMethod("Arith", signature(e1 = "numeric", e2 = "dgCMatrix"), A.n.M) setMethod("Arith", signature(e1 = "logical", e2 = "dgCMatrix"), A.n.M) ## coercing to "general*" / "dgC*" would e.g. lose symmetry of '3 * S' setMethod("Arith", signature(e1 = "numeric", e2 = "dsparseMatrix"), .Arith.atom.CM) setMethod("Arith", signature(e1 = "logical", e2 = "dsparseMatrix"), .Arith.atom.CM) rm(A.M.n, A.n.M) ##-------- originally from ./Csparse.R -------------------- setMethod("Arith", signature(e1 = "CsparseMatrix", e2 = "CsparseMatrix"), function(e1, e2) { ## go via "symmetric" if both are symmetric, etc... s1 <- .M.shape(e1, getClassDef(class(e1))) s2 <- .M.shape(e2, getClassDef(class(e2))) viaCl <- paste0("d", if(s1 == s2) s1 else "g", "CMatrix") callGeneric(as(as(e1, "dMatrix"), viaCl), as(as(e2, "dMatrix"), viaCl)) }) setMethod("Logic", signature(e1 = "CsparseMatrix", e2 = "CsparseMatrix"), function(e1, e2) { ## go via "symmetric" if both are symmetric, etc... s1 <- .M.shape(e1, getClassDef(class(e1))) s2 <- .M.shape(e2, getClassDef(class(e2))) viaCl <- paste0("l", if(s1 == s2) s1 else "g", "CMatrix") callGeneric(as(as(e1, "lMatrix"), viaCl), as(as(e2, "lMatrix"), viaCl)) }) setMethod("Compare", signature(e1 = "CsparseMatrix", e2 = "CsparseMatrix"), function(e1, e2) { d <- dimCheck(e1,e2) ## How do the "0" or "FALSE" entries compare? ## Depends if we have an "EQuality RELation" or not: EQrel <- switch(.Generic, "==" =, "<=" =, ">=" = TRUE, "!=" =, "<" =, ">" = FALSE) if(EQrel) { ## The (0 op 0) or (FALSE op FALSE) comparison gives TRUE ## -> result becomes *dense*; the following may be suboptimal return( callGeneric(as(e1, "denseMatrix"), as(e2, "denseMatrix"))) } ## else: INequality: 0 op 0 gives FALSE ---> remain sparse! cD1 <- getClassDef(class(e1)) cD2 <- getClassDef(class(e2)) Matrix.msg(sprintf("Compare -- \"%s\" %s \"%s\" :\n", cD1@className, .Generic, cD2@className), .M.level = 2) ## NB non-diagonalMatrix := Union{ general, symmetric, triangular} gen1 <- extends(cD1, "generalMatrix") gen2 <- extends(cD2, "generalMatrix") sym1 <- !gen1 && extends(cD1, "symmetricMatrix") sym2 <- !gen2 && extends(cD2, "symmetricMatrix") tri1 <- !gen1 && !sym1 tri2 <- !gen2 && !sym2 G <- gen1 && gen2 S <- sym1 && sym2 && e1@uplo == e2@uplo T <- tri1 && tri2 && e1@uplo == e2@uplo if(T && e1@diag != e2@diag) { ## one is "U" the other "N" if(e1@diag == "U") e1 <- diagU2N(e1) else ## (e2@diag == "U" e2 <- diagU2N(e2) shape <- "t" } else if(!G && !S && !T) { ## e.g. one symmetric, one general ## coerce to generalMatrix and go : if(!gen1) e1 <- as(e1, "generalMatrix", strict = FALSE) if(!gen2) e2 <- as(e2, "generalMatrix", strict = FALSE) shape <- "g" } else { shape <- if(T) "t" else if(S) "s" else "g" } dn <- dimNamesCheck(e1, e2) ## <- FIXME: for 'S'; allow staying ## the result object: newC <- sub("^.", "l", MatrixClass(class(e1))) ## FIXME: "n" result when e1 & e2 are "n", or even whenever possible r <- new(newC) e1is.n <- extends(cD1, "nMatrix") e2is.n <- extends(cD2, "nMatrix") ## Easy case: identical sparsity pattern if(identical(e1@i, e2@i) && identical(e1@p, e2@p)) { if(e1is.n) { if(e2is.n) ## non-equality of identical pattern matrices: all FALSE r@p <- rep.int(0L, d[2]+1L) # and r@i, r@x remain empty else { ## e1 pattern, e2@x rx <- callGeneric(TRUE, e2@x) if(allFalse(rx)) r@p <- rep.int(0L, d[2]+1L) # and r@i, r@x remain empty else { r@x <- rx r@i <- e2@i r@p <- e2@p } } } else if(e2is.n) { ## e1@x, e2 pattern rx <- callGeneric(e1@x, TRUE) if(allFalse(rx)) r@p <- rep.int(0L, d[2]+1L) # and r@i, r@x remain empty else { r@x <- rx r@i <- e1@i r@p <- e1@p } } else { # both have 'x' slot r@x <- callGeneric(e1@x, e2@x) ## and all others are '0 op 0' which give FALSE r@i <- e1@i r@p <- e1@p } r@Dim <- d r@Dimnames <- dn r } else { ## now the 'x' slots ``match'' insofar as they are for the ## same "space" (triangle for tri* and symm*; else rectangle) ## not non0ind() which gives more; ## want only those which correspond to 'x' slot ij1 <- .Call(compressed_non_0_ij, e1, TRUE) ij2 <- .Call(compressed_non_0_ij, e2, TRUE) ii <- WhichintersectInd(ij1, ij2, di=d) I1 <- ii[[1]]; has1 <- length(I1) > 0 I2 <- ii[[2]]; has2 <- length(I2) > 0 ## potentially could be faster for 'nsparse' but this is simple: e1x <- if(e1is.n) rep.int(1L, length(e1@i)) else e1@x e2x <- if(e2is.n) rep.int(1L, length(e2@i)) else e2@x ## 1) common x <- callGeneric(e1x[I1], e2x[I2]) ## 2) "e1 o 0": x2 <- callGeneric(if(has1) e1x[- I1] else e1x, 0) ## 3) "0 o e2": x3 <- callGeneric(0, if(has2) e2x[- I2] else e2x) i <- c(ij1[I1, 1], if(has1) ij1[-I1, 1] else ij1[, 1], if(has2) ij2[-I2, 1] else ij2[, 1]) j <- c(ij1[I1, 2], if(has1) ij1[-I1, 2] else ij1[, 2], if(has2) ij2[-I2, 2] else ij2[, 2]) x <- c(x, x2, x3) if(any(i0x <- is0(x))) { # drop 'FALSE's n0 <- !i0x i <- i[n0] j <- j[n0] x <- x[n0] } .Call(Tsparse_to_Csparse, if(e1is.n && e2is.n) new(paste0("n",shape,"TMatrix"), Dim = d, Dimnames = dn, i = i, j = j) else new(paste0("l",shape,"TMatrix"), Dim = d, Dimnames = dn, i = i, j = j, x = x), FALSE) } }) ##-------- originally from ./sparseMatrix.R -------------------- ## "Arith" short cuts / exceptions setMethod("-", signature(e1 = "sparseMatrix", e2 = "missing"), function(e1, e2) { e1 <- diagU2N(e1) e1@x <- -e1@x .empty.factors(e1) e1 }) ## with the following exceptions: setMethod("-", signature(e1 = "nsparseMatrix", e2 = "missing"), function(e1,e2) callGeneric(as(as(as(e1, "CsparseMatrix"), "dMatrix"), "dgCMatrix"))) setMethod("-", signature(e1 = "pMatrix", e2 = "missing"), function(e1,e2) callGeneric(as(e1, "ngTMatrix"))) ## Group method "Arith" ## have CsparseMatrix methods above ## which may preserve "symmetric", "triangular" -- simply defer to those: setMethod("Ops", signature(e1 = "sparseMatrix", e2 = "nsparseMatrix"), function(e1, e2) callGeneric(as(e1, "CsparseMatrix"), as(e2, "lsparseMatrix"))) setMethod("Ops", signature(e1 = "nsparseMatrix", e2 = "sparseMatrix"), function(e1, e2) callGeneric(as(e1, "lsparseMatrix"), as(e2, "CsparseMatrix"))) ## these were 'Arith', now generalized: if(FALSE) { ## just shifts the ambiguity warnings .. ## o more complicated - against PITA disambiguation warnings: setMethod("Ops", signature(e1 = "TsparseMatrix", e2 = "TsparseMatrix"), function(e1, e2) callGeneric(as(e1, "CsparseMatrix"), as(e2, "CsparseMatrix"))) setMethod("Ops", signature(e1 = "TsparseMatrix", e2 = "CsparseMatrix"), function(e1, e2) callGeneric(as(e1, "CsparseMatrix"), e2)) setMethod("Ops", signature(e1 = "CsparseMatrix", e2 = "TsparseMatrix"), function(e1, e2) callGeneric(e1, as(e2, "CsparseMatrix"))) } ## catch the rest: Rsparse* and T* o R* setMethod("Ops", signature(e1 = "sparseMatrix", e2 = "sparseMatrix"), function(e1, e2) callGeneric(as(e1, "CsparseMatrix"), as(e2, "CsparseMatrix"))) setMethod("Ops", signature(e1 = "sparseMatrix", e2 = "numeric"), function(e1, e2) callGeneric(as(e1, "CsparseMatrix"), e2)) setMethod("Ops", signature(e1 = "numeric", e2 = "sparseMatrix"), function(e1, e2) callGeneric(e1, as(e2, "CsparseMatrix"))) ## setMethod("Compare", signature(e1 = "sparseMatrix", e2 = "sparseMatrix"), ## function(e1, e2) callGeneric(as(e1, "CsparseMatrix"), ## as(e2, "CsparseMatrix"))) ###-------- sparseVector ------------- ###-------- ============ ------------- ## Catch all remaining setMethod("Ops", signature(e1 = "sparseVector", e2 = "ANY"), function(e1, e2) .bail.out.2(.Generic, class(e1), class(e2))) setMethod("Ops", signature(e1 = "ANY", e2 = "sparseVector"), function(e1, e2) .bail.out.2(.Generic, class(e1), class(e2))) ## 1) spVec o (sp)Vec : ------------- ## FIXME: ## 2. o should also happen directly and ## |-> sparse for o = {'*', "/", '&&', '==', ... setMethod("Ops", signature(e1 = "sparseVector", e2 = "atomicVector"), function(e1, e2) { if(length(e2) == 1) { ## scalar ------ special case - "fast" if(all0(callGeneric(FALSE, e2))) { # result remains sparse if(is(e1, "nsparseVector")) { # no 'x' slot, i.e. all TRUE r <- callGeneric(TRUE, e2) if(is.logical(r)) { if(isTRUE(all(r))) # (could be NA) e1 # result unchanged else newSpVec("lsparseVector", x = r, e1) } else { newSpVec(paste0(if(is.integer(r)) "i" else "d", "sparseVector"), x = r, e1) } } else { # has x slot r <- callGeneric(e1@x, e2) if(identical(class(r), class(e1@x))) { e1@x <- r e1 } else { newSpVec(paste0(.V.kind(r), "sparseVector"), x = r, e1) } } } else ## non-sparse result callGeneric(sp2vec(e1), e2) } else ## e2 is not scalar callGeneric(e1, as(e2, "sparseVector")) }) setMethod("Ops", signature(e1 = "atomicVector", e2 = "sparseVector"), function(e1, e2) { if(length(e1) == 1) { ## scalar ------ special case - "fast" if(all0(callGeneric(e1, FALSE))) { # result remains sparse if(is(e2, "nsparseVector")) { # no 'x' slot, i.e. all TRUE r <- callGeneric(e1, TRUE) if(is.logical(r)) { if(isTRUE(all(r))) # (could be NA) e2 # result unchanged else newSpVec("lsparseVector", x = r, e2) } else { newSpVec(paste0(if(is.integer(r)) "i" else "d", "sparseVector"), x = r, e2) } } else { # has x slot r <- callGeneric(e1, e2@x) if(identical(class(r), class(e2@x))) { e2@x <- r e2 } else { newSpVec(paste0(.V.kind(r), "sparseVector"), x = r, e2) } } } else ## non-sparse result callGeneric(e1, sp2vec(e2)) } else ## e1 is not scalar callGeneric(as(e1, "sparseVector"), e2) }) Ops.spV.spV <- function(e1, e2) { n1 <- e1@length n2 <- e2@length if(!n1 || !n2) ## return 0-length : return(if(is.na(match(.Generic, .ArithGenerics))) logical() else numeric()) ## else n1, n2 >= 1 : if(n1 != n2) { if(n1 < n2) { n <- n1 ; N <- n2 } else { n <- n2 ; N <- n1 } if(n == 1L) { # simple case, do not really recycle if(n1 < n2) return(callGeneric(sp2vec(e1), e2)) else return(callGeneric(e1, sp2vec(e2))) } ## else : 2 <= n < N if(N %% n != 0) warning("longer object length is not a multiple of shorter object length") ## recycle the shorter one if(n1 < n2) { e1 <- rep(e1, length = N) } else { e2 <- rep(e2, length = N) } } else { ## n1 == n2 N <- n1 } ## ---- e1 & e2 now are both of length 'N' ---- ## First check the (0 o 0) result is1n <- extends(class(e1), "nsparseVector") is2n <- extends(class(e2), "nsparseVector") r00 <- callGeneric(if(is1n) FALSE else as0(e1@x), if(is2n) FALSE else as0(e2@x)) if(is0(r00)) { ## -> sparseVector e1x <- if(is1n) TRUE else e1@x e2x <- if(is2n) TRUE else e2@x sp <- .setparts(e1@i, e2@i) ## Idea: Modify 'e2' and return it : new.x <- c(callGeneric(e1x[sp[["ix.only"]]], 0), # e1-only callGeneric(0, e2x[sp[["iy.only"]]]), # e2-only callGeneric(e1x[sp[["my"]]], # common to both e2x[sp[["mx"]]])) i. <- c(sp[["x.only"]], sp[["y.only"]], sp[["int"]]) cl2x <- typeof(e2x) ## atomic "class"es - can use in is(), as(), too: if(!is2n && is(new.x, cl2x)) { i. <- sort.int(i., method = "quick", index.return=TRUE) e2@x <- as(new.x, cl2x)[i.$ix] e2@i <- i.$x e2 } else { newSpV(paste0(.kind.type[typeof(new.x)],"sparseVector"), x = new.x, i = i., length = e2@length) } } else { ## 0 o 0 is NOT in {0 , FALSE} --> "dense" result callGeneric(sp2vec(e1), sp2vec(e2)) } } ## {Ops.spV.spV} ## try to use it in all cases setMethod("Ops", signature(e1 = "sparseVector", e2 = "sparseVector"), Ops.spV.spV) ## was function(e1, e2) .bail.out.2(.Generic, class(e1), class(e2))) setMethod("Arith", signature(e1 = "sparseVector", e2 = "sparseVector"), function(e1, e2) callGeneric(as(e1, "dsparseVector"), as(e2, "dsparseVector"))) setMethod("Arith", signature(e1 = "dsparseVector", e2 = "dsparseVector"), Ops.spV.spV) ## "Arith" exception (shortcut) setMethod("-", signature(e1 = "dsparseVector", e2 = "missing"), function(e1) { e1@x <- -e1@x ; e1 }) setMethod("Logic", signature(e1 = "sparseVector", e2 = "sparseVector"), ## FIXME: this is suboptimal for "nsparseVector" !! function(e1, e2) callGeneric(as(e1, "lsparseVector"), as(e2, "lsparseVector"))) setMethod("Logic", signature(e1 = "lsparseVector", e2 = "lsparseVector"), Ops.spV.spV) ## "nsparse" have no 'x' slot --> version of Ops.spV.spV.. ## -------- but also for (nsp.. o lsp..) etc, when lsp... has no NA if(FALSE) ### FIXME setMethod("Logic", signature(e1 = "nsparseVector", e2 = "nsparseVector"), function(e1, e2) { .bail.out.2(.Generic, class(e1), class(e2)) }) ## 2) spVec o [Mm]atrix : ------------- Ops.M.spV <- function(e1, e2) { d <- e1@Dim n1 <- prod(d) n2 <- e2@length if(n1 != n2) { if(n1 && n1 < n2) { # 0-extent matrix + vector is fine stop(sprintf( "dim [product %d] do not match the length of object [%d]", n1, n2)) } ## else n1 > n2 [vector] N <- n1 if(n2 == 1) ## simple case, do not really recycle return(callGeneric(e1, sp2vec(e2))) if(N %% n2 != 0) warning("longer object length is not a multiple of shorter object length") ## else : 2 <= n < N --- recycle the vector e2 <- rep(e2, length = N) } else { ## n1 == n2 N <- n1 } ## ---- e1 & e2 now are both of length 'N' ---- dim(e2) <- d #-> sparseMatrix (!) callGeneric(e1, e2) }## {Ops.M.spV} Ops.spV.M <- function(e1, e2) { n1 <- e1@length d <- e2@Dim n2 <- prod(d) if(n2 != n1) { if(n2 && n2 < n1) { # vector + 0-extent matrix is fine stop(sprintf( "dim [product %d] do not match the length of object [%d]", n2, n1)) } ## else n2 > n1 [vector] N <- n2 if(n1 == 1) ## simple case, do not really recycle return(callGeneric(sp2vec(e1), e2)) if(N %% n1 != 0) warning("longer object length is not a multiple of shorter object length") ## else : 2 <= n < N --- recycle the vector e1 <- rep(e1, length = N) } else { ## n2 == n1 N <- n2 } ## ---- e2 & e1 now are both of length 'N' ---- dim(e1) <- d #-> sparseMatrix (!) callGeneric(e1, e2) }## {Ops.spV.M} ## try to use it in all cases setMethod("Ops", signature(e1 = "Matrix", e2 = "sparseVector"), Ops.M.spV) setMethod("Ops", signature(e1 = "sparseVector", e2 = "Matrix"), Ops.spV.M) Matrix/R/not.R0000644000176200001440000000671112470400545012650 0ustar liggesusers#### --- All method definitions for "!" (not) --- ## Divert everything to "lMatrix" and its subclasses : setMethod("!", "Matrix", function(x) !as(x, "lMatrix")) ## -- diag --- setMethod("!", "ldiMatrix", function(x) { r <- copyClass(x, "lsyMatrix", c("Dim","Dimnames")) n <- x@Dim[1] if (n > 0) { ## off-diagonal: assign all and then reassign diagonals: rx <- rep.int(TRUE, n * n) ## diagonal entries: rx[1L + 0:(n - 1L) * (n + 1L)] <- { if(x@diag == "N") !x@x else FALSE ## "U" } r@x <- rx } r }) ## -- lsparse -- setMethod("!", "lsparseMatrix", ## turns FALSE to TRUE --> dense matrix function(x) !as(x, "denseMatrix"))# was "lgeMatrix" ## Use "Matrix" method !as(. , "lMatrix") ## setMethod("!", "nsparseMatrix", ## ## turns FALSE to TRUE --> dense matrix ## function(x) !as(x, "ngeMatrix")) ## -- ldense --- setMethod("!", "ltrMatrix", function(x) { x@x <- !x@x ## And now fill one triangle with '!FALSE' results : ## TODO: the following should be .Call using ## a variation of make_array_triangular: r <- as(x, "lgeMatrix") n <- x@Dim[1] if(x@diag == "U") r@x[indDiag(n)] <- FALSE ## result has diagonal all FALSE r@x[indTri(n, upper=x@uplo != "U")] <- TRUE r }) setMethod("!", "ltpMatrix", function(x) !as(x, "ltrMatrix")) ## for the other ldense* ones setMethod("!", "lgeMatrix", function(x) { x@x <- !x@x ; x }) setMethod("!", "ldenseMatrix", function(x) { if(is(x, "symmetricMatrix")) { # lsy | lsp x@x <- !x@x x } else ## triangular are dealt with above already : "general" here: !as(x, "lgeMatrix") }) ## -- ndense --- setMethod("!", "ntrMatrix", function(x) { x@x <- !x@x ## And now we must fill one triangle with '!FALSE' results : ## TODO: the following should be .Call using ## a variation of make_array_triangular: r <- as(x, "ngeMatrix") n <- x@Dim[1] coli <- rep(1:n, each=n) rowi <- rep(1:n, n) Udiag <- x@diag == "U" log.i <- if(x@uplo == "U") { if(Udiag) rowi >= coli else rowi > coli } else { if(Udiag) rowi <= coli else rowi < coli } r@x[log.i] <- TRUE r }) setMethod("!", "ntpMatrix", function(x) !as(x, "ntrMatrix")) ## for the other ldense* ones setMethod("!", "ngeMatrix", function(x) { x@x <- !x@x ; x }) setMethod("!", "ndenseMatrix", function(x) { if(is(x, "symmetricMatrix")) { # lsy | lsp x@x <- !x@x x } else ## triangular are dealt with above already : "general" here: !as(x, "ngeMatrix") }) ### ---- sparseVector ----- setMethod("!", "sparseVector", function(x) { n <- x@length if(2 * length(x@i) <= n) !sp2vec(x) else { ## sparse result ii <- seq_len(n)[-x@i] if((has.x <- !is(x, "nsparseVector"))) { xx <- rep.int(TRUE, length(ii)) if((.na <- any(x.na <- is.na(x@x))) | (.fa <- any(x.f <- !x.na & !x@x))) { ## deal with 'FALSE' and 'NA' in x slot if(.na) { ii <- c(ii, x@i[x.na]) xx <- c(xx, x@x[x.na]) } if(.fa) { ## any(x.f) x.f <- x.f & !x.na ii <- c(ii, x@i[x.f]) xx <- c(xx, rep.int(TRUE, sum(x.f))) } ## sort increasing in index: i.s <- sort.list(ii) ii <- ii[i.s] xx <- xx[i.s] } } if(has.x) newSpV("lsparseVector", x = xx, i = ii, length = n) else new("nsparseVector", i = ii, length = n) } }) Matrix/R/Auxiliaries.R0000644000176200001440000015572414147653617014355 0ustar liggesusers#### "Namespace private" Auxiliaries such as method functions #### (called from more than one place --> need to be defined early) .Matrix.avoiding.as.matrix <- FALSE # (always on CRAN -- have documented it since 2015) ## NB: sync with ../NAMESPACE ## Need to consider NAs ; "== 0" even works for logical & complex: ## Note that "!x" is faster than "x == 0", but does not (yet!) work for complex ## if we did these in C, would gain a factor 2 (or so): is0 <- function(x) !is.na(x) & x == 0 isN0 <- function(x) is.na(x) | x != 0 is1 <- function(x) !is.na(x) & x # also == "isTRUE componentwise" ## ##allFalse <- function(x) !any(x) && !any(is.na(x))## ~= all0, but allFalse(NULL) = TRUE w/warning ##all0 <- function(x) !any(is.na(x)) && all(!x) ## ~= allFalse allFalse <- function(x) if(is.atomic(x)) .Call(R_all0, x) else !any(x) && !any(is.na(x)) all0 <- function(x) if(is.atomic(x)) .Call(R_all0, x) else all(!x) && !any(is.na(x)) ##anyFalse <- function(x) isTRUE(any(!x)) ## ~= any0 ## any0 <- function(x) isTRUE(any(x == 0)) ## ~= anyFalse anyFalse <- any0 <- function(x) if(is.atomic(x)) .Call(R_any0, x) else isTRUE(any(!x)) ## These work "identically" for 1 ('==' TRUE) and 0 ('==' FALSE) ## (but give a warning for "double" 1 or 0) ## TODO: C versions of these would be faster allTrue <- function(x) all(x) && !anyNA(x) ## Note that mode() = "numeric" -- as0(), as1() return "double" ## which is good *AS LONG AS* we do not really have i..Matrix integer matrices as1 <- function(x, mod=mode(x)) switch(mod, "integer"= 1L, "double"=, "numeric"= 1, "logical"= TRUE, "complex"= 1+0i, stop(gettextf("invalid 'mod': %s", mod), domain = NA)) as0 <- function(x, mod=mode(x)) switch(mod, "integer"= 0L, "double"=, "numeric"= 0, "logical"= FALSE, "complex"= 0+0i, stop(gettextf("invalid 'mod': %s", mod), domain = NA)) ##' equivalent to extends(cl, classes[1]) || extends(cl, classes[2]) || .... extends1of <- function(class, classes, ...) { if(is.character(class)) class <- getClassDef(class[[1L]]) for(c2 in classes) if(extends(class, c2, ...)) return(TRUE) ## otherwise return FALSE } ##' Should the matrix/Matrix x or a combination of x and y be treated as 'sparse' ? ## sparseDefault <- function(x, y=NULL) { ## if(is.null(y)) ## prod(dim(x)) > 2*sum(isN0(as(x, "matrix"))) ## else ## nrow / ncol ... differentiate this would be for rbind / cbind --> ./bind2.R ## (nnzero(x) + nnzero(y)) * 2 < (nrow(x)+nrow(y)) * nc ## } sparseDefault <- function(x) prod(dim(x)) > 2*sum(isN0(as(x, "matrix"))) ## NB: .fixupDimnames() needs to be defined in ./AllClass.R .M.DN <- function(x) dimnames(x) %||% list(NULL,NULL) .has.DN <- ## has non-trivial Dimnames slot? function(x) !identical(list(NULL,NULL), x@Dimnames) ## This is exported now ( -> ../man/is.null.DN.Rd ): is.null.DN <- function(dn) { is.null(dn) || { if(!is.null(names(dn))) names(dn) <- NULL ch0 <- character(0) identical(dn, list(NULL,NULL)) || identical(dn, list(ch0, NULL)) || identical(dn, list(NULL, ch0)) || identical(dn, list(ch0, ch0)) } } ##' return 'x' unless it is NULL where you'd use 'orElse' `%||%` <- function(x, orElse) if(!is.null(x)) x else orElse ##' not %in% : `%nin%` <- function (x, table) is.na(match(x, table)) nonTRUEoption <- function(ch) is.null(v <- getOption(ch)) || !isTRUE(v) ##' @title Check identical(i, 0:n) {or identical(i, 1:n) when Ostart is false} ##' @param i an integer vector, to be compared with 0:n or 1:n ##' @param n an integer number ##' @param Ostart logical indicating if comparison with 0:n or 1:n should be made ##' @return TRUE or FALSE ##' @author Martin Maechler isSeq <- function(i, n, Ostart = TRUE) { ## FIXME: Port to C, use simple .Call() which is much faster notably in FALSE cases ## and then *export* (and hence document) identical(i, if(Ostart) 0L:n else seq_len(n)) } .bail.out.1 <- function(fun, cl) { stop(gettextf( 'not-yet-implemented method for %s(<%s>).\n ->> Ask the package authors to implement the missing feature.', fun, cl[1L]), call. = FALSE, domain=NA) } .bail.out.2 <- function(fun, cl1, cl2) { stop(gettextf( 'not-yet-implemented method for %s(<%s>, <%s>).\n ->> Ask the package authors to implement the missing feature.', fun, cl1[1L], cl2[1L]), call. = FALSE, domain=NA) } Matrix.msg <- function(..., .M.level = 1) { if(!is.null(v <- getOption("Matrix.verbose")) && v >= .M.level) message(...) } ## not yet used; see also msg.and.solve.dgC.lu() in ./dsCMatrix.R Matrix.msg12 <- function(m1, m2, ...) { if(!is.null(v <- getOption("Matrix.verbose")) && v >= 1) message(if(v >= 2) m2 else m1, ...) } ## TODO: faster via C, either R's R_data_class() [which needs to become API !] ## or even direct getAttrib(x, R_ClassSymbol); .. ##' class - single string, no "package" attribute,.. .class0 <- function(x) as.vector(class(x)) ## we can set this to FALSE and possibly measure speedup: .copyClass.check <- TRUE ## This should be done in C and be exported by 'methods': [FIXME - ask JMC ] copyClass <- function(x, newCl, sNames = intersect(slotNames(newCl), slotNames(x)), check = .copyClass.check) { r <- new(newCl) ## Equivalent of ## for(n in sNames) slot(r, n, check=check) <- slot(x, n) : if(check) for(n in sNames) slot(r, n) <- slot(x, n) else for(n in sNames) # don't check, be fast ## .Call("R_set_slot", r, n, slot(x,n), PACKAGE = "methods") ## "ugly", but not using .Call(*, "methods") attr(r, n) <- attr(x, n) r } ##' Return the (maybe super-)class of class 'cl' from "Matrix", returning character(0) if there is none. ##' ##' @title The Matrix (Super-) Class of a Class ##' @param cl string, class name ##' @param cld its class definition ##' @param ...Matrix if TRUE, the result must be of pattern "[dlniz]..Matrix" ##' where the first letter "[dlniz]" denotes the content kind. ##' @param dropVirtual ##' @param ... other arguments are passed to .selectSuperClasses() ##' @return a character string ##' @author Martin Maechler, Date: 24 Mar 2009 MatrixClass <- function(cl, cld = getClassDef(cl), ...Matrix = TRUE, dropVirtual = TRUE, ...) { ## stopifnot(is.character(cl)) ## Hmm, packageSlot(cl) *can* be misleading --> use cld@package first: if(is.null(pkg <- cld@package)) { if(is.null(pkg <- packageSlot(cl))) return(character()) ## else we use 'pkg' } if(identical(pkg, "Matrix") && (!...Matrix || (cl != "indMatrix" && identical(1L, grep("^[dlniz]..Matrix$", cl))))) cl else { ## possibly recursively r <- .selectSuperClasses(cld@contains, dropVirtual = dropVirtual, namesOnly = TRUE, ...) if(length(r)) { while(!length(r1 <- Recall(r[1], ...Matrix = ...Matrix, dropVirtual = dropVirtual)) && length(r) > 1) r <- r[-1] r1 } else r } } attrSlotNames <- function(m, factors = TRUE) { ## slotnames of Matrix objects which are *not* directly content related sn <- slotNames(m); sn[sn %nin% c("x","i","j","p", if(!factors) "factors")] } ##' @param m ##' @return the slots of 'm' which are "attributes" of some kind. attrSlots <- function(m, factors = TRUE) sapply(attrSlotNames(m, factors=factors), function(sn) slot(m, sn), simplify = FALSE) ##' @return { NULL | TRUE | character | list(.) } attr.all_Mat <- function(target, current, check.attributes = TRUE, factorsCheck = FALSE, ...) { msg <- if(check.attributes) all.equal(attrSlots(target, factors=factorsCheck), attrSlots(current, factors=factorsCheck), check.attributes = TRUE, ...) ## else NULL if(!identical((c1 <- class(target)), (c2 <- class(current)))) ## list(): so we can easily check for this list(c(if(!isTRUE(msg)) msg, paste0("class(target) is ", c1, ", current is ", c2))) else msg } ##' @return combination for all.equal() functions in ./Matrix.R & ./sparseMatrix.R .a.e.comb <- function(msg, r) { if((is.null(msg) || isTRUE(msg)) & (r.ok <- isTRUE(r))) TRUE else c(if(!isTRUE(msg)) msg, if(!r.ok) r) } ## chol() via "dpoMatrix" ## This will only be called for *dense* matrices cholMat <- function(x, pivot = FALSE, ...) { packed <- .isPacked(x) nmCh <- if(packed) "pCholesky" else "Cholesky" if(!is.null(ch <- x@factors[[nmCh]])) return(ch) ## use the cache px <- as(x, if(packed) "dppMatrix" else "dpoMatrix") if (isTRUE(validObject(px, test=TRUE))) ## 'pivot' is not used for dpoMatrix .set.factors(x, nmCh, chol(px, pivot, ...)) else stop("'x' is not positive definite -- chol() undefined.") } invPerm.R <- function(p) { p[p] <- seq_along(p) ; p } ## how much faster would this be in C? -- less than a factor of two? invPerm <- function(p, zero.p = FALSE, zero.res = FALSE) .Call(inv_permutation, p, zero.p, zero.res) ## sign( ) == determinant( ) signPerm <- function(p) { ## Purpose: sign() via the cycles ## ---------------------------------------------------------------------- ## Arguments: a permutation of 1:n ## ---------------------------------------------------------------------- ## Author: Peter Dalgaard, 14 Apr 2008 // speedup: Martin Maechler 2008-04-16 n <- length(p) x <- integer(n) ii <- seq_len(n) for (i in ii) { z <- ii[!x][1] # index of first unmarked x[] entry if (is.na(z)) break repeat { ## mark x[] <- i for those in i-th cycle x[z] <- i z <- p[z] if (x[z]) break } } ## Now, table(x) gives the cycle lengths, ## where split(seq_len(n), x) would give the cycles list ## tabulate(x, i - 1L) is quite a bit faster than the equivalent ## table(x) clen <- tabulate(x, i - 1L) ## The sign is -1 (<==> permutation is odd) iff ## the cycle factorization contains an odd number of even-length cycles: 1L - (sum(clen %% 2 == 0) %% 2L)*2L } detSparseLU <- function(x, logarithm = TRUE, ...) { ## Purpose: Compute determinant() from lu.x = lu(x) ## ---------------------------------------------------------------------- ## Author: Martin Maechler, Date: 15 Apr 2008 if(any(x@Dim == 0)) return(mkDet(numeric(0))) ll <- lu(x, errSing = FALSE) ## ^^^^^^^^^^^^^^^ no error in case of singularity if(identical(NA, ll)) { ## LU-decomposition failed with singularity return(mkDet(ldet = if(anyNA(x)) NaN else -Inf, logarithm=logarithm, sig = 1L)) } ## else stopifnot(all(c("L","U") %in% slotNames(ll))) # ensure we have *sparse* LU r <- mkDet(diag(ll@U), logarithm) ## Det(x) == Det(P L U Q) == Det(P) * 1 * Det(U) * Det(Q); where Det(P), Det(Q) in {-1,1} r$sign <- r$sign * signPerm(ll@p + 1L) * signPerm(ll@q + 1L) r } ## Log(Determinant) from diagonal ... used several times mkDet <- function(d, logarithm = TRUE, ldet = sum(log(abs(d))), sig = -1L+2L*as.integer(prod(sign(d)) >= 0)) { # sig: -1 or +1 (not 0 !) modulus <- if (logarithm) ldet else exp(ldet) attr(modulus, "logarithm") <- logarithm val <- list(modulus = modulus, sign = sig) class(val) <- "det" val } ##' utility, basically == norm(x, type = "2") norm2 <- function(x) if(anyNA(x)) NaN else svd(x, nu = 0L, nv = 0L)$d[1L] dimCheck <- function(a, b) { da <- dim(a) db <- dim(b) if(any(da != db)) stop(gettextf("Matrices must have same dimensions in %s", deparse(sys.call(sys.parent()))), call. = FALSE, domain=NA) da } mmultCheck <- function(a, b, kind = 1L) { ## Check matching matrix dimensions and return that matching dim ## 1) %*% : [n x m] , [m x k] ## 2) crossprod: [m x n] , [m x k] ## 3) tcrossprod: [n x m] , [k x m] ## switch(kind, ## { ## %*% (kind = 1) ## ca <- dim(a)[2L] ## rb <- dim(b)[1L] ## }, ## { ## crossprod (kind = 2) ## ca <- dim(a)[1L] ## rb <- dim(b)[1L] ## }, ## { ## tcrossprod (kind = 3) ## ca <- dim(a)[2L] ## rb <- dim(b)[2L] ## }) ca <- dim(a)[1L + (kind %% 2L)] rb <- dim(b)[1L + (kind > 2)] if(ca != rb) stop(gettextf("non-conformable matrix dimensions in %s", deparse(sys.call(sys.parent()))), call. = FALSE, domain=NA) ca } ##' Constructs "sensical" dimnames for something like a + b ; ##' assume dimCheck() has happened before ##' ##' NOTA BENE: R's ?Arithmetic says ##' --------- ##'> For arrays (and an array result) the dimensions and dimnames are taken from ##'> first argument if it is an array, otherwise the second. ##' but that's not quite correct: ##' The dimnames are taken from second *if* the first are NULL. ##' ##' @title Construct dimnames for a o b ##' @param a matrix ##' @param b matrix ##' @param useFirst logical indicating if dimnames(a), the first, is taken, unless NULL ##' @param check logical indicating if a warning should be signalled for mismatches ##' @return a \code{\link{list}} of length two with dimnames ##' @author Martin Maechler dimNamesCheck <- function(a, b, useFirst = TRUE, check = FALSE) { nullDN <- list(NULL,NULL) h.a <- !identical(nullDN, dna <- dimnames(a)) h.b <- !identical(nullDN, dnb <- dimnames(b)) if(h.a || h.b) { if(useFirst) { if(!h.a) dnb else dna } else { if (!h.b) dna else if(!h.a) dnb else { ## both have non-trivial dimnames r <- dna # "default" result for(j in 1:2) if(!is.null(dn <- dnb[[j]])) { if(is.null(r[[j]])) r[[j]] <- dn else if(check && !identical(r[[j]], dn)) warning(gettextf("dimnames [%d] mismatch in %s", j, deparse(sys.call(sys.parent()))), call. = FALSE, domain=NA) } r } } } else nullDN } ##' @title Symmetrize dimnames(.) ##' @param x a square matrix ##' @param col logical indicating if the column names should be taken when ##' both are non-NULL. ##' @param names logical indicating if the names(dimnames(.)) should be ##' symmetrized and kept *if* they differ. ##' @return a matrix like \code{x}, say \code{r}, with dimnames fulfilling ##' dr <- dimnames(r); identical(dr[1], dr[2]) ##' @author Martin Maechler symmetrizeDimnames <- function(x, col=TRUE, names=TRUE) { dimnames(x) <- symmDN(dimnames(x), col=col, names=names) x } symmDN <- function(dn, col=TRUE, names=TRUE) { if(is.null(dn) || identical(dn[1L], dn[2L])) return(dn) J <- if(col) { if(is.null(dn[[2L]])) 1L else 2L } else { ## !col : row if(is.null(dn[[1L]])) 2L else 1L } if(!is.null(n <- names(dn))) { if(length(n) != 2) stop("names(dimnames()) must be NULL or of length two") if(n[1L] != n[2L]) names(dn) <- if(names) n[c(J,J)] # else NULL } dn[c(J,J)] } rowCheck <- function(a, b) { da <- dim(a) db <- dim(b) if(da[1] != db[1]) stop(gettextf("Matrices must have same number of rows in %s", deparse(sys.call(sys.parent()))), call. = FALSE, domain=NA) ## return the common nrow() da[1] } colCheck <- function(a, b) { da <- dim(a) db <- dim(b) if(da[2] != db[2]) stop(gettextf("Matrices must have same number of columns in %s", deparse(sys.call(sys.parent()))), call. = FALSE, domain=NA) ## return the common ncol() da[2] } ## is.na() is FALSE everywhere. Consequently, this function ## just gives an "all-FALSE" nCsparseMatrix of same form as x ##' ##' @title all FALSE nCsparseMatrix "as x" ##' @param x Matrix ##' @return n.CsparseMatrix "as \code{x}" ##' @author Martin Maechler is.na_nsp <- function(x) { d <- x@Dim dn <- x@Dimnames ## step-wise construction ==> no validity check for speedup r <- new(if(d[1] == d[2] && identical(dn[[1]], dn[[2]])) "nsCMatrix" else "ngCMatrix") r@Dim <- d r@Dimnames <- dn r@p <- rep.int(0L, d[2]+1L) r } allTrueMat <- function(x, sym = (d[1] == d[2] && identical(dn[[1]], dn[[2]])), packed=TRUE) { d <- x@Dim dn <- x@Dimnames r <- new("ngeMatrix", Dim=d, Dimnames=dn, x = rep.int(TRUE, prod(d))) if(sym) as(r, if(packed) "nspMatrix" else "nsyMatrix") else r } allTrueMatrix <- function(x) allTrueMat(x) ## Note: !isPacked(.) i.e. `full' still contains ## ---- "*sy" and "*tr" which have "undefined" lower or upper part isPacked <- function(x) { ## Is 'x' a packed (dense) matrix ? is(x, "denseMatrix") && ## unneeded(!): any("x" == slotNames(x)) && length(x@x) < prod(x@Dim) } ##" Is 'x' a packed (dense) matrix -- "no-check" version .isPacked <- function(x) length(x@x) < prod(x@Dim) emptyColnames <- function(x, msg.if.not.empty = FALSE) { ## Useful for compact printing of (parts) of sparse matrices ## possibly dimnames(x) "==" NULL : dn <- dimnames(x) nc <- ncol(x) if(msg.if.not.empty && is.list(dn) && length(dn) >= 2 && is.character(cn <- dn[[2]]) && any(cn != "")) { lc <- length(cn) message(if(lc > 3) gettextf(" [[ suppressing %d column names %s ... ]]", nc, paste(sQuote(cn[1:3]), collapse = ", ")) else gettextf(" [[ suppressing %d column names %s ]]", nc, paste(sQuote(cn[1:lc]), collapse = ", ")), domain=NA) } dimnames(x) <- list(dn[[1]], character(nc)) x } ## The i-th unit vector e[1:n] with e[j] = \delta_{i,j} ## .E.i.log <- function(i,n) i == (1:n) ## .E.i <- function(i,n) ## r <- numeric(n) ## r[i] <- 1. ## r ## } idiag <- function(n, p=n) { ## Purpose: diag() returning *integer* ## -------------------------------------------------------- ## Author: Martin Maechler, Date: 8 Dec 2007, 23:13 r <- matrix(0L, n,p) if ((m <- min(n, p)) > 0) r[1 + 0:(m - 1) * (n + 1)] <- 1L r } ldiag <- function(n, p=n) { ## Purpose: diag() returning *logical* r <- matrix(FALSE, n,p) if ((m <- min(n, p)) > 0) r[1 + 0:(m - 1) * (n + 1)] <- TRUE r } ## The indices of the diagonal entries of an n x n matrix, n >= 1 ## i.e. indDiag(n) === which(diag(n) == 1) indDiag <- function(n) cumsum(c(1L, rep.int(n+1L, n-1))) ### TODO: write in C and port to base (or 'utils') R ### ----- ### "Theory" behind this: /u/maechler/R/MM/MISC/lower-tri-w.o-matrix.R ## NB: also have "abIndex" version: abIindTri() --> ./abIndex.R ## Size problem: indTri(n) is of size ~ n^2/2 which may be too large! indTri <- function(n, upper = TRUE, diag = FALSE) { ## Indices of (strict) upper/lower triangular part ## == which(upper.tri(diag(n), diag=diag) or ## which(lower.tri(diag(n), diag=diag) -- but ## much more efficiently for largish 'n' stopifnot(length(n) == 1, n == (n. <- as.integer(n)), (n <- n.) >= 0) if(n <= 2) { if(n == 0) return(integer(0)) if(n == 1) return(if(diag) 1L else integer(0)) ## else n == 2 v <- if(upper) 3L else 2L return(if(diag) c(1L, v, 4L) else v) } ## n >= 3 [also for n == 2 && diag (==TRUE)] : ## First, compute the 'diff(.)' of the result [fast, using integers] n. <- if(diag) n else n - 1L n1 <- n. - 1L ## all '1' but a few r <- rep.int(1L, choose(n.+1, 2) - 1) tt <- if(diag) 2L else 3L r[cumsum(if(upper) 1:n1 else n.:2)] <- if(upper) n:tt else tt:n ## now have differences; revert to "original": cumsum(c(if(diag) 1L else if(upper) n+1L else 2L, r)) } prTriang <- function(x, digits = getOption("digits"), maxp = getOption("max.print"), justify = "none", right = TRUE) { ## modeled along stats:::print.dist upper <- x@uplo == "U" m <- as(x, "matrix") cf <- format(m, digits = digits, justify = justify) cf[if(upper) row(cf) > col(cf) else row(cf) < col(cf)] <- "." print(cf, quote = FALSE, right = right, max = maxp) invisible(x) } prMatrix <- function(x, digits = getOption("digits"), maxp = getOption("max.print")) { d <- dim(x) cl <- class(x) ## cld <- getClassDef(cl) tri <- extends(cl, "triangularMatrix") xtra <- if(tri && x@diag == "U") " (unitriangular)" else "" cat(sprintf('%d x %d Matrix of class "%s"%s\n', d[1], d[2], cl, xtra)) if(prod(d) <= maxp) { if(tri) prTriang(x, digits = digits, maxp = maxp) else print(as(x, "matrix"), digits = digits, max = maxp) } else { ## d[1] > maxp / d[2] >= nr : m <- as(x, "matrix") nr <- maxp %/% d[2] n2 <- ceiling(nr / 2) print(head(m, max(1, n2))) cat("\n ..........\n\n") print(tail(m, max(1, nr - n2))) cat("\n ..........\n\n") } ## DEBUG: cat("str(.):\n") ; str(x) invisible(x)# as print() S3 methods do } nonFALSE <- function(x) { ## typically used for lMatrices: (TRUE,NA,FALSE) |-> (TRUE,TRUE,FALSE) if(any(ix <- is.na(x))) x[ix] <- TRUE x } nz.NA <- function(x, na.value) { ## Non-Zeros of x ## na.value: TRUE: NA's give TRUE, they are not 0 ## NA: NA's are not known ==> result := NA ## FALSE: NA's give FALSE, could be 0 stopifnot(is.logical(na.value), length(na.value) == 1) if(is.na(na.value)) x != 0 else if(na.value) isN0(x) else x != 0 & !is.na(x) } ### This assumes that e.g. the i-slot in Csparse is *not* over-allocated: nnzSparse <- function(x, cl = class(x), cld = getClassDef(cl)) { ## Purpose: number of *stored* / structural non-zeros {NA's counted too} ## ---------------------------------------------------------------------- ## Arguments: x sparseMatrix ## ---------------------------------------------------------------------- ## Author: Martin Maechler, 18 Apr 2008 if(extends1of(cld, c("CsparseMatrix", "TsparseMatrix"))) length(x@i) else if(extends(cld, "RsparseMatrix")) length(x@j) else if(extends(cld, "indMatrix")) # is "sparse" too x@Dim[1] else stop(gettext("'x' must be \"sparseMatrix\""), domain=NA) } ## For sparseness handling, return a ## 2-column (i,j) matrix of 0-based indices of non-zero entries: ##' the workhorse for non0ind(.), but occasionally used directly non0.i <- function(M, cM = class(M), uniqT=TRUE) { if(extends(cM, "TsparseMatrix")) { if(uniqT && is_not_uniqT(M)) .Call(compressed_non_0_ij, as(M,"CsparseMatrix"), TRUE) else cbind(M@i, M@j) } else if(extends(cM, "indMatrix")) { cbind(seq_len(nrow(M)), M@perm) - 1L } else { ## C* or R* .Call(compressed_non_0_ij, M, extends(cM, "CsparseMatrix")) } } ##' the "more versatile / user" function (still not exported): non0ind <- function(x, cld = getClassDef(class(x)), uniqT = TRUE, xtendSymm = TRUE, check.Udiag = TRUE) { if(is.numeric(x)) return(if((n <- length(x))) { if(is.matrix(x)) arrayInd(seq_len(n)[isN0(x)], dim(x)) - 1L else (0:(n-1))[isN0(x)] } else integer(0)) ## else stopifnot(extends(cld, "sparseMatrix")) ij <- non0.i(x, cld, uniqT=uniqT) if(xtendSymm && extends(cld, "symmetricMatrix")) { # also get "other" triangle notdiag <- ij[,1] != ij[,2]# but not the diagonals again rbind(ij, ij[notdiag, 2:1], deparse.level=0) } else if(check.Udiag && extends(cld, "triangularMatrix")) { # check for "U" diag if(x@diag == "U") { i <- seq_len(dim(x)[1]) - 1L rbind(ij, cbind(i,i, deparse.level=0), deparse.level=0) } else ij } else ij } if(FALSE) { ## -- now have .Call(m_encodeInd, ...) etc : ## nr= nrow: since i in {0,1,.., nrow-1} these are 1L "decimal" encodings: ## Further, these map to and from the usual "Fortran-indexing" (but 0-based) encodeInd <- function(ij, di) { stopifnot(length(di) == 2) nr <- di[1L] ## __ care against integer overflow __ if(prod(di) >= .Machine$integer.max) nr <- as.double(nr) ij[,1] + ij[,2] * nr } encodeInd2 <- function(i,j, di) { stopifnot(length(di) == 2) nr <- di[1L] ## __ care against integer overflow __ if(prod(di) >= .Machine$integer.max) nr <- as.double(nr) i + j * nr } } else { ##' Encode Matrix index (i,j) |--> i + j * nrow {i,j : 0-origin} ##' ##' @param ij 2-column integer matrix ##' @param dim dim(.), i.e. length 2 integer vector ##' @param checkBnds logical indicating 0 <= ij[,k] < di[k] need to be checked. ##' ##' @return encoded index; integer if prod(dim) is small; double otherwise encodeInd <- function(ij, dim, orig1=FALSE, checkBnds=TRUE) .Call(m_encodeInd, ij, dim, orig1, checkBnds) ## --> in ../src/Mutils.c : m_encodeInd(ij, di, orig_1, chk_bnds) ## ~~~~~~~~~~~ ##' Here, 1-based indices (i,j) are default: encodeInd2 <- function(i, j, dim, orig1=TRUE, checkBnds=TRUE) .Call(m_encodeInd2, i,j, dim, orig1, checkBnds) } ##' Decode "encoded" (i,j) indices back to cbind(i,j) ##' This is the inverse of encodeInd(.) ##' ##' @title Decode "Encoded" (i,j) Indices ##' @param code integer in 0:((n x m - 1) <==> encodeInd(.) result ##' @param nr the number of rows ##' @return ##' @author Martin Maechler decodeInd <- function(code, nr) cbind(as.integer(code %% nr), as.integer(code %/% nr), deparse.level=0L) complementInd <- function(ij, dim, orig1=FALSE, checkBnds=FALSE) { ## Purpose: Compute the complement of the 2-column 0-based ij-matrix ## but as 1-based indices n <- prod(dim) if(n == 0) return(integer(0)) seq_len(n)[-(1L + .Call(m_encodeInd, ij, dim, orig1, checkBnds))] } unionInd <- function(ij1, ij2) unique(rbind(ij1, ij2)) intersectInd <- function(ij1, ij2, di, orig1=FALSE, checkBnds=FALSE) { ## from 2-column (i,j) matrices where i in {0,.., nrow-1}, ## return only the *common* entries decodeInd(intersect(.Call(m_encodeInd, ij1, di, orig1, checkBnds), .Call(m_encodeInd, ij2, di, orig1, checkBnds)), nr=di[1]) } WhichintersectInd <- function(ij1, ij2, di, orig1=FALSE, checkBnds=FALSE) { ## from 2-column (i,j) matrices where i \in {0,.., nrow-1}, ## find *where* common entries are in ij1 & ij2 m1 <- match(.Call(m_encodeInd, ij1, di, orig1, checkBnds), .Call(m_encodeInd, ij2, di, orig1, checkBnds)) ni <- !is.na(m1) list(which(ni), m1[ni]) } ### There is a test on this in ../tests/dgTMatrix.R ! uniqTsparse <- function(x, class.x = c(class(x))) { ## Purpose: produce a *unique* triplet representation: ## by having (i,j) sorted and unique ## ----------------------------------------------------------- ## The following is not quite efficient, but easy to program, ## and much based on C code ## ## TODO: faster for the case where 'x' is already 'uniq'? if(anyDuplicatedT(.)) if(extends(class.x, "TsparseMatrix")) { tri <- extends(class.x, "triangularMatrix") .Call(Csparse_to_Tsparse, .Call(Tsparse_to_Csparse, x, tri), tri) } else stop(gettextf("not yet implemented for class %s", dQuote(class.x)), domain = NA) } ##' non-exported version with*OUT* check -- called often only if(anyDuplicatedT(.)) .uniqTsparse <- function(x, class.x = c(class(x))) { tri <- extends(class.x, "triangularMatrix") .Call(Csparse_to_Tsparse, .Call(Tsparse_to_Csparse, x, tri), tri) } ## Note: maybe, using ## ---- xj <- .Call(Matrix_expand_pointers, x@p) ## would be slightly more efficient than as( , "dgTMatrix") ## but really efficient would be to use only one .Call(.) for uniq(.) ! drop0 <- function(x, tol = 0, is.Csparse = NA) { .Call(Csparse_drop, if(isTRUE(is.Csparse) || is.na(is.Csparse) && is(x, "CsparseMatrix")) x else as(x, "CsparseMatrix"), tol) } uniq <- function(x) { if(is(x, "TsparseMatrix")) uniqTsparse(x) else if(is(x, "sparseMatrix")) drop0(x) else x } asTuniq <- function(x) { if(is(x, "TsparseMatrix")) uniqTsparse(x) else as(x,"TsparseMatrix") } ## is 'x' a uniq Tsparse Matrix ? is_not_uniqT <- function(x, di = dim(x)) is.unsorted(x@j) || anyDuplicatedT(x, di) ## is 'x' a TsparseMatrix with duplicated entries (to be *added* for uniq): is_duplicatedT <- # <- keep old name for a while, as ../inst/test-tools-Matrix.R has used it anyDuplicatedT <- function(x, di = dim(x)) anyDuplicated(.Call(m_encodeInd2, x@i, x@j, di, FALSE, FALSE)) t_geMatrix <- function(x) { x@x <- as.vector(t(array(x@x, dim = x@Dim))) # no dimnames here x@Dim <- x@Dim[2:1] x@Dimnames <- x@Dimnames[2:1] x@factors <- list() ## FIXME -- do better, e.g., for "LU"? x } ## t( [dl]trMatrix ) and t( [dl]syMatrix ) : t_trMatrix <- function(x) { x@x <- as.vector(t(as(x, "matrix"))) x@Dim <- x@Dim[2:1] x@Dimnames <- x@Dimnames[2:1] x@uplo <- if (x@uplo == "U") "L" else "U" # and keep x@diag x } fixupDense <- function(m, from, cldm = getClassDef(class(m))) { if(extends(cldm, "triangularMatrix")) { m@uplo <- from@uplo m@diag <- from@diag } else if(extends(cldm, "symmetricMatrix")) { m@uplo <- from@uplo } m } ##' @title Transform {vectors, matrix, Matrix, ...} to dgeMatrix ##' @export ..2dge <- function(from) .Call(dup_mMatrix_as_dgeMatrix, from) if(FALSE) ## FIXME: From R we want something like (but all in C - where inherits() is "free" ..2dge <- function(from, check=TRUE) { if(check && inherits(from,"geMatrix")) from else .Call(dup_mMatrix_as_dgeMatrix, from) } ## -> ./ldenseMatrix.R : l2d_Matrix <- function(from, cl = MatrixClass(class(from)), cld = getClassDef(cl)) { ## stopifnot(is(from, "lMatrix")) fixupDense(new(sub("^l", "d", cl), x = as.double(from@x), Dim = from@Dim, Dimnames = from@Dimnames), from, cld) ## FIXME: treat 'factors' smartly {not for triangular!} } ## -> ./ndenseMatrix.R : n2d_Matrix <- function(from, cl = MatrixClass(class(from)), cld = getClassDef(cl)) { ## stopifnot(is(from, "nMatrix")) fixupDense(new(sub("^n", "d", cl), x = as.double(from@x), Dim = from@Dim, Dimnames = from@Dimnames), from, cld) ## FIXME: treat 'factors' smartly {not for triangular!} } n2l_Matrix <- function(from, cl = MatrixClass(class(from)), cld = getClassDef(cl)) { fixupDense(new(sub("^n", "l", cl), x = from@x, Dim = from@Dim, Dimnames = from@Dimnames), from, cld) ## FIXME: treat 'factors' smartly {not for triangular!} } ## -> ./ddenseMatrix.R : d2l_Matrix <- function(from, cl = MatrixClass(class(from)), cld = getClassDef(cl)) { fixupDense(new(sub("^d", "l", cl), x = as.logical(from@x), Dim = from@Dim, Dimnames = from@Dimnames), from, cld) ## FIXME: treat 'factors' smartly {not for triangular!} } n2l_spMatrix <- function(from) { ## stopifnot(is(from, "nMatrix")) new(sub("^n", "l", MatrixClass(class(from))), ##x = as.double(from@x), Dim = from@Dim, Dimnames = from@Dimnames) } tT2gT <- function(x, cl = class(x), toClass, cld = getClassDef(cl)) { ## coerce *tTMatrix to *gTMatrix {triangular -> general} d <- x@Dim if(uDiag <- x@diag == "U") # unit diagonal, need to add '1's uDiag <- (n <- d[1]) > 0 if(missing(toClass)) { do.n <- extends(cld, "nMatrix") toKind <- if(do.n) "n" else substr(MatrixClass(cl), 1,1) # "d" | "l"|"i"|"z" toClass <- paste0(toKind, "gTMatrix") } else { do.n <- extends(toClass, "nMatrix") toKind <- if(do.n) "n" else substr(toClass, 1,1) } if(do.n) ## no 'x' slot new(toClass, # == "ngTMatrix" Dim = d, Dimnames = x@Dimnames, i = c(x@i, if(uDiag) 0:(n-1)), j = c(x@j, if(uDiag) 0:(n-1))) else new(toClass, Dim = d, Dimnames = x@Dimnames, i = c(x@i, if(uDiag) 0:(n-1)), j = c(x@j, if(uDiag) 0:(n-1)), x = c(x@x, if(uDiag) rep.int(if(toKind == "l") TRUE else 1, n))) } ## __TODO__ ## Hack for the above, possibly considerably faster: ## Just *modify* the 'x' object , using attr(x, "class') <- toClass ## Fast very special one ../src/Tsparse.c -- as_cholmod_triplet() in ../src/chm_common.c ## 'x' *must* inherit from TsparseMatrix! .gT2tC <- function(x, uplo, diag="N") .Call(Tsparse_to_tCsparse, x, uplo, diag) ## Ditto in ../src/Csparse.c : .gC2tC <- function(x, uplo, diag="N") .Call(Csparse_to_tCsparse, x, uplo, diag) .gC2tT <- function(x, uplo, diag="N") .Call(Csparse_to_tTsparse, x, uplo, diag) gT2tT <- function(x, uplo, diag, toClass, do.n = extends(toClass, "nMatrix")) { ## coerce *gTMatrix to *tTMatrix {general -> triangular} i <- x@i j <- x@j sel <- if(uplo == "U") { if(diag == "U") i < j else i <= j } else { if(diag == "U") i > j else i >= j } i <- i[sel] j <- j[sel] if(do.n) ## no 'x' slot new("ntTMatrix", i = i, j = j, uplo = uplo, diag = diag, Dim = x@Dim, Dimnames = x@Dimnames) else new(toClass, i = i, j = j, uplo = uplo, diag = diag, x = x@x[sel], Dim = x@Dim, Dimnames = x@Dimnames) } check.gT2tT <- function(from, toClass, do.n = extends(toClass, "nMatrix")) { if(isTr <- isTriangular(from)) { gT2tT(from, uplo = attr(isTr, "kind") %||% "U", diag = "N", ## improve: also test for unit diagonal toClass = toClass, do.n = do.n) } else stop("not a triangular matrix") } gT2sT <- function(x, toClass, do.n = extends(toClass, "nMatrix")) { upper <- x@i <= x@j i <- x@i[upper] j <- x@j[upper] if(do.n) ## no 'x' slot new("nsTMatrix", Dim = x@Dim, Dimnames = x@Dimnames, i = i, j = j, uplo = "U") else new(toClass, Dim = x@Dim, Dimnames = x@Dimnames, i = i, j = j, x = x@x[upper], uplo = "U") } check.gT2sT <- function(x, toClass, do.n = extends(toClass, "nMatrix")) { if(isSymmetric(x)) gT2sT(x, toClass, do.n) else stop("not a symmetric matrix; consider forceSymmetric() or symmpart()") } if(FALSE)# unused l2d_meth <- function(x) { cl <- MatrixClass(class(x)) as(callGeneric(as(x, sub("^l", "d", cl))), cl) } ## return "d" or "l" or "n" or "z" .M.kind <- function(x, clx = class(x)) { ## 'clx': class() *or* class definition of x if(is.matrix(x) || is.atomic(x)) { ## 'old style' matrix or vector if (is.numeric(x)) "d" ## also for integer: see .V.kind(), .M.kindC() else if(is.logical(x)) "l" ## FIXME ? "n" if no NA ?? else if(is.complex(x)) "z" else stop(gettextf("not yet implemented for matrix with typeof %s", typeof(x)), domain = NA) } else .M.kindC(clx) } ##' *V*ector kind (as .M.kind, but also knows "i") .V.kind <- function(x, clx = class(x)) { ## 'clx': class() *or* class definition of x if(is.matrix(x) || is.atomic(x)) { ## 'old style' matrix or vector if (is.integer(x)) "i" else if(is.numeric(x)) "d" else if(is.logical(x)) "l" ## FIXME ? "n" if no NA ?? else if(is.complex(x)) "z" else stop(gettextf("not yet implemented for matrix with typeof %s", typeof(x)), domain = NA) } else .M.kindC(clx) } .M.kindC <- function(clx, ex = extends(clx)) { ## 'clx': class() *or* classdefinition if(is.character(clx)) # < speedup: get it once clx <- getClassDef(clx) if(any(ex == "sparseVector")) { ## must work for class *extending* "dsparseVector" ==> cannot use (clx@className) ! if (any(ex == "dsparseVector")) "d" else if(any(ex == "nsparseVector")) "n" else if(any(ex == "lsparseVector")) "l" else if(any(ex == "zsparseVector")) "z" else if(any(ex == "isparseVector")) "i" else stop(gettextf(" not yet implemented for %s", clx@className), domain = NA) } else if(any(ex == "dMatrix")) "d" else if(any(ex == "nMatrix")) "n" else if(any(ex == "lMatrix")) "l" else if(any(ex == "indMatrix")) "n" # permutation -> pattern else if(any(ex == "zMatrix")) "z" else if(any(ex == "iMatrix")) "i" else stop(gettextf(" not yet implemented for %s", clx@className), domain = NA) } ## typically used as .type.kind[.M.kind(x)]: .type.kind <- c("d" = "double", "i" = "integer", "l" = "logical", "n" = "logical", "z" = "complex") ## the reverse, a "version of" .M.kind(.): .kind.type <- setNames(names(.type.kind), as.vector(.type.kind)) .M.shape <- function(x, clx = class(x)) { ## 'clx': class() *or* class definition of x if(is.matrix(x)) { ## 'old style matrix' if (isDiagonal (x)) "d" else if(isTriangular(x)) "t" else if(isSymmetric (x)) "s" else "g" # general } else { if(is.character(clx)) # < speedup: get it once clx <- getClassDef(clx) ex <- extends(clx) if( any(ex == "diagonalMatrix")) "d" else if(any(ex == "triangularMatrix"))"t" else if(any(ex == "symmetricMatrix")) "s" else "g" } } ## a faster simpler version [for sparse matrices, i.e., never diagonal] .M.shapeC <- function(x, clx = class(x)) { if(is.character(clx)) # < speedup: get it once clx <- getClassDef(clx) if (extends(clx, "triangularMatrix")) "t" else if(extends(clx, "symmetricMatrix")) "s" else "g" } class2 <- function(cl, kind = "l", do.sub = TRUE) { ## Find "corresponding" class; since pos.def. matrices have no pendant: cl <- MatrixClass(cl) if(cl %in% c("dpoMatrix","corMatrix")) paste0(kind, "syMatrix") else if(cl == "dppMatrix") paste0(kind, "spMatrix") else if(do.sub) sub("^[a-z]", kind, cl) else cl } ## see also as_smartClass() below geClass <- function(x) { if (is(x, "dMatrix")) "dgeMatrix" else if(is(x, "lMatrix")) "lgeMatrix" else if(is(x, "nMatrix") || is(x, "indMatrix")) "ngeMatrix" else if(is(x, "zMatrix")) "zgeMatrix" else stop(gettextf("general Matrix class not yet implemented for %s", dQuote(class(x))), domain = NA) } .dense.prefixes <- c("d" = "tr", ## map diagonal to triangular "t" = "tr", "s" = "sy", "g" = "ge") .sparse.prefixes <- c("d" = "t", ## map diagonal to triangular "t" = "t", "s" = "s", "g" = "g") as_M.kind <- function(x, clx) { if(is.character(clx)) # < speedup: get it once clx <- getClassDef(clx) if(is(x, clx)) x else as(x, paste0(.M.kindC(clx), "Matrix")) } ## Used, e.g. after subsetting: Try to use specific class -- if feasible : as_dense <- function(x, cld = if(isS4(x)) getClassDef(class(x))) { as(x, paste0(.M.kind(x, cld), .dense.prefixes[.M.shape(x, cld)], "Matrix")) } ## This is "general" but slower than the next definition if(FALSE) .sp.class <- function(x) { ## find and return the "sparseness class" if(!is.character(x)) x <- class(x) for(cl in paste0(c("C","T","R"), "sparseMatrix")) if(extends(x, cl)) return(cl) ## else (should rarely happen) NA_character_ } .sp.class <- function(x) { ## find and return the "sparseness class" (aka "representation") x <- if(!is.character(x)) MatrixClass(class(x)) else MatrixClass(x) if(any((ch <- substr(x,3,3)) == c("C","T","R"))) return(paste0(ch, "sparseMatrix")) ## else NA_character_ } ### Goal: Eventually get rid of these --- want to foster coercions ### ---- *to* virtual classes whenever possible, e.g. as(*, "CsparseMatrix") ## 2007-12: better goal: use them only for "matrix" [maybe speed them up later] ## Here, getting the class definition and passing it, should be faster as_Csparse <- function(x, cld = if(isS4(x)) getClassDef(class(x))) { as(x, paste0(.M.kind(x, cld), .sparse.prefixes[.M.shape(x, cld)], "CMatrix")) } if(FALSE) # replaced by .Call(dense_to_Csparse, *) which is perfect for "matrix" as_Csparse2 <- function(x, cld = if(isS4(x)) getClassDef(class(x))) { ## Csparse + U2N when needed sh <- .M.shape(x, cld) x <- as(x, paste0(.M.kind(x, cld), .sparse.prefixes[sh], "CMatrix")) if(sh == "t") .Call(Csparse_diagU2N, x) else x } ## *do* use this where applicable as_Csp2 <- function(x) { ## Csparse + U2N when needed x <- as(x, "CsparseMatrix") if(is(x, "triangularMatrix")) .Call(Csparse_diagU2N, x) else x } ## 'cl' : class() *or* class definition of from as_gCsimpl2 <- function(from, cl = class(from)) as(from, paste0(.M.kind(from, cl), "gCMatrix")) ## to be used directly in setAs(.) needs one-argument-only (from) : as_gCsimpl <- function(from) as(from, paste0(.M.kind(from), "gCMatrix")) ## slightly smarter: as_Sp <- function(from, shape, cl = class(from)) { if(is.character(cl)) cl <- getClassDef(cl) as(from, paste0(.M.kind(from, cl), shape, if(extends(cl, "TsparseMatrix")) "TMatrix" else "CMatrix")) } ## These are used in ./sparseMatrix.R: as_gSparse <- function(from) as_Sp(from, "g", getClassDef(class(from))) as_sSparse <- function(from) as_Sp(from, "s", getClassDef(class(from))) as_tSparse <- function(from) as_Sp(from, "t", getClassDef(class(from))) as_geSimpl2 <- function(from, cl = class(from)) as(from, paste0(.M.kind(from, cl), "geMatrix")) ## to be used directly in setAs(.) needs one-argument-only (from) : as_geSimpl <- function(from) as(from, paste0(.M.kind(from), "geMatrix")) ## Smarter, (but sometimes too smart!) compared to geClass() above: as_smartClass <- function(x, cl, cld = getClassDef(cl)) { if(missing(cl)) return(as_geSimpl(x)) ## else if(extends(cld, "diagonalMatrix") && isDiagonal(x)) ## diagonal* result: as(x, cl) else if(extends(cld, "symmetricMatrix") && isSymmetric(x)) { ## symmetric* result: kind <- .M.kind(x, cld) as(x, class2(cl, kind, do.sub= kind != "d")) } else if(extends(cld, "triangularMatrix") && isTriangular(x)) as(x, cl) else ## revert to as_geSimpl2(x, cld) } as_CspClass <- function(x, cl) { ## NOTE: diagonal is *not* sparse: cld <- getClassDef(cl) ##(extends(cld, "diagonalMatrix") && isDiagonal(x)) || if (extends(cld, "symmetricMatrix") && isSymmetric(x)) forceSymmetric(as(x,"CsparseMatrix")) else if (extends(cld, "triangularMatrix") && isTriangular(x)) as(x, cl) else if(is(x, "CsparseMatrix")) x else as(x, paste0(.M.kind(x, cld), "gCMatrix")) } asTri <- function(from, newclass) { ## TODO: also check for unit-diagonal: 'diag = "U"' isTri <- isTriangular(from) if(isTri) new(newclass, x = from@x, Dim = from@Dim, Dimnames = from@Dimnames, uplo = attr(isTri, "kind")) else stop("not a triangular matrix") } mat2tri <- function(from, sparse=NA) { isTri <- isTriangular(from) if(isTri) { d <- dim(from) if(is.na(sparse)) sparse <- prod(d) > 2*sum(isN0(from)) ## <==> sparseDefault() above if(sparse) as(as(from, "sparseMatrix"), "triangularMatrix") else new(paste0(.M.kind(from),"trMatrix"), x = base::as.vector(from), Dim = d, Dimnames = .M.DN(from), uplo = attr(isTri, "kind")) } else stop("not a triangular matrix") } try_as <- function(x, classes, tryAnyway = FALSE) { if(!tryAnyway && !is(x, "Matrix")) return(x) ## else ok <- canCoerce(x, classes[1]) while(!ok && length(classes <- classes[-1])) { ok <- canCoerce(x, classes[1]) } if(ok) as(x, classes[1]) else x } ## For *dense* matrices isTriMat <- function(object, upper = NA, ...) { ## pretest: is it square? d <- dim(object) if(d[1] != d[2]) return(FALSE) TRUE.U <- structure(TRUE, kind = "U") if(d[1] == 0) return(TRUE.U) ## else slower test TRUE.L <- structure(TRUE, kind = "L") if(!is.matrix(object)) object <- as(object,"matrix") if(is.na(upper)) { if(all0(object[lower.tri(object)])) TRUE.U else if(all0(object[upper.tri(object)])) TRUE.L else FALSE } else if(upper) if(all0(object[lower.tri(object)])) TRUE.U else FALSE else ## upper is FALSE if(all0(object[upper.tri(object)])) TRUE.L else FALSE } ## For Tsparse matrices: isTriT <- function(object, upper = NA, ...) { ## pretest: is it square? d <- dim(object) if(d[1] != d[2]) return(FALSE) ## else TRUE.U <- structure(TRUE, kind = "U") if(d[1] == 0) return(TRUE.U) TRUE.L <- structure(TRUE, kind = "L") if(is.na(upper)) { if(all(object@i <= object@j)) TRUE.U else if(all(object@i >= object@j)) TRUE.L else FALSE } else if(upper) { if(all(object@i <= object@j)) TRUE.U else FALSE } else { ## 'lower' if(all(object@i >= object@j)) TRUE.L else FALSE } } ## For Csparse matrices isTriC <- function(object, upper = NA, ...) { ## pretest: is it square? d <- dim(object) if(d[1] != d[2]) return(FALSE) ## else TRUE.U <- structure(TRUE, kind = "U") if((n <- d[1]) == 0) return(TRUE.U) TRUE.L <- structure(TRUE, kind = "L") ## Need this, since 'i' slot of symmetric looks like triangular : if(is(object, "symmetricMatrix")) # triangular only iff diagonal : return(if(length(oi <- object@i) == n && isSeq(oi, n-1L) && isSeq(object@p, n)) structure(TRUE, kind = object@uplo) else FALSE) ## else ni <- 1:n ## the row indices split according to column: ilist <- split(object@i, factor(rep.int(ni, diff(object@p)), levels= ni)) lil <- lengths(ilist, use.names = FALSE) if(any(lil == 0)) { pos <- lil > 0 if(!any(pos)) ## matrix of all 0's return(TRUE.U) ilist <- ilist[pos] ni <- ni[pos] } ni0 <- ni - 1L # '0-based ni' if(is.na(upper)) { if(all(sapply(ilist, max, USE.NAMES = FALSE) <= ni0)) TRUE.U else if(all(sapply(ilist, min, USE.NAMES = FALSE) >= ni0)) TRUE.L else FALSE } else if(upper) { if(all(sapply(ilist, max, USE.NAMES = FALSE) <= ni0)) TRUE.U else FALSE } else { ## 'lower' if(all(sapply(ilist, min, USE.NAMES = FALSE) >= ni0)) TRUE.L else FALSE } } ## When the matrix is known to be [n x n] aka "square" ## (need "vector-indexing" work for 'M'): .is.diagonal.sq.matrix <- function(M, n = dim(M)[1L]) all0(M[rep_len(c(FALSE, rep.int(TRUE,n)), n^2)]) .is.diagonal <- function(object) { ## "matrix" or "denseMatrix" (but not "diagonalMatrix") d <- dim(object) if(d[1L] != (n <- d[2L])) FALSE else if(is.matrix(object)) .is.diagonal.sq.matrix(object, n) else ## "denseMatrix" -- packed or unpacked if(is(object, "generalMatrix")) # "dge", "lge", ... .is.diagonal.sq.matrix(object@x, n) else { ## "dense" but not {diag, general}, i.e. triangular or symmetric: ## -> has 'uplo' differentiate between packed and unpacked ### .......... FIXME ............... ## packed <- isPacked(object) ## if(object@uplo == "U") { ## } else { ## uplo == "L" ## } ### very cheap workaround all0(as(object,"matrix")[rep_len(c(FALSE, rep.int(TRUE,n)), n^2)]) } } ## Purpose: Transform a *unit diagonal* sparse triangular matrix ## into one with explicit diagonal entries '1' ## for "dtC*", "ltC* ..: directly xtC.diagU2N <- function(x) if(x@diag == "U") .Call(Csparse_diagU2N, x) else x ##' @title uni-diagonal to "regular" triangular Matrix ##' ##' NOTE: class is *not* checked here! {speed} ##' @param x a dense unidiagonal (x@diag == "U") triangular Matrix ##' ("ltrMatrix", "dtpMatrix", ...). ##' @param kind character indicating content kind: "d","l",.. ##' @param isPacked logical indicating if 'x' is packed ##' @return Matrix "like" x, but with x@diag == "N" (and 1 or TRUE values "filled" in .@x) ##' @author Martin Maechler .dense.diagU2N <- function(x, kind = .M.kind(x), isPacked = length(x@x) < n^2) { ### FIXME: Move this to C ----- (possibly with an option of *not* copying) ## For denseMatrix, .@diag = "U" means the 'x' slot can have wrong values ## which are documented to never be accessed n <- x@Dim[1] if(n > 0) { one <- if(kind == "d") 1. else TRUE if(isPacked) { ## { == isPacked(x)) } : dtp-, ltp-, or "ntpMatrix": ## x@x is of length n*(n+1)/2 if(n == 1) x@x <- one else { di <- if(x@uplo == "U") seq_len(n) else c(1L,n:2L) x@x[cumsum(di)] <- one } } else { ## okay: now have 'x' slot of length n x n x@x[1L+ (0:(n-1L))*(n+1L)] <- one # even for "n..Matrix" } } x@diag <- "N" x } .diagU2N <- function(x, cl, checkDense = FALSE) { ## fast "no-test" version --- we *KNOW* 'x' is 'triangularMatrix' if(extends(cl, "CsparseMatrix")) .Call(Csparse_diagU2N, x) else if(extends(cl, "TsparseMatrix")) .Call(Tsparse_diagU2N, x) else { kind <- .M.kind(x, cl) if(checkDense && extends(cl,"denseMatrix")) { .dense.diagU2N(x, kind) } else { ## possibly dense, not [CT]sparseMatrix ==> Rsparse* .Call(Tsparse_diagU2N, as(as(x, paste0(kind, "Matrix")), "TsparseMatrix")) ## leave it as T* - the caller can always coerce to C* if needed } } } ## .diagU2N() diagU2N <- function(x, cl = getClassDef(class(x)), checkDense = FALSE) { if(extends(cl, "triangularMatrix") && x@diag == "U") .diagU2N(x, cl, checkDense=checkDense) else x } ##' @title coerce triangular Matrix to uni-diagonal ##' ##' NOTE: class is *not* checked here! {speed} ##' @param x a dense triangular Matrix ("ltrMatrix", "dtpMatrix", ...). ##' @return Matrix "like" x, but with x@diag == "U" .dense.diagN2U <- function(x) { ## as we promise that the diagonal entries are not accessed when ## diag = "U", we don't even need to set them to one !! ## and *contrary* to the sparseMatrix case, we keep the diagonal entries in @x ! x@diag <- "U" x } diagN2U <- function(x, cl = getClassDef(class(x)), checkDense = FALSE) { if(!(extends(cl, "triangularMatrix") && x@diag == "N")) return(x) if(checkDense && extends(cl,"denseMatrix")) { .dense.diagN2U(x) } else ## still possibly dense .Call(Csparse_diagN2U, as(x, "CsparseMatrix")) } .dgC.0.factors <- function(x) if(!length(x@factors)) x else { x@factors <- list() ; x } .as.dgC.0.factors <- function(x) { if(!is(x, "dgCMatrix")) as(x, "dgCMatrix") # will not have 'factors' else ## dgCMatrix .dgC.0.factors(x) } ## Caches 'value' in the 'factors' slot of 'x', i.e. modifies 'x', and returns 'value' ## WARNING:: for updating the '@ factors' slot of a function *argument* [CARE!] .set.factors <- function(x, name, value, warn.no.slot=FALSE) .Call(R_set_factors, x, value, name, warn.no.slot) ##' Change function *argument* 'x', emptying its 'factors' slot; USE with CARE! __ DANGER ! __ ##' @return TRUE iff 'x' is modified, FALSE if not. .empty.factors <- function(x, warn.no.slot=FALSE) .Call(R_empty_factors, x, warn.no.slot) ##' The *SAFE* regular function version: empty the factor slot .drop.factors <- function(x, check=FALSE) `slot<-`(x, "factors", check=check, value=list()) ### Fast, much simplified version of tapply() tapply1 <- function (X, INDEX, FUN = NULL, ..., simplify = TRUE) { sapply(unname(split(X, INDEX)), FUN, ..., simplify = simplify, USE.NAMES = FALSE) } ## tapply.x <- function (X, n, INDEX, FUN = NULL, ..., simplify = TRUE) { ## tapply1(X, factor(INDEX, 0:(n-1)), FUN = FUN, ..., simplify = simplify) ## } ### MM: Unfortunately, these are still pretty slow for large sparse ... sparsapply <- function(x, MARGIN, FUN, sparseResult = TRUE, ...) { ## Purpose: "Sparse Apply": better utility than tapply1() for colSums() etc : ## NOTE: Only applicable sum()-like where the "zeros do not count" ## ---------------------------------------------------------------------- ## Arguments: x: sparseMatrix; others as in *apply() ## ---------------------------------------------------------------------- ## Author: Martin Maechler, Date: 16 May 2007 stopifnot(MARGIN %in% 1:2) xi <- if(MARGIN == 1) x@i else x@j ui <- unique(xi) n <- x@Dim[MARGIN] ## FIXME: Here we assume 'FUN' to return 'numeric' ! r <- if(sparseResult) new("dsparseVector", length = n) else numeric(n) r[ui + 1L] <- sapply(ui, function(i) FUN(x@x[xi == i], ...)) r } sp.colMeans <- function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) { nr <- nrow(x) if(na.rm) ## use less than nrow(.) in case of NAs nr <- nr - sparsapply(x, 2, function(u) sum(is.na(u)), sparseResult=sparseResult) sparsapply(x, 2, sum, sparseResult=sparseResult, na.rm=na.rm) / nr } sp.rowMeans <- function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) { nc <- ncol(x) if(na.rm) ## use less than ncol(.) in case of NAs nc <- nc - sparsapply(x, 1, function(u) sum(is.na(u)), sparseResult=sparseResult) sparsapply(x, 1, sum, sparseResult=sparseResult, na.rm=na.rm) / nc } all0Matrix <- function(n,m) { ## an all-0 matrix -- chose what Matrix() also gives -- "most efficiently" n <- as.integer(n) m <- as.integer(m) new(if(n == m) "dsCMatrix" else "dgCMatrix", Dim = c(n,m), p = rep.int(0L, m+1L)) } .setZero <- function(x, newclass = if(d[1] == d[2]) "dsCMatrix" else "dgCMatrix") { ## all-0 matrix from x which must inherit from 'Matrix' d <- x@Dim new(newclass, Dim = d, Dimnames = x@Dimnames, p = rep.int(0L, d[2]+1L)) } ##' Subsetting matrix/vector in "vector style", e.g. M[0], M[TRUE], M[1:2], M[-7] ##' @param x any matrix/Matrix/(sparse)vector, to be subset ##' @param i integer (incl negative!) or logical 'index'. ##' @param allowSparse logical indicating if the result may be a ##' \code{"sparseVector"}; the default is false for reasons of back ##' compatibility (against efficiency here). ##' @note 2018-03: Now partially based on \code{as(x, "sparseVector")[i]} ##' which has been improved itself. .M.vectorSub <- function(x, i, allowSparse=FALSE) { if(prod(dim(x)) == 0) as(x, "matrix")[i] else if(any(as.logical(i))) { if(inherits(x, "denseMatrix")) as(x, "matrix")[i] else { ## sparse ... ## if(is.logical(i)) # unfortunately, this is not-yet-implemented! ## x[as(i, "sparseVector")] ## else if(all(i >= 0)) if(is.numeric(i) && all(i >= 0)) subset.ij(x, ij = arrayInd(i, .dim=dim(x), useNames=FALSE)) else if(allowSparse) # more efficient here as(x, "sparseVector")[i] else # sparse result not allowed sp2vec(as(x, "sparseVector")[i]) } } else ## save memory (for large sparse M): as.vector(x[1,1])[FALSE] } ##' Compute the three "parts" of two sets: ##' @param x arbitrary vector; possibly with duplicated values, ##' @param y (ditto) ##' @param uniqueCheck ##' @param check ##' ##' @return list(x.only = setdiff(x,y), ##' y.only = setdiff(y,x), ##' int = intersect(x,y)) setparts <- function(x,y, uniqueCheck = TRUE, check = TRUE) { if(check) { x <- as.vector(x) y <- as.vector(y) } if(uniqueCheck) { x <- unique.default(x) y <- unique.default(y) } .setparts(x,y) } .setparts <- function(x,y) { n1 <- length(m1 <- match(x,y, 0L)) n2 <- length(m2 <- match(y,x, 0L)) ix <- seq_len(n1)[m1 == 0L] iy <- seq_len(n2)[m2 == 0L] list(x.only = x[ix], ix.only = ix, mx = m1, y.only = y[iy], iy.only = iy, my = m2, int = if(n1 < n2) y[m1] else x[m2]) } ##' @title Warn about extraneous arguments in the "..." (of its caller). ##' A merger of my approach and the one in seq.default() -- FIXME: now have base::chkDots() ##' @author Martin Maechler, June 2012, May 2014 ##' @param ... ##' @param which.call passed to sys.call(). A caller may use -2 if the message should ##' mention *its* caller chk.s <- function(..., which.call = -1, depCtrl = if(exists("..deparseOpts")) "niceNames") { if(nx <- length(list(...))) warning(sprintf(ngettext(nx, "extra argument %s will be disregarded in\n %s", "extra arguments %s will be disregarded in\n %s"), sub(")$", '', sub("^list\\(", '', deparse1(list(...), control=depCtrl))), deparse1(sys.call(which.call), control=depCtrl)), call. = FALSE, domain=NA) } ##' *Only* to be used as function in ##' setMethod.("Compare", ...., .Cmp.swap) --> ./Ops.R & ./diagMatrix.R .Cmp.swap <- function(e1,e2) { ## "swap RHS and LHS" and use the method below: switch(.Generic, "==" =, "!=" = callGeneric(e2, e1), "<" = e2 > e1, "<=" = e2 >= e1, ">" = e2 < e1, ">=" = e2 <= e1) } Matrix/R/dgCMatrix.R0000644000176200001440000001331713556074235013743 0ustar liggesusers#### Sparse Matrices in Compressed column-oriented format ### contains = "dsparseMatrix", "CsparseMatrix" ## Specific conversions, should they be necessary. Better to convert as ## as(x, "TsparseMatrix") or as(x, "denseMatrix") ## Moved to ./Csparse.R : ## setAs("dgCMatrix", "dgTMatrix", .... ## setAs("dgCMatrix", "dgeMatrix", .... ## setAs("dgeMatrix", "dgCMatrix", .... setAs("dgCMatrix", "ngCMatrix", function(from) .C2nC(from, FALSE)) ## rather use Csparse* to lsparse* in ./lsparseMatrix.R , ## but this is for "back-compatibility" (have had tests for it..): setAs("dgCMatrix", "lgCMatrix", function(from) { ## FIXME use .Call() too! r <- new("lgCMatrix") r@x <- as.logical(from@x) ## and copy the other slots for(nm in c("i", "p", "Dim", "Dimnames")) slot(r, nm) <- slot(from, nm) r }) setMethod("image", "dgCMatrix", function(x, ...) image(as(x, "dgTMatrix"), ...)) ## Group Methods, see ?Arith (e.g.) ## ----- ## ## "Arith" is now in ./Ops.R ## ## "Math" and "Math2" in ./Math.R ## "[<-" methods { setReplaceMethod()s } are now in ./Csparse.R ## setMethod("writeHB", signature(obj = "dgCMatrix"), ## function(obj, file, ...) { ## .Deprecated("writeMM") ## .Call(Matrix_writeHarwellBoeing, obj, ## as.character(file), "DGC") ## }) ##-> ./colSums.R for colSums,... rowMeans setMethod("t", signature(x = "dgCMatrix"), function(x) .Call(Csparse_transpose, x, FALSE), valueClass = "dgCMatrix") setMethod("determinant", signature(x = "dgCMatrix", logarithm = "logical"), detSparseLU) # using mkDet() --> ./Auxiliaries.R setMethod("qr", signature(x = "dgCMatrix"), function(x, tol = 1e-07, LAPACK = FALSE, keep.dimnames = TRUE, verbose = !is.null(v <- getOption("Matrix.verbose")) && v >= 1) .Call(dgCMatrix_QR, # -> cs_sqr() and cs_qr() >> ../src/dgCMatrix.c x, ## order = if(verbose) -1L else TRUE, keep.dimnames)) setMethod("qr", signature(x = "sparseMatrix"), function(x, ...) qr(as(as(as(x, "CsparseMatrix"), "dsparseMatrix"), "dgCMatrix"), ...)) LU.dgC <- function(x, errSing = TRUE, order = TRUE, tol = 1.0, keep.dimnames = TRUE, ...) { chk.s(..., which.call=-2) .Call(dgCMatrix_LU, x, order, tol, errSing, keep.dimnames) ## ../src/dgCMatrix.c } setMethod("lu", signature(x = "dgCMatrix"), LU.dgC) setMethod("lu", signature(x = "sparseMatrix"), function(x, ...) .set.factors(x, "lu", lu(as(as(as(x, "CsparseMatrix"), "dsparseMatrix"), "dgCMatrix"), ...))) .solve.dgC.lu <- function(a, b, tol = .Machine$double.eps) { ## @MM: see also solveSparse() in ~/R/MM/Pkg-ex/Matrix/Doran-A.R lu.a <- LU.dgC(a) if(tol > 0) { rU <- range(abs(diag(lu.a@U))) if(rU[1] / rU[2] < tol) stop(gettextf("LU computationally singular: ratio of extreme entries in |diag(U)| = %9.4g", rU[1] / rU[2]), domain=NA) } n <- dim(a)[1L] ## == dim(a)[2], as a[.,.] is square matrix b.isMat <- if(missing(b)) { ## default b = Identity = Diagonal(nrow(a)), however more efficiently b <- .sparseDiagonal(n) TRUE } else { isM <- !is.null(dim(b)) if(isM && nrow(b) != n) stop("RHS 'b' has wrong number of rows:", nrow(b)) if(!isM && length(b) != n) stop("RHS 'b' has wrong length", length(b)) isM } ## bp := P %*% b bp <- if(b.isMat) b[lu.a@p+1L, ] else b[lu.a@p+1L] ## R:= U^{-1} L^{-1} P b R <- solve(lu.a@U, solve(lu.a@L, bp)) ## result = Q'R = Q' U^{-1} L^{-1} P b = A^{-1} b, as A = P'LUQ R[invPerm(lu.a@q, zero.p=TRUE), ] } ## FIXME: workaround, till .Call(dgCMatrix_matrix_solve, a, b, sparse=TRUE) works: .solve.dgC <- function(a, b, sparse, tol = .Machine$double.eps) if(sparse) .solve.dgC.lu(a, b, tol=tol) else .Call(dgCMatrix_matrix_solve, a, b, FALSE) .solve.dgC.mat <- function(a, b, sparse=FALSE, tol = .Machine$double.eps, ...) { chk.s(..., which.call=-2) if(sparse) .solve.dgC.lu(a, b, tol=tol) else .Call(dgCMatrix_matrix_solve, a, b, FALSE) } ## Provide also for pkg MatrixModels .solve.dgC.chol <- function(x, y) .Call(dgCMatrix_cholsol, as(x, "CsparseMatrix"), y) .solve.dgC.qr <- function(x, y, order = 1L) { cld <- getClass(class(x)) .Call(dgCMatrix_qrsol, # has AS_CSP(): must be dgC or dtC: if(extends1of(cld, c("dgCMatrix", "dtCMatrix"))) x else as(x, "dgCMatrix"), y, order) } setMethod("solve", signature(a = "dgCMatrix", b = "matrix"), .solve.dgC.mat) setMethod("solve", signature(a = "dgCMatrix", b = "ddenseMatrix"), .solve.dgC.mat) setMethod("solve", signature(a = "dgCMatrix", b = "dsparseMatrix"), function(a, b, sparse=NA, tol = .Machine$double.eps, ...) { chk.s(..., which.call=-2) if(is.na(sparse)) { if(isSymmetric(a)) ## TODO: fast cholmod_symmetric() for Cholesky return(solve(forceCspSymmetric(a, isTri=FALSE), b, tol=tol)) #-> sparse result ## else sparse <- FALSE # (old default) } ## FIXME: be better when sparse=TRUE (?) .solve.dgC(a, as(b, "denseMatrix"), tol=tol, sparse=sparse) }) ## This is a really dumb method but some people apparently want it ## (MM: a bit less dumb now with possibility of staying sparse) setMethod("solve", signature(a = "dgCMatrix", b = "missing"), function(a, b, sparse=NA, tol = .Machine$double.eps, ...) { chk.s(..., which.call=-2) if(is.na(sparse)) { if(isSymmetric(a)) ## TODO: fast cholmod_symmetric() for Cholesky return(solve(forceCspSymmetric(a, isTri=FALSE), b = Diagonal(nrow(a)))) #-> sparse result ## else sparse <- FALSE # (old default) } if(sparse) .solve.dgC.lu(a, tol=tol) # -> "smart" diagonal b else .Call(dgCMatrix_matrix_solve, a, b=diag(nrow(a)), FALSE) }) Matrix/R/Csparse.R0000644000176200001440000004750714127645633013472 0ustar liggesusers#### Methods for the virtual class 'CsparseMatrix' of sparse matrices stored in #### "column compressed" format. #### -- many more specific things are e.g. in ./dgCMatrix.R setAs("CsparseMatrix", "TsparseMatrix", function(from) ## |-> cholmod_C -> cholmod_T -> chm_triplet_to_SEXP ## modified to support triangular (../src/Csparse.c) .Call(Csparse_to_Tsparse, from, is(from, "triangularMatrix"))) ## special cases (when a specific "to" class is specified) setAs("dgCMatrix", "dgTMatrix", function(from) .Call(Csparse_to_Tsparse, from, FALSE)) setAs("dsCMatrix", "dsTMatrix", function(from) .Call(Csparse_to_Tsparse, from, FALSE)) setAs("dsCMatrix", "dgCMatrix", function(from) .Call(Csparse_symmetric_to_general, from)) for(prefix in c("d", "l", "n")) setAs(paste0(prefix,"sCMatrix"), "generalMatrix", function(from) .Call(Csparse_symmetric_to_general, from)) rm(prefix) setAs("dtCMatrix", "dtTMatrix", function(from) .Call(Csparse_to_Tsparse, from, TRUE)) if(FALSE) ## old version C2dense <- function(from) { ## |-> cholmod_C -> cholmod_dense -> chm_dense_to_dense cld <- getClassDef(class(from)) if (extends(cld, "generalMatrix")) .Call(Csparse_to_dense, from, FALSE) else { ## "triangular" or "symmetric" : tri <- extends(cld, "triangularMatrix") ## Csparse_to_dense loses symmetry and triangularity properties. ## With suitable changes to chm_dense_to_SEXP (../src/chm_common.c) ## we could do this in C code -- or do differently in C {FIXME!} if (tri && from@diag == "U") from <- .Call(Csparse_diagU2N, from) as(.Call(Csparse_to_dense, from, symm = !tri), # -> "[dln]geMatrix" paste0(.M.kindC(cld), .dense.prefixes[if(tri) "t" else "s"], "Matrix")) } } C2dense <- function(from) .Call(Csparse_to_dense, from, NA_integer_) setAs("CsparseMatrix", "denseMatrix", C2dense) ## special cases (when a specific "to" class is specified) setAs("dgCMatrix", "dgeMatrix", function(from) .Call(Csparse_to_dense, from, 0L)) setAs("dsCMatrix", "denseMatrix", function(from) .Call(Csparse_to_dense, from, 1L)) setAs("dtCMatrix", "denseMatrix", function(from) .Call(Csparse_to_dense, from, -1L)) setAs("dgCMatrix", "vector", function(from) .Call(Csparse_to_vector, from)) setAs("dsCMatrix", "vector", function(from) .Call(Csparse_to_vector, from)) setMethod("as.vector", "dgCMatrix", function(x, mode) as.vector(.Call(Csparse_to_vector, x), mode)) setMethod("as.vector", "dsCMatrix", function(x, mode) as.vector(.Call(Csparse_to_vector, x), mode)) ## could do these and more for as(., "numeric") ... but we *do* recommend as(*,"vector"): ## setAs("dgCMatrix", "numeric", Csp2vec) ## setAs("dsCMatrix", "numeric", Csp2vec) ## |-> cholmod_C -> cholmod_dense -> chm_dense_to_matrix ## cholmod_sparse_to_dense converts symmetric storage to general ## storage so symmetric classes are ok for conversion to matrix. ## unit triangular needs special handling ##' exported .dxC2mat <- function(from, chkUdiag=TRUE) .Call(Csparse_to_matrix, from, chkUdiag, NA) setAs("dgCMatrix", "matrix", function(from) .Call(Csparse_to_matrix, from, FALSE, FALSE)) setAs("dsCMatrix", "matrix", function(from) .Call(Csparse_to_matrix, from, FALSE, TRUE)) setAs("dtCMatrix", "matrix", function(from) .Call(Csparse_to_matrix, from, TRUE, FALSE)) ## NB: Would *not* be ok for l*Matrix or n*Matrix, ## --------- as cholmod coerces to "REAL" aka "double" ..m2dgC <- function(from) .Call(matrix_to_Csparse, from, "dgCMatrix") ..m2lgC <- function(from) .Call(matrix_to_Csparse, from, "lgCMatrix") .m2dgC <- function(from) { if(!is.double(from)) storage.mode(from) <- "double" .Call(matrix_to_Csparse, from, "dgCMatrix") } .m2lgC <- function(from) { if(!is.logical(from)) storage.mode(from) <- "logical" .Call(matrix_to_Csparse, from, "lgCMatrix") } .m2ngC <- function(from) { if(!is.logical(from)) storage.mode(from) <- "logical" if(anyNA(from)) stop("cannot coerce NA values to pattern \"ngCMatrix\"") .Call(matrix_to_Csparse, from, "ngCMatrix") } setAs("matrix", "dgCMatrix", .m2dgC) setAs("matrix", "lgCMatrix", .m2lgC) setAs("matrix", "ngCMatrix", .m2ngC) ## Here, use .m2dgC() instead of ..m2dgC() as C-level ## matrix_to_Csparse(x, "dgCMatrix") fails when x is *integer* : setAs("matrix", "CsparseMatrix", ## => choosing 'l*' or 'dgCMatrix' (no tri-, sym-, diag-): function(from) (if(is.logical(from)) ..m2lgC else .m2dgC)(from)) setAs("numeric", "CsparseMatrix", function(from) (if(is.logical(from)) ..m2lgC else .m2dgC)(as.matrix.default(from))) setAs("CsparseMatrix", "symmetricMatrix", function(from) { if(isSymmetric(from)) forceCspSymmetric(from) else stop("not a symmetric matrix; consider forceSymmetric() or symmpart()") }) .validateCsparse <- function(x, sort.if.needed = FALSE) .Call(Csparse_validate2, x, sort.if.needed) ##-> to be used in sparseMatrix(.), e.g. --- but is unused currently ## NB: 'sort.if.needed' is called 'maybe_modify' in C -- so be careful ## more useful: .sortCsparse <- function(x) .Call(Csparse_sort, x) ## modifies 'x' !! ### Some group methods: ### Subsetting -- basic things (drop = "missing") are done in ./Matrix.R ### ---------- "[" and (currently) also ./sparseMatrix.R subCsp_cols <- function(x, j, drop) { ## x[ , j, drop=drop] where we know that x is Csparse* dn <- x@Dimnames jj <- intI(j, n = x@Dim[2], dn[[2]], give.dn = FALSE) r <- .Call(Csparse_submatrix, x, NULL, jj) if(!is.null(n <- dn[[1]])) r@Dimnames[[1]] <- n if(!is.null(n <- dn[[2]])) r@Dimnames[[2]] <- n[jj+1L] if(drop && any(r@Dim == 1L)) drop(as(r, "matrix")) else { if(!is.null(n <- names(dn))) names(r@Dimnames) <- n r } } subCsp_rows <- function(x, i, drop)# , cl = getClassDef(class(x)) { ## x[ i, drop=drop] where we know that x is Csparse* dn <- x@Dimnames ii <- intI(i, n = x@Dim[1], dn[[1]], give.dn = FALSE) r <- .Call(Csparse_submatrix, x, ii, NULL) if(!is.null(n <- dn[[1]])) r@Dimnames[[1]] <- n[ii+1L] if(!is.null(n <- dn[[2]])) r@Dimnames[[2]] <- n if(drop && any(r@Dim == 1L)) drop(as(r, "matrix")) else { if(!is.null(n <- names(dn))) names(r@Dimnames) <- n r } } subCsp_ij <- function(x, i, j, drop) { ## x[i, j, drop=drop] where we know that x is Csparse* d <- x@Dim dn <- x@Dimnames ## Take care that x[i,i] for symmetricM* stays symmetric i.eq.j <- identical(i,j) # < want fast check ii <- intI(i, n = d[1], dn[[1]], give.dn = FALSE) jj <- if(i.eq.j && d[1] == d[2]) ii else intI(j, n = d[2], dn[[2]], give.dn = FALSE) r <- .Call(Csparse_submatrix, x, ii, jj) if(!is.null(n <- dn[[1]])) r@Dimnames[[1]] <- n[ii + 1L] if(!is.null(n <- dn[[2]])) r@Dimnames[[2]] <- n[jj + 1L] if(!i.eq.j) { if(drop && any(r@Dim == 1L)) drop(as(r, "matrix")) else { if(!is.null(n <- names(dn))) names(r@Dimnames) <- n r } } else { ## i == j if(drop) drop <- any(r@Dim == 1L) if(drop) drop(as(r, "matrix")) else { if(!is.null(n <- names(dn))) names(r@Dimnames) <- n if(extends((cx <- getClassDef(class(x))), "symmetricMatrix")) .gC2sym(r, uplo = x@uplo) # preserving uplo else if(extends(cx, "triangularMatrix") && !is.unsorted(ii)) as(r, "triangularMatrix") else r } } } setMethod("[", signature(x = "CsparseMatrix", i = "index", j = "missing", drop = "logical"), function (x, i,j, ..., drop) { na <- nargs() Matrix.msg("Csp[i,m,l] : nargs()=",na, .M.level = 2) if(na == 4) subCsp_rows(x, i, drop=drop) else if(na == 3) .M.vectorSub(x, i) # as(x, "TsparseMatrix")[i, drop=drop] else ## should not happen stop("Matrix-internal error in [i,,d]; please report") }) setMethod("[", signature(x = "CsparseMatrix", i = "missing", j = "index", drop = "logical"), function (x,i,j, ..., drop) { Matrix.msg("Csp[m,i,l] : nargs()=",nargs(), .M.level = 2) subCsp_cols(x, j, drop=drop) }) setMethod("[", signature(x = "CsparseMatrix", i = "index", j = "index", drop = "logical"), function (x, i, j, ..., drop) { Matrix.msg("Csp[i,i,l] : nargs()=",nargs(), .M.level = 2) subCsp_ij(x, i, j, drop=drop) }) ## workhorse for "[<-" -- for d*, l*, and n..C-sparse matrices : ## --------- ----- replCmat <- function (x, i, j, ..., value) { di <- dim(x) dn <- dimnames(x) iMi <- missing(i) jMi <- missing(j) na <- nargs() Matrix.msg("replCmat[x,i,j,.., val] : nargs()=", na,"; ", if(iMi | jMi) sprintf("missing (i,j) = (%d,%d)", iMi,jMi), .M.level = 2) if(na == 3) { ## vector (or 2-col) indexing M[i] <- v : includes M[TRUE] <- v or M[] <- v ! x <- as(x, "TsparseMatrix") x[i] <- value # may change class e.g. from dtT* to dgT* clx <- sub(".Matrix$", "CMatrix", (c.x <- class(x))) if("x" %in% .slotNames(c.x) && any0(x@x)) ## drop all values that "happen to be 0" drop0(x, is.Csparse=FALSE) else as_CspClass(x, clx) } else ## nargs() == 4 : replCmat4(x, i1 = if(iMi) 0:(di[1] - 1L) else .ind.prep2(i, 1, di, dn), i2 = if(jMi) 0:(di[2] - 1L) else .ind.prep2(j, 2, di, dn), iMi=iMi, jMi=jMi, value=value) } ## replCmat replCmat4 <- function(x, i1, i2, iMi, jMi, value, spV = is(value,"sparseVector")) { dind <- c(length(i1), length(i2)) # dimension of replacement region lenRepl <- prod(dind) lenV <- length(value) if(lenV == 0) { if(lenRepl != 0) stop("nothing to replace with") else return(x) } ## else: lenV := length(value) is > 0 if(lenRepl %% lenV != 0) stop("number of items to replace is not a multiple of replacement length") if(lenV > lenRepl) stop("too many replacement values") clx <- class(x) clDx <- getClassDef(clx) # extends() , is() etc all use the class definition ## keep "symmetry" if changed here: x.sym <- extends(clDx, "symmetricMatrix") if(x.sym) { ## only half the indices are there.. ## using array() for large dind is a disaster... mkArray <- if(spV) # TODO: room for improvement function(v, dim) spV2M(v, dim[1],dim[2]) else array x.sym <- (dind[1] == dind[2] && all(i1 == i2) && (lenRepl == 1 || lenV == 1 || isSymmetric(mkArray(value, dim=dind)))) ## x.sym : result is *still* symmetric x <- .Call(Csparse_symmetric_to_general, x) ## but do *not* redefine clx! } else if(extends(clDx, "triangularMatrix")) { xU <- x@uplo == "U" r.tri <- ((any(dind == 1) || dind[1] == dind[2]) && if(xU) max(i1) <= min(i2) else max(i2) <= min(i1)) if(r.tri) { ## result is *still* triangular if(any(i1 == i2)) # diagonal will be changed x <- diagU2N(x) # keeps class (!) } else { # go to "generalMatrix" and continue x <- as(x, paste0(.M.kind(x), "gCMatrix")) ## & do not redefine clx! } } ## Temporary hack for debugging --- remove eventually -- FIXME : ## see also MATRIX_SUBASSIGN_VERBOSE in ../src/t_Csparse_subassign.c if(!is.null(v <- getOption("Matrix.subassign.verbose")) && v) { op <- options(Matrix.verbose = 2); on.exit(options(op)) ## the "hack" to signal "verbose" to the C code: i1[1] <- -i1[1] if(i1[1] == 0) warning("i1[1] == 0 ==> C-level verbosity will not happen!") } if(extends(clDx, "dMatrix")) { has.x <- TRUE x <- .Call(dCsparse_subassign, if(clx %in% c("dgCMatrix", "dtCMatrix")) x else as(x, "dgCMatrix"), i1, i2, as(value, "sparseVector")) } else if(extends(clDx, "lMatrix")) { has.x <- TRUE x <- .Call(lCsparse_subassign, if(clx %in% c("lgCMatrix", "ltCMatrix")) x else as(x, "lgCMatrix"), i1, i2, as(value, "sparseVector")) } else if(extends(clDx, "nMatrix")) { has.x <- FALSE x <- .Call(nCsparse_subassign, if(clx %in% c("ngCMatrix", "ntCMatrix"))x else as(x, "ngCMatrix"), i1, i2, as(value, "sparseVector")) } else if(extends(clDx, "iMatrix")) { has.x <- TRUE x <- .Call(iCsparse_subassign, if(clx %in% c("igCMatrix", "itCMatrix"))x else as(x, "igCMatrix"), i1, i2, as(value, "sparseVector")) } else if(extends(clDx, "zMatrix")) { has.x <- TRUE x <- .Call(zCsparse_subassign, if(clx %in% c("zgCMatrix", "ztCMatrix"))x else as(x, "zgCMatrix"), i1, i2, ## here we only want zsparseVector {to not have to do this in C}: as(value, "zsparseVector")) } else { ## use "old" code ... ## does this happen ? ==> if(identical(Sys.getenv("USER"),"maechler"))## does it still happen? __ FIXME __ stop("using \"old code\" part in Csparse subassignment") ## else warning("using\"old code\" part in Csparse subassignment\n >>> please report to Matrix-authors@r-project.org", immediate. = TRUE) xj <- .Call(Matrix_expand_pointers, x@p) sel <- (!is.na(match(x@i, i1)) & !is.na(match( xj, i2))) has.x <- "x" %in% slotNames(clDx)# === slotNames(x), ## has.x <==> *not* nonzero-pattern == "nMatrix" if(has.x && sum(sel) == lenRepl) { ## all entries to be replaced are non-zero: ## need indices instead of just 'sel', for, e.g., A[2:1, 2:1] <- v non0 <- cbind(match(x@i[sel], i1), match(xj [sel], i2), deparse.level=0L) iN0 <- 1L + .Call(m_encodeInd, non0, di = dind, orig1=TRUE, checkBounds=FALSE) has0 <- if(spV) length(value@i) < lenV else any(value[!is.na(value)] == 0) if(lenV < lenRepl) value <- rep_len(value, lenRepl) ## Ideally we only replace them where value != 0 and drop the value==0 ## ones; FIXME: see Davis(2006) "2.7 Removing entries", p.16, e.g. use cs_dropzeros() ## but really could be faster and write something like cs_drop_k(A, k) ## v0 <- 0 == value ## if (lenRepl == 1) and v0 is TRUE, the following is not doing anything ##- --> ./Tsparse.R and its replTmat() ## x@x[sel[!v0]] <- value[!v0] x@x[sel] <- as.vector(value[iN0]) if(extends(clDx, "compMatrix") && length(x@factors)) # drop cashed ones x@factors <- list() if(has0) x <- .Call(Csparse_drop, x, 0) return(if(x.sym) as_CspClass(x, clx) else x) } ## else go via Tsparse.. {FIXME: a waste! - we already have 'xj' ..} ## and inside Tsparse... the above i1, i2,..., sel are *all* redone! ## Happens too often {not anymore, I hope!} ## Matrix.msg("wasteful C -> T -> C in replCmat(x,i,j,v) for [i,j] <- v") x <- as(x, "TsparseMatrix") if(iMi) x[ ,i2+1L] <- value else if(jMi) x[i1+1L, ] <- value else x[i1+1L,i2+1L] <- value if(extends(clDx, "compMatrix") && length(x@factors)) # drop cashed ones x@factors <- list() }# else{ not using new memory-sparse code if(has.x && any0(x@x)) ## drop all values that "happen to be 0" as_CspClass(drop0(x), clx) else as_CspClass(x, clx) } ## replCmat4 setReplaceMethod("[", signature(x = "CsparseMatrix", i = "index", j = "missing", value = "replValue"), replCmat) setReplaceMethod("[", signature(x = "CsparseMatrix", i = "missing", j = "index", value = "replValue"), replCmat) setReplaceMethod("[", signature(x = "CsparseMatrix", i = "index", j = "index", value = "replValue"), replCmat) ### When the RHS 'value' is a sparseVector, now can use replCmat as well setReplaceMethod("[", signature(x = "CsparseMatrix", i = "missing", j = "index", value = "sparseVector"), replCmat) setReplaceMethod("[", signature(x = "CsparseMatrix", i = "index", j = "missing", value = "sparseVector"), replCmat) setReplaceMethod("[", signature(x = "CsparseMatrix", i = "index", j = "index", value = "sparseVector"), replCmat) ## A[ ij ] <- value, where ij is (i,j) 2-column matrix setReplaceMethod("[", signature(x = "CsparseMatrix", i = "matrix", j = "missing", value = "replValue"), function(x, i, j, ..., value) ## goto Tsparse modify and convert back: as(.TM.repl.i.mat(as(x, "TsparseMatrix"), i=i, value=value), "CsparseMatrix")) ## more in ./sparseMatrix.R (and ./Matrix.R ) setReplaceMethod("[", signature(x = "CsparseMatrix", i = "Matrix", j = "missing", value = "replValue"), function(x, i, j, ..., value) ## goto Tsparse modify and convert back: as(.TM.repl.i.mat(as(x, "TsparseMatrix"), i=i, value=value), "CsparseMatrix")) setMethod("t", signature(x = "CsparseMatrix"), function(x) .Call(Csparse_transpose, x, is(x, "triangularMatrix"))) ## NB: have extra tril(), triu() methods for symmetric ["dsC" and "lsC"] and ## for all triangular ones, where the latter may 'callNextMethod()' these: setMethod("tril", "CsparseMatrix", function(x, k = 0, ...) { k <- as.integer(k[1]) dd <- dim(x); sqr <- dd[1] == dd[2] stopifnot(-dd[1] <= k, k <= dd[1]) # had k <= 0 r <- .Call(Csparse_band, x, -dd[1], k) ## return "lower triangular" if k <= 0 if(sqr && k <= 0) .gC2tC(r, uplo = "L") else r }) setMethod("triu", "CsparseMatrix", function(x, k = 0, ...) { k <- as.integer(k[1]) dd <- dim(x); sqr <- dd[1] == dd[2] stopifnot(-dd[1] <= k, k <= dd[1]) # had k >= 0 r <- .Call(Csparse_band, x, k, dd[2]) ## return "upper triangular" if k >= 0 if(sqr && k >= 0) .gC2tC(r, uplo = "U") else r }) setMethod("band", "CsparseMatrix", function(x, k1, k2, ...) { k1 <- as.integer(k1[1]) k2 <- as.integer(k2[1]) dd <- dim(x); sqr <- dd[1] == dd[2] stopifnot(-dd[1] <= k1, k1 <= k2, k2 <= dd[2]) if(extends(cl <- getClassDef(class(x)), "symmetricMatrix") && k1 != -k2) { ## result is *not* symmetric (but C's Csparse_band will keep '->stype'): x <- as(x, "generalMatrix") # -> .Call(Csparse_symmetric_to_general, .) } else if(extends(cl, "triangularMatrix") && x@diag == "U") x <- .diagU2N(x, cl) r <- .Call(Csparse_band, x, k1, k2) if(sqr && as.numeric(k1) * k2 >= 0) ## triangular result as(r, paste0(.M.kind(x), "tCMatrix")) else if (k1 < 0 && k1 == -k2 && isSymmetric(x)) ## symmetric ## does this always work ?? as(r, paste0(.M.kind(x), "sCMatrix")) else r }) setMethod("diag", "CsparseMatrix", function(x, nrow, ncol) { ## "FIXME": could be more efficient; creates new ..CMatrix: dm <- .Call(Csparse_band, diagU2N(x), 0, 0) dlen <- min(dm@Dim) ind1 <- dm@i + 1L # 1-based index vector if (is(dm, "nMatrix")) { val <- rep.int(FALSE, dlen) val[ind1] <- TRUE } else if (is(dm, "lMatrix")) { val <- rep.int(FALSE, dlen) val[ind1] <- as.logical(dm@x) } else { val <- rep.int(0, dlen) ## cMatrix not yet active but for future expansion if (is(dm, "cMatrix")) val <- as.complex(val) val[ind1] <- dm@x } val }) setMethod("writeMM", "CsparseMatrix", function(obj, file, ...) .Call(Csparse_MatrixMarket, obj, path.expand(as.character(file)))) setMethod("Cholesky", signature(A = "CsparseMatrix"), function(A, perm = TRUE, LDL = !super, super = FALSE, Imult = 0, ...) Cholesky(as(A, "symmetricMatrix"), perm=perm, LDL=LDL, super=super, Imult=Imult, ...)) ## TODO (in ../TODO for quite a while .....): setMethod("Cholesky", signature(A = "nsparseMatrix"), function(A, perm = TRUE, LDL = !super, super = FALSE, Imult = 0, ...) stop("Cholesky() -> *symbolic* factorization -- not yet implemented")) if(FALSE) isDiagCsp <- function(object) { d <- dim(object) if((n <- d[1]) != d[2]) FALSE else if(n == 0) TRUE else # (n >= 1) ## "FIXME": do this in C --->>> for now use Csparse_to_Tsparse (m <- length(i <- object@i)) == 0 || { m <= n && !anyDuplicated(i) && ## length(p <- object@p) == n+1L && all((dp <- diff(object@p)) <= 1L) && length(j <- base::which(dp == 1L)) == m && all(j == i+1L) } } if(FALSE) setMethod("isDiagonal", signature(object = "CsparseMatrix"), isDiagCsp) setMethod("isDiagonal", signature(object = "CsparseMatrix"), function(object) isDiagTsp(.Call(Csparse_to_Tsparse, object, is(object, "triangularMatrix")))) Matrix/R/colSums.R0000644000176200001440000002306112533262160013471 0ustar liggesusers#### Collect methods for colSums(), rowSums(), colMeans(), rowMeans() here. #### ======= ------- -------- -------- ## Utilities: ## .as.dgC.Fun <- function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) { ## x <- as(x, "dgCMatrix") ## callGeneric() ## } ## .as.dgT.Fun <- function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) { ## x <- as(x, "dgTMatrix") ## callGeneric() ## } .as.d.Fun <- function(x, na.rm = FALSE, dims = 1) { x <- as(x, "dMatrix") callGeneric() } .as.dge.Fun <- function(x, na.rm = FALSE, dims = 1) { x <- as(x, "dgeMatrix") callGeneric() } .as.gC.Fun <- function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) { x <- as_gCsimpl(x) callGeneric() } .as.C.Fun <- function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) { x <- as(x, "CsparseMatrix") ## or if necessary as_Csparse(.) callGeneric() } ### Dense Matrices: ------------------------------------------------- setMethod("colSums", signature(x = "denseMatrix"), .as.d.Fun) setMethod("colMeans", signature(x = "denseMatrix"), .as.d.Fun) setMethod("rowSums", signature(x = "denseMatrix"), .as.d.Fun) setMethod("rowMeans", signature(x = "denseMatrix"), .as.d.Fun) ## FIXME: "works" but not optimally for triangular/symmetric(packed)/.. setMethod("colSums", signature(x = "ddenseMatrix"), .as.dge.Fun) setMethod("colMeans", signature(x = "ddenseMatrix"), .as.dge.Fun) setMethod("rowSums", signature(x = "ddenseMatrix"), .as.dge.Fun) setMethod("rowMeans", signature(x = "ddenseMatrix"), .as.dge.Fun) setMethod("colSums", signature(x = "dgeMatrix"), function(x, na.rm = FALSE, dims = 1) .Call(dgeMatrix_colsums, x, na.rm, TRUE, FALSE), valueClass = "numeric") setMethod("colMeans", signature(x = "dgeMatrix"), function(x, na.rm = FALSE, dims = 1) .Call(dgeMatrix_colsums, x, na.rm, TRUE, TRUE), valueClass = "numeric") setMethod("rowSums", signature(x = "dgeMatrix"), function(x, na.rm = FALSE, dims = 1) .Call(dgeMatrix_colsums, x, na.rm, FALSE, FALSE), valueClass = "numeric") setMethod("rowMeans", signature(x = "dgeMatrix"), function(x, na.rm = FALSE, dims = 1) .Call(dgeMatrix_colsums, x, na.rm, FALSE, TRUE), valueClass = "numeric") ### Sparse Matrices: ------------------------------------------------- ## Diagonal ones: .diag.Sum <- function(x, na.rm = FALSE, dims = 1) if(x@diag == "U") rep(1, x@Dim[1]) else as.numeric(x@x) .diag.Mean <- function(x, na.rm = FALSE, dims = 1) { n <- x@Dim[1L] if(x@diag == "U") rep(1/n, n) else as.numeric(x@x)/n } setMethod("colSums", signature(x = "diagonalMatrix"), .diag.Sum) setMethod("rowSums", signature(x = "diagonalMatrix"), .diag.Sum) setMethod("colMeans", signature(x = "diagonalMatrix"), .diag.Mean) setMethod("rowMeans", signature(x = "diagonalMatrix"), .diag.Mean) rm(.diag.Sum, .diag.Mean) ### Csparse --- the fast workhorse ones ### 1) those with .Call(.), {d, i, l, n} gCMatrix x {col|row}{Sums|Means} : ## the last two arguments to .gCMatrix_(col|col)(Sums|Means) are 'trans' and 'means' setMethod("colSums", signature(x = "dgCMatrix"), function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) .Call(dgCMatrix_colSums, x, na.rm, sparseResult, FALSE, FALSE)) setMethod("rowSums", signature(x = "dgCMatrix"), function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) .Call(dgCMatrix_colSums, x, na.rm, sparseResult, TRUE, FALSE)) setMethod("colMeans", signature(x = "dgCMatrix"), function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) .Call(dgCMatrix_colSums, x, na.rm, sparseResult, FALSE, TRUE)) setMethod("rowMeans", signature(x = "dgCMatrix"), function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) .Call(dgCMatrix_colSums, x, na.rm, sparseResult, TRUE, TRUE)) setMethod("colSums", signature(x = "igCMatrix"), function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) .Call(igCMatrix_colSums, x, na.rm, sparseResult, FALSE, FALSE)) setMethod("rowSums", signature(x = "igCMatrix"), function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) .Call(igCMatrix_colSums, x, na.rm, sparseResult, TRUE, FALSE)) setMethod("colMeans", signature(x = "igCMatrix"), function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) .Call(igCMatrix_colSums, x, na.rm, sparseResult, FALSE, TRUE)) setMethod("rowMeans", signature(x = "igCMatrix"), function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) .Call(igCMatrix_colSums, x, na.rm, sparseResult, TRUE, TRUE)) setMethod("colSums", signature(x = "lgCMatrix"), function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) .Call(lgCMatrix_colSums, x, na.rm, sparseResult, FALSE, FALSE)) setMethod("rowSums", signature(x = "lgCMatrix"), function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) .Call(lgCMatrix_colSums, x, na.rm, sparseResult, TRUE, FALSE)) setMethod("colMeans", signature(x = "lgCMatrix"), function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) .Call(lgCMatrix_colSums, x, na.rm, sparseResult, FALSE, TRUE)) setMethod("rowMeans", signature(x = "lgCMatrix"), function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) .Call(lgCMatrix_colSums, x, na.rm, sparseResult, TRUE, TRUE)) setMethod("colSums", signature(x = "ngCMatrix"), function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) .Call(ngCMatrix_colSums, x, na.rm, sparseResult, FALSE, FALSE)) setMethod("rowSums", signature(x = "ngCMatrix"), function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) .Call(ngCMatrix_colSums, x, na.rm, sparseResult, TRUE, FALSE)) setMethod("colMeans", signature(x = "ngCMatrix"), function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) .Call(ngCMatrix_colSums, x, na.rm, sparseResult, FALSE, TRUE)) setMethod("rowMeans", signature(x = "ngCMatrix"), function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) .Call(ngCMatrix_colSums, x, na.rm, sparseResult, TRUE, TRUE)) ### 2) the other Csparse ones are "just" coerced to a *gCMatrix : setMethod("colSums", signature(x = "CsparseMatrix"), .as.gC.Fun) setMethod("colMeans", signature(x = "CsparseMatrix"), .as.gC.Fun) setMethod("rowSums", signature(x = "CsparseMatrix"), .as.gC.Fun) setMethod("rowMeans", signature(x = "CsparseMatrix"), .as.gC.Fun) ##setMethod("rowSums", signature(x = "dgCMatrix"), ## function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) ## sparsapply(x, 1, sum, sparseResult = sparseResult, na.rm = na.rm)) ##setMethod("rowMeans", signature(x = "dgCMatrix"), sp.rowMeans) ## --- Tsparse ---- ## .as.C.Fun -- since there's now C code for dgCMatrix_colSums setMethod("colSums", signature(x = "TsparseMatrix"), .as.C.Fun) setMethod("colMeans", signature(x = "TsparseMatrix"), .as.C.Fun) setMethod("rowSums", signature(x = "TsparseMatrix"), .as.C.Fun) setMethod("rowMeans", signature(x = "TsparseMatrix"), .as.C.Fun) ## setMethod("colSums", signature(x = "TsparseMatrix"), .as.dgT.Fun, ## valueClass = "numeric") ## setMethod("colMeans", signature(x = "TsparseMatrix"), .as.dgT.Fun, ## valueClass = "numeric") ## ## setMethod("rowSums", signature(x = "TsparseMatrix"), .as.dgT.Fun, ## valueClass = "numeric") ## setMethod("rowMeans", signature(x = "TsparseMatrix"), .as.dgT.Fun, ## valueClass = "numeric") ## setMethod("colSums", signature(x = "dgTMatrix"), ## function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) ## sparsapply(x, 2, sum, sparseResult = sparseResult, na.rm = na.rm)) ## setMethod("rowSums", signature(x = "dgTMatrix"), ## function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) ## sparsapply(x, 1, sum, sparseResult = sparseResult, na.rm = na.rm)) ## setMethod("colMeans", signature(x = "dgTMatrix"), sp.colMeans) ## setMethod("rowMeans", signature(x = "dgTMatrix"), sp.rowMeans) ## --- Rsparse ---- ## row <-> col of the "transposed, seen as C" : setMethod("rowSums", signature(x = "RsparseMatrix"), function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) colSums(.tR.2.C(x), na.rm=na.rm, dims=dims, sparseResult=sparseResult)) setMethod("rowMeans", signature(x = "RsparseMatrix"), function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) colMeans(.tR.2.C(x), na.rm=na.rm, dims=dims, sparseResult=sparseResult)) setMethod("colSums", signature(x = "RsparseMatrix"), function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) rowSums(.tR.2.C(x), na.rm=na.rm, dims=dims, sparseResult=sparseResult)) setMethod("colMeans", signature(x = "RsparseMatrix"), function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) rowMeans(.tR.2.C(x), na.rm=na.rm, dims=dims, sparseResult=sparseResult)) ## ## These two are obviously more efficient than going through Tsparse: ## setMethod("colSums", signature(x = "dgRMatrix"), ## function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE) ## sparsapply(x, 2, sum, sparseResult = sparseResult, na.rm = na.rm)) ## setMethod("colMeans", signature(x = "dgRMatrix"), sp.colMeans) ## --- indMatrix [incl pMatrix ] --- setMethod("colSums", signature(x = "indMatrix"), function(x, na.rm = FALSE, dims = 1) tabulate(x@perm, nbins=x@Dim[2])) setMethod("colMeans", signature(x = "indMatrix"), function(x, na.rm = FALSE, dims = 1) tabulate(x@perm, nbins=x@Dim[2])/x@Dim[1]) ## for completeness: setMethod("rowSums", signature(x = "indMatrix"), function(x, na.rm = FALSE, dims = 1) rep.int(1, x@Dim[1])) setMethod("rowMeans", signature(x = "indMatrix"), function(x, na.rm = FALSE, dims = 1) rep.int(1/x@Dim[2], x@Dim[1])) Matrix/R/dsparseMatrix.R0000644000176200001440000000444613774675543014725 0ustar liggesusers### d(ouble)sparseMatrix methods : setMethod("image", "dsparseMatrix", function(x, ...) image(as(x, "dgTMatrix"), ...)) ## fails e.g. for 'dtCMatrix'; "triangularMatrix" has own method in ./triangularMatrix.R setMethod("chol", signature(x = "dsparseMatrix"), function(x, pivot=FALSE, cache=TRUE, ...) { nm <- if(pivot) "sPdCholesky" else "spdCholesky" if(!is.null(ch <- x@factors[[nm]])) return(ch) ## use the cache px <- as(x, "symmetricMatrix") if (isTRUE(validObject(px, test=TRUE))) { if(cache) .set.factors(x, nm, chol(as(px, "CsparseMatrix"), pivot=pivot, ...)) else chol(as(px, "CsparseMatrix"), pivot=pivot, ...) } else stop("'x' is not positive definite -- chol() undefined.") }) setMethod("determinant", signature(x = "dsparseMatrix", logarithm = "logical"), function(x, logarithm = TRUE, ...) determinant(as(x,"CsparseMatrix"), logarithm, ...)) ##-> now dgC or dsC or dtC .. which *have* their methods setMethod("lu", signature(x = "dsparseMatrix"), function(x, cache=TRUE, ...) if(cache) .set.factors(x, "lu", lu(as(x, "dgCMatrix"), ...)) else lu(as(x, "dgCMatrix"), ...)) setMethod("is.finite", signature(x = "dsparseMatrix"), function(x) { if(any(!is.finite(x@x))) { r <- allTrueMat(x, packed = FALSE) x <- as(as(as(x,"CsparseMatrix"), "dgCMatrix"),"dgTMatrix") notF <- which(!is.finite(x@x)) r[cbind(x@i[notF], x@j[notF]) + 1L] <- FALSE r } else allTrueMat(x) }) setMethod("is.infinite", signature(x = "dsparseMatrix"), function(x) { if(any((isInf <- is.infinite(x@x)))) { cld <- getClassDef(class(x)) if(extends(cld, "triangularMatrix") && x@diag == "U") isInf <- is.infinite((x <- .diagU2N(x, cld))@x) r <- as(x, "lMatrix") # will be "lsparseMatrix" - *has* x slot r@x <- if(length(isInf) == length(r@x)) isInf else is.infinite(r@x) if(!extends(cld, "CsparseMatrix")) r <- as(r, "CsparseMatrix") as(.Call(Csparse_drop, r, 0), "nMatrix") # a 'pattern matrix } else is.na_nsp(x) }) ## Group Methods, see ?Arith (e.g.): "Ops" --> ./Ops.R, "Math" in ./Math.R, ... ## ----- Matrix/R/dgeMatrix.R0000644000176200001440000000642413047113565014001 0ustar liggesusers ## ..2dge() -> ./Auxiliaries.R setAs("matrix", "dgeMatrix", ..2dge) setAs("numLike", "dgeMatrix", ..2dge) ge2mat <- function(from) array(from@x, dim = from@Dim, dimnames = from@Dimnames) setAs("dgeMatrix", "matrix", ge2mat) ## "[" settings are "up in" Matrix.R & denseMatrix.R setMethod("as.vector", "dgeMatrix", function(x, mode) as.vector(x@x, mode)) setMethod("norm", signature(x = "dgeMatrix", type = "missing"), function(x, type, ...) norm(x, type = "O", ...)) setMethod("norm", signature(x = "dgeMatrix", type = "character"), function(x, type, ...) if(identical("2", type)) norm2(x) else .Call(dgeMatrix_norm, x, type), valueClass = "numeric") setMethod("rcond", signature(x = "dgeMatrix", norm = "missing"), function(x, norm, ...) rcond(x, norm = "O", ...)) setMethod("rcond", signature(x = "dgeMatrix", norm = "character"), function(x, norm, ...) { if({d <- dim(x); d[1] == d[2]}) .Call(dgeMatrix_rcond, x, norm) else rcond(qr.R(qr(if(d[1] < d[2]) t(x) else x)), norm=norm, ...) }, valueClass = "numeric") ##> FIXME: R-devel (2.11.0) norm() is *wrong* for NAs, whereas this dgeMatrix ##> ----- one works, even though both should call the identical LAPACK 'dlange' ????? ##> Hence, keep the Matrix version active for now: ##> if(getRversion() < "2.11.0" || R.version$`svn rev` < 51018) ##--- the same for "traditional" 'matrix': ## 2017-02-08: Rather keep using base norm for 'matrix' ## setMethod("norm", signature(x = "matrix", type = "character"), ## function(x, type, ...) .Call(dgeMatrix_norm, ..2dge(x), type), ## valueClass = "numeric") setMethod("t", signature(x = "dgeMatrix"), t_geMatrix) .dge.diag <- function(x, nrow, ncol) .Call(dgeMatrix_getDiag, x) setMethod("diag", signature(x = "dgeMatrix"), .dge.diag) setMethod("diag<-", signature(x = "dgeMatrix"), function(x, value) .Call(dgeMatrix_setDiag, x, value)) setMethod("chol", signature(x = "dgeMatrix"), cholMat) setMethod("solve", signature(a = "dgeMatrix", b = "missing"), function(a, b, ...) .Call(dgeMatrix_solve, a), valueClass = "dgeMatrix") setMethod("solve", signature(a = "dgeMatrix", b = "ddenseMatrix"), function(a, b, ...) .Call(dgeMatrix_matrix_solve, a, b), valueClass = "dgeMatrix") setMethod("solve", signature(a = "dgeMatrix", b = "matrix"), function(a, b, ...) .Call(dgeMatrix_matrix_solve, a, b), valueClass = "dgeMatrix") setMethod("solve", signature(a = "dgeMatrix", b = "sparseMatrix"), function(a, b, ...) .Call(dgeMatrix_matrix_solve, a, as(b, "denseMatrix")), valueClass = "dgeMatrix") ## not needed - method for numeric defined for Matrix class ## setMethod("solve", signature(a = "dgeMatrix", b = "numeric"), ## function(a, b, ...) ## .Call(dgeMatrix_matrix_solve, a, as.matrix(as.double(b)))) setMethod("lu", signature(x = "dgeMatrix"), function(x, warnSing = TRUE, ...) .Call(dgeMatrix_LU, x, warnSing), valueClass = "denseLU") setMethod("determinant", signature(x = "dgeMatrix", logarithm = "missing"), function(x, logarithm, ...) .Call(dgeMatrix_determinant, x, TRUE)) setMethod("determinant", signature(x = "dgeMatrix", logarithm = "logical"), function(x, logarithm, ...) .Call(dgeMatrix_determinant, x, logarithm)) ##-> ./expm.R for expm() ##-> ./colSums.R for colSums,... rowMeans Matrix/R/nsparseMatrix.R0000644000176200001440000000117312524132306014702 0ustar liggesusers#### Superclass Methods for all sparse nonzero-pattern matrices .C2nC <- function(from, isTri = is(from, "triangularMatrix")) .Call(Csparse_to_nz_pattern, from, isTri) setAs("CsparseMatrix", "nsparseMatrix", function(from) .C2nC(from)) setAs("CsparseMatrix", "nMatrix", function(from) .C2nC(from)) setAs("nsparseMatrix", "dsparseMatrix", function(from) as(from, "dMatrix")) setMethod("is.na", signature(x = "nsparseMatrix"), is.na_nsp) if(getRversion() >= "3.1.0") setMethod("anyNA", signature(x = "nsparseMatrix"), function(x) FALSE) setMethod("image", "nsparseMatrix", function(x, ...) image(as(x,"dMatrix"), ...)) Matrix/R/dsTMatrix.R0000644000176200001440000000234312501023016013751 0ustar liggesusers### Coercion and Methods for Symmetric Triplet Matrices ## Now in ./Tsparse.R ## setAs("dsTMatrix", "dsCMatrix", ## function(from) .Call(Tsparse_to_Csparse, from, FALSE)) setAs("dsTMatrix", "dgTMatrix", function(from) .Call(dsTMatrix_as_dgTMatrix, from)) setAs("dsTMatrix", "lsTMatrix", function(from) new("lsTMatrix", i = from@i, j = from@j, uplo = from@uplo, Dim = from@Dim, Dimnames = from@Dimnames)) ## Conversion <--> dense storage is via dsyMatrix : setAs("dsTMatrix", "dsyMatrix", function(from) .Call(dsTMatrix_as_dsyMatrix, from)) setAs("dsTMatrix", "dgeMatrix", function(from) as(as(from, "dsyMatrix"), "dgeMatrix")) setAs("dsTMatrix", "matrix", function(from) as(as(from, "dsyMatrix"), "matrix")) to_dsT <- function(from) as(as(from, "dsyMatrix"), "dsTMatrix") setAs("dgeMatrix", "dsTMatrix", to_dsT) setAs("matrix", "dsTMatrix", to_dsT) setMethod("t", "dsTMatrix", function(x) new("dsTMatrix", Dim = x@Dim, Dimnames = x@Dimnames[2:1], i = x@j, j = x@i, x = x@x, uplo = if (x@uplo == "U") "L" else "U")) ## setMethod("writeHB", signature(obj = "dsTMatrix"), ## function(obj, file, ...) callGeneric(as(obj, "CsparseMatrix"), file, ...)) Matrix/R/expm.R0000644000176200001440000000222011004063604013001 0ustar liggesusers#### All methods for expm() , the Matrix Exponential setMethod("expm", signature(x = "dgeMatrix"), function(x) .Call(dgeMatrix_exp, x)) setMethod("expm", signature(x = "Matrix"), function(x) expm(as(x, "dMatrix"))) setMethod("expm", signature(x = "dMatrix"),function(x) expm(as(x, "dgeMatrix"))) ## but these trigger first: expmSpec <- function(x, newClass) { r <- copyClass(x, newClass, c("uplo", "Dim", "Dimnames")) r@x <- expm(as(as(x, "dMatrix"),"generalMatrix"))@x r } setMethod("expm", signature(x = "triangularMatrix"), function(x) expmSpec(x, "dtrMatrix")) setMethod("expm", signature(x = "symmetricMatrix"), function(x) expmSpec(x, "dsyMatrix")) setMethod("expm", signature(x = "ddiMatrix"), function(x) { if(x@diag == "U") { x@diag <- "N" x@x <- rep.int(exp(1), x@Dim[1]) } else { x@x <- exp(x@x) } x }) ## Not necessary (and there's no direct ldi -> ddi coercion anyway: ## setMethod("expm", signature(x = "ldiMatrix"), ## function(x) expm(as(x,"ddiMatrix"))) ## As long as this is not "in R" : setMethod("expm", signature(x = "matrix"), function(x) expm(Matrix(x))) Matrix/R/lsparseMatrix.R0000644000176200001440000000174612524132306014706 0ustar liggesusers#### Superclass Methods for all sparse logical matrices C2l <- function(from) { if(extends(cld <- getClassDef(class(from)), "lsparseMatrix")) return(from) ## else if(!(is.n <- extends(cld, "nsparseMatrix"))) { ## len.x <- length(from@x) from <- .Call(Csparse_drop, from, 0) ## did.drop <- length(from@x) != len.x } r <- as(.C2nC(from, extends(cld, "triangularMatrix")), "lsparseMatrix") if(!is.n && any(ina <- is.na(from@x))) { ## NAs must remain NA ## since we dropped, we "know" that the 'x' slots match: stopifnot(length(from@x) == length(r@x)) is.na(r@x) <- ina } r } setAs("CsparseMatrix", "lMatrix", C2l) setAs("CsparseMatrix", "lsparseMatrix", C2l) setAs("lsparseMatrix", "matrix", function(from) as(as(from, "ldenseMatrix"), "matrix")) setAs("lsparseMatrix", "dsparseMatrix", function(from) as(from, "dMatrix")) setMethod("image", "lsparseMatrix", function(x, ...) image(as(x,"dMatrix"), ...)) Matrix/R/ltTMatrix.R0000644000176200001440000000237311004710614013771 0ustar liggesusers#### Logical Sparse Triangular Matrices in Triplet format ### contains = "lsparseMatrix" setAs("matrix", "ltTMatrix", function(from) as(as(from, "ltrMatrix"), "TsparseMatrix")) setAs("ltTMatrix", "lgTMatrix", function(from) tT2gT(from, cl = "ltTMatrix", toClass = "lgTMatrix")) setAs("ltTMatrix", "generalMatrix", function(from) tT2gT(from, cl = "ltTMatrix", toClass = "lgTMatrix")) setAs("ltTMatrix", "ltCMatrix", function(from) .Call(Tsparse_to_Csparse, from, TRUE)) setAs("ltTMatrix", "lgCMatrix", function(from) as(.Call(Tsparse_to_Csparse, from, TRUE), "lgCMatrix")) setAs("ltTMatrix", "dtTMatrix", function(from) new("dtTMatrix", i = from@i, j = from@j, x = rep.int(1, length(from@i)), uplo = from@uplo, diag = from@diag, Dim = from@Dim, Dimnames = from@Dimnames)) setAs("ltTMatrix", "ltrMatrix", function(from) .Call(ltTMatrix_as_ltrMatrix, from)) setAs("ltTMatrix", "matrix", function(from) as(as(from, "ltrMatrix"), "matrix")) setMethod("t", "ltTMatrix", function(x) new("ltTMatrix", Dim = x@Dim[2:1], Dimnames = x@Dimnames[2:1], i = x@j, j = x@i, x = x@x, diag = x@diag, uplo = if (x@uplo == "U") "L" else "U")) Matrix/R/AllGeneric.R0000644000176200001440000000645513556272737014102 0ustar liggesusers#### Define those generics that we need, if they don't exist; #### not all will be exported setGeneric("expand", function(x, ...) standardGeneric("expand")) setGeneric("isDiagonal", function(object) standardGeneric("isDiagonal")) setGeneric("isTriangular", function(object, upper = NA, ...) standardGeneric("isTriangular")) ## Boolean Arithmetic Matrix multiplication setGeneric("%&%", function (x, y) standardGeneric("%&%")) ## isSymmetric is "S3 generic" in R's base/R/eigen.R setGeneric("facmul", function(x, factor, y, transpose, left, ...) standardGeneric("facmul")) setGeneric("BunchKaufman", function(x, ...) standardGeneric("BunchKaufman")) setGeneric("lu", function(x, ...) standardGeneric("lu")) ##NB ## do not redefine the "base signature" ##NB setGeneric("chol", def = function(x, pivot= FALSE,...) standardGeneric("chol"), ##NB useAsDefault= function(x, pivot= FALSE,...) base::chol(x, pivot, ...)) ##NB setGeneric("qr", def = function(x, tol=1e-7,...) standardGeneric("qr"), ##NB useAsDefault= function(x, tol=1e-7,...) base::qr(x, tol, ...)) if(is.na(match("...", names(formals(implicitGeneric("crossprod")))))) { ## base:crossprod() has no '...', but since 2015-03, there's an implicit generic setGeneric("crossprod", function(x, y=NULL, ...) standardGeneric("crossprod"), useAsDefault= function(x, y=NULL, ...) base::crossprod(x, y)) setGeneric("tcrossprod", function(x, y=NULL, ...) standardGeneric("tcrossprod"), useAsDefault= function(x, y=NULL, ...) base::tcrossprod(x, y)) } setGeneric("Schur", function(x, vectors, ...) standardGeneric("Schur")) setGeneric("unpack", function(x, ...) standardGeneric("unpack")) setGeneric("pack", function(x, ...) standardGeneric("pack")) setGeneric("expm", function(x) standardGeneric("expm")) setGeneric("writeMM", function(obj, file, ...) standardGeneric("writeMM")) setGeneric("tril", function(x, k = 0, ...) standardGeneric("tril")) setGeneric("triu", function(x, k = 0, ...) standardGeneric("triu")) setGeneric("band", function(x, k1, k2, ...) standardGeneric("band")) setGeneric("Cholesky", function(A, perm = TRUE, LDL = !super, super = FALSE, Imult = 0, ...) standardGeneric("Cholesky")) setGeneric("symmpart", function(x) standardGeneric("symmpart")) setGeneric("skewpart", function(x) standardGeneric("skewpart")) ## A version of coercion to "symmetric" which does *NOT* check, ## but just takes the ## upper (or lower) values and ## ``declares'' the result symmetric: setGeneric("forceSymmetric", function(x, uplo) standardGeneric("forceSymmetric")) setGeneric("nnzero", function(x, na.counted = NA) standardGeneric("nnzero"), signature = "x") setGeneric("updown", function(update, C, L) standardGeneric("updown")) if(FALSE) ## only "need this", as 'Dvec' should not get its default from base::qr.Q : ## unfortunately, this masks base::qr.Q with a warning setGeneric("qr.Q", function(qr, complete = FALSE, Dvec) standardGeneric("qr.Q"), useAsDefault = function(qr, complete = FALSE, Dvec) { if(missing(Dvec)) base::qr.Q(qr, complete=complete) else base::qr.Q(qr, complete=complete, Dvec=Dvec) }) Matrix/R/dspMatrix.R0000644000176200001440000000527714147653617014046 0ustar liggesusers### Coercion and Methods for Symmetric Packed Matrices dsp2dsy <- function(from) .Call(dspMatrix_as_dsyMatrix, from) dsp2C <- function(from) dsy2C(.Call(dspMatrix_as_dsyMatrix, from)) setAs("dspMatrix", "dsyMatrix", dsp2dsy) ## setAs("dspMatrix", "dsCMatrix", dsp2C) setAs("dspMatrix", "CsparseMatrix", dsp2C) setAs("dspMatrix", "sparseMatrix", dsp2C) ## dge <--> dsp via dsy .dense2sp <- function(from) .dsy2dsp(.dense2sy(from)) setAs("dgeMatrix", "dspMatrix", .dense2sp) setAs("matrix", "dspMatrix", function(from) .dense2sp(..2dge(from))) ## S3-matrix <--> dsp via dsy setAs("dspMatrix", "matrix", function(from) .dsy2mat(dsp2dsy(from))) setMethod("rcond", signature(x = "dspMatrix", norm = "character"), function(x, norm, ...) .Call(dspMatrix_rcond, x, norm), valueClass = "numeric") setMethod("rcond", signature(x = "dspMatrix", norm = "missing"), function(x, norm, ...) .Call(dspMatrix_rcond, x, "O"), valueClass = "numeric") setMethod("BunchKaufman", signature(x = "dspMatrix"), function(x, ...) .Call(dspMatrix_trf, x)) ## Should define multiplication from the right setMethod("solve", signature(a = "dspMatrix", b = "missing"), function(a, b, ...) .Call(dspMatrix_solve, a), valueClass = "dspMatrix") setMethod("solve", signature(a = "dspMatrix", b = "matrix"), function(a, b, ...) .Call(dspMatrix_matrix_solve, a, b), valueClass = "dgeMatrix") setMethod("solve", signature(a = "dspMatrix", b = "ddenseMatrix"), function(a, b, ...) .Call(dspMatrix_matrix_solve, a, b), valueClass = "dgeMatrix") ##setMethod("solve", signature(a = "dspMatrix", b = "numeric"), ## function(a, b, ...) ## .Call(dspMatrix_matrix_solve, a, as.matrix(b)), ## valueClass = "dgeMatrix") ## No longer needed ## setMethod("solve", signature(a = "dspMatrix", b = "integer"), ## function(a, b, ...) { ## storage.mode(b) <- "double" ## .Call(dspMatrix_matrix_solve, a, as.matrix(b)) ## }, valueClass = "dgeMatrix") setMethod("norm", signature(x = "dspMatrix", type = "character"), function(x, type, ...) if(identical("2", type)) norm2(x) else .Call(dspMatrix_norm, x, type), valueClass = "numeric") setMethod("norm", signature(x = "dspMatrix", type = "missing"), function(x, type, ...) .Call(dspMatrix_norm, x, "O"), valueClass = "numeric") setMethod("t", signature(x = "dspMatrix"), function(x) .dsy2dsp(t(dsp2dsy(x))), # FIXME inefficient valueClass = "dspMatrix") setMethod("diag", signature(x = "dspMatrix"), function(x, nrow, ncol) .Call(dspMatrix_getDiag, x)) setMethod("diag<-", signature(x = "dspMatrix"), function(x, value) .Call(dspMatrix_setDiag, x, value)) Matrix/R/dgTMatrix.R0000644000176200001440000001741413543747253013771 0ustar liggesusers## Now in ./Tsparse.R ## setAs("dgTMatrix", "dgCMatrix", ## function(from) .Call(Tsparse_to_Csparse, from, FALSE) ## ) setAs("dgTMatrix", "dgeMatrix", function(from) .Call(dgTMatrix_to_dgeMatrix, from)) setAs("dgTMatrix", "matrix", function(from) .Call(dgTMatrix_to_matrix, from)) setAs("dgeMatrix", "dgTMatrix", function(from) as(as(from, "dgCMatrix"), "dgTMatrix")) if(FALSE) ## special case, relatively ugly, needed ?? setAs("dgTMatrix", "dsCMatrix", function(from) { if (!isSymmetric(from)) stop("cannot coerce non-symmetric \"dgTMatrix\" to \"dsCMatrix\" class") upper <- from@i <= from@j uC <- as(new("dgTMatrix", Dim = from@Dim, Dimnames = from@Dimnames, i = from@i[upper], j = from@j[upper], x = from@x[upper]), "dgCMatrix") new("dsCMatrix", Dim = uC@Dim, p = uC@p, i = uC@i, x = uC@x, uplo = "U") }) ## This is faster: setAs("dgTMatrix", "dtCMatrix", function(from) { if(!(iTri <- isTriangular(from))) stop("the matrix is not triangular") ## else stopifnot(is.character(uplo <- attr(iTri, "kind"))) .Call(Tsparse_to_tCsparse, from, uplo, "N") }) setAs("dgTMatrix", "dtTMatrix", function(from) check.gT2tT(from, toClass = "dtTMatrix", do.n=FALSE)) setAs("dgTMatrix", "triangularMatrix", function(from) check.gT2tT(from, toClass = "dtTMatrix", do.n=FALSE)) setAs("dgTMatrix", "dsTMatrix", function(from) check.gT2sT(from, toClass = "dsTMatrix", do.n=FALSE)) setAs("dgTMatrix", "symmetricMatrix", function(from) check.gT2sT(from, toClass = "dsTMatrix", do.n=FALSE)) mat2dgT <- function(from) { x <- as.double(from) nz <- isN0(x) new("dgTMatrix", Dim = dim(from), Dimnames = .M.DN(from), i = row(from)[nz] - 1L, j = col(from)[nz] - 1L, x = x[nz]) } setAs("matrix", "dgTMatrix", mat2dgT) ## "[" methods are now in ./Tsparse.R ## "[<-" methods { setReplaceMethod()s } too ... ## help/man page --> ../man/image-methods.Rd ## setMethod("image", "dgTMatrix", ## *The* real one function(x, xlim = c(1, di[2]), ylim = c(di[1], 1), aspect = "iso", sub = sprintf("Dimensions: %d x %d", di[1], di[2]), xlab = "Column", ylab = "Row", cuts = 15, useRaster = FALSE, useAbs = NULL, colorkey = !useAbs, col.regions = NULL, lwd = NULL, border.col = NULL, ...) { ## 'at' can remain missing and be passed to levelplot di <- x@Dim xx <- x@x if(length(xx) == 0 && length(x) > 0) { # workaround having "empty" matrix x@x <- 0 x@i <- x@j <- 0L } if(missing(useAbs)) { ## use abs() when all values are non-neg useAbs <- if(length(xx)) min(xx, na.rm=TRUE) >= 0 else TRUE } else if(useAbs) xx <- abs(xx) ## rx <- range(xx, finite=TRUE) ## FIXME: make use of 'cuts' now ## and call levelplot() with 'at = ', making sure 0 is included and matching ## *exactly* - rather than approximately if(is.null(col.regions)) col.regions <- if(useAbs) { grey(seq(from = 0.7, to = 0, length = 100)) } else { ## no abs(.), rx[1] < 0 rx <- range(xx, finite=TRUE) nn <- 100 n0 <- min(nn, max(0, round((0 - rx[1])/(rx[2]-rx[1]) * nn))) col.regions <- c(colorRampPalette(c("blue3", "gray80"))(n0), colorRampPalette(c("gray75","red3"))(nn - n0)) } if(!is.null(lwd) && !(is.numeric(lwd) && all(lwd >= 0))) # allow lwd=0 stop("'lwd' must be NULL or non-negative numeric") stopifnot(length(xlim) == 2, length(ylim) == 2) ## ylim: the rows count from top to bottom: ylim <- sort(ylim, decreasing=TRUE) if(all(xlim == round(xlim))) xlim <- xlim+ c(-.5, +.5) if(all(ylim == round(ylim))) ylim <- ylim+ c(+.5, -.5) # decreasing! levelplot(xx ~ (x@j + 1L) * (x@i + 1L), # no 'data' sub = sub, xlab = xlab, ylab = ylab, xlim = xlim, ylim = ylim, aspect = aspect, colorkey = colorkey, col.regions = col.regions, cuts = cuts, par.settings = list(background = list(col = "transparent")), ##=== panel = if(useRaster) panel.levelplot.raster else function(x, y, z, subscripts, at, ..., col.regions) { ## a trimmed down version of lattice::panel.levelplot x <- as.numeric(x[subscripts]) y <- as.numeric(y[subscripts]) ## ## FIXME: use level.colors() here and 'at' from above -- ## ----- look at 'zcol' in panel.levelplot() numcol <- length(at) - 1 num.r <- length(col.regions) col.regions <- if (num.r <= numcol) rep_len(col.regions, numcol) else col.regions[1+ ((1:numcol-1)*(num.r-1)) %/% (numcol-1)] zcol <- rep.int(NA_integer_, length(z)) for (i in seq_along(col.regions)) zcol[!is.na(x) & !is.na(y) & !is.na(z) & at[i] <= z & z < at[i+1]] <- i zcol <- zcol[subscripts] if (any(subscripts)) { ## the line-width used in grid.rect() inside ## levelplot()'s panel for the *border* of the ## rectangles: levelplot()panel has lwd= 0.01: ## Here: use "smart" default ! if(is.null(lwd)) { wh <- grid::current.viewport()[c("width", "height")] ## wh : current viewport dimension in pixel wh <- c(grid::convertWidth(wh$width, "inches", valueOnly=TRUE), grid::convertHeight(wh$height, "inches", valueOnly=TRUE)) * par("cra") / par("cin") pSize <- wh/di ## size of one matrix-entry in pixels pA <- prod(pSize) # the "area" p1 <- min(pSize) lwd <- ## crude for now if(p1 < 2 || pA < 6) 0.01 # effectively 0 else if(p1 >= 4) 1 else if(p1 > 3) 0.5 else 0.2 ## browser() Matrix.msg("rectangle size ", paste(round(pSize,1), collapse=" x "), " [pixels]; --> lwd :", formatC(lwd)) } else stopifnot(is.numeric(lwd), all(lwd >= 0)) # allow 0 if(is.null(border.col) && lwd < .01) # no border border.col <- NA grid.rect(x = x, y = y, width = 1, height = 1, default.units = "native", ## FIXME?: allow 'gp' to be passed via '...' !! gp = gpar(fill = col.regions[zcol], lwd = lwd, col = border.col)) } }, ...) }) ## Uses the triplet convention of *adding* entries with same (i,j): setMethod("+", signature(e1 = "dgTMatrix", e2 = "dgTMatrix"), function(e1, e2) { dimCheck(e1, e2) new("dgTMatrix", i = c(e1@i, e2@i), j = c(e1@j, e2@j), x = c(e1@x, e2@x), Dim = e1@Dim, Dimnames = e1@Dimnames) }) ## setMethod("writeHB", signature(obj = "dgTMatrix"), ## function(obj, file, ...) callGeneric(as(obj, "CsparseMatrix"), file, ...)) Matrix/R/dsyMatrix.R0000644000176200001440000001137613556074212014043 0ustar liggesusers### Coercion and Methods for Dense Numeric Symmetric Matrices ##' @export (!) Note: ..?dense2sy() work for "dgeMatrix" *and* "matrix" .dense2sy <- function(from, ...) { if(isSymmetric(from, ...)) # < with tolerance! .Call(dense_to_symmetric, from, "U", FALSE) else stop("not a symmetric matrix; consider forceSymmetric() or symmpart()") } ## NB: The alternative, 'zero tolerance' { <=> isSymmetric(*, tol=0) } ## breaks too much previous code -- though it would be much faster -- ##' usable directly as function in setAs() <== no "..." ..dense2sy <- function(from) { if(isSymmetric(from)) # < with tolerance! .Call(dense_to_symmetric, from, "U", FALSE) else stop("not a symmetric matrix; consider forceSymmetric() or symmpart()") } setAs("dgeMatrix", "dsyMatrix", ..dense2sy) setAs("matrix", "dsyMatrix", function(from) .dense2sy(..2dge(from))) .dsy2mat <- function(from, keep.dimnames=TRUE)# faster .Call(dsyMatrix_as_matrix, from, keep.dimnames) ..dsy2mat <- function(from) .Call(dsyMatrix_as_matrix, from, TRUE) setAs("dsyMatrix", "matrix", ..dsy2mat) .dsy2dsp <- function(from) .Call(dsyMatrix_as_dspMatrix, from) setAs("dsyMatrix", "dspMatrix", .dsy2dsp) dsy2T <- function(from) { # 'dsT': only store upper *or* lower uplo <- from@uplo if(any0(dim(from))) { ij <- matrix(0L, 0,2) ; m <- from@x } else { ## FIXME! working via "matrix" is *not* efficient: ## the "other triangle" is filled, compared with 0, and then trashed: m <- .Call(dsyMatrix_as_matrix, from, FALSE) # no dimnames! ij <- which(m != 0, arr.ind = TRUE, useNames = FALSE) ij <- ij[if(uplo == "U") ij[,1] <= ij[,2] else ij[,1] >= ij[,2], , drop = FALSE] } new("dsTMatrix", i = ij[,1] - 1L, j = ij[,2] - 1L, x = as.vector(m[ij]), uplo = uplo, Dim = from@Dim, Dimnames = from@Dimnames) } setAs("dsyMatrix", "dsTMatrix", dsy2T) setAs("dsyMatrix", "dsCMatrix", dsy2C <- function(from) .T2Cmat(dsy2T(from), isTri=FALSE)) ## Note: Just *because* we have an explicit dtr -> dge coercion, ## show( ) is not okay, and we need our own: setMethod("show", "dsyMatrix", function(object) prMatrix(object)) setMethod("rcond", signature(x = "dsyMatrix", norm = "character"), function(x, norm, ...) .Call(dsyMatrix_rcond, x, norm), valueClass = "numeric") setMethod("rcond", signature(x = "dsyMatrix", norm = "missing"), function(x, norm, ...) .Call(dsyMatrix_rcond, x, "O"), valueClass = "numeric") setMethod("solve", signature(a = "dsyMatrix", b = "missing"), function(a, b, ...) .Call(dsyMatrix_solve, a), valueClass = "dsyMatrix") setMethod("solve", signature(a = "dsyMatrix", b = "matrix"), function(a, b, ...) .Call(dsyMatrix_matrix_solve, a, b), valueClass = "dgeMatrix") setMethod("solve", signature(a = "dsyMatrix", b = "ddenseMatrix"), function(a, b, ...) .Call(dsyMatrix_matrix_solve, a, b)) setMethod("solve", signature(a = "dsyMatrix", b = "denseMatrix"), ## eg. for ddi* or ldi* function(a, b, ...) .Call(dsyMatrix_matrix_solve, a, as(b,"dMatrix"))) setMethod("norm", signature(x = "dsyMatrix", type = "character"), function(x, type, ...) if(identical("2", type)) norm2(x) else .Call(dsyMatrix_norm, x, type), valueClass = "numeric") setMethod("norm", signature(x = "dsyMatrix", type = "missing"), function(x, type, ...) .Call(dsyMatrix_norm, x, "O"), valueClass = "numeric") ## *Should* create the opposite storage format: "U" -> "L" and vice-versa: setMethod("t", signature(x = "dsyMatrix"), t_trMatrix, valueClass = "dsyMatrix") setMethod("BunchKaufman", signature(x = "dsyMatrix"), function(x, ...) .Call(dsyMatrix_trf, x)) setMethod("BunchKaufman", signature(x = "matrix"), function(x, uplo=NULL, ...) .Call(matrix_trf, x, uplo)) setAs("dsyMatrix", "dpoMatrix", function(from){ if(is.null(tryCatch(.Call(dpoMatrix_chol, from), error = function(e) NULL))) stop("not a positive definite matrix") ## else copyClass(from, "dpoMatrix", sNames = c("x", "Dim", "Dimnames", "uplo", "factors")) }) setMethod("diag", signature(x = "dsyMatrix"), function(x, nrow, ncol) .Call(dgeMatrix_getDiag, x)) setMethod("diag<-", signature(x = "dsyMatrix"), function(x, value) .Call(dgeMatrix_setDiag, x, value)) ## Now that we have "chol", we can define "determinant" methods, ## exactly like in ./dsCMatrix.R ## DB - Probably figure out how to use the BunchKaufman decomposition instead ## {{FIXME: Shouldn't it be possible to have "determinant" work by ## default automatically for "Matrix"es when there's a "chol" method available? ## ..> work with ss <- selectMethod("chol", signature("dgCMatrix")) ## -- not have to define showMethod("determinant", ...) for all classes Matrix/R/Math.R0000644000176200001440000002242014002532573012734 0ustar liggesusers####--- All "Math" and "Math2" group methods for all Matrix classes (incl sparseVector) ------ #### ==== ===== ## "Design-bug": log(x, base) has *two* arguments // ditto for "trunc()" !! ## ---> need "log" methods "everywhere to catch 2-arg case ! ###--------- Csparse Math.vecGenerics <- grep("^cum", getGroupMembers("Math"), value=TRUE) ## "cummax" .. "cumsum" : work on full *vector* and return vector also for matrix input setMethod("Math", "CsparseMatrix", function(x) { if(.Generic %nin% Math.vecGenerics && is0(callGeneric(0.))) { ## sparseness, symm., triang.,... preserved cl <- class(x) has.x <- !extends(cl, "nsparseMatrix") ## has.x <==> *not* nonzero-pattern == "nMatrix" if(has.x) { type <- storage.mode(x@x) r <- callGeneric(x@x) } else { ## nsparseMatrix type <- "" r <- rep.int(as.double(callGeneric(TRUE)), switch(.sp.class(cl), CsparseMatrix = length(x@i), TsparseMatrix = length(x@i), RsparseMatrix = length(x@j))) } if(type == storage.mode(r)) { x@x <- r x } else { ## e.g. abs( ) --> integer Csparse ## FIXME: when we have 'i*' classes, use them here: rx <- new(sub("^.", "d", MatrixClass(cl))) rx@x <- as.double(r) ## result is "same" sNams <- slotNames(cl) for(nm in sNams[sNams != "x"]) slot(rx, nm) <- slot(x, nm) rx } } else { ## no sparseness (or no matrix!); C2dense() returns *numeric* callGeneric(C2dense(x)) } }) ## {Math} setMethod("log", "CsparseMatrix", function(x, base = exp(1)) log(C2dense(x), base)) ###--------- ddenseMatrix ##' Used for dt[rp]Matrix, ds[yp]Matrix (and subclasses, e.g. dpo*(), cor*() !): ##' as dgeMatrix has direct method: setMethod("Math", "ddenseMatrix", function(x) { if(.Generic %in% Math.vecGenerics) # vector result callGeneric(as(x,"dgeMatrix")@x) else if(is(x, "symmetricMatrix")) { ## -> result symmetric: keeps class cld <- getClassDef(class(x)) if((po <- extends(cld, "dpoMatrix")) || extends(cld, "dppMatrix")) { # result is *not* pos.def! x <- as(x, if(po) "dsyMatrix" else "dspMatrix") } ## "symmetricMatrix" has 'factors' slot: if(!is.null(x@factors)) x@factors <- list() x@x <- callGeneric(x@x) x } else { ## triangularMatrix (no need for testing), includes, e.g. "corMatrix"! ## if(is0(f0 <- callGeneric(0.))) { ## -> result remains triangular if(is0(callGeneric(0.))) { ## -> result remains triangular cld <- getClassDef(class(x)) if(extends(cld, "triangularMatrix")) { if((isF <- extends(cld, "MatrixFactorization")) || extends(cld, "corMatrix")) { x <- as(x, if(isF && .isPacked(x)) "dtpMatrix" else "dtrMatrix") } } else if(inherits(x, "compMatrix")) # has 'factors' slot if(!is.null(x@factors)) x@factors <- list() x@x <- callGeneric(x@x) x } else { if(inherits(x, "compMatrix")) # has 'factors' slot if(!is.null(x@factors)) x@factors <- list() ## result is general: *could* use f0 <- callGeneric(0.) for the whole 0-triangle, ## but this is much easier: callGeneric(as(x,"dgeMatrix")) } } }) ## "log" with *two* arguments setMethod("log", "ddenseMatrix", function(x, base = exp(1)) { if(is(x, "symmetricMatrix")) { ## -> result symmetric: keeps class cld <- getClassDef(class(x)) if((po <- extends(cld, "dpoMatrix")) || extends(cld, "dppMatrix")) { # result is *not* pos.def! x <- as(x, if(po) "dsyMatrix" else "dspMatrix") } ## "symmetricMatrix" has 'factors' slot: if(!is.null(x@factors)) x@factors <- list() x@x <- log(x@x, base) x } else { ## triangularMatrix or generalMatrix, includes, e.g. "corMatrix"! if(inherits(x, "compMatrix")) # has 'factors' slot if(!is.null(x@factors)) x@factors <- list() ## result is general: *could* use -Inf for the whole 0-triangle, ## but this is much easier: log(as(x,"dgeMatrix"), base) } }) ###--------- denseMatrix ## FIXME: Once we have integer (idense..), sign(), abs(.) may need different: setMethod("Math", signature(x = "denseMatrix"), function(x) callGeneric(as(x, "dMatrix"))) # -> "ddenseMatrix" above setMethod("log", "denseMatrix", function(x, base = exp(1)) log(as(x, "dMatrix"), base)) ###--------- dgeMatrix setMethod("Math", signature(x = "dgeMatrix"), function(x) { if(.Generic %in% Math.vecGenerics) callGeneric(x@x) else { x@x <- callGeneric(x@x) x } }) setMethod("log", "dgeMatrix", function(x, base = exp(1)) { x@x <- log(x@x, base) x }) ###--------- diagMatrix ## Till 2014-08-04, went via "dtC" (triangular) setMethod("Math", signature(x = "diagonalMatrix"), function(x) { if(.Generic %in% Math.vecGenerics) # vector result callGeneric(.diag2mat(x)) ## else if(is0(f0 <- callGeneric(0.))) { ## result remains diagonal else if(is0(callGeneric(0.))) { ## result remains diagonal cl <- class(x) if(!extends(cl, "ddiMatrix")) cl <- class(x <- as(x, "dMatrix")) ##d type <- storage.mode(x@x) if(x@diag == "U") { ##d if((f1 <- callGeneric(as1(mod=type))) == 1 && type == "double") if((f1 <- callGeneric(1.)) == 1) return(x) # [ddi] as f(0) = 0, f(1) = 1 else { n <- x@Dim[1] return( Diagonal(n=n, x = rep.int(f1, n)) ) } } r <- callGeneric(x@x) ##d if(type == storage.mode(r)) { x@x <- r x ##d } else { ## e.g. abs( ) --> integer Csparse ##d ## FIXME: when we have 'i*' classes, use them here: ##d rx <- new(sub("^.", "d", cl)) ##d rx@x <- as.double(r) ##d ## result is "same" ##d sNams <- slotNames(cl) ##d for(nm in sNams[sNams != "x"]) ##d slot(rx, nm) <- slot(x, nm) ##d rx ##d } } else { ## no sparseness, i.e., no diagonal, but still symmetric: ## FIXME: gain efficiency by reusing f0 for *all* off-diagonal entries! callGeneric(as(as(as(.diag2sT(x), "dMatrix"), "denseMatrix"), "dspMatrix")) } }) ## {Math} setMethod("log", "diagonalMatrix", function(x, base = exp(1)) { ## no sparseness, i.e., no diagonal, but still symmetric: r <- as(as(as(.diag2sT(x), "dMatrix"), "denseMatrix"), "dspMatrix") diag(r) <- if(x@diag == "U") 0 else log(x@x, base) ## Assign log(0, ) == -Inf to all off-diagonal elements; ## indices depend crucially on uplo = "U" / "L" : n <- x@Dim[[1L]] if(n >= 1L) { k <- seq_len(n) i <- k*(k+1)/2 # as r@uplo == "U" ## } else { # uplo == "L" ## cumsum(c(1, if(n>1) n:2)) ## } r@x[-i] <- -Inf # = log(0, ) } r }) ## NB: "Math2" (round, signif) for diagMatrix is perfectly via "dMatrix" ###--------- dMatrix ## Use these as "catch-all" -- more specific methods are for sub-classes (sparse) setMethod("Math2", signature(x = "dMatrix"), ## Assume that Generic(u, k) |--> u for u in {0,1} ## which is true for round(), signif() ==> all structure maintained function(x, digits) { x@x <- callGeneric(x@x, digits = digits) x }) ## the same, first coercing to "dMatrix": setMethod("Math2", signature(x = "Matrix"), function(x, digits) { x <- as(x, "dMatrix") x@x <- callGeneric(x@x, digits = digits) x }) ###--------- sparseMatrix setMethod("Math", signature(x = "sparseMatrix"), function(x) callGeneric(as(x, "CsparseMatrix"))) setMethod("log", "sparseMatrix", function(x, base = exp(1)) log(as(x, "CsparseMatrix"), base)) ###--------- sparseVector setMethod("Math", signature(x = "sparseVector"), function(x) { if(.Generic %nin% Math.vecGenerics && is0(callGeneric(0.))) { ## sparseness preserved cld <- getClassDef(class(x)) kind <- .M.kindC(cld)# "d", "n", "l", "i", "z", ... has.x <- kind != "n" if(has.x) { rx <- callGeneric(x@x) if(kind == "d") { x@x <- rx x } else { new("dsparseVector", x = rx, i = x@i, length = x@length) } } else { ## kind == "n" new("dsparseVector", x = rep.int(callGeneric(1), length(x@i)), i = x@i, length = x@length) } } else { ## dense callGeneric(sp2vec(x)) } }) setMethod("log", "sparseVector", function(x, base = exp(1)) log(sp2vec(x), base)) setMethod("Math2", signature(x = "dsparseVector"), ## Assume that Generic(u, k) |--> u for u in {0,1} ## which is true for round(), signif() ==> all structure maintained function(x, digits) { x@x <- callGeneric(x@x, digits = digits) x }) ## the same, first coercing to "dsparseVector": setMethod("Math2", signature(x = "sparseVector"), function(x, digits) { x <- as(x, "dsparseVector") x@x <- callGeneric(x@x, digits = digits) x }) Matrix/R/dpoMatrix.R0000644000176200001440000000546612322331041014013 0ustar liggesusers#### Positive-definite Symmetric Matrices -- Coercion and Methods setAs("dpoMatrix", "dppMatrix", function(from) copyClass(.Call(dsyMatrix_as_dspMatrix, from), "dppMatrix", sNames = c("x", "Dim", "Dimnames", "uplo", "factors")))#FIXME , check=FALSE setAs("dpoMatrix", "corMatrix", function(from) { if(!is.null(cm <- from@factors$correlation)) return(cm) ## else sd <- sqrt(diag(from)) if(is.null(names(sd)) && !is.null(nms <- from@Dimnames[[1]])) names(sd) <- nms Is <- Diagonal(x = 1/sd) .set.factors(from, "correlation", new("corMatrix", as(forceSymmetric(Is %*% from %*% Is), "dpoMatrix"), sd = unname(sd))) }) setAs("dpoMatrix", "lMatrix", function(from) as(as(from, "dsyMatrix"), "lMatrix")) setAs("dpoMatrix", "nMatrix", function(from) as(as(from, "dsyMatrix"), "nMatrix")) if(FALSE) # should no longer be needed setAs("corMatrix", "lMatrix", function(from) as(as(from, "dpoMatrix"), "lMatrix")) ## Needed *in addition* to the general to_dpo() method below: setAs("dspMatrix", "dpoMatrix", function(from) as(as(from,"dsyMatrix"), "dpoMatrix")) to_dpo <- function(from) # not coercing to "dsy*" explicitly: as(as(as(as(from, "symmetricMatrix"), "dMatrix"), "denseMatrix"), "dpoMatrix") setAs("Matrix", "dpoMatrix", to_dpo) setAs("matrix", "dpoMatrix", to_dpo) setMethod("chol", signature(x = "dpoMatrix"), function(x, pivot, ...) .Call(dpoMatrix_chol, x)) setMethod("rcond", signature(x = "dpoMatrix", norm = "character"), function(x, norm, ...) .Call(dpoMatrix_rcond, x, norm)) setMethod("rcond", signature(x = "dpoMatrix", norm = "missing"), function(x, norm, ...) .Call(dpoMatrix_rcond, x, "O")) setMethod("solve", signature(a = "dpoMatrix", b = "missing"), function(a, b, ...) .Call(dpoMatrix_solve, a), valueClass = "dpoMatrix") setMethod("solve", signature(a = "dpoMatrix", b = "dgeMatrix"), function(a, b, ...) .Call(dpoMatrix_dgeMatrix_solve, a, b), valueClass = "dgeMatrix") setMethod("solve", signature(a = "dpoMatrix", b = "matrix"), function(a, b, ...) .Call(dpoMatrix_matrix_solve, a, b), valueClass = "matrix") mkDet.via.chol <- function(x, logarithm, ...) mkDet(logarithm, ldet = 2*sum(log(abs(diag(chol(x))))), sig = 1L) setMethod("determinant", signature(x = "dpoMatrix", logarithm = "logical"), mkDet.via.chol) setMethod("determinant", signature(x = "dpoMatrix", logarithm = "missing"), function(x, logarithm, ...) mkDet.via.chol(x, logarithm=TRUE)) ## Is this usable / necessary? -- FIXME! ## setMethod("solve", signature(a = "dpoMatrix", b = "numeric"), ## function(a, b, ...) ## as.numeric(.Call(dpoMatrix_matrix_solve, ## a, as.matrix(b))), ## valueClass = "numeric") Matrix/R/dtrMatrix.R0000644000176200001440000000752513047113565014036 0ustar liggesusers#### Triangular Matrices -- Coercion and Methods ## FIXME: get rid of this (coerce to "triangular..") ?!? setAs("dgeMatrix", "dtrMatrix", function(from) asTri(from, "dtrMatrix")) setAs("dtrMatrix", "dtpMatrix", dtr2dtp <- function(from) .Call(dtrMatrix_as_dtpMatrix, from)) setAs("dtrMatrix", "sparseMatrix", function(from) .dense2C(from, kind="tri", uplo=from@uplo)) setAs("dtrMatrix", "CsparseMatrix", function(from) .dense2C(from, kind="tri", uplo=from@uplo)) .dtr2mat <- function(from, keep.dimnames=TRUE) .Call(dtrMatrix_as_matrix, from, keep.dimnames) ## needed for t() method setAs("dtrMatrix", "matrix", function(from) .Call(dtrMatrix_as_matrix, from, TRUE)) setAs("matrix", "dtrMatrix", function(from) as(..2dge(from), "dtrMatrix")) setAs("Cholesky", "lMatrix", function(from) as(as(from, "dtrMatrix"), "lMatrix")) setAs("BunchKaufman", "lMatrix", function(from) as(as(from, "dtrMatrix"), "lMatrix")) ## Group Methods: ## TODO: carefully check for the cases where the result remains triangular ## instead : inherit them from "dgeMatrix" via definition in ./dMatrix.R ## Note: Just *because* we have an explicit dtr -> dge coercion, ## show( ) is not okay, and we need our own: setMethod("show", "dtrMatrix", function(object) prMatrix(object)) setMethod("determinant", signature(x = "dtrMatrix", logarithm = "missing"), function(x, logarithm, ...) callGeneric(x, TRUE)) setMethod("determinant", signature(x = "dtrMatrix", logarithm = "logical"), function(x, logarithm, ...) mkDet(diag(x), logarithm)) setMethod("diag", signature(x = "dtrMatrix"), function(x, nrow, ncol) .Call(dtrMatrix_getDiag, x), valueClass = "numeric") setMethod("diag<-", signature(x = "dtrMatrix"), function(x, value) { .Call(dtrMatrix_setDiag, if(x@diag == "U") .dense.diagU2N(x, "d", isPacked=FALSE) else x, value) }) setMethod("norm", signature(x = "dtrMatrix", type = "character"), function(x, type, ...) if(identical("2", type)) norm2(x) else .Call(dtrMatrix_norm, x, type), valueClass = "numeric") setMethod("norm", signature(x = "dtrMatrix", type = "missing"), function(x, type, ...) .Call(dtrMatrix_norm, x, "O"), valueClass = "numeric") setMethod("rcond", signature(x = "dtrMatrix", norm = "character"), function(x, norm, ...) .Call(dtrMatrix_rcond, x, norm), valueClass = "numeric") setMethod("rcond", signature(x = "dtrMatrix", norm = "missing"), function(x, norm, ...) .Call(dtrMatrix_rcond, x, "O"), valueClass = "numeric") setMethod("chol2inv", signature(x = "dtrMatrix"), function (x, ...) { chk.s(..., which.call=-2) if (x@diag != "N") x <- diagU2N(x) .Call(dtrMatrix_chol2inv, x) }) setMethod("solve", signature(a = "dtrMatrix", b="missing"), function(a, b, ...) { ## warn, as e.g. CHMfactor have 'system' as third argument chk.s(..., which.call=-2) .Call(dtrMatrix_solve, a) }, valueClass = "dtrMatrix") setMethod("solve", signature(a = "dtrMatrix", b="ddenseMatrix"), function(a, b, ...) { chk.s(..., which.call=-2) .Call(dtrMatrix_matrix_solve, a, b) }, valueClass = "dgeMatrix") setMethod("solve", signature(a = "dtrMatrix", b="dMatrix"), function(a, b, ...) { chk.s(..., which.call=-2) .Call(dtrMatrix_matrix_solve, a, as(b,"denseMatrix")) }, valueClass = "dgeMatrix") setMethod("solve", signature(a = "dtrMatrix", b="Matrix"), function(a, b, ...) { chk.s(..., which.call=-2) .Call(dtrMatrix_matrix_solve, a, as(as(b, "dMatrix"), "denseMatrix")) }, valueClass = "dgeMatrix") setMethod("solve", signature(a = "dtrMatrix", b="matrix"), function(a, b, ...) { chk.s(..., which.call=-2) .Call(dtrMatrix_matrix_solve, a, b) }, valueClass = "dgeMatrix") setMethod("t", signature(x = "dtrMatrix"), t_trMatrix) Matrix/R/kronecker.R0000644000176200001440000001230212621355273014031 0ustar liggesusers#### Collect methods for kronecker() here. #### =========== ### ... all but the ``fall back methods'' which are in ./Matrix.R ... ## ~~~~~~~~~~ ### Request: Should be *fast* particularly when used with Diagonal() ! tmp <- function (X, Y, FUN = "*", make.dimnames = FALSE, ...) { kronecker(as(X, "TsparseMatrix"), Y, FUN = FUN, make.dimnames = make.dimnames, ...) } setMethod("kronecker", signature(X="diagonalMatrix", Y="ANY" ), tmp) setMethod("kronecker", signature(X="diagonalMatrix", Y="Matrix" ), tmp) setMethod("kronecker", signature(X="ANY", Y="sparseMatrix" ), tmp) ## the above could recurse infinitely : setMethod("kronecker", signature(X="sparseMatrix", Y="TsparseMatrix"), tmp) tmp <- function (X, Y, FUN = "*", make.dimnames = FALSE, ...) { kronecker(X, as(Y, "TsparseMatrix"), FUN = FUN, make.dimnames = make.dimnames, ...) } setMethod("kronecker", signature(X="ANY", Y="diagonalMatrix"), tmp) setMethod("kronecker", signature(X="Matrix", Y="diagonalMatrix"), tmp) setMethod("kronecker", signature(X="sparseMatrix", Y="ANY" ), tmp) setMethod("kronecker", signature(X="TsparseMatrix", Y="sparseMatrix"), tmp) rm(tmp) ## from ./dgTMatrix.R : setMethod("kronecker", signature(X = "dgTMatrix", Y = "dgTMatrix"), function (X, Y, FUN = "*", make.dimnames = FALSE, ...) { if (FUN != "*") stop("kronecker method must use default 'FUN'") ## otherwise we don't know that many results will be zero ydim <- Y@Dim xi <- X@i xnnz <- length(xi) yi <- Y@i ynnz <- length(yi) new("dgTMatrix", Dim = X@Dim * ydim, i = rep.int(yi, xnnz) + ydim[1] * rep.int(xi, rep.int(ynnz, xnnz)), j = rep.int(Y@j, xnnz) + ydim[2] * rep.int(X@j, rep.int(ynnz, xnnz)), ## faster than x = as.vector(outer(Y@x, X@x, FUN = FUN) x = as.vector(Y@x %*% t(X@x))) }) ## triangularity -- should be preserved "when obvious": setMethod("kronecker", signature(X = "dtTMatrix", Y = "dtTMatrix"), function (X, Y, FUN = "*", make.dimnames = FALSE, ...) { if (FUN != "*") stop("kronecker method must use default 'FUN'") ## otherwise we don't know that many results will be zero if(X@uplo != Y@uplo) { ## result not triangular X <- as(X, "dgTMatrix") Y <- as(Y, "dgTMatrix") return(callGeneric()) } ## else: both 'uplo' are the same -- result *is* triangular ## d.U <- (dX <- X@diag == "U") && (dY <- Y@diag == "U") if(Y@diag == "U") Y <- .diagU2N(Y, "dtTMatrix") ydim <- Y@Dim if(X@diag != "U") { xi <- X@i xj <- X@j xx <- X@x } else { ## X@diag == "U" nx <- X@Dim[1] # triangular matrices are square ii <- seq_len(nx) - 1L xi <- c(X@i, ii) xj <- c(X@j, ii) xx <- c(X@x, rep.int(1, nx)) } xnnz <- length(xi) yi <- Y@i ynnz <- length(yi) new("dtTMatrix", Dim = X@Dim * ydim, i = rep.int(yi, xnnz) + ydim[1] * rep.int(xi, rep.int(ynnz, xnnz)), j = rep.int(Y@j, xnnz) + ydim[2] * rep.int(xj, rep.int(ynnz, xnnz)), ## faster than x = as.vector(outer(Y@x, X@x, FUN = FUN) x = as.vector(Y@x %*% t(xx)), uplo = X@uplo, diag = "N" # if(d.U) { "U" , but drop the entries} else "N" ) }) setMethod("kronecker", signature(X = "dtTMatrix", Y = "dgTMatrix"), function (X, Y, FUN = "*", make.dimnames = FALSE, ...) { if(trY <- isTriangular(Y)) { Y <- gT2tT(Y, uplo = attr(trY, "kind") %||% "U", diag = "N", ## improve: also test for unit diagonal toClass = "dtTMatrix", do.n= FALSE) } else { X <- as(X, "dgTMatrix") } callGeneric() #-> dtT o dtT or dgT o dgT }) setMethod("kronecker", signature(X = "dgTMatrix", Y = "dtTMatrix"), function (X, Y, FUN = "*", make.dimnames = FALSE, ...) { if(trX <- isTriangular(X)) { X <- gT2tT(X, uplo = attr(trX, "kind") %||% "U", diag = "N", ## improve: also test for unit diagonal toClass = "dtTMatrix", do.n= FALSE) } else { Y <- as(Y, "dgTMatrix") } callGeneric() #-> dtT o dtT or dgT o dgT }) setMethod("kronecker", signature(X = "TsparseMatrix", Y = "TsparseMatrix"), function (X, Y, FUN = "*", make.dimnames = FALSE, ...) { if(!is(X, "dMatrix")) X <- as(X, "dMatrix") if(!is(Y, "dMatrix")) Y <- as(Y, "dMatrix") if(is(X, "symmetricMatrix")) X <- as(X, "generalMatrix") if(is(Y, "symmetricMatrix")) Y <- as(Y, "generalMatrix") callGeneric() }) if(FALSE) # probably not needed setMethod("kronecker", signature(X = "dgTMatrix", Y = "TsparseMatrix"), function (X, Y, FUN = "*", make.dimnames = FALSE, ...) { ## a case where Y is neither "dgT" nor "dtT" : if(!is(Y, "dMatrix")) Y <- as(Y, "dMatrix") if(is(Y, "symmetricMatrix")) Y <- as(Y, "generalMatrix") callGeneric() }) ## from ./dsparseMatrix.R : setMethod("kronecker", signature(X = "dsparseMatrix", Y = "dsparseMatrix"), function (X, Y, FUN = "*", make.dimnames = FALSE, ...) { if(is(X, "symmetricMatrix")) X <- as(X, "generalMatrix") if(is(Y, "symmetricMatrix")) Y <- as(Y, "generalMatrix") kronecker(as(X, "TsparseMatrix"), as(Y, "TsparseMatrix"), FUN = FUN, make.dimnames = make.dimnames, ...) }) Matrix/R/symmetricMatrix.R0000644000176200001440000001475613507406216015264 0ustar liggesusers#### symmetricMatrix : virtual class setAs("denseMatrix", "symmetricMatrix", function(from) ## vvvv do *check* symmetry .Call(dense_to_symmetric, from, "U", TRUE)) setAs("matrix", "symmetricMatrix", function(from) .Call(dense_to_symmetric, from, "U", TRUE)) ### ----------- forceSymmetric() ----- *all* methods ------------------------ ## forceSymmetric() coerces to "symmetricMatrix" withOUT testing ## ---------------- contrary to as(M, ) which should only ## work when 'M' is a symmetric matrix __ in the sense of isSymmetric() __ ## i.e., with allowing a little bit of asymmetric numeric fuzz: setMethod("forceSymmetric", signature(x = "matrix", uplo="ANY"), function(x, uplo) .Call(dense_to_symmetric, x, if(missing(uplo)) "U" else uplo, FALSE)) symCls <- names(getClass("symmetricMatrix")@subclasses) for(cls in symCls) { ## When x is symmetric and uplo is missing, we keep 'uplo' from 'x': setMethod("forceSymmetric", signature(x = cls, uplo="missing"), function(x, uplo) x) setMethod("forceSymmetric", signature(x = cls, uplo="character"), function(x, uplo) { if(uplo == x@uplo) x else ## uplo is "wrong" for x t(x) }) } setMethod("forceSymmetric", signature(x = "denseMatrix", uplo="character"), function(x, uplo) .Call(dense_to_symmetric, x, uplo, FALSE)) setMethod("forceSymmetric", signature(x = "denseMatrix", uplo="missing"), function(x, uplo) { uplo <- if(is(x, "triangularMatrix")) x@uplo else "U" ## FIXME? diagU2N() ?? .Call(dense_to_symmetric, x, uplo, FALSE) }) setMethod("forceSymmetric", signature(x="sparseMatrix"), function(x, uplo) { x <- as(x, "CsparseMatrix") callGeneric() }) ##' @title Transform a CsparseMatrix into a [dln]sCMatrix (symmetricMatrix) ##' @param x CsparseMatrix ##' @param uplo missing, "U", or "L" ##' @param isTri logical specifying if 'x' is triangular ##' @param symDimnames logical specifying if dimnames() will be forced to ##' symmetric even when one of the two is NULL. ##' New: 3 cases {FALSE, NA, TRUE} [default: now 'NA' was equivalent to originally 'FALSE'] forceCspSymmetric <- function(x, uplo, isTri = is(x, "triangularMatrix"), symDimnames = NA) { ## isTri ==> effectively *diagonal* if(isTri && x@diag == "U") x <- .Call(Csparse_diagU2N, x) if(missing(uplo)) uplo <- if(isTri) x@uplo else "U" .Call(Csparse_general_to_symmetric, x, uplo, symDimnames) } .gC2sym <- function(x, uplo, symDimnames = NA) .Call(Csparse_general_to_symmetric, x, uplo, symDimnames) setMethod("forceSymmetric", signature(x="CsparseMatrix"), function(x, uplo) forceCspSymmetric(x, uplo)) setMethod("symmpart", signature(x = "symmetricMatrix"), function(x) x) setMethod("skewpart", signature(x = "symmetricMatrix"), function(x) .setZero(x)) ##' Allow x@Dimnames to be contain one NULL with still symmetric dimnames() if(FALSE) ##' R version {overwritten, just below}: symmetricDimnames <- function(x) { r <- x@Dimnames # validity ==> r is length-2 list if(is.null(r[[1L]]) && !is.null(r[[2L]])) r[[1L]] <- r[[2L]] else if(is.null(r[[2L]]) && !is.null(r[[1L]])) r[[2L]] <- r[[1L]] r } symmetricDimnames <- function(x) .Call(R_symmetric_Dimnames, x) setMethod("dimnames", signature(x = "symmetricMatrix"), symmetricDimnames) ###------- pack() and unpack() --- for *dense* symmetric & triangular matrices: packM <- function(x, Mtype, kind, unpack=FALSE) { cd <- getClassDef(cx <- class(x)) if(extends(cd, "sparseMatrix")) stop(sprintf("(un)packing only applies to dense matrices, class(x)='%s'", cx)) if(!missing(kind) && kind == "symmetric") { ## use 'unpack' but not 'Mtype' ## special treatment for positive definite ones: as(x, if(unpack) { if(extends(cd, "dppMatrix")) "dpoMatrix" else paste0(.M.kindC(cd), "syMatrix") } else { ## !unpack : "pack" : if(extends(cd, "dpoMatrix")) "dppMatrix" else paste0(.M.kindC(cd), "spMatrix") }) } else as(x, paste0(.M.kindC(cd), Mtype)) } setMethod("unpack", "symmetricMatrix", function(x, ...) packM(x, kind="symmetric", unpack=TRUE)) setMethod("pack", "symmetricMatrix", function(x, ...) packM(x, kind="symmetric")) setMethod("unpack", "triangularMatrix", function(x, ...) packM(x, "trMatrix", unpack=TRUE)) setMethod("pack", "triangularMatrix", function(x, ...) packM(x, "tpMatrix")) ## to produce a nicer error message: pckErr <- function(x, ...) stop(sprintf("(un)packing only applies to dense matrices, class(x)='%s'", class(x))) setMethod("unpack", "sparseMatrix", pckErr) setMethod("pack", "sparseMatrix", pckErr) rm(pckErr) ##' pack () -- smartly: setMethod("pack", signature(x = "matrix"), function(x, symmetric=NA, upperTri = NA, ...) { if(is.na(symmetric)) ## must guess symmetric / triangular symmetric <- isSymmetric.matrix(x) if(symmetric) { pack(.Call(dense_to_symmetric, x, "U", TRUE), ...) } else { # triangular ## isTriMat(..) : should still check fully (speed up ?) .. if(isTr <- isTriMat(x, upper=upperTri)) { uplo <- attr(isTr, "kind") pack(new(paste0(.M.kind(x),"tpMatrix"), x = x[indTri(nrow(x), upper=(uplo == "U"), diag=TRUE)], Dim = dim(x), Dimnames = .M.DN(x), uplo = uplo), ...) } else stop("'x' is not symmetric nor triangular") } }) ## {"traditional"} specific methods setMethod("unpack", "dspMatrix", function(x, ...) dsp2dsy(x), valueClass = "dsyMatrix") setMethod("unpack", "dtpMatrix", function(x, ...) dtp2dtr(x), valueClass = "dtrMatrix") ### ## autogenerate coercions ## as(*, "symmetricMatrix") ## ~~~~~~~~~~~~~~~~~~~~~~~~~ ## Basic problem: ## This should work at package install time when package:Matrix does not exist! if(FALSE) local({ allCl <- getClasses("package:Matrix") ## << fails at install time!!!! clss <- allCl[sapply(allCl, extends, class2 = "Matrix")] virt <- sapply(clss, isVirtualClass) ## Now ensure coercions for all non-virtual "Matrix" inheriting classes: for(cl in clss[!virt]) { cld <- getClassDef(cl) if(extends(cld, "symmetricMatrix")) cat("\tsymmetric:\t", cl,"\n") else if(extends(cld, "triangularMatrix")) cat("\ttriangular:\t", cl,"\n") else if(extends(cld, "diagonalMatrix")) cat("\tdiagonal:\t", cl,"\n") else { cat("do ",cl,"\n") ## setAs(cl, "symmetricMatrix", ## function(from) as(from, ".s.Matrix")) } }## for }) Matrix/R/lsCMatrix.R0000644000176200001440000000415311004710547013752 0ustar liggesusers#### Logical Symmetric Sparse Matrices in Compressed column-oriented format ### contains = "lsparseMatrix" setAs("lsCMatrix", "matrix", function(from) as(as(from, "generalMatrix"), "matrix")) setAs("lsCMatrix", "lgCMatrix", function(from) .Call(Csparse_symmetric_to_general, from)) ## needed for indexing (still ?) setAs("lsCMatrix", "lgTMatrix", function(from) as(as(from, "generalMatrix"), "lgTMatrix")) aslsC.by.lgC <- function(from) as(as(from, "lgCMatrix"), "symmetricMatrix") setAs("lgTMatrix", "lsCMatrix", aslsC.by.lgC) # <-> needed for Matrix() setAs("matrix", "lsCMatrix", aslsC.by.lgC) ## Specific conversions, should they be necessary. Better to convert as ## as(x, "TsparseMatrix") or as(x, "denseMatrix") setAs("lsCMatrix", "lsTMatrix", function(from) .Call(Csparse_to_Tsparse, from, FALSE)) setAs("lsCMatrix", "dsCMatrix", function(from) new("dsCMatrix", i = from@i, p = from@p, x = as.double(from@x), uplo = from@uplo, Dim = from@Dim, Dimnames = from@Dimnames)) if(FALSE) # needed ? setAs("lsCMatrix", "dgTMatrix", function(from) as(as(from, "dsCMatrix"), "dgTMatrix")) ## have rather tril() and triu() methods than ## setAs("lsCMatrix", "ltCMatrix", ....) setMethod("tril", "lsCMatrix", function(x, k = 0, ...) { if(x@uplo == "L" && k == 0) ## same internal structure + diag new("ltCMatrix", uplo = x@uplo, i = x@i, p = x@p, x = x@x, Dim = x@Dim, Dimnames = x@Dimnames) else tril(as(x, "lgCMatrix"), k = k, ...) }) setMethod("triu", "lsCMatrix", function(x, k = 0, ...) { if(x@uplo == "U" && k == 0) new("ltCMatrix", uplo = x@uplo, i = x@i, p = x@p, x = x@x, Dim = x@Dim, Dimnames = x@Dimnames) else triu(as(x, "lgCMatrix"), k = k, ...) }) setMethod("chol", signature(x = "lsCMatrix"), function(x, pivot=FALSE, ...) chol(as(x, "dgCMatrix"), pivot=pivot, ...)) ## Use more general method from CsparseMatrix class ## setMethod("t", signature(x = "lsCMatrix"), ## function(x) ## .Call(lsCMatrix_trans, x), ## valueClass = "lsCMatrix") Matrix/MD50000644000176200001440000006657714154217453012061 0ustar liggesusers675a3a48a357cb2ee05ed285387b3e85 *ChangeLog cee5d7a26015e92483189135aec9fd66 *DESCRIPTION 49c7113b5e0e4fbf269132f6a5ff5b06 *LICENCE cf93e388888f9c1b4d6a837a722389b6 *NAMESPACE 79db04911b0db95b42af3cf39074ddde *R/AllClass.R efdfaabdaeabd9fbf74c8005cd74b99b *R/AllGeneric.R 035518b058f5a4e9c9d8b9f5cfb246a8 *R/Auxiliaries.R e184b3cf64c092b6ed0a0d22eb332a44 *R/CHMfactor.R d4293b0a95fc6e892e9f0180070dbfd1 *R/Csparse.R d7497671f04e08d0d703b650fd3eacff *R/HBMM.R 3f37d43942f54523314df6f5406cf488 *R/Hilbert.R 4d794b4715d6efa432fd7cf86f69da7a *R/KhatriRao.R 7cd5d5938844fa73c1a2b50fae7fdd19 *R/LU.R 197e5f362225d239bd773e48c5d64536 *R/Math.R e51fd393dbaa1840ccd542b60dbbdb9b *R/Matrix.R e19ed36934229e22f41552d4d40c5d5a *R/MatrixFactorization.R 0b5206bab6dfddccb8a288fd01ac91bf *R/Ops.R cbe898c72117dff19f606c1d1b4fee35 *R/Rsparse.R 6433ca318f74c40760e68b1d56466d09 *R/SparseM-conv.R 06e2827859c01e8f88b0ff6059af5903 *R/Summary.R 6a7da18f24f62bb82f1d7bd0e9c94cf9 *R/Tsparse.R e0e755ece77810961adf04e91b70230d *R/abIndex.R ca7dda9b343edd7322d28eb794d67947 *R/bandSparse.R 000150ca84a498406ac11b52acc9d369 *R/bind2.R 36fc495f5f428bc1855952343790bfa3 *R/colSums.R 73f70ce30c4eb94c71d69d824173f8e3 *R/condest.R 9107b79ca2f8d9d0692f2a11614def29 *R/corMatrix.R 30d3814cd0c8e0bb65e32a8afcf266e7 *R/dMatrix.R 1494b03ff03603b6feff2b5b72e80249 *R/ddenseMatrix.R 98062e51bc73b785d28fe2efaec6f7b9 *R/denseMatrix.R 4598bf99d942e19a5f1d54f7812511b1 *R/dgCMatrix.R 7eea936db6cd3af3a26f077325cc5eae *R/dgTMatrix.R 4a19560632a9bab7a208659535578cc9 *R/dgeMatrix.R bb037f863507a8c4a1c04d17a5bec8d8 *R/diagMatrix.R be76b734bbed865c5a76f90ecd874448 *R/dpoMatrix.R 8820816c1ba5b2b9cc958829d9b8a439 *R/dppMatrix.R 23d4c6327f7a77005f9797aa146dc122 *R/dsCMatrix.R 09de435f59f2647d1df19343018f2944 *R/dsTMatrix.R 0b637ba08284d236fc762613af4c7c68 *R/dspMatrix.R 37538e52ac1a0c9f53db593ff12cc7d7 *R/dsparseMatrix.R c23b81a0cd992c7fc8e0b69caf37e161 *R/dsyMatrix.R 00383411351e9f52768820c5d769c8dd *R/dtCMatrix.R e826da941555bb348d828af69c77b7dc *R/dtTMatrix.R 019575cc5f9a75d8a2196b6018f48d32 *R/dtpMatrix.R 4cc6181517f3cef3721b56ff91454aa0 *R/dtrMatrix.R cac2aed2748ce92e00d6a59c1120619d *R/eigen.R 333accc94fd2c5ba991ce2473e4cd510 *R/expm.R 81c04317005ed6237b4686d3c033a9d5 *R/indMatrix.R 0a95fa59e5d79a0c7a161a21e3b952d4 *R/kronecker.R ed7d9a69e8f94a5f491addef1f07d9c4 *R/lMatrix.R 2cc411a9418590cc3d864f172d49dad3 *R/ldenseMatrix.R d5ba767108658df9fdd005cb7b27c431 *R/lgCMatrix.R 6ee5d8250439cac40030ec3a6b5f2b72 *R/lgTMatrix.R 32f129fb9fec2b6de53b2e4d6bbab656 *R/lsCMatrix.R 599da5bf12a53c62027b1a71dddc3a56 *R/lsTMatrix.R acf5c490e61aaebc2321862f4a3b6078 *R/lsparseMatrix.R e4d8788301b8df1c0c3a3e6058bcdd2a *R/ltCMatrix.R 47012791a775a04b711b374e846d4637 *R/ltTMatrix.R 5e16ca4b45953dc6397f7c2c092f9078 *R/ndenseMatrix.R f26e351d881e373de6ee9fd543c168e0 *R/nearPD.R 9167008b2f0588136afeae7cca15bd29 *R/ngCMatrix.R fcb45493f9bf912c437e6bd8469d4628 *R/ngTMatrix.R d5e42272817bc3082d5860d296abba02 *R/nnzero.R a7d4c2f2e58bf7b10dda13211a67190a *R/not.R 4264a9bacf136df9609ac07a9aa269b2 *R/nsCMatrix.R 1d83aff8b65c3776a8bcbfddff2e8109 *R/nsTMatrix.R ef9e369349fd33729f55a96c2b5713b2 *R/nsparseMatrix.R c99cb4378118814181ae1945d1e8113e *R/ntCMatrix.R f12c8b3ac756a91e8c0dfdf270a38b98 *R/ntTMatrix.R 0514b0a4895312a1820692af6df7f8ed *R/pMatrix.R da7fc80f7bba428f0f57b21d8741c076 *R/products.R 24205505bb16c0c69bfe8ede4aad871e *R/rankMatrix.R 96aa526115e8e025781c3b98229bbfaa *R/spModels.R 3f8ab6ed4be9b4155b70bbe36816b7b4 *R/sparseMatrix.R 051d36e642ea26d62207b78eb0fb17c5 *R/sparseQR.R 7dae1c82ccb5db3066b1c51bfe593258 *R/sparseVector.R 05f2a3a6050547bcf4c5ec9915ba364c *R/symmetricMatrix.R 1c79964c44bab5c8843bcab8055ef2a9 *R/triangularMatrix.R 24a3e5815f0d49ba3361f3f94f519049 *R/zzz.R 2a2b19a3cc46d48cef7fd7fa306f045b *TODO 90f838db2b6e6f55b34f019562270049 *build/partial.rdb 9baa97c36e41dcf59a5dd2c552de3ca7 *build/vignette.rds f2ad5375e270deeb7b041272dd095032 *cleanup 9f8e37cf17a5d4811d0c28f07148cf7d *data/CAex.R c60c038f2c6d15c5303d81330991c838 *data/KNex.R d6193dad1031a61ebc3d3e38fabd252d *data/USCounties.R 0d65337740b3914f535239cbe6e8a2df *data/datalist a40150a1c71deabec67e61af2b8f7e38 *data/wrld_1deg.R 8734f0b040c6292983d273d4251d250a *inst/Copyrights cb641eb46a4b4f459f4da4c67f99690a *inst/Doxyfile 028c7e578fbbee6706a97d6e8c59681d *inst/NEWS.Rd ea747a35318c564002a7144ebd510e28 *inst/doc/Announce.txt bac68d3a4425ca2e234668cced364ca6 *inst/doc/Comparisons.R 09e13507b9832a30aa92e8aff0dc96a0 *inst/doc/Comparisons.Rnw f19c1a11ea3c8eea37ca5871afd24cfa *inst/doc/Comparisons.pdf 2812fdc46495ac74ebdc299860a197bc *inst/doc/Design-issues.R 5a9e99ce004c325e01fb2773e58052f5 *inst/doc/Design-issues.Rnw 0304a6279dbe27c4c562a1be5a52f7a9 *inst/doc/Design-issues.pdf 588c7243a45ab43dd45a0d856423e89d *inst/doc/Intro2Matrix.R 6bb038dd0a9c26fa751c1fe084328a1f *inst/doc/Intro2Matrix.Rnw 9ae85e1ec23a82620ac9630b57ac6516 *inst/doc/Intro2Matrix.pdf 1a59a7d3257a30349a5e10285ea05a69 *inst/doc/Introduction.R c39a26dfe7ccaafd044e88468155b153 *inst/doc/Introduction.Rnw e4e5957b6a16d380ae9fc863dc503d52 *inst/doc/Introduction.pdf 20ced7019f5a55639aa1af1a2dfa1057 *inst/doc/SuiteSparse/AMD.txt facc21d5bf9bcbf3e57a8b3c7bd1caa0 *inst/doc/SuiteSparse/CHOLMOD.txt a6693872cf6e74e758f3fa327c606fec *inst/doc/SuiteSparse/COLAMD.txt d75882d4bb768ba0ea352291652daaee *inst/doc/SuiteSparse/SPQR.txt 530be1afa9c08d576c1a64be8b3e5b7b *inst/doc/SuiteSparse/SuiteSparse_config.txt 6d217288f5da4fe419afaa34988bf42d *inst/doc/SuiteSparse/UserGuides.txt fd17dfab29a894aa9d33ff5fa75e3967 *inst/doc/sparseModels.R b131db6dd2216719942b771909097ae6 *inst/doc/sparseModels.Rnw 4a6910aab83da630e3cf876898a15fa3 *inst/doc/sparseModels.pdf dcd11f6947f910f743254824e930b2c7 *inst/external/CAex_slots.rda be886d6bb832210bb654b9ad064fe0ff *inst/external/KNex_slots.rda 90f019ec81e67d7f3542f7ca39bf3f2d *inst/external/USCounties_slots.rda ecf98cf53529ca8e794e48f1ce4e4bde *inst/external/Z_NA_rnk.rds f01fae298b6f33c20cef0ab32ee468c4 *inst/external/jgl009.mtx 47bc35200e7b3fc1cdd6ab1adbeef3a0 *inst/external/lund_a.mtx fc72dd2599982f25f9ffbfc75f149134 *inst/external/lund_a.rsa a5748e10322306f8c2114db09cd58dd8 *inst/external/pores_1.mtx 8758e19cf3478732e62e563b638bcda7 *inst/external/symA.rda 7980f700b4fd62d0d6de7f96201b2645 *inst/external/symW.rda 7e22a368a5d129fc7396432949fb72ab *inst/external/test3comp.rda 697db4242eb44425ce2550fafdc957a8 *inst/external/utm300.rua ca51a0b8b76e7ea3e7881cc8da1390b1 *inst/external/wrld_1deg_slots.rda 5ce5ea63a73e4641173fe37b6a809a01 *inst/external/wrong.mtx bb494089190644c5cb1af6d65d4b56c7 *inst/include/Matrix.h e44c6f2df3e4f633d3755053cef8f993 *inst/include/Matrix_stubs.c e9067dd00e3789dae7542f4817cb959e *inst/include/cholmod.h 08c1ee614bd8d32365ef3952119c2e63 *inst/po/de/LC_MESSAGES/Matrix.mo 727e95322ecc905228bba0000485534a *inst/po/de/LC_MESSAGES/R-Matrix.mo bfc15a2d6e4bf47b981bbae0e6a0cba6 *inst/po/en@quot/LC_MESSAGES/Matrix.mo c1a3cf8e8caa9480a88985882d061e19 *inst/po/en@quot/LC_MESSAGES/R-Matrix.mo ef04354200ddc299c7f23bc505b114e9 *inst/po/fr/LC_MESSAGES/Matrix.mo b41183a47743f55b95ed99ddb0c221b7 *inst/po/fr/LC_MESSAGES/R-Matrix.mo 276240a69bf307451ec43e7110bce724 *inst/po/it/LC_MESSAGES/Matrix.mo 19bc916b08825ad8c43e3c734ddf72e2 *inst/po/it/LC_MESSAGES/R-Matrix.mo 7328e375b8d267bffd4e43e7f973aa5f *inst/po/ko/LC_MESSAGES/Matrix.mo 4b3ce922c40ddc343f00fcdfd3bb5583 *inst/po/ko/LC_MESSAGES/R-Matrix.mo 7a995cf90ad991538a394103a1307fdc *inst/po/lt/LC_MESSAGES/Matrix.mo ce85b9efba4bfd524d4d149d0931bd0f *inst/po/lt/LC_MESSAGES/R-Matrix.mo c4a01f4d116fa907d75f8dd5563c1a8c *inst/po/pl/LC_MESSAGES/Matrix.mo 28128cb42bdf42268824f171b3d658fb *inst/po/pl/LC_MESSAGES/R-Matrix.mo 8533f66f05ce0cc956c78ae28aeba5ca *inst/test-tools-1.R 0e2f00b6677a27002041d9dc92a6fab2 *inst/test-tools-Matrix.R 384ad19fd9e35dfa867ff36dc6d502f4 *inst/test-tools.R b03ea3a203bfea24bb54f7d797d2a53c *man/BunchKaufman-methods.Rd a84142e187e2a8d79be122f60b91395e *man/CAex.Rd 5b10b3332f494d1fc81c004541234d8b *man/CHMfactor-class.Rd f39cd7f9daaa240217e1d6ce0f810b47 *man/Cholesky-class.Rd 67893950e7e4ec247d084014f505c0b5 *man/Cholesky.Rd 17320b5f124586c8e868a04da2135769 *man/CsparseMatrix-class.Rd 2015517ea1587cd6f03c994337355c64 *man/Diagonal.Rd 74df4ccf77c8797a57520d36afe98a0f *man/Hilbert.Rd 8743b4fa2a7f121badda6d3022a9f2e5 *man/KNex.Rd 7b81b5d90ede29d521819227497f26e7 *man/KhatriRao.Rd b79c16e807bb0dc031ddb41644d605f6 *man/LU-class.Rd e34bbb732812b338d5a263246bc89ca4 *man/Matrix-class.Rd a0b6c2f8ffb1e3f09bf3625312107c9b *man/Matrix.Rd c50c7e06a955a5d2ecea071b7160b2bf *man/MatrixClass.Rd 34116420a7c90c8df288f9eba5233966 *man/MatrixFactorization-class.Rd 5dd89d0942cd13d832c1614261595532 *man/RsparseMatrix-class.Rd 965323db9aa812ceff4c71d7b0881397 *man/Schur-class.Rd d15bfb87449f86c5cb9b65e77de821bb *man/Schur.Rd 12da656e739b166f6ff138a5f8ad135a *man/SparseM-conv.Rd b946bf426edf45858278e6eaacb14f4a *man/Subassign-methods.Rd 85cef320006f63173bddab42fb1742c4 *man/TsparseMatrix-class.Rd 119e8a808282036675985593f22aa5f0 *man/USCounties.Rd 82c40ab7acdece7076e47a3afe9d6202 *man/Xtrct-methods.Rd e71bf7921ef9b0ad3485a162c2a4175b *man/abIndex-class.Rd 0611d202a92b93597a926a452ac5f525 *man/abIseq.Rd 6b4ec88403685427fea91824fecd33fc *man/all-methods.Rd 3468e037f94352ea8fe8803cde364d17 *man/all.equal-methods.Rd f4f8612666bf98866b98f1630a89f5f0 *man/atomicVector-class.Rd da07b900084e02c0ceff67c59f00a721 *man/band.Rd b2c97cfc0efd869b8c850e477c0961b7 *man/bandSparse.Rd 6a0361645912beba595a4174e3dbd185 *man/bdiag.Rd 908ebebcda1ea09c3f061fbe869ab333 *man/boolean-matprod.Rd da37a200c0808e1adceb773cec30b476 *man/cBind.Rd 04fb17cae6c3ab4f90243af2b5586801 *man/chol.Rd 56c41276d74b7373b67fe98947b62834 *man/chol2inv-methods.Rd 8d7c220ad9a7fe5b76e28c945f9f7a79 *man/colSums.Rd 16c76be17728e8ade8678ab81a125899 *man/compMatrix-class.Rd d1b55fe34437f6dac0ea54d272f1fe42 *man/condest.Rd 253bb6ac974d08c57d9da1fec62ea887 *man/dMatrix-class.Rd 61bcd63c92c3fd085f3cace9bf58f7f2 *man/ddenseMatrix-class.Rd fea7d6aa90395d29ab34ebe90603aec4 *man/ddiMatrix-class.Rd 6f39723018431aef5d98da8086ada47a *man/denseMatrix-class.Rd fe73603f3fe76c38641b2daac7297bb8 *man/dgCMatrix-class.Rd 33311e5379364ad7d6fa816ce187506d *man/dgRMatrix-class.Rd 47b1d62a76cdd35e010cbe9cec526656 *man/dgTMatrix-class.Rd 72308d53b230cfb96df740c7f93a29e2 *man/dgeMatrix-class.Rd 546b1c5f8bab6de2265cd8817a8a92b5 *man/diagU2N.Rd 2209d909e4016f4b766f1ec2088f5119 *man/diagonalMatrix-class.Rd 600227d6a7315d336ea3f9655491ac4a *man/dpoMatrix-class.Rd fe1acb9ad779ffe89d0169baec96938c *man/drop0.Rd 2e193c409e5072667ff59aee82235321 *man/dsCMatrix-class.Rd e6232ded0c7b441674776381b8e25efa *man/dsRMatrix-class.Rd 5a84601e5f8ed336d3cc947e6703d271 *man/dsparseMatrix-class.Rd 507561ace7510ffe9954309f28427a7d *man/dsyMatrix-class.Rd fc4cbba5c7ad7815e760cd18ba6f8e8f *man/dtCMatrix-class.Rd 9e88fe051b42ffdfc4fdc08361372a21 *man/dtRMatrix-class-def.Rd 3f894c8473e90abe89ca43c9d8cbe465 *man/dtpMatrix-class.Rd 6a2a558316ce2fb53198f5a3353f58b0 *man/dtrMatrix-class.Rd 6a387be8b8359afca25df874f53ecf05 *man/expand.Rd bd915f2d2c25992d3a4923c338ff88d1 *man/expm.Rd 6851b7ea3ad9ba6408d49e5dd2c9fe48 *man/externalFormats.Rd dd7dc20ed8afa4c6a0dd752270ff2617 *man/facmul.Rd 12fee6d998e1b954161ce53043fae6e2 *man/forceSymmetric.Rd c332f4d33b290c48d2b066d87b9ad588 *man/formatSparseM.Rd 10534177267141a74ee6f1403862bf3c *man/generalMatrix-class.Rd 62fde3213a1be9c3665f467b15d19883 *man/graph2T.Rd 02b9c1bd7458618da04793f0e915c6ff *man/image-methods.Rd 9a698c3e6da46368323fca085e2014aa *man/indMatrix-class.Rd 0853b4b3c74400077c7e660d7ba11e97 *man/index-class.Rd 1bc58269199564d45feef99cf46ca01f *man/invPerm.Rd eeed15170e23c5a284c59332a97f76cc *man/is.na-methods.Rd 46efc2ba7204f7391229a157e0853997 *man/is.null.DN.Rd 70cb42ba2fbfebc7e94b82138da9a3f3 *man/isSymmetric-methods.Rd a10db7f99dd8dbf64f407149d28a13ce *man/isTriangular.Rd ed16ec064ca2ce017b1ac7b60f97ee3b *man/kronecker-methods.Rd 55098a59974d83541bf3d00f66760a7a *man/ldenseMatrix-class.Rd bec8838d4bd72f6a27d62383edc953b5 *man/ldiMatrix-class.Rd cc4f3ec710ac4aaa17e75e6ff265dafc *man/lgeMatrix-class.Rd 414ed370bf65f846147b5ddf4b04caff *man/lsparseMatrix-classes.Rd f1e1cfefe3650a6c19b1c63b7d6052dc *man/lsyMatrix-class.Rd fc78ae1f310100dc8dbe8cff430a2093 *man/ltrMatrix-class.Rd f5127ffbf702e88219a61c8385c53de2 *man/lu.Rd 74bc4da62d254454beaf6215be9382d2 *man/mat2triplet.Rd 0d747fec479866528765389a665bb781 *man/matrix-products.Rd 4a449d40a733322c55cf7146d8ddb43e *man/nMatrix-class.Rd 3e94bd26a125e628e83c7b6d4d8a045c *man/ndenseMatrix-class.Rd 3793db5c5e6a0cfc189d96b7dfe91bd1 *man/nearPD.Rd 07c563eefd115c5f74e5ba28231ffb46 *man/ngeMatrix-class.Rd ffb57c3063559175113661c71b6f130d *man/nnzero.Rd 001c81a2b8215c310e817aa60ea2095b *man/norm.Rd 07d71b43dd151e9ec97599ed39c97053 *man/nsparseMatrix-classes.Rd b299d889bba52b4d4e558b7d121eb97a *man/nsyMatrix-class.Rd 11890bb8c3bdd03d0d0ca39ab95a6c08 *man/ntrMatrix-class.Rd b44976fc24c22cc0d7d0bf722a951a3b *man/number-class.Rd 358232f60f227a3908652716415f6b5c *man/pMatrix-class.Rd e9384f6173e7234e6e098777ed323349 *man/printSpMatrix.Rd 30788cbd05d4dfd195e7707dd125e72d *man/qr-methods.Rd d5d83af4ec9779d67f438f0abf1cb16d *man/rankMatrix.Rd e6a10cf788588d6a28eb8b8ed328a790 *man/rcond.Rd eaa76f30797997d7d49d45c2f9c55c4f *man/rep2abI.Rd 4bd0fe0494027a0145e0357a7d839d87 *man/replValue-class.Rd 12d2c9caa3c91beecd1f6c60903478f6 *man/rleDiff-class.Rd fa6680ef9377ca18133924fbe5b2c4de *man/rsparsematrix.Rd f35cbc129237b69f91e59e05c3cd049f *man/solve-methods.Rd 9b68c5da96127168eb998860261126ef *man/spMatrix.Rd e5aa82eea40b7ab8fb16371017ebd0dd *man/sparse.model.matrix.Rd 41ee4b254fd4375e8f500a03e3cb8e2e *man/sparseLU-class.Rd 83cc47a425a3ec22aab7194085ad8542 *man/sparseMatrix-class.Rd c90d6886757e306e81581b99dcf7ceb8 *man/sparseMatrix.Rd aaaeedb1b37258fd2ca01a7de68edd33 *man/sparseQR-class.Rd 98b4e7da1c3bd1736ed9b7eff66055dc *man/sparseVector-class.Rd d55a0d5dc2476a64f08435526794ad8d *man/sparseVector.Rd 3f3010b99b5b9081fb75f8543b4031f6 *man/symmetricMatrix-class.Rd 749ddc8f3da2e72556ea5a3b605e570e *man/symmpart.Rd 7c865bb2197d10d31e7262b4ecac067f *man/triangularMatrix-class.Rd 77598fe8249969008a753f46af557c00 *man/uniqTsparse.Rd c85d81fef271d0f630bea4ad1ddf67d8 *man/unpack.Rd 95a864f6e2b3c41d1aefd0c6686f278a *man/unused-classes.Rd 0ef56496d0eca5c262145a3bc0760242 *man/updown.Rd 36856a6ca013cb6dce65016eba8c521b *man/wrld_1deg.Rd adcb52f1ecb0199644468cf07fcdab74 *po/Matrix.pot 7f9e57d49fe9a124733bbe2d5536c24f *po/R-Matrix.pot 9da8a3179089818fbf285d9d6002c5a9 *po/R-de.po d0adb79a72b24cc56a6f39845ddeca39 *po/R-fr.po 824656328489eaad9a352144b00c5c66 *po/R-it.po cbe1ec7580adccdce9f4dd185e9f7fc9 *po/R-ko.po 47ffe972f607c9f6dfed7ed039eae566 *po/R-lt.po f6f46ac7246486b243f2ff25cbd39c19 *po/R-pl.po fb4ab8f48447cd0fd3de16f2ce9e7afa *po/de.po db9f449c7afda14d60c42d6c0782ee0d *po/fr.po 2f614504f5ab5646e95bec5ae3a32a26 *po/it.po 30fa11e8bde035c9c49f4d87f73ac08c *po/ko.po be384b0f6e2541a668cb7fa7ca903542 *po/lt.po 6c578cb20cccdbc5fa6c6075fb576abf *po/pl.po f1dd8f7390a0da64bd647126f49431cc *po/update-me.sh d564f974ab9d0216714a4e9bb460888a *src/AMD/Include/amd.h ab12fd060364d0eeda67731450dda3c3 *src/AMD/Include/amd_internal.h 44b5e7133f7f818d07d17637c8410c51 *src/AMD/Makefile 2df4e18aa3b3cc889f3d521e98a42c20 *src/AMD/Source/Makefile 41ec90eacd97a62c7393f9a66f714662 *src/AMD/Source/amd_1.c fc12596df9e5a12177d1c6e5dba8fce5 *src/AMD/Source/amd_2.c 23003d2ff7e400dc8738a838951a80cb *src/AMD/Source/amd_aat.c 359f2804fbe6f2cdf92a592a8bb6346e *src/AMD/Source/amd_control.c c0a3524d4f5ddcb63065eeabe8ae57f8 *src/AMD/Source/amd_defaults.c 896cccbf9ea7f21142964fe1868da79d *src/AMD/Source/amd_dump.c d2c2d032a544ad771e1cbc5c4919c4e0 *src/AMD/Source/amd_info.c 086739e8011cdb4d98a8605cca59f0ab *src/AMD/Source/amd_order.c 5f8f83de491e328aefbff08a09c3b467 *src/AMD/Source/amd_post_tree.c d696467688131d58e3acf9e5a627360e *src/AMD/Source/amd_postorder.c 5d46a2442b5d099f6ba9fa6b427d7a1f *src/AMD/Source/amd_preprocess.c 56f64a3203f5752b5a012b806f101d8c *src/AMD/Source/amd_valid.c c07546f3d3e2857387fe0cdce6d7b255 *src/AMD/Source/make-Make.R 55d6a34f38b378f64f9bc05c96168890 *src/AMD/Source/make_o.mk ba1939e26fe468ab12d05db7bb99a2bd *src/CHMfactor.c 30dc9cebc72c3cab2862a1f04209874e *src/CHMfactor.h d2d49c52f19cae17de0efe9bbd0e50b0 *src/CHOLMOD/Check/License.txt a6a8759ae19d9078ec04530d31c5180b *src/CHOLMOD/Check/cholmod_check.c a790fc8c409f465c93400cbaf8e2ea49 *src/CHOLMOD/Check/cholmod_read.c f538b7f07e4248e2eb67d16c7571fb41 *src/CHOLMOD/Check/cholmod_write.c 887d3c7dc221e09fa581c96ce66e76f2 *src/CHOLMOD/Cholesky/License.txt ea289556183948c4b3f5309656beb0b6 *src/CHOLMOD/Cholesky/cholmod_amd.c 0bec6c175861bf722413633c5127d21a *src/CHOLMOD/Cholesky/cholmod_analyze.c 2b0f3a59a18076d7270c5c856f65ae94 *src/CHOLMOD/Cholesky/cholmod_colamd.c ab14e2224df91d90a726aa8d37125d1f *src/CHOLMOD/Cholesky/cholmod_etree.c 24793eeb061a9c26b3834f0f422d8441 *src/CHOLMOD/Cholesky/cholmod_factorize.c d139d2ca810efcb360eba3dedb3a29b5 *src/CHOLMOD/Cholesky/cholmod_postorder.c 6637f976d6cbec2bbea62c1964fec0a7 *src/CHOLMOD/Cholesky/cholmod_rcond.c 8ec749d7a2b29875841b598d3672ed89 *src/CHOLMOD/Cholesky/cholmod_resymbol.c 336f36a7952773b8b724b5932d6f9e17 *src/CHOLMOD/Cholesky/cholmod_rowcolcounts.c e1725967691d217d614e749bb3db913d *src/CHOLMOD/Cholesky/cholmod_rowfac.c 42790e888b94da5ce7f8d822258336f4 *src/CHOLMOD/Cholesky/cholmod_solve.c 0b29fb59bd00892cee38508bd6c1be00 *src/CHOLMOD/Cholesky/cholmod_spsolve.c 189e18b2104803d0e0d39a3b6b03e99f *src/CHOLMOD/Cholesky/debug_c 9574c620c6e39670d278947452787ded *src/CHOLMOD/Cholesky/t_cholmod_lsolve.c 1e79a8a5620e2cd5d76c18ce352245d8 *src/CHOLMOD/Cholesky/t_cholmod_ltsolve.c 4596c898fa5572f49cf428c9ea23366f *src/CHOLMOD/Cholesky/t_cholmod_rowfac.c f648c37e680eb79b677aaa0efe66c810 *src/CHOLMOD/Cholesky/t_cholmod_solve.c 0b650d81b9287230f7335cb5d6404b97 *src/CHOLMOD/Core/License.txt eb4c6ad7286636777285b2163ce8b44c *src/CHOLMOD/Core/cholmod_aat.c 270db0e35c4bba3b73fabc1d1cf4c297 *src/CHOLMOD/Core/cholmod_add.c a2af0345308ccae36d74456a752735ac *src/CHOLMOD/Core/cholmod_band.c a750efa7b7a60dc535b8786dbcc6e95b *src/CHOLMOD/Core/cholmod_change_factor.c 32d83812ab434be37e53f8bc0a6c3e1f *src/CHOLMOD/Core/cholmod_common.c ff68b20bd393e64b72a82a7297a2f5be *src/CHOLMOD/Core/cholmod_complex.c 9cf2038ab02d7f1a1398e7a792bceee8 *src/CHOLMOD/Core/cholmod_copy.c f12e1b0e82a3d318a8c39634ffc18867 *src/CHOLMOD/Core/cholmod_dense.c c6cb3cc439b75d3f899b4bc6a373a047 *src/CHOLMOD/Core/cholmod_error.c 98d05f2c2021391e2436b3d98fcc9b72 *src/CHOLMOD/Core/cholmod_factor.c e52ca0b9a66e14c51adcd5bdf2518233 *src/CHOLMOD/Core/cholmod_memory.c f6a9a08dcfa01c17a2db3ff197ea5cd9 *src/CHOLMOD/Core/cholmod_sparse.c cc8a39157e8a4bfd5d09d67216ad2df9 *src/CHOLMOD/Core/cholmod_transpose.c 896f74cc1d05206ddb210503e289e59b *src/CHOLMOD/Core/cholmod_triplet.c edf80c5be30905b6e7d39c6bb475614f *src/CHOLMOD/Core/cholmod_version.c b9a0f158d3c428138474b466317b05eb *src/CHOLMOD/Core/t_cholmod_change_factor.c d312cf79f2399b70f12009f7f4c97bed *src/CHOLMOD/Core/t_cholmod_dense.c c0a69959da9f6c8d9b7ccefff044ac88 *src/CHOLMOD/Core/t_cholmod_transpose.c e7557b90fc46f07d8a1a3a0ca97f4367 *src/CHOLMOD/Core/t_cholmod_triplet.c 43dea0a98ff00c4d001efdcf9e1107fe *src/CHOLMOD/Include/License.txt aebdd50c54b3d11988fa4be5fb71d05f *src/CHOLMOD/Include/README.txt cf4197c2fc01aca0b8f09a2a912f1e3e *src/CHOLMOD/Include/cholmod.h ff92b3b77108a58e9aa71b645c3accb3 *src/CHOLMOD/Include/cholmod_blas.h b6e1a9dd6eda272f5fd566ae2a3f1b19 *src/CHOLMOD/Include/cholmod_camd.h 4af20acf26e4884121f510ab9b9677cb *src/CHOLMOD/Include/cholmod_check.h 1d38d136504dd8712a4486684151e398 *src/CHOLMOD/Include/cholmod_cholesky.h b9b557b4fce4ed0c5d45fdb29eacf094 *src/CHOLMOD/Include/cholmod_complexity.h f30283b57821e962699fcdebe401d29e *src/CHOLMOD/Include/cholmod_config.h 85ab2d763ab9f5b5005312860aac9011 *src/CHOLMOD/Include/cholmod_core.h af5810b5faf02bc0c2bc32e1ae8f5d3d *src/CHOLMOD/Include/cholmod_internal.h 49b635af7e67fe230a215dc6392c2e81 *src/CHOLMOD/Include/cholmod_io64.h 4c33c07f0fee0c8f3eb5e2d24a0410e4 *src/CHOLMOD/Include/cholmod_matrixops.h 310517514527d7a853a70a477906f9ad *src/CHOLMOD/Include/cholmod_modify.h 0164f39b8f2a5f88f9b2cfcfbdac3f6a *src/CHOLMOD/Include/cholmod_partition.h 9411cccd4a7e2f2477583482e7c9e4f2 *src/CHOLMOD/Include/cholmod_supernodal.h 3ea4215bdf808d34bb7b2fe19e3b4e9e *src/CHOLMOD/Include/cholmod_template.h e18d16dd7650530c14404002c4130fbc *src/CHOLMOD/Lib/Makefile a298bc42f87addd27a4b4c0834b444e0 *src/CHOLMOD/Makefile e60f67b276c37ca2fc0796a45b61c470 *src/CHOLMOD/MatrixOps/License.txt 9884ada423d22844b53841d5d30c63ee *src/CHOLMOD/MatrixOps/cholmod_drop.c cdaaeb7402db7439d58861281ab7ebaf *src/CHOLMOD/MatrixOps/cholmod_horzcat.c 7aa434c4cfeb67ddd4fc4d21260df4af *src/CHOLMOD/MatrixOps/cholmod_norm.c b3d041382e74124c62ad753781b04a2a *src/CHOLMOD/MatrixOps/cholmod_scale.c 8ecc9194aa1b76412d72ca23704716ba *src/CHOLMOD/MatrixOps/cholmod_sdmult.c a3208187e74f173316038592d21777a7 *src/CHOLMOD/MatrixOps/cholmod_ssmult.c 120868ee7de5785fdd40c9ed6c540544 *src/CHOLMOD/MatrixOps/cholmod_submatrix.c fe53d8a9195fa77ca4bdb401942b8681 *src/CHOLMOD/MatrixOps/cholmod_symmetry.c ab660c53894c46ac21d8db5f4f555a80 *src/CHOLMOD/MatrixOps/cholmod_vertcat.c 37eb2ff5d173ba7429b84efe6513a955 *src/CHOLMOD/MatrixOps/t_cholmod_sdmult.c e38b4b22e31f8f215bbf4580cf50619c *src/CHOLMOD/Modify/License.txt 5ffd4e3a5d8847e7d7addd09f1767be4 *src/CHOLMOD/Modify/cholmod_rowadd.c 7c0358e2b63264c221e6760294bf97ba *src/CHOLMOD/Modify/cholmod_rowdel.c 69bccd35100b4e78d4d9bc475f1748b7 *src/CHOLMOD/Modify/cholmod_updown.c 8da287ae47456c8c5e4f7203c41caa00 *src/CHOLMOD/Modify/t_cholmod_updown.c 627b70a1a8817fe8186a540f5a0f5e36 *src/CHOLMOD/Modify/t_cholmod_updown_numkr.c b0cf7a9044494b5ea9481a1728c710e6 *src/CHOLMOD/Partition/License.txt ca532ef26111d9c42d7ba0ec2df1f7ff *src/CHOLMOD/Partition/cholmod_camd.c 6fe37e68727d1cdc783989ced2041f92 *src/CHOLMOD/Partition/cholmod_ccolamd.c c93f24417b08ee13217b2facc68dbde6 *src/CHOLMOD/Partition/cholmod_csymamd.c 04ef9f55e9bc467dd6ccb2b7db0d7482 *src/CHOLMOD/Partition/cholmod_metis.c 0fdefe77fe37ebfdc52e62a638997624 *src/CHOLMOD/Partition/cholmod_nesdis.c 08629b176847ad848a0327e6fde2210a *src/CHOLMOD/Supernodal/License.txt 42a014820a3ccf68e1189d92a6056175 *src/CHOLMOD/Supernodal/cholmod_super_numeric.c 5e0478f02c0954fd0b1b3547e4d2ecdf *src/CHOLMOD/Supernodal/cholmod_super_solve.c f020861359cd23510fb14489e403d349 *src/CHOLMOD/Supernodal/cholmod_super_symbolic.c 1ad404233a51f38540a959c36d880bda *src/CHOLMOD/Supernodal/t_cholmod_gpu.c 47985c9e3105b2eb8ad5545f843b4d49 *src/CHOLMOD/Supernodal/t_cholmod_super_numeric.c 087752a1b22d12e5e51a5a4852d57323 *src/CHOLMOD/Supernodal/t_cholmod_super_solve.c 22baa75870c7411e901df9b3bc420eaa *src/COLAMD/Include/colamd.h 44b5e7133f7f818d07d17637c8410c51 *src/COLAMD/Makefile 7110287b532b98a27a8324742cbf8edd *src/COLAMD/Source/Makefile b4a48a5fb881806aa039010f5f62ca26 *src/COLAMD/Source/colamd.c 286dfe368779b26c95c60fdf3f90096f *src/Csparse.c 684b703246b23a66b77fce3dc0e5d73a *src/Csparse.h aaf50db0c135a37f06f5bc69602d2a5a *src/Lapack-etc.h f5280d50bab44fc2a9d831a1b7dfc299 *src/Makevars 84c25b7ef6405f60afa84f20c95cb7a7 *src/Mutils.c 71979bda5159850e48835e3ab1d9fb2e *src/Mutils.h 34a94c6db1f395da28ca4e94dd9cf9ca *src/SuiteSparse_config/Makefile 0815699f04c57aec0cf1c4f701cfd1d9 *src/SuiteSparse_config/SuiteSparse_config.c 178a780e84cc133b1624b44c4e53225f *src/SuiteSparse_config/SuiteSparse_config.h d41d8cd98f00b204e9800998ecf8427e *src/SuiteSparse_config/SuiteSparse_config.mk 1cf7c17bb7f79d7d22577cf4770cfc37 *src/Syms.h 6c81ed089776f9a1a0db37237ffeb40d *src/TMatrix_as.c 0ef00bab2b7ffb79f64b25311decd236 *src/TMatrix_as.h 6551aecedc2b54c2c1f4c8a0973861f2 *src/Tsparse.c 20c550b57138bf22290ea759dfcb1c3e *src/Tsparse.h 3714d37c755fbf0b5b2a88362b651390 *src/abIndex.c ea6bdd1b33f38c8c2913eeef6eb21be3 *src/abIndex.h 19549c74aa256cff999e6c1ded52c8b1 *src/chm_common.c 5adb17aa22194e4df4b7aa18d1a5a935 *src/chm_common.h c857fab5c7847800ad654e3fbe9b517e *src/cs.c 1bcb7a109eed6463413de50e66989bb3 *src/cs.h 749274eb9cfbbb5cf0db83c0ae4300cd *src/cs_utils.c 0b6112e86dab4fcececbadd2e84582ea *src/cs_utils.h 968a537b0d4b96bb7934fa14a69eb0ae *src/dense.c 5a371dda647640f816f987e20befc749 *src/dense.h 20ccc16ccbc5d0e1c52ffb3a522ea69c *src/dgCMatrix.c 2392fd374cf7d259fedbef27f0a13e7f *src/dgCMatrix.h 8af0d16d1af609253ed3cab40820f652 *src/dgTMatrix.c 341e051982a88f9c4d9a02c1376978fc *src/dgTMatrix.h d512040a245deb37f513c82d6967fabf *src/dgeMatrix.c 57bfc26d18613c6697941ecec424455c *src/dgeMatrix.h 29e8038fc969bfbd6772ab8cdc436c94 *src/dpoMatrix.c 1c6cb704654ab73e9ef5d37eb353c053 *src/dpoMatrix.h 15796d0a68e4af4cb12a616567d3c6c1 *src/dppMatrix.c 1848f8927618d62ef401a3567dc0e7ff *src/dppMatrix.h 33132143f52714e00724817157cd7096 *src/dsCMatrix.c dadce6c58bc388ff5f6501f4c3cafab1 *src/dsCMatrix.h 4c647ad93f52c844007baa87cc677766 *src/dspMatrix.c 3cec3b3c82ef008305d29a23a5dce930 *src/dspMatrix.h 4b972fa8c8c2a89a3bc97476da207f3d *src/dsyMatrix.c cac83ba78bc67319b1b33995c59c7ddd *src/dsyMatrix.h dfa6c6dfa8e203ba8b967df0baca4708 *src/dtCMatrix.c 0eab9c4475b8630bb8f2a3ebb782530e *src/dtCMatrix.h 88a53b25ad8a93bd8f30b9df6d999d9c *src/dtTMatrix.c fac7ed66a9097104e94c3d91c01fcdc7 *src/dtTMatrix.h bfd6e2afda55069418623ccc716b1696 *src/dtpMatrix.c 1741bb5920113d5e5bc7c6d7d1209bd2 *src/dtpMatrix.h 8b945c10596e5338023e0592384d13dc *src/dtrMatrix.c 82e3c3c33fe020de8f659f26517abac8 *src/dtrMatrix.h cc1dca4dce1c8f68cf41f991ad349236 *src/factorizations.c 37fd937251ae9f1c68d974bd6169ade3 *src/factorizations.h 4cddf7625280c0bd23b0e7a533fee29f *src/init.c 26dfe9528badc58b534f9afd9b328227 *src/ldense.c d8522bb27a18eea16d17c411d8da9e38 *src/ldense.h 4bbf40e67cb551cfbf026600da8775d2 *src/lgCMatrix.c dc61a6a68eab8320a5616f4714d137d5 *src/lgCMatrix.h c6752ca685ada37ee45200e4cc2ed0f7 *src/scripts/0get-SuiteSparse.sh f3b6b0ff9a8088a21a1c46c9d7797f4d *src/scripts/DEPS.mkf 0aba26556ef5ddd3adc0031d41ef0d4c *src/scripts/DEPS.mkf_make.sh 15eb76d731d373a415312098f6f707e5 *src/scripts/SOURCES_C.mkf 92b7b42ff7d55c28151eb9a33641b1cb *src/scripts/UFconfig.patch2 f1d325ea608f75622777bef1fbe55611 *src/scripts/fixup-fn.R 4fcbb2353e3eaae1582c8533b73010b5 *src/sparseQR.c 68c429cbb92387ef9ce70dac75a6e934 *src/sparseQR.h 2e623510d32213208f40240fc50a0c57 *src/t_Csparse_subassign.c 2394f5def013c7e571231935320fa6c3 *src/t_Csparse_validate.c c55fe12890cabcf61d562a4969825c02 *src/t_Matrix_rle.c 7fb7e87a1910464bbedb110d74ad9c40 *src/t_gCMatrix_colSums.c edb93b23eb7e6db1f454970b4c663f3a *src/t_matrix_to_Csp.c e6de21ff3bf0908eaca620d9b868b4f1 *src/t_sparseVector.c a5ded77bce8df79c8c5096c20a57d6e6 *tests/Class+Meth.R d5093f6cf410ce01b155e2677553feee *tests/Simple.R 4aede3ab1ede1a5d7b88968cc41a8498 *tests/abIndex-tsts.R ce85ee2aba7d78e88fef738a0d1c7118 *tests/base-matrix-fun.R 8dbba9926eae3855264961dad330367f *tests/bind.R 1e91a17395adfea9d4754c1a2e61e2b8 *tests/bind.Rout.save 7b3458450be97737bef6152babab85d1 *tests/dg_Matrix.R 49eaa922eefeb2273c175b06d676c0c0 *tests/dpo-test.R 619dcd46ed5d6d63e575fb20e3609c0a *tests/dtpMatrix.R 8eee86c287319ef9bd896c65622c13c8 *tests/factorizing.R 11f08c243708cb83d0cae802ba309b8a *tests/group-methods.R 378f7bbe42747926afd24fc406230692 *tests/indexing.R 979b4d5f8528b9f4c1250b2d9b8c4629 *tests/indexing.Rout.save d5186da3a6f6e656dde0b98020df1d9f *tests/matprod.R 06d9de87597574aff0aa03776011bfa8 *tests/matr-exp.R b7c429b45be3e645394ee4f7d8747986 *tests/other-pkgs.R 340630d078b2a3727437daf327ee6663 *tests/spModel.matrix.R fe6cd95e5fa1f664c7dda44b2ad8d774 *tests/validObj.R eca424b43492f27bcb4ba5a1fdb0a0c7 *tests/write-read.R 09e13507b9832a30aa92e8aff0dc96a0 *vignettes/Comparisons.Rnw 5a9e99ce004c325e01fb2773e58052f5 *vignettes/Design-issues.Rnw 6bb038dd0a9c26fa751c1fe084328a1f *vignettes/Intro2Matrix.Rnw c39a26dfe7ccaafd044e88468155b153 *vignettes/Introduction.Rnw f64681e48c222aad57f4d43cad34d68d *vignettes/Matrix.bib 74ca9e8b3e91ace4ee3f9e85506bcdfa *vignettes/myVignette.sty b131db6dd2216719942b771909097ae6 *vignettes/sparseModels.Rnw Matrix/inst/0000755000176200001440000000000014154165362012502 5ustar liggesusersMatrix/inst/test-tools-1.R0000644000176200001440000004231714151637577015120 0ustar liggesusers#### Tools for Package Testing --- in Matrix, sourced by ./test-tools.R #### ------------------------- ## to be used as, e.g., ## source(system.file("test-tools-1.R", package="Matrix"), keep.source=FALSE) ### ------- Part I -- unrelated to "Matrix" classes --------------- if(!exists("paste0", .BaseNamespaceEnv)) # have in R >= 2.15.0 paste0 <- function(...) paste(..., sep = '') identical3 <- function(x,y,z) identical(x,y) && identical (y,z) identical4 <- function(a,b,c,d) identical(a,b) && identical3(b,c,d) identical5 <- function(a,b,c,d,e) identical(a,b) && identical4(b,c,d,e) identical6 <- function(a,b,c,d,e,f) identical(a,b) && identical5(b,c,d,e,f) identical7 <- function(a,b,c,d,e,f,g)identical(a,b) && identical6(b,c,d,e,f,g) if( exists("assertCondition", asNamespace("tools")) ) { ## R > 3.0.1 if(FALSE) { assertError <- function(expr, verbose=getOption("verbose")) tools::assertCondition(expr, "error", verbose=verbose) assertWarning <- function(expr, verbose=getOption("verbose")) tools::assertCondition(expr, "warning", verbose=verbose) assertWarningAtLeast <- function(expr, verbose=getOption("verbose")) tools::assertCondition(expr, "error", "warning", verbose=verbose) } else { require(tools)#-> assertError() and assertWarning() assertWarningAtLeast <- function(expr, verbose=getOption("verbose")) tools::assertCondition(expr, "error", "warning", verbose=verbose) } } else { ## in R <= 3.0.1 : ##' @title Ensure evaluating 'expr' signals an error ##' @param expr ##' @return the caught error, invisibly ##' @author Martin Maechler assertError <- function(expr, verbose=getOption("verbose")) { d.expr <- deparse(substitute(expr)) t.res <- tryCatch(expr, error = function(e) e) if(!inherits(t.res, "error")) stop(d.expr, "\n\t did not give an error", call. = FALSE) if(verbose) cat("Asserted Error:", conditionMessage(t.res),"\n") invisible(t.res) } ## Note that our previous version of assertWarning() did *not* work correctly: ## x <- 1:3; assertWarning({warning("bla:",x[1]); x[2] <- 99}); x ## had 'x' not changed! ## From ~/R/D/r-devel/R/src/library/tools/R/assertCondition.R : assertCondition <- function(expr, ..., .exprString = .deparseTrim(substitute(expr), cutoff = 30L), verbose = FALSE) { fe <- function(e)e getConds <- function(expr) { conds <- list() tryCatch(withCallingHandlers(expr, warning = function(w) { conds <<- c(conds, list(w)) invokeRestart("muffleWarning") }, condition = function(cond) conds <<- c(conds, list(cond))), error = function(e) conds <<- c(conds, list(e))) conds } conds <- if(nargs() > 1) c(...) # else NULL .Wanted <- if(nargs() > 1) paste(c(...), collapse = " or ") else "any condition" res <- getConds(expr) if(length(res)) { if(is.null(conds)) { if(verbose) message("assertConditon: Successfully caught a condition\n") invisible(res) } else { ii <- sapply(res, function(cond) any(class(cond) %in% conds)) if(any(ii)) { if(verbose) { found <- unique(sapply(res, function(cond) class(cond)[class(cond) %in% conds])) message(sprintf("assertCondition: caught %s", paste(dQuote(found), collapse =", "))) } invisible(res) } else { .got <- paste(unique((sapply(res, function(obj)class(obj)[[1]]))), collapse = ", ") stop(gettextf("Got %s in evaluating %s; wanted %s", .got, .exprString, .Wanted)) } } } else stop(gettextf("Failed to get %s in evaluating %s", .Wanted, .exprString)) } assertWarning <- function(expr, verbose=getOption("verbose")) assertCondition(expr, "warning", verbose=verbose) assertWarningAtLeast <- function(expr, verbose=getOption("verbose")) assertCondition(expr, "error", "warning", verbose=verbose) }# [else: no assertCondition ] ##' [ from R's demo(error.catching) ] ##' We want to catch *and* save both errors and warnings, and in the case of ##' a warning, also keep the computed result. ##' ##' @title tryCatch both warnings and errors ##' @param expr ##' @return a list with 'value' and 'warning', where ##' 'value' may be an error caught. ##' @author Martin Maechler tryCatch.W.E <- function(expr) { W <- NULL w.handler <- function(w){ # warning handler W <<- w invokeRestart("muffleWarning") } list(value = withCallingHandlers(tryCatch(expr, error = function(e) e), warning = w.handler), warning = W) } ##' Is 'x' a valid object of class 'class' ? isValid <- function(x, class) isTRUE(validObject(x, test=TRUE)) && is(x, class) ##' Signal an error (\code{\link{stop}}), if \code{x} is not a valid object ##' of class \code{class}. ##' ##' @title Stop if Not a Valid Object of Given Class ##' @param x any \R object ##' @param class character string specifying a class name ##' @return \emph{invisibly}, the value of \code{\link{validObject}(x)}, i.e., ##' \code{TRUE}; otherwise an error will have been signalled ##' @author Martin Maechler, March 2015 stopifnotValid <- function(x, class) { if(!is(x, class)) stop(sprintf("%s is not of class \"%s\"", deparse(substitute(x)), class), call. = FALSE) invisible(validObject(x)) } ## Some (sparse) Lin.Alg. algorithms return 0 instead of NA, e.g. ## qr.coef(, y). ## For those cases, need to compare with a version where NA's are replaced by 0 mkNA.0 <- function(x) { x[is.na(x)] <- 0 ; x } ##' ... : further arguments passed to all.equal() such as 'check.attributes' is.all.equal <- function(x,y, tol = .Machine$double.eps^0.5, ...) identical(TRUE, all.equal(x,y, tolerance=tol, ...)) is.all.equal3 <- function(x,y,z, tol = .Machine$double.eps^0.5, ...) is.all.equal(x,y, tol=tol, ...) && is.all.equal(y,z, tol=tol, ...) is.all.equal4 <- function(x,y,z,u, tol = .Machine$double.eps^0.5, ...) is.all.equal3(x,y,z, tol=tol, ...) && isTRUE(all.equal(z,u, tolerance=tol, ...)) ## A version of all.equal() for the slots all.slot.equal <- function(x,y, ...) { slts <- slotNames(x) for(sl in slts) { aeq <- all.equal(slot(x,sl), slot(y,sl), ...) if(!identical(TRUE, aeq)) return(paste("slot '",sl,"': ", aeq, sep='')) } TRUE } ## all.equal() for list-coercible objects -- apart from *some* components all.equal.X <- function(x,y, except, tol = .Machine$double.eps^0.5, ...) { .trunc <- function(x) { ll <- as.list(x) ll[ - match(except, names(ll), nomatch = 0L)] } all.equal(.trunc(x), .trunc(y), tolerance = tol, ...) } ## e.g. in lme4: ## all.equal.X(env(m1), env(m2), except = c("call", "frame")) ## The relative error typically returned by all.equal: relErr <- function(target, current) { ## make this work for 'Matrix' ==> no mean() .. n <- length(current) if(length(target) < n) target <- rep(target, length.out = n) sum(abs(target - current)) / sum(abs(target)) } ##' Compute the signed relative error between target and current vector -- vectorized ##' @title Relative Error (:= 0 when absolute error == 0) ##' @param target numeric, possibly scalar ##' @param current numeric of length() a multiple of length(target) ##' @return *vector* of the same length as current ##' @author Martin Maechler relErrV <- function(target, current) { n <- length(target <- as.vector(target)) ## assert( is multiple of ) : if(length(current) %% n) stop("length(current) must be a multiple of length(target)") RE <- current RE[] <- 0 fr <- current/target neq <- is.na(current) | (current != target) RE[neq] <- 1 - fr[neq] RE } ##' @title Number of correct digits: Based on relErrV(), recoding "Inf" to 'zeroDigs' ##' @param target numeric vector of "true" values ##' @param current numeric vector of "approximate" values ##' @param zeroDigs how many correct digits should zero error give ##' @return basically -log10 (| relErrV(target, current) | ) ##' @author Martin Maechler, Summer 2011 (for 'copula') nCorrDigits <- function(target, current, zeroDigs = 16) { stopifnot(zeroDigs >= -log10(.Machine$double.eps))# = 15.65 RE <- relErrV(target, current) r <- -log10(abs(RE)) r[RE == 0] <- zeroDigs r[is.na(RE) | r < 0] <- 0 # no correct digit, when relErr is NA r } ## is.R22 <- (paste(R.version$major, R.version$minor, sep=".") >= "2.2") pkgRversion <- function(pkgname) sub("^R ([0-9.]+).*", "\\1", packageDescription(pkgname)[["Built"]]) showSys.time <- function(expr, ...) { ## prepend 'Time' for R CMD Rdiff st <- system.time(expr, ...) writeLines(paste("Time", capture.output(print(st)))) invisible(st) } showProc.time <- local({ ## function + 'pct' variable pct <- summary(proc.time())# length 3, shorter names function(final="\n", ind=TRUE) { ## CPU elapsed __since last called__ ot <- pct ; pct <<- summary(proc.time()) delta <- (pct - ot)[ind] ## 'Time' *not* to be translated: tools::Rdiff() skips its lines! cat('Time', paste0("(",paste(names(delta),collapse=" "),"):"), delta, final) } }) ##' A version of sfsmisc::Sys.memGB() which should never give an error ##' ( ~/R/Pkgs/sfsmisc/R/unix/Sys.ps.R ) ##' TODO: on Windows, with memory.size() & memory.limit() defunct, how do I get it ???? Sys.memGB <- function(kind = "MemTotal", ## "MemFree" is typically more relevant NA.value = 2.10201) { if(!file.exists(pf <- "/proc/meminfo")) return(if(.Platform$OS.type == "windows") NA.value ## memory.limit() / 1000 ## no longer with R 4.2.0 else NA.value) mm <- tryCatch(drop(read.dcf(pf, fields=kind)), error = function(e) NULL) if(is.null(mm) || any(is.na(mm)) || !all(grepl(" kB$", mm))) return(NA.value) ## return memory in giga bytes as.numeric(sub(" kB$", "", mm)) / (1000 * 1024) } ##' @title turn an S4 object (with slots) into a list with corresponding components ##' @param obj an R object with a formal class (aka "S4") ##' @return a list with named components where \code{obj} had slots ##' @author Martin Maechler S4_2list <- # <- "old" name (I like less: too hard to remember) as.listS4 <- function(obj) { sn <- .slotNames(obj) ## structure(lapply(sn, slot, object = obj), .Names = sn) `names<-`(lapply(sn, slot, object = obj), sn) } assert.EQ <- function(target, current, tol = if(showOnly) 0 else 1e-15, giveRE = FALSE, showOnly = FALSE, ...) { ## Purpose: check equality *and* show non-equality ## ---------------------------------------------------------------------- ## showOnly: if TRUE, return (and hence typically print) all.equal(...) T <- isTRUE(ae <- all.equal(target, current, tolerance = tol, ...)) if(showOnly) return(ae) else if(giveRE && T) { ## don't show if stop() later: ae0 <- if(tol == 0) ae else all.equal(target, current, tolerance = 0, ...) if(!isTRUE(ae0)) writeLines(ae0) } if(!T) stop("all.equal() |-> ", paste(ae, collapse=sprintf("%-19s","\n"))) else if(giveRE) invisible(ae0) } ##' a version with other "useful" defaults (tol, giveRE, check.attr..) assert.EQ. <- function(target, current, tol = if(showOnly) 0 else .Machine$double.eps^0.5, giveRE = TRUE, showOnly = FALSE, ...) { assert.EQ(target, current, tol=tol, giveRE=giveRE, showOnly=showOnly, check.attributes=FALSE, ...) } ### ------- Part II -- related to matrices, but *not* "Matrix" ----------- add.simpleDimnames <- function(m, named=FALSE) { stopifnot(length(d <- dim(m)) == 2) dimnames(m) <- setNames(list(if(d[1]) paste0("r", seq_len(d[1])), if(d[2]) paste0("c", seq_len(d[2]))), if(named) c("Row", "Col")) m } as.mat <- function(m) { ## as(., "matrix") but with no extraneous empty dimnames d0 <- dim(m) m <- as(m, "matrix") if(!length(m) && is.null(d0)) dim(m) <- c(0L, 0L) # rather than (0, 1) if(identical(dimnames(m), list(NULL,NULL))) dimnames(m) <- NULL m } assert.EQ.mat <- function(M, m, tol = if(showOnly) 0 else 1e-15, showOnly=FALSE, giveRE = FALSE, ...) { ## Purpose: check equality of 'Matrix' M with 'matrix' m ## ---------------------------------------------------------------------- ## Arguments: M: is(., "Matrix") typically {but just needs working as(., "matrix")} ## m: is(., "matrix") ## showOnly: if TRUE, return (and hence typically print) all.equal(...) validObject(M) MM <- as.mat(M) # as(M, "matrix") if(is.logical(MM) && is.numeric(m)) storage.mode(MM) <- "integer" attr(MM, "dimnames") <- attr(m, "dimnames") <- NULL assert.EQ(MM, m, tol=tol, showOnly=showOnly, giveRE=giveRE) } ## a short cut assert.EQ.Mat <- function(M, M2, tol = if(showOnly) 0 else 1e-15, showOnly=FALSE, giveRE = FALSE, ...) assert.EQ.mat(M, as.mat(M2), tol=tol, showOnly=showOnly, giveRE=giveRE) if(getRversion() <= "3.6.1" || R.version$`svn rev` < 77410) ## { methods::canCoerce() : use .class1(), not class() } canCoerce <- function(object, Class) { is(object, Class) || !is.null(selectMethod("coerce", c(methods:::.class1(object), Class), optional = TRUE, useInherited = c(from=TRUE, to=FALSE))) } chk.matrix <- function(M) { ## check object; including coercion to "matrix" : cl <- class(M) cat("class ", dQuote(cl), " [",nrow(M)," x ",ncol(M),"]; slots (", paste(slotNames(M), collapse=","), ")\n", sep='') stopifnot(validObject(M), dim(M) == c(nrow(M), ncol(M)), identical(dim(m <- as(M, "matrix")), dim(M)) ) } isOrthogonal <- function(x, tol = 1e-15) { all.equal(diag(as(zapsmall(crossprod(x)), "diagonalMatrix")), rep(1, ncol(x)), tolerance = tol) } .M.DN <- Matrix:::.M.DN ## from ../R/Auxiliaries.R : dnIdentical <- function(x,y) identical(.M.DN(x), .M.DN(y)) dnIdentical3 <- function(x,y,z) identical3(.M.DN(x), .M.DN(y), .M.DN(z)) ##' @title Are two matrices practically equal - including dimnames ##' @param M1, M2: two matrices to be compared, maybe of _differing_ class ##' @param tol ##' @param dimnames logical indicating if dimnames must be equal ##' @param ... passed to all.equal(M1, M2) ##' @return TRUE or FALSE is.EQ.mat <- function(M1, M2, tol = 1e-15, dimnames = TRUE, ...) { (if(dimnames) dnIdentical(M1,M2) else TRUE) && is.all.equal(unname(as(M1, "matrix")), unname(as(M2, "matrix")), tol=tol, ...) } ##' see is.EQ.mat() is.EQ.mat3 <- function(M1, M2, M3, tol = 1e-15, dimnames = TRUE, ...) { (if(dimnames) dnIdentical3(M1,M2,M3) else TRUE) && is.all.equal3(unname(as(M1, "matrix")), unname(as(M2, "matrix")), unname(as(M3, "matrix")), tol=tol, ...) } ##' here, as it also works for qr() chkQR <- function(a, y = seq_len(nrow(a)),## RHS: made to contain no 0 a.qr = qr(a), tol = 1e-11, # 1e-13 failing very rarely (interesting) ##---------- Qinv.chk = !sp.rank.def, QtQ.chk = !sp.rank.def, verbose = getOption("Matrix.verbose", FALSE), giveRE = verbose, quiet = FALSE) { d <- dim(a) stopifnot((n <- d[1]) >= (p <- d[2]), is.numeric(y)) kind <- if(is.qr(a.qr)) "qr" else if(is(a.qr, "sparseQR")) "spQR" else stop("unknown qr() class: ", class(a.qr)) if(!missing(verbose) && verbose) { op <- options(Matrix.verbose = verbose) on.exit(options(op)) } ## rank.def <- switch(kind, ## "qr" = a.qr$rank < length(a.qr$pivot), ## "spQR" = a.qr@V@Dim[1] > a.qr@Dim[1]) sp.rank.def <- (kind == "spQR") && (a.qr@V@Dim[1] > a.qr@Dim[1]) if(sp.rank.def && !quiet && (missing(Qinv.chk) || missing(QtQ.chk))) message("is sparse *structurally* rank deficient: Qinv.chk=", Qinv.chk,", QtQ.chk=",QtQ.chk) if(is.na(QtQ.chk )) QtQ.chk <- !sp.rank.def if(is.na(Qinv.chk)) Qinv.chk <- !sp.rank.def if(Qinv.chk) { ## qr.qy and qr.qty should be inverses, Q'Q y = y = QQ' y : if(verbose) cat("Qinv.chk=TRUE: checking Q'Q y = y = QQ' y :\n") ## FIXME: Fails for structurally rank deficient sparse a's, but never for classical assert.EQ(drop(qr.qy (a.qr, qr.qty(a.qr, y))), y, giveRE=giveRE, tol = tol/64) assert.EQ(drop(qr.qty(a.qr, qr.qy (a.qr, y))), y, giveRE=giveRE, tol = tol/64) } piv <- switch(kind, "qr" = a.qr$pivot, "spQR" = 1L + a.qr@q)# 'q', not 'p' !! invP <- sort.list(piv) .ckQR <- function(cmpl) { ## local function, using parent's variables if(verbose) cat("complete = ",cmpl,": checking X = Q R P*\n", sep="") Q <- qr.Q(a.qr, complete=cmpl) # NB: Q is already "back permuted" R <- qr.R(a.qr, complete=cmpl) rr <- if(cmpl) n else p stopifnot(dim(Q) == c(n,rr), dim(R) == c(rr,p)) assert.EQ.Mat(a, Q %*% R[, invP], giveRE=giveRE, tol=tol) ## = =============== if(QtQ.chk) assert.EQ.mat(crossprod(Q), diag(rr), giveRE=giveRE, tol=tol) ## =========== ==== } .ckQR(FALSE) .ckQR(TRUE) invisible(a.qr) }## end{chkQR} Matrix/inst/test-tools.R0000644000176200001440000000111712021103253014720 0ustar liggesusers#### Will be sourced by several R scripts in ../tests/ ### ------- Part I & -- unrelated to "Matrix" classes --------------- ### ------- Part II -- related to matrices, but *not* "Matrix" ----------- source(system.file("test-tools-1.R", package = "Matrix"), keep.source = FALSE) ### ------- Part III -- "Matrix" (classes) specific ---------------------- source(system.file("test-tools-Matrix.R", package = "Matrix"), keep.source = FALSE) doExtras <- interactive() || nzchar(Sys.getenv("R_MATRIX_CHECK_EXTRA")) || identical("true", unname(Sys.getenv("R_PKG_CHECKING_doExtras"))) Matrix/inst/Copyrights0000644000176200001440000000460110500266672014556 0ustar liggesusersThe files src/iohb.[ch] are available at http://math.nist.gov/~KRemington/harwell_io/ and carry the following copyright Fri Aug 15 16:29:47 EDT 1997 Harwell-Boeing File I/O in C V. 1.0 National Institute of Standards and Technology, MD. K.A. Remington ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ NOTICE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted provided that the above copyright notice appear in all copies and that both the copyright notice and this permission notice appear in supporting documentation. Neither the Author nor the Institution (National Institute of Standards and Technology) make any representations about the suitability of this software for any purpose. This software is provided "as is" without expressed or implied warranty. ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ The files src/mmio.[ch] are available through http://math.nist.gov/MatrixMarket/mmio-c.html and carry the following copyright Fri Aug 15 16:29:47 EDT 1997 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Matrix Market I/O library for ANSI C Roldan Pozo, NIST (pozo@nist.gov) See http://math.nist.gov/MatrixMarket for details and sample calling programs. ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ NOTICE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted provided that the above copyright notice appear in all copies and that both the copyright notice and this permission notice appear in supporting documentation. Neither the Author nor the Institution (National Institute of Standards and Technology) make any representations about the suitability of this software for any purpose. This software is provided "as is" without expressed or implied warranty. ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ The function mm_read_banner in mmio.c has been edited to conform with the definitions of constants in mmio.h. (String constants in mmio.h are in lower case and variables containing strings were being converted to upper case before being compared to the constants.) Matrix/inst/doc/0000755000176200001440000000000014154165630013245 5ustar liggesusersMatrix/inst/doc/Comparisons.R0000644000176200001440000001201514154165605015666 0ustar liggesusers### R code from vignette source 'Comparisons.Rnw' ################################################### ### code chunk number 1: preliminaries ################################################### options(width=75) ################################################### ### code chunk number 2: modelMatrix ################################################### data(Formaldehyde) str(Formaldehyde) (m <- cbind(1, Formaldehyde$carb)) (yo <- Formaldehyde$optden) ################################################### ### code chunk number 3: naiveCalc ################################################### solve(t(m) %*% m) %*% t(m) %*% yo ################################################### ### code chunk number 4: timedNaive ################################################### system.time(solve(t(m) %*% m) %*% t(m) %*% yo) ################################################### ### code chunk number 5: catNaive ################################################### dput(c(solve(t(m) %*% m) %*% t(m) %*% yo)) dput(unname(lm.fit(m, yo)$coefficients)) ################################################### ### code chunk number 6: KoenNg ################################################### library(Matrix) data(KNex, package = "Matrix") y <- KNex$y mm <- as(KNex$mm, "matrix") # full traditional matrix dim(mm) system.time(naive.sol <- solve(t(mm) %*% mm) %*% t(mm) %*% y) ################################################### ### code chunk number 7: crossKoenNg ################################################### system.time(cpod.sol <- solve(crossprod(mm), crossprod(mm,y))) all.equal(naive.sol, cpod.sol) ################################################### ### code chunk number 8: xpxKoenNg ################################################### system.time(t(mm) %*% mm) ################################################### ### code chunk number 9: fullMatrix_crossprod ################################################### fm <- mm set.seed(11) fm[] <- rnorm(length(fm)) system.time(c1 <- t(fm) %*% fm) system.time(c2 <- crossprod(fm)) stopifnot(all.equal(c1, c2, tol = 1e-12)) ################################################### ### code chunk number 10: naiveChol ################################################### system.time(ch <- chol(crossprod(mm))) system.time(chol.sol <- backsolve(ch, forwardsolve(ch, crossprod(mm, y), upper = TRUE, trans = TRUE))) stopifnot(all.equal(chol.sol, naive.sol)) ################################################### ### code chunk number 11: MatrixKoenNg ################################################### mm <- as(KNex$mm, "dgeMatrix") class(crossprod(mm)) system.time(Mat.sol <- solve(crossprod(mm), crossprod(mm, y))) stopifnot(all.equal(naive.sol, unname(as(Mat.sol,"matrix")))) ################################################### ### code chunk number 12: saveFactor ################################################### xpx <- crossprod(mm) xpy <- crossprod(mm, y) system.time(solve(xpx, xpy)) system.time(solve(xpx, xpy)) # reusing factorization ################################################### ### code chunk number 13: SparseKoenNg ################################################### mm <- KNex$mm class(mm) system.time(sparse.sol <- solve(crossprod(mm), crossprod(mm, y))) stopifnot(all.equal(naive.sol, unname(as(sparse.sol, "matrix")))) ################################################### ### code chunk number 14: SparseSaveFactor ################################################### xpx <- crossprod(mm) xpy <- crossprod(mm, y) system.time(solve(xpx, xpy)) system.time(solve(xpx, xpy)) ################################################### ### code chunk number 15: sessionInfo ################################################### toLatex(sessionInfo()) ################################################### ### code chunk number 16: from_pkg_sfsmisc ################################################### if(identical(1L, grep("linux", R.version[["os"]]))) { ##----- Linux - only ---- Sys.procinfo <- function(procfile) { l2 <- strsplit(readLines(procfile),"[ \t]*:[ \t]*") r <- sapply(l2[sapply(l2, length) == 2], function(c2)structure(c2[2], names= c2[1])) attr(r,"Name") <- procfile class(r) <- "simple.list" r } Scpu <- Sys.procinfo("/proc/cpuinfo") Smem <- Sys.procinfo("/proc/meminfo") } # Linux only ################################################### ### code chunk number 17: Sys_proc_fake (eval = FALSE) ################################################### ## if(identical(1L, grep("linux", R.version[["os"]]))) { ## Linux - only --- ## Scpu <- sfsmisc::Sys.procinfo("/proc/cpuinfo") ## Smem <- sfsmisc::Sys.procinfo("/proc/meminfo") ## print(Scpu[c("model name", "cpu MHz", "cache size", "bogomips")]) ## print(Smem[c("MemTotal", "SwapTotal")]) ## } ################################################### ### code chunk number 18: Sys_proc_out ################################################### if(identical(1L, grep("linux", R.version[["os"]]))) { ## Linux - only --- print(Scpu[c("model name", "cpu MHz", "cache size", "bogomips")]) print(Smem[c("MemTotal", "SwapTotal")]) } Matrix/inst/doc/Comparisons.Rnw0000644000176200001440000002150212070262574016232 0ustar liggesusers\documentclass{article} \usepackage{myVignette} \usepackage[authoryear,round]{natbib} \bibliographystyle{plainnat} %%\VignetteIndexEntry{Comparisons of Least Squares calculation speeds} %%\VignetteDepends{Matrix} \begin{document} \SweaveOpts{engine=R,eps=FALSE,pdf=TRUE,width=5,height=3,strip.white=true,keep.source=TRUE} \setkeys{Gin}{width=\textwidth} \title{Comparing Least Squares Calculations} \author{Douglas Bates\\R Development Core Team\\\email{Douglas.Bates@R-project.org}} \date{\today} \maketitle \begin{abstract} Many statistics methods require one or more least squares problems to be solved. There are several ways to perform this calculation, using objects from the base R system and using objects in the classes defined in the \code{Matrix} package. We compare the speed of some of these methods on a very small example and on a example for which the model matrix is large and sparse. \end{abstract} <>= options(width=75) @ \section{Linear least squares calculations} \label{sec:LeastSquares} Many statistical techniques require least squares solutions \begin{equation} \label{eq:LeastSquares} \widehat{\bm{\beta}}= \arg\min_{\bm{\beta}}\left\|\bm{y}-\bX\bm{\beta}\right\|^2 \end{equation} where $\bX$ is an $n\times p$ model matrix ($p\leq n$), $\bm{y}$ is $n$-dimensional and $\bm{\beta}$ is $p$ dimensional. Most statistics texts state that the solution to (\ref{eq:LeastSquares}) is \begin{equation} \label{eq:XPX} \widehat{\bm{\beta}}=\left(\bX\trans\bX\right)^{-1}\bX\trans\bm{y} \end{equation} when $\bX$ has full column rank (i.e. the columns of $\bX$ are linearly independent) and all too frequently it is calculated in exactly this way. \subsection{A small example} \label{sec:smallLSQ} As an example, let's create a model matrix, \code{mm}, and corresponding response vector, \code{y}, for a simple linear regression model using the \code{Formaldehyde} data. <>= data(Formaldehyde) str(Formaldehyde) (m <- cbind(1, Formaldehyde$carb)) (yo <- Formaldehyde$optden) @ Using \code{t} to evaluate the transpose, \code{solve} to take an inverse, and the \code{\%*\%} operator for matrix multiplication, we can translate \ref{eq:XPX} into the \Slang{} as <>= solve(t(m) %*% m) %*% t(m) %*% yo @ On modern computers this calculation is performed so quickly that it cannot be timed accurately in \RR{} \footnote{From R version 2.2.0, \code{system.time()} has default argument \code{gcFirst = TRUE} which is assumed and relevant for all subsequent timings} <>= system.time(solve(t(m) %*% m) %*% t(m) %*% yo) @ and it provides essentially the same results as the standard \code{lm.fit} function that is called by \code{lm}. <>= dput(c(solve(t(m) %*% m) %*% t(m) %*% yo)) dput(unname(lm.fit(m, yo)$coefficients)) @ %$ \subsection{A large example} \label{sec:largeLSQ} For a large, ill-conditioned least squares problem, such as that described in \citet{koen:ng:2003}, the literal translation of (\ref{eq:XPX}) does not perform well. <>= library(Matrix) data(KNex, package = "Matrix") y <- KNex$y mm <- as(KNex$mm, "matrix") # full traditional matrix dim(mm) system.time(naive.sol <- solve(t(mm) %*% mm) %*% t(mm) %*% y) @ Because the calculation of a ``cross-product'' matrix, such as $\bX\trans\bX$ or $\bX\trans\bm{y}$, is a common operation in statistics, the \code{crossprod} function has been provided to do this efficiently. In the single argument form \code{crossprod(mm)} calculates $\bX\trans\bX$, taking advantage of the symmetry of the product. That is, instead of calculating the $712^2=506944$ elements of $\bX\trans\bX$ separately, it only calculates the $(712\cdot 713)/2=253828$ elements in the upper triangle and replicates them in the lower triangle. Furthermore, there is no need to calculate the inverse of a matrix explicitly when solving a linear system of equations. When the two argument form of the \code{solve} function is used the linear system \begin{equation} \label{eq:LSQsol} \left(\bX\trans\bX\right) \widehat{\bm{\beta}} = \bX\trans\by \end{equation} is solved directly. Combining these optimizations we obtain <>= system.time(cpod.sol <- solve(crossprod(mm), crossprod(mm,y))) all.equal(naive.sol, cpod.sol) @ On this computer (2.0 GHz Pentium-4, 1 GB Memory, Goto's BLAS, in Spring 2004) the crossprod form of the calculation is about four times as fast as the naive calculation. In fact, the entire crossprod solution is faster than simply calculating $\bX\trans\bX$ the naive way. <>= system.time(t(mm) %*% mm) @ Note that in newer versions of \RR{} and the BLAS library (as of summer 2007), \RR's \code{\%*\%} is able to detect the many zeros in \code{mm} and shortcut many operations, and is hence much faster for such a sparse matrix than \code{crossprod} which currently does not make use of such optimizations. This is not the case when \RR{} is linked against an optimized BLAS library such as GOTO or ATLAS. %% Also, for fully dense matrices, \code{crossprod()} indeed remains faster (by a factor of two, typically) independently of the BLAS library: <>= fm <- mm set.seed(11) fm[] <- rnorm(length(fm)) system.time(c1 <- t(fm) %*% fm) system.time(c2 <- crossprod(fm)) stopifnot(all.equal(c1, c2, tol = 1e-12)) @ % using stopifnot(.) to save output \subsection{Least squares calculations with Matrix classes} \label{sec:MatrixLSQ} The \code{crossprod} function applied to a single matrix takes advantage of symmetry when calculating the product but does not retain the information that the product is symmetric (and positive semidefinite). As a result the solution of (\ref{eq:LSQsol}) is performed using general linear system solver based on an LU decomposition when it would be faster, and more stable numerically, to use a Cholesky decomposition. The Cholesky decomposition could be used but it is rather awkward <>= system.time(ch <- chol(crossprod(mm))) system.time(chol.sol <- backsolve(ch, forwardsolve(ch, crossprod(mm, y), upper = TRUE, trans = TRUE))) stopifnot(all.equal(chol.sol, naive.sol)) @ The \code{Matrix} package uses the S4 class system \citep{R:Chambers:1998} to retain information on the structure of matrices from the intermediate calculations. A general matrix in dense storage, created by the \code{Matrix} function, has class \code{"dgeMatrix"} but its cross-product has class \code{"dpoMatrix"}. The \code{solve} methods for the \code{"dpoMatrix"} class use the Cholesky decomposition. <>= mm <- as(KNex$mm, "dgeMatrix") class(crossprod(mm)) system.time(Mat.sol <- solve(crossprod(mm), crossprod(mm, y))) stopifnot(all.equal(naive.sol, unname(as(Mat.sol,"matrix")))) @ Furthermore, any method that calculates a decomposition or factorization stores the resulting factorization with the original object so that it can be reused without recalculation. <>= xpx <- crossprod(mm) xpy <- crossprod(mm, y) system.time(solve(xpx, xpy)) system.time(solve(xpx, xpy)) # reusing factorization @ The model matrix \code{mm} is sparse; that is, most of the elements of \code{mm} are zero. The \code{Matrix} package incorporates special methods for sparse matrices, which produce the fastest results of all. <>= mm <- KNex$mm class(mm) system.time(sparse.sol <- solve(crossprod(mm), crossprod(mm, y))) stopifnot(all.equal(naive.sol, unname(as(sparse.sol, "matrix")))) @ As with other classes in the \code{Matrix} package, the \code{dsCMatrix} retains any factorization that has been calculated although, in this case, the decomposition is so fast that it is difficult to determine the difference in the solution times. <>= xpx <- crossprod(mm) xpy <- crossprod(mm, y) system.time(solve(xpx, xpy)) system.time(solve(xpx, xpy)) @ \subsection*{Session Info} <>= toLatex(sessionInfo()) @ <>= if(identical(1L, grep("linux", R.version[["os"]]))) { ##----- Linux - only ---- Sys.procinfo <- function(procfile) { l2 <- strsplit(readLines(procfile),"[ \t]*:[ \t]*") r <- sapply(l2[sapply(l2, length) == 2], function(c2)structure(c2[2], names= c2[1])) attr(r,"Name") <- procfile class(r) <- "simple.list" r } Scpu <- Sys.procinfo("/proc/cpuinfo") Smem <- Sys.procinfo("/proc/meminfo") } # Linux only @ <>= if(identical(1L, grep("linux", R.version[["os"]]))) { ## Linux - only --- Scpu <- sfsmisc::Sys.procinfo("/proc/cpuinfo") Smem <- sfsmisc::Sys.procinfo("/proc/meminfo") print(Scpu[c("model name", "cpu MHz", "cache size", "bogomips")]) print(Smem[c("MemTotal", "SwapTotal")]) } @ <>= if(identical(1L, grep("linux", R.version[["os"]]))) { ## Linux - only --- print(Scpu[c("model name", "cpu MHz", "cache size", "bogomips")]) print(Smem[c("MemTotal", "SwapTotal")]) } @ \bibliography{Matrix} \end{document} Matrix/inst/doc/sparseModels.pdf0000644000176200001440000105616114154165627016421 0ustar liggesusers%PDF-1.5 % 22 0 obj << /Length 2374 /Filter /FlateDecode >> stream xYs_QBNEq;t3DӎND)ZPyeew8$h9yK(o]mF %K3BzTU L݌ޏ5{;w.b;r|S Ers߽@^,ץhd=Zԍ$-n~ 6@ ^ n6QWHqao%M;頀B۷|5NopzO.'5̴nbIp[;,ML m?:Q`*ElZJ k+KSɩ xƟ= |lj.ʂK;2F5XFQOt9~m"UN?zs\O`5tNcd8u% #=GW5z$ЦCk (Pv45J'8 c6F4RXls*ƎNy|i :б΀'xĽ7lO>KHӽ]B>ᖮ7o2H2n4(; ͈0B%>1ݚv)ִl%h#&PFԦ{ ݩ)!r +X4(ρHLE@*ːJu@0/4 }tY> @4 ~nhxѶ3lp!&AM8nX(2ܙ7r etjiO2T-iZz%A׵բ ?#;Hx-F&Y i ğghw|zZI=pvq+Vz"K!=uJ bRv=@KaGq1$?ˍ tS ƘTQԃgZXZ gK3viˡ9xb >G "R 0`͈/v'F&%ra4n(gҼjy/d,M[}NJf!ӁaAorY.2S5(al(EmS{N3w IT^\Ee5?6Cre(oU9wVfe%h QR9BJ㠓PG1uf:[R{}KJI6>8 -!P[_j_zi)!a%WAc7-z1` .<΢-hΣ߯oW*ڋwL.mM1߅lv FLPh@m"~̜C{a*h)շP@yV:YUu̜ :GU㟥6=&5Tt*IY7ʝ٪E#l~׹p:xsz4]gƫښ/-酙uʷ%!J໨9ӇAѢVPYV}WM\>*_o]`5$(H(ڊگVԻ2ҿ 'w=b2Z-1RL)<˕Bc7r|*M-}KNShu{eN[ u.!;FR3v{ w҉% w[s΅\)- dd/N5ӹ|Gh_G,͎,Ϣ=%Q!\"->1b:wx^DG O>mTې;Dq]4 gz3w7HiFolA« 3{M[47UrPv+n_ 2U$XNpe_@ I:s@.{ӽx!uŐaC-zg$DNl>hyiw1f endstream endobj 44 0 obj << /Length 1373 /Filter /FlateDecode >> stream xYo6_ad/"%Q҆aC0/ h@Gƒ iǻD9,;Pxǻ>L1}}hG(RHzt>4^]NDcQǒ:aӿFh"H(v}-^ʊP}/Б))"wfRSh;hoЮЃnm-w%zp MB"y̦Gh{ ۰|.nY%YЧváQmS X.]QH$ zF #[[6ebICly t fn&x#@z;8P~$Le<.AW}ߠM h,%RDGX05#x|A~-/iiT+ rד徯f8N|.!F9:XсAK@SPp@WV8 1g-s4ޔ @+w5ۿot,ΑlA 0ҖMAK3z-9~99=] >ks96sH(_[2܉aXO]-kV;fAFW}I&G&XBohδERcJIj5:vkmI*,dfpipZK\3zq$A=Dv֌UUA,x^X ?иSv3x'ҒoK"{u @t|68 ;p̍m d4O[p+}-t]pv]]@0Y*Qt]׹@Uɧ%) lGmQЬ9`dS Z g5ŚnXšyY}_-˅-B`pߙ=A0w'CG !o;b +iId[ ]|N%!pʹdfD:5/eLDezi3Ճu8P0HZVE˥TJC³}:!W.Z+b<יKNЁO<-;`u9F`!Xۂ 1JW3-> stream xYo6_at*o5CRZڇC{jAƨm$@}R-;@ǻ铣*"Ot2GJ l1(cƓ0NTOM)Zj/LUQQ+nctO*`Y:@T zGoêe((I Pa  bIEĐ!́`@ `F R0xqYD3\Nz4QJqLΌ`nAć=FgZObB[%/Tz}KXQl{S1emCRخ?݉ n  m m2US[#u*aW,luWͪXVuܲ`=В5*Dcl)4-#Uv 4}Ͱod5 etI쉊>]s3>3p{+zꔢz byOlVC vBZF̵'ʕ=dXS7Op Kx1E=q*h+ySLv#/gein2޹th圽 uMo„kFHה0+.Y/U\f 3W25JՉ爪̔7/" H\mԭэ;eke!>=yPayeWw Pލ} [ڰhϹV}' ռ(faA.;fu:_ ՙ!Qg = Q7 S5N-/dumKsf[N w{[ϏL/J $v`$i5$TĹ_r*i[1׵5"J[6Jqcq{6N,`>KS}c`@mkBB8T6STY\>FDdq[oCL9D\4xlZZLC[+ZG@S9iW/\XUF %8NE[ -E}I@hKg֛Aq_vz֎Mg0MqШk{5xWL玍5;,J9g7rzs!j)l;زw|_k})Y"bp%#ۍ~ݓKcCEʥioOIfoUEZh8dչ[?6?23`!SRa/IÝyoމuUˀj^uஆIy l7Х*ҦKld%bD$y0> endstream endobj 56 0 obj << /Length 1796 /Filter /FlateDecode >> stream x]o6= ,E$A;kAحmyҏ")ˋeA$}߉](at0dr(T6?>L8,2' ,!FbX¯15^""M e2ws> bQaQH5az^ۂGl -xO-1:}oIƱBEнOS'<[4r)m)F4u M3AکL,iFSӜ!>DI^~Ϳ%pd0bMْ5۞:3\`4ǥ)LOc/x<7L?p f+/Xr~ՑugA {C,q(4$F䤚W'bM{E~[cBZ&7|~\!3'%(H6G\ ixgE>#3xALS) 3BM, 8Xa-V6mBL˽hQ2.0ף3^\>]e3^|u'hf_oi-+XC=vU*WL?m1c}c\[Di[](q f|)iSEɨAδJ}$TXI#*A,*XI0zd>dSX1W{mc7F)O6K玍,Z9DM78e14FQ+ zk"8jvӰM2{9&Yw'_i7S JL4/dh3ĭ /zuJ2 k !H8ƾ`D`?f*r;5(R:FAޔ*G?*5'R NT+U66BWn|A`E١؊俲.?OƬ-_>%O=K4]a(} Bzü;FX2*&7PlZ|D/9"ӤLyX\QAOONtD_JH9}|}w LlC =%ǒ;%'ܓ9ңy|Î~H,;Iظ37Vϑcxཞ꒣DiNv֪yq{LQ|m躑+j*58[<6f#!]h| QC_܆ݫ>5|ߣ{v-,i}̶m;}T"L>0ɹǦw˃A endstream endobj 52 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpuIC54l/Rbuild75e401a5533cf/Matrix/vignettes/sparseModels-modMat-warpbreaks.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 58 0 R /BBox [0 0 576 144] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 59 0 R/F3 60 0 R>> /ExtGState << >>/ColorSpace << /sRGB 61 0 R >>>> /Length 875 /Filter /FlateDecode >> stream xˎJ y /gr8H t#h!J\I>̢vS.w5~.v.ap蜃n?<~EĨ`L1{)BEaw gO?~>O 9ng{OGWicGabks9{}w[]V@*|X|’ie+|)wsÛ@p%UHB|끹`ˈ/#<_FxȣeDQPeDoJ?M:BG^ xZ-4˛NQ%Mǫg !YJ=Aۓ#-ُR>U+:Ti(j*q6y$N{8sM{8sM{8sM{8oȓ o,˭+1 $Wb86bSĵ]Zqǐ֥tcKxuR{*_Wy/`KחWu?eTktɊhC,Sn ȀY,Xd T&2c&sYSܿ M#[P+Vֶ+T3`.-g Xĵv*dy,(uJ p!rŠɂ1 Fh&j oڎ|%eZU+O 9/ЋUy3RJTjH9b6M!Q-D iGC!(5RC')5cmBCYXΡRV (VW n+J"  %g>Jiu*4!ƫP`BC:!Jl٧BC)'`yBC)gdmetmBC)' (n0 ţe e('|'?n endstream endobj 63 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 66 0 obj << /Length 1024 /Filter /FlateDecode >> stream xڥVY6~6/rkqE4zH-oIYNZԲ1o\Hqș9,IY(nGTMF2" q5 (ee:UI` sy f]#qvlpӌuQ՛%L-:ϮYv@ޢzC~u0>^_eP279Ѫ <leأc )ޒk ߥJujӭ'pK`mx-xv|ͷK {f{@"P9ǝi Z.sKYˑf06H)*ID;Kڻ"0_YVKBQȓ.A.U,H,2QqMq6IT>] [ ճ?<}ϴkx +v3Ecϝ򙺲,Vn\Q쳣OUM/p*Q`j96sI fƝC]~>y-($w8Qv\K[f@d:gpO4VEڸQ]J*%LKmÔ*uC1mPsg%`vL>: Uh?0G#<,`L9Q6? 0`[W5&,1 ˈh\F,7ag2j'[݀/2h'^"yK#;JߧKüﬥsy׎"< @c|\zz%=C_ Jћܜ'k%{} ?bÇNo1WǢ}"\#90x֭}"NR<L)<˔xBakA%͹0>5:yhG;Lr(AUϡn|*^IhPB~y~aTtdq-WnymxTVd^Ȟ$a#yz>0VY\Tr&Ã?fS endstream endobj 53 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpuIC54l/Rbuild75e401a5533cf/Matrix/vignettes/sparseModels-morley-data.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 68 0 R /BBox [0 0 576 396] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 69 0 R/F3 70 0 R>> /ExtGState << >>/ColorSpace << /sRGB 71 0 R >>>> /Length 1466 /Filter /FlateDecode >> stream xo6Wpfc @ 46CS1bQ~Vq7`~|$yђ{ݸ?Ë?tŏ?70>Ƙ9V\u}wwQ^ϮXgP"˒>}{fA>~ys3G]|~]:sIoB9St礧Y7w'wy59_Kro޺~?{7ZN%ݺu\|K:pli:^gH,>o1f6XOcu7qWY/G4':1| '>'N%{n+aO1l°˧_Aw5i0o(f@ثKQ g) u)H| =RG^ =df0JMsk FI=gmjfQݴ -aS=$4Q*@[I=SF)Y@k:O$.8 y"q^X;<ҽy"q͞:O$nCy"qK@;> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 78 0 obj << /Length 2604 /Filter /FlateDecode >> stream xZYs~@%!s쩊\WJ$XJ*IK` "KC~{{zHvczf7M5jDSrjTQfd!OUVppupm Ru:.n|;R) +%ȰkͲ .}:6*7󒷇6?HH{DgJJ{Dŏ(3KKT$z $dXOOONU$\>U} uoDX\lSU81uth#n_5<>fDzu@'9ʊGy@2->dߨ&B*M@(FE\Fzm87UsZٯOu[uzԎ]"=>Y:mzeߏ֋;1~˛[BUCi2-e}i5A2GD.k0'Ivge3^屖e ]3K^c^OzZH?b3nh2W)|(*K3N%IxѢ&wZ:{S&oh8`R~{Ygɧ iz:-TcTRC}}Ar)5B9vUCGvU%l-xv=yx[_Ш>gCH7[lө8LzK=)"κyh}E4͎s+!>M[YZ!&(y~/ĵEWHaԏ~w[)g?ȯ{}=^JNe&O˼~etG 3J3by\Xoù/m2ud<-ç͎0 ! j}L /|(D{|+Z6Us]*\"W5־td^Ŏ{pDzuY>yǗ˟6g{1B$gr8b)EtryY!{ۿU`:g(AWk"KW ;(-ڂn*to#?Xq@pq~keӚK!C5 A&i#|P>^3? BN<:Sz 7R +Օ}\4B"}xѺj0oUxh6Ay-/8LDzj(;[|FvMń7m(8Fg/8ntG:L 罩MX-a{;gYK({j?;l;oKYڹeFd~mڧ߀/ļwhWi]CJP*ٰ_so#lP &#+JnKemL Z1ӲC}wFT~I!6x7KD[JGB K\3t[6:_!G&ChEgc|nd{bsKagsRfʅn$EYkGzX15ii}ٮ844eѺNt*yɩغ1\ ӻSU%=WJTrwS(/#dX2&cM{c@1Kb7!WX0e%6ps{~LҼ#+u VEׄC)d2$8d\bdM h UZ.]MLlDS:J'UBz ;i8ZBy {L&B8Z4zt&RɒpusW+B=jKc *c+xQ{twHWJ&xʢExfjY k'CHxT7p sT 2jO0G[ M`2t1,J3R%p*T~Xiq&zɧ *}A-X#LˇL; }& b?Oǵ> <1uS&S8Z=ijN(rxaٺc$mRd- zlqHbƸcqKg !sURUtBcG1> stream xVK0+"V+AELlYu{>V.!@w  bx<'GN’PdD‰<9s3x;t!!劾yܜQK,nH_1NP# G3R4ů4 {k-{Hy>IdY9,m7Q3Ex< [,e-{˥YUZZ#eoVatM%X2vjyV&i8gI hSP`k%gC2&,2ε:y3 9zFVڄ6%L2ā$4*Zx|xXArMXB].)1H]Ybل9*m@j\|`5K5ʥ]`F7缕W*I0/,q aЗ!m?y_uQkIɡ%!!:/ =%"G,AQF,Qw+!SǾ ڔ5  `ZКu6WZ5[:]SH(ɛU64FsyP6xC5^[ȉ&]b*#Sуv~%)lռKۣPNUD]o-b_펢0j{ށB=?:jfk]Vj4r މ}~>o6 >_f͙?EG~)^+;TRM"]e endstream endobj 88 0 obj << /Type /XObject /Subtype /Image /Width 900 /Height 450 /BitsPerComponent 8 /ColorSpace /DeviceRGB /Length 17650 /Filter/FlateDecode /DecodeParms<> >> stream xy\T*in Vz6MsAjie71J˰VWw) %c*8`f,G|Ι|A}sG"@1Q(0 F(CbP a!@1Q(0 F(CbP a!@1Q(0 F(CbP a!@1Q(0 F(CbP a!@1Q(0 F(CbP a!@1Q(0 F(CbP a!@1Q(0 F(CbP a!@1Q(0 F~ᇥK* 'w^zD8y=zT^8 6|JWNڵk/b^^1(ի_u{tGٕ+Wx㍯Z8K_RN/;w.ZՑ#G,YtGj0 Fq*6t:lU9Q(0 F(CbP a!@1Q(M_~y׮]Jɝ;wGJwę !ƏߨQ#ⴴZbŊ[nU/*1*''GV3 f-׮]Bdgg+ݑg6o49|DLnƠќZ+oѢE;`kv6~~~ܠҮ~\kqޮf͚?9}|,u{KJljo'7ŋ͎ v9V6>qB8@U@Ϟ=m_TBsB$'+'RSS|}}HFH%¨C1>*98¨a8¨K2>ɩO. uCE0 0 N'T*b+.0 ; IVa%pjQ8 a5Y l0 +v0 [`CQX !0 (͜[EXMh}3fX0 8 8 (`Vr*jVEFX33F(V0 ޙ|##pX/*0ak09jN%\^'3`QQ fX`!,5G3V`gaJJwZN>t/tg@`6.[lΜ9UJLL񉈈HLLE8QUr3&''GU2eJlll~~abccO^p6ϰ9[}CBBxƍ{>A=zt\|ѣG,c`@m8[~zcbb*]x"..Motx3 b@97n6t钕e799988k׮rKwafX%@U-QTTn޲ebVkV}W\駟\~c:zΝ;wf1 b!Df ڥWVTT/0F_}UsjfFS?[.\pB#e*ŋi.F݅jURxɗxcf̙wqSV`!Č3*ƫ/ p0h 41Y`\@@ȑ#̙3ӳ&X3pRz2E QZW쀀id0 Xk̓'O-.\4c:s0:i$!Ă /u:kfa"DU^5vؤ?>"",EX\kfTjժ[n5*@1_ xJ/UҦMm۶) c餦]vJf\cz F@L`~1P(-fXQgQ`}̰QͰYa8gX0 װ: (p=̰ (1jCQ2>ɩ!XAҧ _@P ϰ 3i3Kswq{^<87Y{n?/}uπ~qX^AUu h<8yj}=qCϭq~\|ӝ6X=7!v?QW"0ZUaԩQ$b+PaBU ,0 SkaFEa5.0 [*3/Q%N0 d|)l ^`p^oy(\+7fϞݶm1cƜ9sƠ&111""'"""11IL+ W\0`… QFkn]tIKKkL?lذӧd7X _*8p`ԩ+Wܾ}֭[oܸ1vX --?4hѣGW^1p˗=z_ +%9Uݴi;# 2o߾/_B,^X&pss{u:]||TofX.ɩ¨ZW~PܵkWyow!}iP3't,)##à%//om۶-**7iٲejjjqqV5^eiii۷o7^SPPЬY33 P+5aub˖-ϟ7RָqI&v4Taɓ'ZVVV\\,WVTT/0F׬Y@u<==~4oL^^bݺu֭3R#ڪ_9g-))Yxq||NKHHn`rwwBRVk4&_wųg6^ӳgvڙ<`GL.n +(-00Prʇ~HYz4h`N w}7y,YCRF.WPPh& SM41^h˻CŅfjaÆ&+,bܹC ڷoߖ-[$*P~~~YYYdggjV=ܸ PSիWϟ?G_"##+DGGgff*dT<ݩ̭p=̌nU 3a* 1?QpxY1j{ U0Vc0xH__1cƬ]zfXXh^4Maau{1??/...##z/ #̰0ŊaСC[l9sfn***RRR^yΝ;~ӦMʬ] +gdE7n#߻wݻw}ĉ˗/_A%%%V\'vO`j޼#<ҧOYotׯ_YNjVJl-haaٳgϞ_U_}ArB%e0J4--Bj򊌌ׯ_߾}v2 =`Pèt^z{@{fk<3Lz.TC}Hw߸q#55u߾}w޷oߗ_~_F=fXΝ;OVkXU*wŋw޽sΝ;wfeeI*GC:t;L3[aX1Θ1c׮]rKƍ(\oTkXY fb};:tȐ!{E0㋰ V!+2dС[ޫcP+m۶Yqa˰ǎ{ON2_u1cƴo߾aÆ]ty饗\bPX$& ckX"Ynٳg\Rk4I&[>>>|ӧOy7n܈߿#Gm?{zzJ5SL;t0lذC˖-Ob8 fXΚ,J^Npg}6<<\j|,r?J#̜9Sl2#G! T^^R~73 C-H.:$Xv1++5JNN6صsN///!DRR_o_ƍ=zBZr_ra!ēO>ifAFpf V Vft֭Ҭd vOoUTT̙3g޼yBvI_&''wU.޽{``;,0V\Zf%x*6LnSSNKKK g̘?rH!DQQQ~~|e˖Zx4kĆ >c5.\[ !.\j*#eM4IJJjР9 +B77\F<<< ?~(hذ۷o/&5k̠XjzjEEa;(//7Wd|Uj׋%%%ƣȭ[ n+Wh׮]8ֳg{n޼f}N>G{Æ Æ fb\Vk4&_wҤI&M2^bSTVizKƁXQ)N6ƍn޼9m4!=c֭ۨQf͚uA{???FSׅFo]Vu륉8rFg͚O?uiʕGtґ#G>ԠYfYΜ9G=zT1((Gمj/++쀀ZmR]+)9iJlv̊iӦ֭?sĉһw3Ϝ9s/hڴ^.77w+W4hkԨ":::33ɓތ .DFFJ_,p<̰;fپSN͚5;lذaÆwy端zh =zLqÆ Gׯ4)]й`iNcccNV4>T[o[:I&!TG˖-{Gt2d??cǎٳRMTTرcrrrRRR?~3 \ʽVlwJjڴdԨQv튌ܳgORRRAA?ر-Z5V+++KHHuV||ʠ& `ӫ̰tVкvڱc4hpwH *UVQQwM81;;g!!!mڴٶmKf/ ]v/^|駷o.eĘ!֭[׮]YTTtڵR˾:35ʒa={_)++롇ڻw/2}ʇxzzZp3(װ8,F,Js 6LرcѢE&Lj߾}~V[~^zY5̰4KoVK/-ZHj3gbʔ)|_+fXP%聯4lG6L>/, YrfŋB@`inkvVj˒aT^z-JƂ8^Jl? a( a8#(tPV(JjAaXĉ=<}z i1 3fggO4QFiii~A=zꌌ._ѣf0[JT`' :'~g v-^X&pss{u:]|| +8a}wg5n`Wrrrppp׮]ݻر%1 ZWLjdmV <3ݺujVQ\jD@F1Wv0 PfXm0 P7,nUQ2T(}p %9(0Ψ='0y}#:]qBr!6V (W{j0 K0qjFa}̰jFaOaF8aFጘaAFzanF_ @9[T̙3G&111""'"""11IL&` @5ܔ%fggq[Lvaذaߗ-[f~PcgX8 OtSLyת,HKK e77[n :t&Mܹ9(\Nǩ>?y"$$ŋ !܄nnnoN7PVS͌:uJѪU/ԩS{ v*t=00pǎfv2 NF'SnnnEEEGl255X/2ށbivֈ[n]erVr*8g>|H5s0*~͚5u3g\lYppK/T\\,h֬QRիW+** |`%j4Jl%={ٳꜜ[4 .uV>}/÷mvw,X^pwwBNVk4&;ꫯFGGy76a{ҢE !Č3*ƫۮp0z}4o޼_~_}ՙ3gڶmh j 41Y`\ppȑ#̙3~&O86fXٴ^z"Ʃhj4/;;; @4Y˜a<رY ի'}2QFFƅ "##/M)syhHHHII{O?ɍV:tSO=%:i$!Ă :NڎZLS&gXvy>W՟C=믿;vjƎGDDY!q ++BDEE9r?u~ƍ9s/>>>rͪUnݺdgf1W̰tVHHH6mmۦtGX3l+555,,lڵGV/5T3`/ϰB۪ь)#cq+Ύ0 N[8&(8;Vv0 íWl0 0^( a`(jt+pvQ2~9p Qcb)Fxl%"\3V X3@F-fX=Q 3p1QEXpQ BQQ\O +j0 ,V aXY.`%(o":#(p,+A.V{B3GfX-0 `ḛVM8[)((pss۹sm䚮_^PPtGN;}t?<<<3?U*UӦM3qƥKZjtGUr03  !? 6m:a=_FOQ3g|@<<<.\tGaԒZ/]hl+G|Jwę}+UTT4nܸP~jɒ%nnn UB#F4jH8 !.ipCbP a!@1Q(0 F(|}}}}}h4͚5S#ά~^^^viƿ]^=;̚7oV?M'TQQqMlmׯ_oРҽpr !ݕ3t0[Abf!@1Q(0 F(CbP a!k׮^:++K;ONHHPpNQد7n̞=;22ۻm۶cƌ9sAMbbbDDODDDbbbԽuL>}ر E8pAAA?a:ujذaN0ȵlٲ9sT*t]***&L8pJ_#Gɓ' !:tOqBiӦ韤/Nغu~;lׯ 3f̰a4MfΝ;'0uTPPЦM!Dttĉڵ+**kZ۱cGz|||*찻(ԫ*:uߪnݺI_9rD1hРrNW^^.~R#++iӦ52 E;wͭW^r0Zr⩧dn֬YB˗-bܹҗ r)}YQQQѷo֭[KQ"y!喊K&&&J_2u7tP!˗l!å/1bDLLLLLW0jQuaw5QةИ!C!?7olP m׽Eǫ,Z 2tm)`7B]Vnτ .dsΕè FŇEpTFFƖ-[[v߶mۢVZղeK.׽>͞=_0 [ĵkrrrn|߿e˖#G<}T8[Č3z1c̛7o̘1O?tM&d2.Mf9yСCܤ5kfP&\z^^^Vy' 7o^ E !rrr"""Znqm۶۷GEx{{?)))֭Zݟz)3`Qe]3w%%%sν;Ǝ+pwwBT*Qu/D݋/f{d(//B9sfڴi|w}}҉' B-Z4~!C 8'xwl6UE03 wM<111K,oh4,((h4B8]v-_|ҥ:uA !5ko;v|2\woFǎ+)tmƍ;w3g΄ dkͨ2쮀*`Ν;d//}mٲENBZWYAjxGv%--M1sL_^y!DLLJOdlݺFobĉeeeRxxxDEE]~ɓ 5`Tv7vjGљ'O[222.\ ׽umK1xɓ'juttɓ'ۏ;V_:np1hx񢼗A*BEEEZhQZZZ]޽{?|?!ā,Uj*/ [ۅSNjRˆ esuMرCnj=#} QK;`T]|]aٳB__AU˓ʤ;k,럧.r1" B.]&N8`!D``  Z_T*?eʔT*oocǎ5 r]TFu6UWvA=ڵkW"++K*ݻwƍ{op*(l)K, 6mZAA^ƹrrry N4ҥK r]TFm0<.BX70@1Q(0 F(CbP a!@1Q(0 F(CbP a!@1Q(0 F(CbP a̕;pOO϶m8pѢE%%%>͛U*=c~qSV\9sLܙ{%%% 4HbfL{&NXRRңG˗fee8p`F:vǣtJZJJJttV]tk׮{?Xӓo޼y=z駟,ep̌ /VZ|AB4jhB={VOIIV7o,//`Q0槟~:x7߬&<<'xGN<^PP/FEE5iҤM6ÇM'|RFa~ JRVwڥRFyرp///wwwqKBBB7nܽ{$Oï\Ox{{{xx4k!n`c{!D6m"""QT}Anj-pss+**:{͛7mڴf͚&MX.\ӧOnnoEE˗>ꫯ>vۍ792nܸɓ'~\ʗ !Zm囜{9 !n޼iN@u`ԩS=zT+5Is\ *6@cBCCW6;9RQXX(XEBsYR)kܸ{FF !Ξ=o>#e6m:~x˖-M4iذŋ+/]$5RZZZCF(ir_uNKKBOR 4>\e"$$VǍpJQ0FV !~駱c ˊƍ'ԩF Bk׮~A߿WtwwU]T! 111sB|g=zXlُ?񄄄.]o_||w騨_~֭[W\Ϥ*M8SNս\.]ǎ[`tkמm&0m75kǟ}YZJHH֭Ҹq?c=<<˥OpB#u]w=C7n|ח,YwYV۱cׯ'%fF,/ɓ'_|ŻI& y;cPߧO~m̙oٲaVZuK)Xvm|||׮]ZӧZmxxePUw=>deeUTTH!@1|LF(CbP a!@1Q(0 F(CbP a!@1Q(0 F(CbP a!@1Q^矪xzz/..իG}reFF"='{_[liѢg֭y晬eW^;wnΝ6l7` 6TyB+ի111o,8Izݲe7nܨTv2JL&6oG}WޣG*ysjzJ??W:ue˖+Gu֭UZۼy~*]fMF*m۶Gѯ{Q`aQ!!4̀ӼYfoOA999RYiii۶m]M6|_iUW\y׭Fϝ;נAI&!!!ׯ_{Q`(`/ˡCGȕ7oެZ&2|_v?ԩS u:ݞ={`'U;O>j<UJk8z  4 O?c:|!޻F>>>>>{^rewSN 4 ={v^^~ѯ֭[Æ ;w|XjٳT9l0@|AM+|jn())>,U-\R6r;]&LZc#]#Fڻuf^Q`KM8\H)))R^^?%SZZjоyݻwKYYY111/^B4nܸO>Ү!Ct/']gиrJ[nܺu*ĒQFIh?_K**88XKNN~衇XeǎoGΙ3;vlBBBqq\y-iE'iժqUV7߼ۤ+W?_|EKi}'Nؽ{wFFƲeˤk֬ZM6/^+B#moڴIh׮]^^^ZZZFFơCO valڴiv~.^x…zHj?SwJZVo7|s˖-W>}zn.((2iӦF^^^*ӨQ>@.,,\d<޸qc[\Gnnnok׮rs~Gi[$#yO3YbE׮]}||&Nػwo>kժUPPP\\\Æ !\zjer6mZnݤ?k<򈗗| _w)iĉ婩={;koQiӦ6m4i~zy*e;_z{uy/$gϞ1b4?_)/$Փ6 ̯4"&&fȑŋE'gqF*++B4lgy%6tXJ/}0*h۶\URR">>}tEEի7o LtС/-oKB/Bݻo8pرc\Ҁ1cvwwqƽB'Nt:+D-۱VZ[dovWo3|Faj5{]F m03 8iYfk4N}^' !}zb*O[_}UN:6mtРAUrʥK:m߾QZZ*ڬcՑ'O=4hѢK0ӉKK>+ BX=^nݺ[J>>>[l:tR6(--ӘȜ2Nm_tixx||׿ހTVؤ?V&ױByK/mZ_(“t&Zk9&L0fI]v駟,.-8Jl0 8/B0""z/ŋ[ʅLyRRRrssz!ybF4rѦM:AAA76Io]Ν6U9w\ˊ &̗'H_N2%55UKX[jap .]ZxѣZ!!!4u';~]v%}\#/^_rss7oSO}YYYRMOث_|?W^^j*i}U^`ՎUIR 0@wmٲEڐ"W|#zIΝ_J&M$Ӹqciѣ?`uwƍ#F/BZbŊ>@kwK _VXѳgORAuz,ϼ"8?=ӿoذ9ss=s͟?_?֯ԩS?z1c)SXcϟ/U.q%4irw}0''g{۷o>w#G5JCuss6lXM+$Gy=# U.!!ĉ w/_{(kdٳg壌?M%bbb=zO>eʔ{+888::zŊǏ͛7֮];dȐ;z{{7j(44tĈ{t1oٰaØ1cvڰaQF};whU'88^tiϞ=}}}A:w>{;֯_I&k֬ٸq{* l۶mv :w\y!^z>5PӇmZzؘJ¿P3P a!@1Q(0 F(CbP a!@1Q(0 D" endstream endobj 96 0 obj << /Length 1050 /Filter /FlateDecode >> stream xW[O;~Wԗ]^9RhQ[U !Aـϩ6 TUFv&㝙o.:ALfK $u!;SH5шhF$ҼKhJ?"FtZ|#}[AK p^Яv;蜨}g;b)X)`ӟx6}Nt2ZwMpDu x8bMIgPT=-=Q#ۍ $ "Y# xcli FV0iZZ <k'j+#%"2-WТLW1{QA(#Uo bP]ͿZZP%'eR Lyϗ{J2:z/Qߤ3 |CxU'bN]y=q[HuТ/,E?y&˒b7թ u'y'dI 0=SBYlԃr'L\X@ڮ7Ylw2s^ndr[ʨn(^:M.5h_T=TEmjQ =o0ɑ';s@A]P۸ew@wE{ \j Тz%K}5w*sL0oXk0{ۦg?N3,h=&,}]àK-Ӽb;񪺝"Aݳm:G\wynq{ƀ{kcsSo~h=:37TGP7"S`s9—r+[af2YX] +VHmjƲLe@ݹhfskkM vEyP76p6^?hm"BGL9񼪽Gӝm@,V8k2b^ʦӳn˕x^pr~}!>ZqT8%{zӕ:r#cB>u2m7? $Xƥ] zý?B endstream endobj 124 0 obj << /Length1 1838 /Length2 10957 /Length3 0 /Length 12114 /Filter /FlateDecode >> stream xڍT-ww.ݭiqwB <@pww;3Z^UT묯Uԙ@,l Eqv6' 5Z vAdj4u}):lvn~v~66ISw9@ `rAppr[Z.GG8@ M]@v+Mm@0R Z:zxxڹ88[ 3ǫMl5#͏ 3kn>9j@7ASrrESǺ42Ih(i<| 8WfSO)ܱ2xF$h"1w3+_48\ I0'h|wS|JքrxcfiPWw*cWhâjf:jǔ4d5>ԥ2wO$ :挭ǚmwb(4zE˂99+O 0Xʒ&d ?˪^Ly w]a4)* 7ɾ#q":! (og')a¦HUHYaqЊ3aGJ!V'3}/BhОB#:Dh/-j+'qcB-+wc9K}LqnVNhjUܾa P#MgC8+9p2}a$YYFnQy5l]TXE5# [ҧQzsz`ixfa +B ֩x)(NǗt: H@z$.l0yƓin&D}m0WS6(:3~Vۏhe&Tj;E^lv{j 4[>C 'ߎA˭~f\<S'` nRZs"\>Q,lX=7:5z4@1\9-$ְqe$Gؾ4rv5o3w`'W5K Ffw%. S bi 9iN3W:!2ʟT)Q-t˵s_b{Â=ɐ[*+_lFbCͧjcݓrǒlCgHZw5rrxtqeiPqDLb 覈 P"(*=rlV84 'fJ.] vXpglzQ^{AБ*GwmOi'YbD"g}Mq &59r嬤XFHCgn#!BP|ӔvJqV'+d(xU' рa<].h3C..v8JOj0lX<8L&SZ*qi{ݛ5Hwٮg#%;;.$V R6$>X3x$f˓aVMʓ%XR'~ 'ГipV:m?!U9(NT&8,5ʵ,UPZjtyݰKXٳPpkz8KH{4Do+{KPob4I;B<)ol\/?Z{AG:4o@8%)ǽE9X3HI(9Y_T뉿l=" Ln?v}SNe:g2BÔv!&P-sfQ^qa޾%|y$hdPxJό7!HkORj{~1 Ч D؎2"Y_s&PϡD{c[ٜ䛶&g yԇTυmd^("6-Dԝ[7 -2 x0+p~s2ʧ|hR'`b#S45ȀR[ &IWkfh|pPosG|gZؓxr5vǫM8:7 p[||ltaXqJ\1– =Ln55.mi! "˧.7Npጱ/\R |]4V햪rΒdmRC 8ߗ0yNH)(fOIn%˓L<4˞RuQ ?46lҨ`42Se4nM;>gWDޢV9Jt|ܣ۩8p .:II<66JJ(+X {(lO!k/AH%W2PưQYCs9M8\޺@o׎nLlֵ⨥ BʬQrVo 6G*uRtBht=0~.&ni~ј3+˲ l4N6L2x?:g+JJ6V@ۀ.:,J B &PC6 7E9J,ļmtF_Ŷ躼9N>[,d?QЧi?ʴpkP].;"?<=І6C>c j 4 ]VZ HΕ)䅥^5^<^RBǍΉ}L[Wex>< 6֩!x%/黺:UlW]0ڒxKlwZy>Cԕ4z % aׄLqw >&N45^рVo񾽳Qy0kS.i9Ԇ8G^ m׽vsfJ2S1zI^p/:l%i;#tT_d6׺xtK.ܰܯ\>1xar΂*oZJiOGffMϤNp.rZũbU<ANJ7.97e(6I6&f[Њ Ŗp ӑ> Sb>L*߽a>&g+FE n;[ tDh*x-G%0nlBa5}u8"m47i\~8'P|ex$2-#>f䗟\oA) ?hJvBg^p3t@)ދL^i%QE+n@̿wt:<A&HK,Eޫ *R…XF_q¾'׉ N6?T <[Jj ";>sD:pO:2+. p.?O/>kl)r]@lK-q5C8ZmQ^t:(GYнFQ߰qq6SJڧf.'*"sSOփX _ft^ήHMb Z~A1w{q`8g;p}0kY˥8>Fd-iT5Ұہp[@a\3G|̺dM̲'r2 $Ge|/:S u~kq׼@T#p(_ SFX} u#{Yj ®_jnVl{1Az<\&Q &5X}2+ݚ;0cԩRs݀9KV#v~ISNgl>d_E>37{Rebu%<1(2]lAJ`U#9 k1>Q9hgCGh1G}\EC"$ɭZlsM|sE2 !혴o#_>NolRrKZhyߨwL|x[WJKe~3(3,4CH 8N+@aLHvy:zp70٢76.N;5U摒3-ƯPLɓ*70t%4E~-7>.4`ƺj6 ڼaYKE4 #}xQT5Ǎ+5f97%Zd&^v9KlhI\i͔$Wb?w6bF쬁y`5eD2@lj#$X@LK.bsk1;ݨ WIBU7i]7/);|{zUKj̧n1xd"nr'΀ˤ$86>K"[eC1⾡>9M$J̄G$wyTX.8Yzh_5a?BËeLdr,Q*Rb.7HQ˫y=icEu&vHF 2ȑNB4ڤ ]4G71L=u{LQޙ \w[F#s![2b UVQG;20uDK ۔Ic%Oe, 9P3N5aABD4XYh|" pEmwrRO]|rAm휕ҪIvr#UT-۷qrж -ds)ր],A Jxw j+ڀԁO $>\\~^pWZgDm28cfVRߩU6Zck!Hs>r8q&/za)f찷-bVC(BFMmhr̾ULҚ:@I #O&jR9X>3M|W8+]TramG:#mO6U~U޼L׌q紏ӸZ,껩ql'W*^> ~> SQn&#YAZᮢW8=kђ/]U18Ng{Wtňl5n>AW`-6s7yȶ/HLAX6(-Q}jʍ]x#9ț*N+랣4P;G!0xt&EӼf>;qkIpg\*f\wtOaM3:F'FKQץToPm` 1gZH]: OxUvTT,!zBmewN:~j);qFqhB(f ϴoYws9 >(ڢ#[+HygTT@g"%*egQ0BÕS`q+"ǂ=-ţ~S尘sY\,4sN>kð(]});ˆ\I0jx]ʁ:XXVqكN賤;e}bQ,שf236/{6[YQ*4&.PtCUj$V*|\K?KWM''@Ʈ q'0.U[gm&E ,VQ&x_8V/J(A1xFαE$lg:e7G!Z-7 m5kj4V֠8?#ͬDm $^2Rm- 53$o"]k;4J<@G $=G l0%?`&DSoV9Cن5WMAr[C@r}HS(tE8n:T}q1BZDQA'op]"gz"o<49[%߄EG-rؕ7($ A1-8Ydh~cd3[sc/U6$Ir00Za;#﹠4]O;:Q83lR5~ϢM)N k8IU~+|M%W-.9\^̠IOz"N"N-ZqBm)!9|ЕDѲL {9IsrMqC(CRIB|g@ujI>u]y"7nZꇯoݠ|{ wUa۪{JOyCxX#-<c&RX2b,wlLN{ $y9mDMo3$Ws[ɑΗC"oC l h"p9VaA+=anؑݬnWNIG}#IуY3SIfs):QG=r6!kήm4Mاx\ah6ޔ4e9}ЕxH7"ٰ79|5+ SթqDD>0̦E!=9/VX >d!nBF2hut'R6wV ~PqqV1Fɾh5bn!Djs/kz˕Ks`2lZ4:$9E9)UKD/BU G #C;qm"~04bmdv_c(-?ǽ +s2E oy]QdW'ZHZ[|&dn|`p<3d[0ir"}S4>,)}HͶBp/$΂Ym붐*M]N7.=ȎA˺`;9I'z.qd(Vy oy Ryth58p)""޴ߵ`P0oX#%)z|M021,4q hr))?S%2ޑpZm)@Te5g,|C)kGi]dtyc/d\EU;7xGk4]|%8i6E*#)BwS C 8A#QBƔ7na& GSaJӨɅ#?6;^6>#ΌP ղy{J'o,I`[S\f4?P[] 3skC$ʩ f܏zS=t%7q-j{u Љkwqi='7Qpg16)B ņ'oÌ:@BsN)QY8"jchi*S[}ܾb,ٓϛX##n~ V篜[q.﵄rmymqCJ u.㦶34`%-3d8Zo#{ټ.A'Ac`9$މ14[hV3?i wqjpګvN.C-<p[R)),VzN#O.IVuݨD3ٍn@Ic(G3p!bi=T}־|QI;x.XE#?ӎ"Lϲ껧 w A#K.̾u/vWH[ WֵNkQ_ 6CeXr |[dž_pЖ3YtIP!TC .5zf* 7!bE>%].#[./L!U]%]laݡhZYx{iYqBC1RID]xOwV55t_-E# $N})č#2`)j8V8m^ѐ}tEMf uPswM XMk!Vrdx q?\9dރ%G$ q哄r0X8NjH3(A̵+ӷm^հGWiLZaumޣ\3Y,48x\:ۼUL]ߚk.u\ig=)HG6-Id{d=&_L&)j7r# k 'Ī.Y6 zLf^YU*j]7_Б@.6>yjOذ!`gS`ס,4Qp'xg[6-'{-x䵒4eʪ[z\kCbŮ?8"4%* c}}A<TNNc\,oh ׼?ƌuL%c/|lH`Dk!{#e)[1iw}fC AFBe'~d&lN^#6ߗ\8+ŹKB{$nM# ^ˆ=hajn45<"1[@,4kCƳ诤a*m^-JɊ&#L~Y9jX#=Z17G (r-]/k  ^F㥉@=r;=zdSSU5偍]|!ř#,{wòV*͛YY]i;$o%{[UV~"PE8yZ_4SY#Z%5!7}"剛:}RU F8ދ%JN1\ n1Ow;p?ll>BPv3*x k] ha 0!^S%Ԃ%OY}p ;>֬ꡐWf}^ṰV. 癄ը XfdLR i5 ;󄷂W?PSvtѱ]V.ld[zI߀'Ds74AQD/߆EMF|\ɾh™ј֙sE ](9 {}.A Dv8DVK0d bw_6Iͻp]8d0SvDn$oJ#}m|vwԸ}$BV?35%A+)U/FryF\Zݹ|3d`y~nץ.]+4> stream xڍtTT6tini`!f`fnPIQR@FJ@}}9oZ{s]}]IGGnQP< q@AKބ@ +ێjA p 0ƦF0@EA @G`O a$upD`Dr (GME[ BP>H.Byyy]p47E9z$ ~ h]!Fc ȿp{n .P[ y ꀾ&  s9?/  a>P`u5yQ(n  7`O0ls:P7iH˯~f%C!~E@lo݇rap/'{(vn|0DMƄo<@"¢x:*`e! ߌ Cn`OBx@??`E6( o7G@3 Я߿,nf{|ʚzr\FS^ <x~~a!@%yt?}G=ݲ\Bd{?w忲D=\\~?~+↹hoo1/]ۧhAk";(/e7%4( GB}Z~|7u| o8?K*lvT&pa0Y#G;o|08&.#~mTT3eGZ[F\So%C [)DSUXiq 9vGŋNjcNU%#Y+숦 K$fOwzF v䪻qx d7B1Ys=DtOTKLnTk_ƚ~dͳɚf$;&xt۶b Q3YO~Toii>D[|48c$Ūr"S2̥/PO$8#]++30]wcp8dM+*nŰ.vCZW)ݕA[\6/օ4c9+ v4p"76 GC >ʃ bHϚ=uo'6Lm|eX?Ԥr"eY|?WMQRBBݼ*i^ueks:5^?lە+C $dX]wK;06ΎH9>}M']#xݜQvܺB7&,T|heS؅{jr{o{w͸B YzbT*^.kVPq.˞ /|6&:@ }vt-.gUԊ|U}id $nD(c-+oUC[HĹ em'd`SFdOym. ?!+Fje➲w{~[t[H i#S9>AVaǜmےi͚?인RvZߵ}@?bu8`.z,o0O۩%)qrNmݞ(FbdgG."xy _{Ӱ^K1kީU$tU1PD+E?rބft쒠Q{W4ztо~267jDf]50LHں1+aՌ+z:ng4ǘ5sq99b&%՜fkx얠]u Wb*(4/ rv('1(\yy:YjY M$SiouP .+ڟ[mIUe)bT+:v.\ab<'f$e_ |A9vk-^1=8ףБJXy;iX?Hi*ZpCm`TR{jca !w]Y!LGin ꦌ<[ZLrc p"iE/PiR|j¢*"7{VAZyXIıчi~_Hc br^N`l4T;ڷ8$,NQQO0q;ɢv*]3h¹\/}@n_JjqYszCNK T2]羗˶ m3!*|WS -~)#_L~t3lI ; WY:nE-zM" Pۑuo!e[X,|:JG, 3yܚ] ^lC[8U2˂Q{ffW4B1qU4$U'Evh`tH_'db7Kyc p8S64XY|l42y\&A/O1yCBgysbJ>c~dxQr4թVYuW@}&5PTrjl`mL1|)&BZ>9Y)S5be&ss5Oy(,Mtq5^ܩ Wz[iCf4uPEP -qp䛍qq.sܓjZϋe{TB)H91 3=9l fF"h ڗ7eϿ%}K Do]u%qBJ׬2"AkdOz!렳&ʹ Ws6FU)bdwݪ%L` n^;D[di|Y& ހھ` Ù(@HZ⛲$N#Idh.L7yJRI3`0+]Rin=8P&/U^;s m ־YcJs?zK|1Z,=U=US+7Cav&mli!VՆ΋̝1,.GQ B2$wTZ+_t$SW@ܕ14Kp_k|?h&3fOGh 'Hh-dj#`\}KˁyރsoV HZnl܍HD,ҧTj&Y:'[8,_u ]Q Or8?|= p8q61#/m^+ER2ØsNe:tw^*_>Ap\ک0󇭛EP`djbG`KuǬib"|-;;1]5kjDTw|]E"e$̩/նS.Mo 5xH ~|<2~x?>C[hmv } \żۇ`K[xk~gkzuI_}isy/);U Y4r˨7m rin}|nHjqGn~ꈉu֌aT) #f4.zF ADKKhڠQuM)~SFZG`Qi. 6k?q5k6@z#Az~FRb'Cx.i8"]Sjbu*B׎H0zN&, /K`ʞV\]>j ǺSYREJ&><_Z[0R)r=ď*.a7X5]k5坘S9YX ن͊"$\r{z)JΝv@l&Ep݅#)h0 |QG Aj`@L7zN{s.ZjBѐW𧟠Z b׻v!.78 ߦ}nqM^~˦ fg+4aBuqz;6p1j,톶PzQ^޷AbZ!" F0_tM;W9PSCG7=B'lA+BN<>stcʖd y)}:!iT啦,}xpLR]mJfOxN Ϣ31ÀsOkп!&r!Gjyb)6cf8f{Ub5T>1~ ՗嫱)w&CbhcL80qo4~K% t\\B}[{":L.r$\%6Q rpq$p endstream endobj 128 0 obj << /Length1 1384 /Length2 5931 /Length3 0 /Length 6879 /Filter /FlateDecode >> stream xڍtT6)t(1H "ݭ C0"* H tHK}{y}Yy}]{_fg5SE@Up( PR1@?(HnC9CC0\?JH(ucSnZ8ࡇ3$J$@ (7(=a-~CNȮpAP7upB 1(Z`" 0@@`P?RpJ;P^^^`w~^C9P'kd6g4~Bv/FB7g w BuM+X//@+ ; \\p`stT5Q(^n vvGă=0g w`|3!H+ʝkF_inYnpqQS!}sNp5UW1fEDb qU ep݌Ao>hw'Bz@ ( 'w3#a @_V7 E} }&&<FSQ @ %D0@LLD`؟F#XnHFݳpQ7ԅ8tKr;G_YWwGο?qC]ԍ 7b7v07rP;k#a0o. q1ٍ~i"an/ߍ N77 -7gI8aKh"0 !9曕 Q-7p&p3?$u@ Fro{[P7B85H9V5V*[¾b=lIU2CUK7?`'̶9n⤺y^]j5_?EVj]YdѱB1sSy=:BSBx`٘l{{tGRN ^$ع^Y<28DhtuSO=5W?7*ij1`Gܷ43Dy|4RkT % .)'ԝI#yC;Jq!(󼃓[C uRU\'s.%N|K^pzxz"+8?[jtCţ\fPн0?Zô͸;- I.wMR`pئ3YU04[I^/=KF^Q6610]:!pI[Q+gGX \qnJQx,J\ΐѸJ;( Czx;gEn9kW )x-v#x6 :.M݊rAw6Ƽ?O(B[-FTk%9ڈ NW^r 2,t ڃNep/r1;*ȒZ?W=y^Z=$.q)~*oqt2;wV[nKhgxM|uahJI]?ލ[W ٓcFR뒃2VcL[/oFn<-}-ܶx(1ITERɤ=oj4) J;pv $zogKӮEdrR2KOcFŧ鏤ʖ)r1϶NP]ֹz U?2a̚"c/.0Gx ;6Gis`ZJx}< -v}rph+\ƥ+QBiYߵZ1\|#G%*꜏f,nFZmYn]G!ɔ ߔ{q KʰV.iq+Mg~S8\}+t`י5Mm(Ǫ'69NC /W^dӾsg`q|=zQM1TxְM/fh^^%_i%8|Y ?zPT,nēDIvC2k[e<‰ )mnRb95p9,B)Es+g%{8q\ƟjryA@s+F1%A*9 QB?1^!<}MII8"ý5D_$_ut]Q:JҖh= >xGlꛖKH%t ל}ma[4z fX )q"AKo=T9)1QYgxrxG>@NZCA}YyF'%x<*>0BsOzs,U VIIUnm {84kъOy? T{YKVʓ{J9==VV4եwo$nXX=V6, bGGZUlY}ճb_ϒd[|굧qD2MYqiڥp8-Dە/Vse~YHXmZ@vd"yN pRمUIu 2;( 36 vN5%;׶/W*R/b#uwcWYaX=-2%P-Wʈt0'e %/-۶μ2/c;[ a=RQOQRL;#aw`1ћ>*>\Ւ`z~IPʐc3/VsJF|,wq= ?"}KI }`B.{ (?uJN M_77-۰JEB2U^Q>*սuI ӱuoZY?yce´\򠳾5Rf&ڨޥdWUv9c(#;r!ǩ΄:6fj?競+IVEUIT6O1 H>!kMޖM{8F&鸳BX+FT^6Gu9ZZq)_PkG cY̸$ jL)B[څ3'8$3N689ԺPwR߱6Óu0Ukݍ:i5'K"iۧ)!dPF^$0l882Q,0<CcJRgjT(!80UWJ ^,&)OxLη0́faY<Nf{Gm`jY8nҒ󀺊XEM~0.UDNyY{6m xOD6WiɱN Ǐd, Xcwt&iiv 5&^ojLϣߺ+逬;8 %uGP$lE19lJHXn TV*0f!p8?!G3n[EpR-r6<|&6fa=HDh3!fal]bmryj]qJ#%[+5A t%yY&]Q+vP `_Ӊ8ley*:$G.T,:/rmIܭH<Í(~SHPU[d>=B72Vw)qā5bR*-NSڵ{(IfZjg嫘4)TgRfcJ$"Lҏqʍl2,T<:4 :W^Nh_mhOq/<;{6A`"J~'V/c 红c:*%?;@UvgT" ` fAE0/bR/kO3,ژiٌ_'ۯM~@/S UŨՁ\Da)ܷI@+_ǝ3@?Ȝ k),>?~ZyYYWsAFc>ҾRVJg`]8i[я4kb&x1)?#嘹G`%;u`%뀷N2#|yP!4`m0|@*KOblwP~֭=RmxҸ&wM.Xs;"zMStubM6lrEĹ T.h!瀮EdmlvJ |Oa ۑk;Q.ꊾhf, `,wzrX@ok9h5RR>bط2c:+yԼ º9'|+-$5ɾ91f+ݴz,wZH2ӑ=y}?MM_YϦ8 p@c>i$8&㗼?LJr}^߳"Jw#3 _C\t5^{UhPAQ}εcϗdWL/vu'Al&xC smejnvlDt/2x3[7* Rz'|)Ah|"fYI,} gi'vm7͈]%ʐجn䧚ɗcc;F YbzeB  : ˳ej:6ʐc8yʖeh.Rz,S1bR> stream xڍTo7tJ 5ni0` nQCRRAF)x/y߳s\}ݟ뻍wE$ $ BQΐqB6c w E$BcJ`P x HJ@HoC8RpW;!"ፄ:8y>8l9<] H- F9B\m-R(B2<O(q = v-t.Z#d:BTQ`$Ww3W;0P" kik8~>;g-v: 6;`0l6t0@E^FwWH(u#w]..W;H-z. t[nh u{QW 9@Pa0x:'0F@P="= ? u{@(3*["AmQԕhb$ `Bӏdf_?X[^_Q*(^a$$E;c0:WwA]_$kC8L./A [3p(WoE*Ϝsiу]Y ^m8z\jC\WAMi^~!>П8]{ E:I?q uɡQ۱Z8o9t\?ܱ`HuN` G,P)d!J})djI=s7Ȇ^YeiDkz L.zn~8G;Ez}׿;>Q}27u綿}h0s)GXcLłxXg) 4.^S_yXx8}~f8EOS: xO98voLX< _g4K͗j$;J`w. AB!{S"#%CD2yntfiȃƯ[g;F}{K;)W¡6kʑ:R~H  JI_>(nAU)'{α݃Ι0a.>1Vcgs3ց& R]ۦġX瞜'Ck(Sʫyk?tida|?"Z_d}u[1]HA41-۵2I ~Yzhȵ0+i\ pLozsH6l#~1I. ,Y:j۾UIW4+t؅Ղ,[|w0h> 5`"c~\>vwF(֚a#|k/bleIF6r~ٰ(|O3gzE01ұO<$d李~?(m޴$E4 lGm2>B @4>T{SeJh'[qQ~gL< |i4V_r#L E RŁD 6jdrYEA o Vg\]1cMhn}"$;d+/u\j̏?=lyS*2!\~}!.V PОq=ī8/"}cѠCBJgʢԪړal/nJu^\\*f JiSY`>h]TfW"xiI+a*ReC#Gwɱz=#0E;9E qG,aɯ x$F̏Np<){]|k.@_ϒaZ:7S-?7.i=1~fWȴll܉ZFyl:ԧz^ee, TG&0 he&a4gz%7¿IYQk=Mny{_GGGyϢ67~ r9=4Wیe=;,`nSYz;~`k^+U*N/CC3c('j}MʳR 3Y2,q*VW;/ xpdeCfg9BִtG*b7J$裭r⢾J2O܁Yn;1GZFsȂoSv 85d}?jؐnu=%m4uy7ߊ+sR 7,8g8ͬ棠G jDml2;^fvV}MOǟaR"(֯lr`vbPO2Xq?>)5@ S\  xi)ϊi ҩ`Њg?M@##dܵq~6 t!q$CW/XGf/xvOnVtgl$"kqHX^iacK+Pf؃T &,ܭ Sr:S9 sl(4^ú^u gW^i2ֺ~[*mit>>eF &/0vP{Mk*-"{]$zv dJeb4^;jݠT K~M=>k' }MA7Fl\"t柎Z'KxNJr @sC+e/g ~ʇ7t;F)n`*l^%B׈z_ʹt>%Fq<T{GNi  UeZ 2AjԒ4יcV̖n55)Gk1UA*Oۜ(t򹜻s/[|ݳ{Nuk*T ]HxX_ۧ5}2w G[WގُQu;`6Q/Fvi}vJHYDG˳8ql )"b[:1*_DB{vt!2fnz+-}i}XoBl,`1nLHw(kw7خqUeM{RZ:59X,V*0BEK[Wd䃍T+Cկumzdv5ʗX3n%}4cKSNL\F6Kr0TC6m;42WbE{E~? {U{3`M%7T7EuU^좣͝S0XYN+ᨥ e[Nڑ"KխGol 9FlV˜k^JvEN|S?CY[WwT }Unbt\J[<;f{Ȍ>ck#`2VIhwa~]g8|']|=tP\?sl0YI`3B lϟT^gn!Gm6+Ą5v,^D ~@}ڱ 3#L|%)&mK7.ܩJZ"TS CRE|]`PYO%4iqHV!`7[Bjbؕ}>8Idux[&iͯ4rsٛKfsq@Y`jP.L"$ř:s?MͭOƆ#%z<LR+RTHlE?>xfʩﵿ5E <7XSIv3hӶ%Zx-}?\ zx[k󍊤ԓږf) }Auj6gcP8{cE!M֯dw:Kg^=Zx"gPtAy{fMKϓ6a$$4oQ{] zuqKy*F[!릺w,FPaȃaLd -#dW"=Z!M74I.@12Q$=5vNn "+:>÷cUl"bVd(m]F%d*( BRi!yOV߆oSɮ3t7"i͉V-Iyp^%-G:)̯Ɇˆ}PyLop쭔ŤaM,6ϓ\zf ݻy4 ,r߼PNqq12D"/qj.}VzR4Aw> gڙ_f%4LnSR#+^DǼyQؿTS?͞9{ b)Q~7Vװӻ-ݎ>l(Z%0kjy9ӽVơvG"[ .ji?TT*bܶ_]ʸz*)Q60rKy\8t|ɮL90-U'eZ|毼 1BD 9eϥlʉTcT=D:~@O׋+;τsvڢ11MU*=Ps,ا$`| *1k}k wHV*ɓd˲-;HLM\+{:bťԏ*d9gm&qmAY21"$k#Y)U/FL=YV`ٕZV ͢FU*Qr*I=H1i6xqWCk`rwT@8ʱksOOYҳN/2FZ8~ Ӥ7Y>] ^G1 rY˾WѮ$Y8賟_tź'.H9CaEFЬ: 62Dҥa}s+u~ ϑ{w2Ўoƶ4_UJt&-b}8Ϭ$QKƉGYJaʼmGu)9 B>f(p:IhҋsjHn_N'n(Ғbg9%41P*ϞwX¿.S~s-L(g|Qgu$r1Èh;%{M_>!~: X]c~N[Rjz25{~YjJ4bX[V\a+ẊZ=Flb&1qd\376uU $O-yZX}K~VJ[TnĪDp,G^Ȼ,S ZHbw:VfdT4%Kvlfw%S!h dDr11e:w{a?nsĉS#,6 N!ՄV{/#]hlbtӂKm11xbrBTc:@iE;sիqp7)cNV fjRgwiCֲcM~,e9uH+5#1Tj/rkI+.3a9|ΗX-N `zk{6nKB "rX(`NЪ{ll &&"ũq,dE Ұ Hex64TA*ni,M>t`ݣ&0I&5쐙W3e6{Lfov{7>v{vǣ݇ 5%xiiM>bVdküzk<Қ,,%)I|XpJ˃yeaWzHmÃae^]^m=exca#ϼwlmAZ24:tl-z}'{ Q0>v^yH@(  ax$>zR[u 63$~u>`Ru]mt?9A|&,a9us!+3>aXG1G 55'aL/m];KE^:gPN!nYlv?Lrp Yv:b~ 4Z}I CtUd Xݜ;eVL,64:{lNP ӹCG.7fyG[L 4uk,/'ZxlxիTe:AXD)M tP JZXȰE0ig-=3*zps_g+ò2qᴅS]x9\0}4u_/ Hl*XFև}Cc1FFO0'42Cb4^}r H_'*dlAB4Yڷ j'0\RNO>^9S?,S_`D 4N [`SNR-loW%O&(A*ӔT!#/RES /QN'%>Y Ot/,3 |V#uhZ(]Pݐml_^[*#JjQ @Ť}{Vdoazi]s$ҪWr̋~ߧM.J[VU!TGg) :g[ ڝ=ImYYkݻOt[Oan<1SemcFt*I (AYvdj*қ{+D6f5aZx?R> stream xڍtT.)-C7% ҝJ CCt Htw# HR" {׺wZ|{gww? #k*!H/P "x@~<}׍buu! #Q>0@$,@ؿWqf "P7<y+:_v$&&; uApiuB;vH8'/ɍj+ !P7k`& g2^<_aB(# 2PWp:@ Vr'!3 l`P:/ ínT> s[;du`Ԁsœnn0_#*eE< GO ݛfO_53UQ A㳅"B@QQ~* r&uF8lPC@`6P @C|wA+- (7揍Z+ ^'XU!< "VvO tug1MPHn BP7ݐ0;PuG@P#j@aNUAQBۢ ܔ`^Pkmb2Cn_T_1 B`7ؐˆ>/ `oǏ^}ϳ'uނg eCx#t{DK IOKG&~ȏL}roM!]I!whE*`B~2.1ג'z"OLL;SMn5ϩYݲrE>^ 63w9/_ܲᥛWv& _}:ݦj?OaKb37^\VNFw,!U8##G6 y꒽G+CG/`avk扳}%#\HxAduDZ& 0|J>M ItRW53e;H.JGQo]Vb~WswM6͜Va1M++#F''b"?tpȨY1n6=hϯ,1| ,j%eL@5_r8-1V|0+׻C;s orZ/o yJ*vElIBrYoara&n1R7x[VCa=ӺsU&Ô's!'3h6mXelڷ{Fx`ڡ bu.Fa hk~O;4ϵ -MrIy(Kٺ*JR{Kݭ2&k#DUr}-hf޳ Z4^9pJY=jH YJDƁC4c:O Fl*8M,463³ $'b#U3=\>mmiT""1'-y6 %nO q |ӶEaHbђ'YU5e9MX(kN58A^r$C/q>@f..Krl&WIK:+zZ>ٛczgu\Je+lP3![ dD~Zo"͋7<k%v<9Oqhߣ}{O}QLi{5O? ;8j?q` SWsF8'i7}i`>9(ՙP:r6ndKW[Euj[g@rgVb.D:oWXqf޸ @;}jjy58ג $B]C'XwF$9y=޿>,%fي#w)J ;?~A3VTYA^<-M=h^9)3ڹYU!Se6|;BQsw|?ÑM(^TybrlМHzYl6Hj5<Mecv#ubapxYӍF6Dkx}sT:H{gJ^ܽ,ʄr> ( c~ җzZrvd^wDտY&+$4WR S= C7$CjO @<, JWψbeRE^TҾ uZ/ +Ks0s{NϚ4Mi[,8{'NlZ7#:19iR5O;{ޜ5J0FݥԃsFa%~+Xٱ_,(s-u,}-Ni3 pw}5E8ktYxJo*tg>[h8l,cܙ0Dͷw~ט:e`!EwsJ4_*h#teEpK(gC6, غ=4;*}N7gkZ~9{F2/@sEWmxkmtpgQ]=,c`JNSߚ]gA؉O~ihotX  <-*wJ͒t~pa[.' MitƢC$y5@:Y;I (M\քd=56f55X st 2 ێ}hKDrQjsі7ʴϾ?Np.׵x`wa8湚4S~G5+Oי8\j{&fېo|3Þ_ADh|bX\-N= b7/.03Ú݂~gclr6(Rj}p/J~S\CmSfi뢹ZaCBMdOIʾ[X.CQRI-VȾTZ?cX%sD&r/wxBJU]贔rDg/%Kh]r P\k1#2j3I'DȩEnL_A?`ӼLc X:x4]TX>C)M3j~xJQZ^7.SHO1~MfiJ&5({Y8\R$1 X@AX-2o=#&wHu˥F-BS8ݨí ~C(!eD<12HCea'A&mt>..Om-^J/0'64ID*Ǧ6"#5co Yag4,,BܼEÆ D^ׇoMh|Q,[Eoor3Rj]r_D }ב9%*NM}kpd׍>k4eKQqF=t%iJ(ǶFqi! 3)̛N#ĩ q|eA:`9 –\]_>(P$|ʹtzCй܊G9":xT4()qH/lcVEP^&|S8HEQIEpHZ\ث7dg$nJy6|]:3&B`ڋZX&D5Њ;[r^u2܂chL&wK2*μlJOϙϟ''*dj׀aߛٖIi7da,'}%ڔͰ bl F I ^eMԹİWK@4u.>f/:{.Ƥx5鞧FW%: f=eD'1<6$zƈ>)sKIuveuT?7ԱXIGǀW\o&hvڛ:ǒ{.8T-MvTObSSE^=ýD#oe1:}D?c8j?i&3 ^(Ti,Iyn~YXpidO^wilu_1:ʫO}X46#)SNy\}q`dB.\R׭i}BZabB{Z:c`S{^5SQ>c_B}`Klݐ}rzo n߷;7 fܨ/+)Nz"hh${v6/#.ڨejݡOz"@ƕ2o9(Oj\vDD74Uͧmw_ʈͤ~%=YLQ `~*Vg+eEutrT.~K(F gf bp|+S^ b["Kxa$bعhCFGJ?fpe8Xl+=B ~*&1Nļ-Ra |;i3D5/╒dB r|Jڿ^/IցԬ,Ί=/?xZ- a)VXjemoz ۺ_H轙O+g2821seB;] ViXLVɞ~K!2rC?}ޯ?^U-8gg=k`8-܍}X RY'[ | ܤO&yDLB#J5Fg%bo%bPt§Xi8[Wl`LƑ) `$[Q>{"^Hz^/|x>M\L?2 endstream endobj 134 0 obj << /Length1 2462 /Length2 20811 /Length3 0 /Length 22225 /Filter /FlateDecode >> stream xڌT6mNMm۶ݝmۘL5SMl۶k=_Vku8N_WdD*tB@q{;:&zFn2#Lo1:ގ/'˻LN j`b0s3qp32މ jfi HD<,-\#҄ A/w- gb}hbdP7x%7;39?- t:M  ja\ xX=\LN)Yc h ?tMdi/g#{[#;OK;s  .KB 03mhdlofdicdn̍BJ]3~ӼwYTh ;?QK'{="L],]R6y]l\,#ab^/%o{"f?pFn@+o#8&& hni] 4{L?y{_/S{;?/?G',lce11~/(Y;|\dަ @7\oߖ'$jc/5 ޗj9Z9Jh,n4Ut1g[2K; }4K~Z& ~9R1<އLh ]]~O [b0A? `  Ab0HAdx{>]ȷm̠۸˿(`3F!GS .e(Ǣ-$Mb[OZ*%ѽ;_1iO^ϖDsM7zP8 ukzu>桽E{MU6g4 hnXcSUa7"8d UюgwR)Q2E^CpEnAțV{J(Ⱦ-֫zzG=?5M4O$`b,I{m>=X6hq^~SWWU!0c(pőzo0v42~/ Þ$t&iU+R^39{`τLw<@iUՍH'N)G3fߞI4.:K9l-Ʋ87os0ltb;L)-GTC2F"Yp˔HQ2a +إIIm蒰7t:>GqapdFə̓+Gph]ʘ{>x&ϰS7S!v!~|j+^ɗI20<~{aRN.PiJؽ5i4T^W!`lIvn\PكӑHtb:C̀0`)cbV]YOy &}i:E@b WL f!d.ci /XA֎Mҝx2K뾘EKԳc ɬ-&e]Qɑm`lXrc2/ԏ=II f7ݙ6db̹BT*² {Xgl"YBw6<$M vP0 _@B8Q;{T)w 4.^e| ?k%"z|ϩo3r"T`:eEœ$mYNn~BWeUܶkJ<9auDlH'"^у5@24Z㹖gY`E Emy~SRx=SXک =W?3tU3YOsL%Z$~-$ ކ@nBeR.=v G[ *:(C[hea}|ea#c9Z5lr*!Ζ1Σ?5#}/~b*]%]3L>;% (ݙSl$\<"UP?0KKpS*J` b󶋐<$,]jgH5,}es:,8XCb v`ʄ8v%0yTa?3 /byUp(ow\ 0<dk\VrTҟlJx“na5FV)I61aq0P`'z‹ID/_ۏ8< ]:Uni($ņt) ApPiAMTCսf%Z8]۳}] $NJ99y -Ƒ!;0)l8!x^t nB@Q (բ Sqz4b)jINpAALbk`E $ORM Cvt XIۣ_\dCZI»^u 20ۖ2T$O}lI<فpfnW^ yzls2!L 2{d0eYO8.&(IE-ߧ0s!P{}oꩋՇ''l;V|Dh3 f?aK-&PotyBB -7D ~pU/FetiB&Qa6rqPN H '촼 Y|l+ (lr^7vksoN*9.X+Xf֟el;?"sz:]^™8vӰuzf>~8AR-msɡڳ䖼iSY0*⋫:N@alIpGl ͐%S;u[!@1,I C@-t=4KJ|xu2q͋E@-=ŨvhȢ3$<9彶u?+%\ $2]bf_7bG.6X#" D}hJ͹,H{A %dnyؾC7CH99  kZtt_NLi9r.@+\PJi1J ,ƹtfI AQ)1$q7Lѱ?8B2 M[TIAixW{V,MK6~xAW:E`~PC{A0\B̹>%g YOFhEQ:cQ(Sm#bY]'Fr,/eB|v}{=5~BBڅ;hGTi#]u2߰yJ@';I>~.c0-&2L;[mt.hrn}NĜ{Q,76 Yni[ ɲ']5ye~d>j)޵V[䷢հ0ܑk|nJ|njD&5ݧ: 4poK~b/dt4XjN=ݣ>˝L8>.8 Ao1]dQڅ ءA!Gٛ bzh ^)i-7k}!xuˁ[<>=(WxQf?bTZð1ͰœB,XIgu?NbӨ:A :D., Br3f9CYM 0E#3/E>T\.6B[C4ar|` eldcu6W0?·"]WMvrl=Ÿ#1%[&RȥE'OWMVEZFy0\?k!6HTζBӉ 1$sIY,2h_LgYz.ycI=(=#agiڠL =r#͟[2 ;𙃇Y*ߔ{.λ6q5TUHQ9;F hhf$E'Z$ 5S^Lg8X┘61=;BS !-Y1P Ny f)kEPQTYKG>`E(쀪>CtxRT1Y-)C|d2$dH(.:TlKMx؁' Iz>_ Ƌ3#wi`KTv/XV[1U05w" " աv-+v{>]\RSH_ve<5uuH2n#I0ߦ+J'x}_MM;SFJh-1fʌOu;2N|+FzD, (e7LOǘڳ~noh܅e'ϤvyͭkrM]'oq/zN|& K"%;,2>*}gcuG(v== &t"ȣ> cX3A.Oe}9_[hNI*}6Y;#3`k<Qg-gH:4vvf?y.iAeo &~x{#9)02bDWĊ+nڷ\!ʅT*,~1ᛷҬֳFoTO "7,aK0iBUʑmc] <ƫ./ry!r˲eJs5ʫYO4\`rZCDUX^dVa*{gpԷDӱ1+}T0 5OS)4"\6Okyy]Kj.Y6SSKm/%Ȟ(wAܟƢֱ3[NO_# <;ʟQ.չ،EmD郛׃ػ!&;9wC&Q'!sEC۠{IZQR]ۿ ջ!$pxzMԁ; _t+O{U/jU]T;7!тi2|l c Hymz" ORVI~GyףԴ4fU %8WQW@d**wްk_%dۅ8A* {:ʑ/L.v4Ҡ0sοǮS%惲P<ao"w \fmig~;l)jO~9ࣽ%h@O]su|H `2b}1˒?{w ;cѥlin*T:n6PB;-/7KomPȲǞr!R@' S* (a?"w;vY !oU-$QY3x{@5+\rӼ5fuyHIQ/4Ԓ$/3LhӸPmlnCh5 G0>H" 7#:Y<_WNOӧ.Fh}%ڠPw FvMDf `s @8^C8GIl=JeH.Vc,HC!F;eMi3T$m\GX{禅&ߍvM,W- C`Ƶ b#}K]Dkn2W}!R``N)ZoGxY_v"L 1J;)zD (,suMiCaYU)#[tkBW) |v\ZbB'*3tnF>XO5H@EMv9&!&=Ұ<3hh n~bbB8&Uŕo=vÅ2}mr$#n]/Nh:6a5=T?j( J H<=,؃Tǔ "f~dmqQ/Ў2SoM(y kU~Q`IT'Ô/elR,g 3/Ɉ}ꔻ9O|b.]oI%-xQJ6`RΦt'(Xࠨ ~pruGΒB 1M>} ~+b 6?(J 홦$H oi1@c,yǷ{>Fuu{YcZAwZ9ry+/f +:/kk`eL4Pm*7: 50j"Pҝ_)]ӞKz+;dzUT+ނ#rv䦭k}_>]JFMnZ[J qƗA~auDŽT]6yҺEp }xCԸ*= )G=JԏnSI ˁo7o3X`F>F76iV:sKP12Lշ>}CQqy]kaiDtwzb/bE1]mK)mH4rlA,m bB8C~Ni`_C}BIeqi *xDH|a݆CIE~6F%Q*Z[vi_@@ j12k[%GhTEOq^K?'=eGm[1GȑךL6 2nZD'g{%LTAX( ʣU$C8I}}{o &d1*ZG?Y6~_$jfkYInZ)-PSVJ[$ډBjDJ Q& UzA?3 |ޢ=3ş'Uw0PtF8n>yh~JʅHU0H8e|͢@zrzI^~qՙGoBrv׽||f(^G&:]~\X;cdjvD_߾'vC-#VdGQk*[ӦC^;iN81겼Z\؆%,aK8ܽ]7fWtig *Bv+6ef_C[X QA_TύoRz_gw 61X7+G /^$tڟ>)ȴ-b'> e ]x|%yѤ!fwm^k54Ѵ']Wz)O=-9zH"@%<_&/=Es4Q.Ϗ#&mz H=oS ݐ𱼢me+## +I7BfȐh1cSa̽piL]RFx&7ȣD`& rhPX Ī| EX]y.y"rԇذgRkUcGaΚO9; 4ߌV >9[نE}~;H2_,E"é|^m ^?ib3u+|zˠ(ƽ + CE7R4Զ㻅⿲{unswuù;|dGT-'#ŨIȲlq_z2esl) .Ru/FB!FɐfsQ6$Ph e F$6vzgY@Rl SšgMON)CMCe(4}fMӆbݏp l8e.}×t$]J6AE(ע=_D$O SC >+(pa=XEZvS3P ^ٍ ɋ\c_/t'r@hyD*DУ_ñt[⡎yM$^u@ IJsR՗t)pǹf8SC6lzhmhRY2A9Be= Aut Q2X`嬬Or`9Oc*didulĈutZsnGjO<;w9*+CV!+$[8(0Jz!R;|I#]zJ!3۴:u/4myIǕGTreߨL#<fYQ1{&֫Pٞ!;Jum nQV(hF>3,==䮱:ve֋)xo$ӽE˥&גfe<&VD𕵾ϼWՑ^GqFm3Y<>KhO9G3ZcAr\[@Dp6_҉, ] ^%-WcxEƘk?.?5֣GݸqRPbH9@&'ҙ)EWU(T8%j{ ${ (7J8GwK2a+̼j~Xb pxE0R*;&/[xhM0Qyc:8Y0wPGҌgsD,x}qAasUYSPv!W:nWD巿ëB 7 \ޛ$ ?뭪Zv4Cfp6ĸ/ =]%Duz׷,;CmNd&,6)7.Ai f# 2ڤnVlހ9*^[C7{h8-Ckng&dx>hsw6_yvk\Α΢P,}$&VʴbY#״mxMgkۮKeȧ-W* U˩W4Ȇx5fGi1ur} F|Bu4nVY]"jqc? 5iE_ cI*c\,Q$Nis{"+('vW)1j,ʒЮ2* xIob ކ_${w5?ZEH/c0sRugJ>$^W =q$m?]عz#VP# һ\T!ĻÛBtjE %j Wv7cm anV@{朒m`T N#ahYZ͑Urs==(3ɮXPSǵ!UЩ4p'8窢IÇ`hW_i`|Ǒ-co?h~sz|EBSfybqdtLMZ=\K -\rd:6HWW\%yL%:Ǩ58 +X)kaj7@å"G!JS)+ cM(7+dc%vaP0ҵK ˦vwc]4i]1Gm-D2F¸^x wLH_r !wbʩ A;*H(t 9E%Iq:t!QÈ:ϬE`#KyA0 ^N\'O1PG/Atݿ }Il2;+g j2ft-uNyar__~9i!`2,y5ֆm𼔖.yUAaXx 4x9Jpglv0{bSC?Q"SJO6` gBq͏A>vQTȐ3ȵ:[Ʊ-V/Iݐo 6TgƧz1[SsǴ yyQ]wd4Vݣܝ8No 5ohInN{~}yeMZG~PV7߲-j0!IГ~wlJq 7z KR(PmҰ _:kJtAZ D٤qMn$j[!842FZJ\$6UV%QѴo9rz[$9t!=L8h3˟XqJz D7]3[3Jno(mwn3je rtcͪt.Pj %xdIJLXaj#sM|sc5w+E2>Y 8\qx\uMҲ]^^2:\W4,j SsbX,B$ ; |r_|qr5 $4!ᭉ $!vvp"[C1ק@[l%_\g/fc k5qJ6V( t0| 'eT P; ,d;G~ HRIrLL%pkk%n(./"9a,V@B>M\e[?ϾjrժT\e@c&H/g"qQx(U)vtLG?u(l#9w~;B&sbLiYu_yzBT]ա MQ2_Eb?|8Ɨ]CYYIoGvtǒ̸QeDfa&d+RcC|34ibD _7yt[TG/}#;|M$p"hh=]6q!C4}F5@Α?;t`NI,ig`LuC^aX ^ #/ZS ]: WaE@C7crj!i5d"PZQWI4~R1yU]}GԨD &C6!&om*b93yT߃&tzFB~n:pS_,% ʿGHzNMTp&d;`5 x[ّ+fθO5mᑫIii"}ǩ`27V%G6=W0m!->F+xKG;蟶%And*AxwSM?# 湖pi0_7[۶@O=%NяP] C7 ]s U@˛,LQ1d 98umm5qTq0W\1PF(5+.azra,IV#LJ#/_~xV,㣎,ǡ9-wbynB"$tp׻q`) lui~Zw!]haJuXο~;2g=1;ZIQTſ? C*mXABW#.]/[ 4l7}N[ɴzn_w6jd!T-:vaUU~,R}R@3SF؞{%l0y .`BTTY5z|:gTIs#9>sESPp0E}c@y5v*YM)nv F%|y;LBcrjs) E0L+K8Djׄ: vL7 ǻ&q |)h18Y]"!om7 QXz1lԵc||1?' I@9 RL3eCt=l1ԕFyޱ@&N?*mo},"$[޼/sI&t4A[@uzX֟QЭ%I쒠)@m,Uݐaz YBZtTnquBo$z#cb#f"Vp<@|s+: .,GZ܂0*r?bZCcIOФ&Y(S|O>t8piH14~Ts6hHv4k޷܆;0*̳5גmЯNB:R at`k aV *k"iyפ~c4YJr'٢3ق9_ 5"Au_XF.W!`XȄ.i2n4%\cdy/ss 2'%Vn<ě$=?Vc)Ap-?V]U.~wڔilβ'g]nҗ2}14ZͲE/}vw^ 8$ШTaŌL>HЍ[՟5_JWH< }} 1vva)Hĥ))s<[E&`u//3x] +1Alm‡\lJ2ҹmָ8˞Gya]47M=Dd:v)_LXdhLmuI$] vQ ^d U_hB*z! \7YL̘Ј:{o7ƎQ4#(:i(_o0(bzaE8~xFNA$E(aŏLq]q3l!hR6}Dϕ"~]TC|=FXqkMR `!Ņz\Q3'{miFɾuOԥFTNWwl3!\j$9-8Ԥ`),Cb NKbaR%}*|>0d,9,޻b0`œCyL5BĚͻyrH868,LSԱ_To(Y=sQ Z7q"utEFuo:Ή@fvOGhO؏x{k(S\L< 9i[v'v+$ =OOh3q9F; Խ.Qom@[?v_*f5.̻ČG>jRpMG2ˉJZr.O)$TFJza,Z/ԂJ.RSsqu !&[}st,y\ l調S'iƛB1j2 Fj.#US 'YIV?.*z Wy_r{|b,y8t`\L]M7A E:jQoXQ<QIn|rRصl==D4тzӨ}:V ImsI4L8(3Xz3d+.gڔ5b*G9lc!h5>@@lY&Qb)1("D2MHN>|V̨OF*ao\X2׸mS|ǂ1ue-҅/Qp)DO91>b=xD"C-n>&9Xrև+ >45m! /XMr' -esj# B|}1B;aX }JQ]룚ڝJ ]}{v/,bD\UG'aBz|,I>򰎁A1N,/VB55RgcJScfhK8%GFF8-B-hpp7&pa ԅBÍ._l !H7 )YyMjf84YteC_Y^&:^mRGm?l%6HSMu8{$vGj:0|#9Mnוo,yFۈ$~ֵXifrFSm\%;@٤lGD1Q2S":̿ ;O-7\8 endstream endobj 136 0 obj << /Length1 1787 /Length2 10443 /Length3 0 /Length 11575 /Filter /FlateDecode >> stream xڍT\.Lww3 Cw 3])!t]ҥ ҥt ry{}׺wZ3:هA[[jQvyp | Pbfևz8C6c1BPW pѦxij>88CtA^P0@ c1+¡ef3 CmA0X sB<|+8/7ŝn/z8t! c`&d`qsY ,7oCʞ ߄Gzz<_q `K50=;sPwe uK, X2g( Up{,[ǗQ %`?6_HAXG! W S^cq@+*a xA"^葩FL#xmAg巟Qռocÿ/سc9ߐ >r|wo\ ]^o+{ Ǧ!^z7y=]< _o l }-ZuwN$5ͼeCOc ]_ʥ,o(].5Gt JҝL64Q| 0HIí/p<0 [9(v!O`Xv3컊)x8/hܴD>3DyjIX%k 7_wd4E dMW#//Ye|!_wIseԽZ0OQR"[mRƐ&{z*fΥ }rikEg#7u Mk E"5Emœ~𕤩U Z+}NwW}eՙ5h gslסqw %bsSSnm{Z"6'K\ZK6jT'i9YmMV[5Xу$r5U9ŘOnZ=T>+EE'b,<3;â(Sa'JlF!jK~_e9P+c?+fV)|މD.9Hjܿw 5վhE(D"~_vۡ 3E L/YsAA.h_o#I#셆^ @ S u{1qt6.)7IDRG%W{򢛙:bCқ/=RSѫ9 A@d258E?Luw&쇷^|s6%c`ᰣ_xrP\w[or;Xu)ݿ&A.ͧ(Lw$Y1R?).HR[u ZOYįBYӹײ֋Mz>p13,"S< C5D82X >ap.Xx7oOC? Bq=.ӆ\nhC"b) 5wX=g *4=k 3tիx3A)SY¨f M^ћyg}s`f7ns9n̥%"ba#;WKw -O~@Z/z_56eD:ǥL0αL.DGٌ  SP+f$i u=gD,5 (=m/Nlp ZWq6{ o /M/Xuㆩ\gh5*`9Sĵ~5Y_ɆLM'l" &4Vaa4}}J)d$SI<\@ y$>)82Nz}4M+öH _s\ͳ`DzBt^ά۵:s+a3tʃN8lo- s)Uʩ1B8 pPMU(7jNƹ4~8YƉꋞ>͑biN:keuGG:)=7^H~ΑsilsN$# _pB[9ei<Yr@حMr'NAa|쟯$}_M"èky7Ӱ.(vY* DfsU\zf-ɫnu }L,{+ꦾ@]rym5Y^_"?["<9ݫ rP~)mYF$7ʗUţuZGFhQ46H'!Хqҽ)OW=&vJa5<H t$<Ռw{ۃw&lo]хr6qܰ⤨d'M%1C,Ӑ*t!0$+:}[ʯ^bV73cLn YCcl _:Lr+0a`%0;a>ZT蝉 ^r4Z6;U q[B:9aay>+G+L j8Җ+/JC\#$ĔȐ }Ct**/c{(G&=1UWdm8zũQ)[DGC$;B+YP~ y3Q*1C{˯_=JP3m&.fna#aHϭ.wKnz̍4/f8td: Ͱ'EI )/DٖoGa)cH=JM*>>Y@C@'jac'0DY7fx-:JUfqʏ!)f.Gj%VyXQtgqe-4ų$m>(j}6k)xD`miIvdDŇ$Ǹ 3.;kB%Ɔ8F)wC P3|V5ACxjrfLweV }7C+Q`F@fe%}b]$fi\D>d<bDoH=Pd[6Pě+w/e^(7I}Ͱ}|4$4R9 6vBk07ݏT./Ss1h 1ώyYM /MCcicgXsV":/`-u#^X. `-]OHvm.GT2jO縇׎.XYy ǔbx((CU-J;/[ #Topߣ":ܹzq600I 0 zJ d\~h\rYl gk"x'~lſ<%"/D?E 9"+WۍRV 󓵞y ^ϔB]Ӗ/qϧOD&4E^t)@ ;*)azOanu#ۃsߋM]qXpye.A<*VHAi9g-S#|Rj!*U55}㎐XZ:̱%\BHJ1N朊)=UN}FkqiF]%~c5vE}c;Ջ9B^[7g|8(P5y|ZR$t'l/:Ds&Gt^fSlckdkWՅZp.Ś3+#wId1ͬޱUgէ_s~CkǾ_}x?WVu@; ';rѯ#qqLe- Ɔ"n-i: "n=-d`v]E37'>E@.mWe oOY *Hg YgA׾YGlKb|1G]M+OԘsZ"\hbrS5|fjn,sc"n ˈJۀٺ/n\%0mliS0Y0'jy%mmP8u9+ ͋Xolhx@}{fD²SΎ\pmVOrWPosP~XX( [rLƵ7r}iҠuF^̙Bs_:K8si7zUoyV0 :OX|I3gêi5O}s84ẠQS>6?-w\sd|  /.bB,Xp&j'=*v}޳) n8y/NLfuΧl h3!TSZZ{g9 $ƞ$oTl5 U[1UhnL(\-7Ciz?$u_ĝ2xM¹~'ߚFގT35W)_x/rEʹN6^_GZ tVrf~:]:H7gYG$jײpd֮ljR1rNSAzt|Sz5-KoKb$A\h m6  ්Cў^) NƔ`Vְ oOc_'_,R6,]=f߹_?>U9M/W>8V(BwO9]W]ogsM5< s))lj_.[z&̲.ߤa^:V(ymdFT4~ח-yl5::^z>$)1@cZ%][9~N07/eaLd<M55Ci7v(H艎H Mb{~K:-͉)Et57f&hbRNƓJʸ^j1LW#6fkS\,k70->or vIUk!»[˓Cs 66aLػ}EkG'N ?}>/ B!eM2ɵ1Z-`(\)q[ &%v:'~uLc))4*Ojh fuP6vI5Q#%(̷Hx55] "tj 0AV$5L'wܺU cN."CkT*0WǶsr(Wd;p>ml=6f`î :xV'b}-̂Juבg)i ^I8C]pnpM}6&hNǽ~=hĩ,J1P0NAIZ=Bl܀>U*Fha&Ur]o)zS(dCkM駎ٚWCOǭ@91/"|qOqnsdl$,_ƊޚXβE 'Wx)dwFK}ƶB}KࡥLr7LggEªz$f*1‚LBQL>۝جWK_"<_:>/a4C)B~E oj 7_<1Y#&Ԏ:LqD$43دJ]Osy"2LBĆ ~d.:h#KEO?sAPej6̀ԏ-䊛%cPnT^;>k|c[6C=?z6E凛͢˽(4/\Rus'̜Q#AcaqV#Ku]S_ kU[zb`ON!VoʨmLeiSfä;>\m`~ygGuopQYD&N2ڠMr&~2{HY1*=H!$(rq}=Z5F0٦G:>BDO@]`o]CfPmoA~ ]*ZCO&y;,Oԛ&%5jreAfjm:U:RzC~bMC|jnN{o\B.8i|+ f~3&%tْyUքSK_5ÉYqteQL{vmbE絕z,;OvL/hsטEMQRXì:uig_|nN $2LF񎵕3']dX 5*%B  &O%޿5t-d r٘|.Î@IΩ2ſWJ0>#t\K{:m:mE#V.oNzU+/>4Ss&9Ѩ~jEA-R[̫I4  7eQT$KM(  KuBk)+YJ/CO jsƳ >.x-oOKW}xzXeV5P4DFRiI~y_dLr t4Qb{4lCј A4L:,DBoMٹ׵hǓϋ1t2b+֟ʽfIF0~اA沖8]8X\aU?Sq`ѽqNWbXh=iܛDpc 3s ~7oKU|2?(@i 4?,AJғFGptIZuה{^7y,dX]%7fsRIr.6r,Pa<YuSǍ)Cm9 A++{}Sfd[ɞ #XN;Z|w5wyi{9;:>`[?&G6H%:ejQJk *|gGbxQ^4lБ۸ vlQZ/95l5J6>0|¨Ӓ+p%7~/E%oB6T]'w!J ɿSWf+%P&|^oG8Ѳ. FX VKcMI!B5q1@VL KQA z+L^^JM {Yݸmkxubc.yk)|7g%x760{Sw-r'D1%Md$ >RfW?t_ͼL!|V*yw.ۋt}8O:%ͷ ORA5OGR(7}vwU} x$4r]Cɇ!UY)]SLWd!0$ܟ&5VL7τt  /Մ@])lfmU׎^8dѻW 8MSfU=)'cJ<)"QHk0Cs1ȓd=^fzsC>OK҃1Od'Q$<߂VsF(ܸzѧNup үԉ,lw`{W {]h˝.utHXз(>ZA/9?LL}< PA2X1%Eͻxe2w܈W&fQ/'RUhyujckeŢPGbm0mz[0*G>~3xYE_)cG1'@voYE'Yٴ'O~]s}m EudFvvAe?!!- Jqm_a%3X$͞uu ҶG;uwKMn)ak 4b  kmh+i37x)[ VQOB =MfR0w /..n' @԰ S`Ue 1$Jtan~б(732j2grEk脉Cb:-i{C T]@ux^L`E0Ed Z!n _0Bfwgf_SR| F~ejLdSe\]W?^P]jƒ~*rWJ+0!e{4Iqmuv ݛ:#K^7_n{qݩlQt E_QK\݁TFz]B ("6˽!pUj!1w(e@"L%7\B4d_l}IE_OԮ0D'-ɨfUсn A3-zDvcf7#z9n}>ŦK e+tx8 sq ~۠\S3ɜXjl0W_{f%OpnR9@"oâipC"5+"g+o8KKiɊd׼a d#w*lp) m Kaui8b0%^n렱%3,elb_纄EA4yr/3%T -^kyg9}X )dpBBr i_m/W8߻;CgK{le$i7$/.IO@+`L13F1 ň# ku2T/Ye0ⓖX.W4W'4hjlӟ9Wb: wMmA::)yS>^kg<1o*KsӱZ~#  Ls endstream endobj 138 0 obj << /Length1 1539 /Length2 8014 /Length3 0 /Length 9026 /Filter /FlateDecode >> stream xڍP\.C`:h`pww%kHw4;Dp#9{jW_uнPdYe`P76Nv' N [Avq0t=ɤݞaPJO!E e(`P+$bct̿>LN;@4lO'Z;4a`uss===]a.6"LO-@ v[~ P1wU;@\fi<  `듇; x:)PuC2Vˀwo@gsKK9XCU%v7/7V9귡+`nd'ss:st8B~P+I#;?) n !P+EX;gw&O"ln^>/ {YvQr?UsX?X^>`;矊F+lb'l~|{Ͽe:xetdX: x@f; Ca_>u_ {}cH 0FO?LGQo߄d?jsGOuw{2i k kfVwʻ?́8m@Vj7Kۿ\9@`5+Vqrpi,6#OGJC-aV'H\ΧQ{0=X\0~([sF'7+@~?@? >r|KwMOMv`/%,R0Ԯ&JܓmgLxnG7g52;xB\og^kqvђR"LHHU )>Upc1d'nLUjb= >2LdZ70}YnGu X|vK6q¹O=P'J*\#(~Kwf'צdOD=gPP>`_W"kezXv?vĆjP[|F3[eҲF!uhuC!b*+|` ҌM cɳ1[8|$t(@1QT߫RBi.mk{PwADGʶE/i͸.Zx1fz:N+<oFAQPN;DM. $W7c"nm\>kn'#eC4qijG`j61=I9N1rULS-Iz,!֦\wLŒx!nB/)ŞEZ=![n/~N2Nσply,>fٱzME4/kG6-v(1ks')LM.l^8-+y$BKfu#"ڜ٦cI6qݽC?g ' RWQV b]jP.ʕ0?!]^\0͡8,QY*utYk&(m ow-CCuS54?{-.g鏇a? %/G$5Ȝhl[WPqv;7M";.|W3fbG'ռ;r\vmȞkJ݉<.utb-!&R_uݝlj-bT3[9OnV-Zu!G#ۈGrƒ\EL^޲*׈|A6r㒌AonFp[V ,kdHT[þl ͉b{6QtLd CnnPb2G/nw>2r Np[j}\Ase#3Ւu;[cb!s:)F&sHoԷwIk0,F2ڻAMIQZwTaV+=Bx+?6_7 kN͊P|ҹy(o!< k-dvb}qj=nE!vVPbb 4S)3ZڂaC g϶lDDuio{0 r˙ovpkS=Xhɞ_w$qQ;3S_G*g /Ĺ+52HMԅvEdy!z@v\G̼&=]"%+@`'DvkKjgEDٻc~Ƥ^4󎈎c\;nmvȁԋ4gNƎ%{W~)uEivT*fH*aTcIކU.릳L|+T!P2Ҏ@UE هa%סӻXGd ֮kɘgނ/8?.j4ŋ 1J9^$xU}^3vޚcL_K_>6٥oL"!8^MDOBܽc9#϶mS<,YWRpSKpݨ^dĆY0YhL J$8ݾBN̠13$%mSkcSryƴYVBŞ0҄Fib7-l+} bo5M6(riEiM;r@o[%#\[|XTwY>;7B&&d\h</kp$E$["}h@9CDIxV?j lUn9 ] GF48!\VUΪ֊Ŏ{S M!mP%/˦B9y uyQlrjMy1}>='NݖzvQw> }%d%6>8;Д\ ^B{\>d~ܖBwxbgoLIՀ1zp׍h  bTf:31] RϻO}}-v6?sa$f^'uS O@gP}z>ʳYT2L)МtK;L%xERy]+Q2JFHh@9aǹo&nqVcPtR>Z{e劬>bd>fVe;(a*|<ƹ"+@xͮud9f@hr6Zr=72V\#WGe=<)+L:cQ]JQ,SoVڦWGO1-D\z>N? +ۼF sVTW$W[mZ47D8p{Wio^|Ob8-x^}0P#O2*uKwEFTOe_5zfcvfZv8fMNFyCyNacLSHI? aO PyLg]fk*ń _tU@Z4$-k.9il t1(ϭ] U2edN{=p@Vs pR_+{@1 <["6I`ԨGu$i[ǫ9M䌞W[| Kʄɻ9p/+!@ug$WT}仴"Ph^OVxn@cޗ1. ;47'}Z]Zx z -vJ(toBkEJώܜZO0VGw+%w)(il|(:'~o5ћ\ZmdLۖ$Cȅ4_fbHj\1[`U2Ũ#G_ nlm7k4}[7F @ gJbe4ch-ٖ/;9JҼsҩN_#j*:rL֭JOx0{F$^3`P4A4E]qw_>ciEt4zc139Iw.a\dBNUasTC{3j2VО^3I*:}o\s=լZz=Q+a ]$DlO3W1@ZxRqSeGOD7FhJ&$@:E0lx4MaK囲H4c&nV"qTף&>t {cՉ薮5][vf{9r4"S sZ̎:M<(%sĔiR2HcLNk >IUmscн@η@}s/˜rnoF|8>Ot$E'&xIse bյ=oQ?>pn>ݘ|b'iD|]9uL7y% 0#y6YOl􄩌 ߶}}chq\Lֵä|ǵ+W>7ߐCkzH߭7ܭysm#~sl(w;x3#dh\茔! ; Z-wG(Fr}YT$ViI9"p9WUO* ?SIޘ` [A]Ӱ>O_ITRgfKP(HINQ\]Ԅ8:bŸ>PEX2 NJjuky&G!67, K#@]wJ)택g}WЯ",+b;nӽb "}8 Z$B4G 68A5dWQ+X^Z8!j? ("+/t$pRVwZl ٕ_> 3⏶]1*9:m.l.8+6(&5X[Ui~ |@VRɌu MoNc8SkPs3o8t175-!pJ5ȹ_zGc_Lyt,) Go#H=>6vX=[YOOWBvo`)-$%m `%>x\Dh}3tldf~&W|mX5sZ\9ڑ!h4rT€Q:-8Z: Jv-5BUljm.|FH{pI ,\9AEKİ""oN! -/ƨ^t/v2}g=CE;$XDs4Jx?JҭAnS2֍FB‰͌gyODT}}A3-{ =^hwXt|RǡOBteGVsf]m[ϫD?hDx fnbѯ}v3fԜPf :uF\#Y%qK6&ԩQ5aLʜ4zq{ 8kԘB6H &'m^ cu*kMs:Y_dhO> `\McKo8"·{-k  Q1uf'|().;3ݔmJ.VT"sLh\h')!`^ )\1pc񴑥Iߗ"*M:`4|;HVyI8$%T{$gDB t&UѶ=z-[CC./ڸOyW(U59a?zBQrz/%JR+`rމͭtz1o,i6*UJąC<*z3i7 3EeY0J )B—mf8y0u% odiy$)u;~VmRz{=kvK=e! 4tX_cdA.Ɂ7(e;P˗$k7rd>Ssy/3q~e_,[{vp uê64پؾ6~kO !< ;A`1"ҫF*iIQrwFt ?=̶glEySxzAϠY|pGJYzfD<'P^GP*y^N _- DOq ~g%J]!`i 9.hK>gce -2!"S0Z[ɠpϼ\R‘0^gXc&1Cӥޙ͗֯B-U\[ \gĎ'Wv3mzc!CUfR c06 g鳄M1;=TOBG9/}?ENc!2.lwEgxhtb\/[zl(YڵUCxhl;#,' MWuQSƧ~H*bv_E]/U:|ڳ_ݤm62F^Ϲ~bE7Y |?L1aaag(c HV/fԐ$ʕ6 \JG2)*|;)WY{TN]oX띋 endstream endobj 140 0 obj << /Length1 1603 /Length2 8582 /Length3 0 /Length 9633 /Filter /FlateDecode >> stream xڍP.Cqhpww).%@ Rkq(E;ŭ] oq{Ͻgޛ$[֞0hpB 0[B][͋ :b0=@_0fT<<|AQ!Qnn/7ȿ !9+/-@=0^@\}APX6,!?; P:]`m:_!PWQ..oooN+N$ ;uh=^@[v/\`:<@V@L =``[;p2Vˀh<<@ g+؁ 5N`mh[yYa (h`ݝ;r!0!˃m_@\\`@@}\ lnӕK r*ma#BBc;+V+`k~0='0?0xx (hc&a7pÈ -[?˥mcde!>n7!!hZ_e W)`o`wcn-m?v!֣G[Z} q_ZWu-P+Ȁ=Dh 8EzjB<@삸G*'أ4Rl]+ww+_ Ð@? pq!P ^ >\rE YD\6F05Kx`ls5 `\0r!ćP\py%'1lZ\PbR ֦/;l^. h0 {XZ›c{\ba 5*+tR&yo<Ϩ-Zwۭ߈QSrJ<8!6w0y h^{*/کTż/ы6 )f`=CJBc%;}q9EJ<Fa _: ]^.2z2cR* F9ҢyfxU (pхdk&~­ĚF" wZgUQ>' n", gENǡBD8h?\,ޗ,TdeӞL\ջa?j yn EU_^@F⺗isn8䖈8 RrΪyBDe-+|~ AX`J y/]mkj9B8tIFc$H#aL.M̊H䅪ၔ OC9=K>JQ ~7N/p(# ػ-s.P=(bpx0~6h_ōư_O/wvV)]ob 4M -ude"}B=8(eߙGdpS<o;I"GBLtdiD7|uIB3+V\ǯkϊ%^̀TWp{ڧ'3ⱙbo%; ,#k-C-_r$T Rksxx1Տa1$N{?W0xo)=Y6?/͵BLE"t.o"Wmmu q]y&Gclyg[p ۂvej;YANX*d՚aw6y }Sc#=@MvKխ6=Jid-,6٦f2<T9&<`/qii3j[Z#yZ 1Q*?xVDb0F&Eqsy$蚠/TE6Op;d.fo"+åUWt``\\.L .L@3u-Y/3 y*6owrY`+n=w\̙Sp F+TQcm4eR_ъ%s$x2cʼ{M'PZ=hhȭx Ź]nRyĴ5}VD,DXP2{Aw$I8k?gϮ2EɞT58V}W ]9ЬѣSU~Uv~;>ӯ%xA&4P,wcыѳBٚ{iݓ/2>5d\D4v`h 'j6wSiu@N"}EBpCu3`wZ֤x<[5Iˑƫ!k5X|z0Vm"N\_aI2X]vͣwg oqL"MK\N,nNۄh+4)!mwdxk|8b\Gp_鼗 oLqx\~bbIꢪ20/ظ7PA~_>Xg@ZVs˅Ġe)+QτƻК"!)uY?lhƽ8rؗwl<*,jgԕM)bLz )SDcNyF]}TU]CYhMPO Q8\&r'HH;a?*yB؝>4 ˇ|, / AZJˡCgd)zxd}B-p82gJTۍNK|dX%w mpJ}+n5s<|hNMRX=!/\/'چkHpc7 2(4݃XC;i%дaD@b:Z`=<-^oL76^?&WH /#;WVNF( g$V/JBir䓍D[K3yn3$)_6j̇7UZx2/hlv|tEB#vy o*q+]Eo;5[1t̸͚Ԙ|QUll%J-`m} x"wGf6/&>e0U #˸&Ni.8tIua B<*G >;l!Vd;JK!!ݻu!j_Kh5#jN >R>篹k%;B_mjAފ7O_A$\(=źn 7[`bgXZлJs%1)UhdOn=rK݈?q`iVV}kukMcػN^mcwRO>bnjؼ_lCa&*Nozlnk|&!/sї1AʱO!pFX{ɋ7uG I6m:i%14k. 2^E%89% na Q4J-==+iyNeK 9~AA퀤LDD*GXxKQ|P-`r?0Bـ$gKъ6L4B`vW3Tx{Ř)R4|0fh $ih-(VRŀ BxdoqDvG.OI+;R fnt:Rdfp^OZ V]b'u׆:EWB]N.uxXO|Al4>`2`|ř_s<~'< dzڱQăvm;ۺ|!mk(sP)=#Wj[p%њN͋=T3h,PkH_<(NUŁ(!'`ia7 'U2ņ v .:%IA!UhMc5jD$U:{Uå+ԐM1^zXhvߎer/S{1žnʌABvyndD626,6C{*%׺ I1Qh}f1m޻;{k$vDaZ,7|NLyam"Neyĩɚ\`oɩmӸ>ٲu'1pFiˁ~I%0kABKx:]W[=;9{!"jТH3*-L(WQ/v~gӂ1okCYl!aZMjm/X+߽!<운_ 1Ƚ'*3AG=~Fu{R18 \ ^I\lJ鱵Hvs1Z䏖-~Zjc#'^9L8a(JhZBPg_-m ohj6'u>PtSl"3hludA9m&`-UVΗ+"ā^8232lX?޾|e7VyQY}7#B]8ɴV,ފ{#?"9mdp^'f\ SOv0zrg+@qjJ0mF۠>s?6ck8JupfhōypOݬ/oP:]m:ïBo2W-(YK(l9zH>;B -h7:@{Ks~%>O'J9~psE;~Aemv^%V-iz G>dQR&yԦ͖UEvKԼo'^٥0QIILN~w=yBRЊ9pBz${~@)$J|S~MBk٘Ƌd(\z!fNORbBSpBy2z Fyz$ߪh7˻28 $sQ'I:T-#d*o i {*/h.oy{==ԥY:.JӐㅎ.֫ 'r8Dic OӪ/UTǟjuVG^|,>a71׵.<B8r6Qwz*b$:E|~X5n6V<Ētpt*5?ިc}1  d!kpgd88_h.gi͔7fdP3YUI1¼YwQvhO |r҅ AX^?nY _nRItYffW+zzwOߠ-ZGQ]wp3t-HҞ/XEUI$-0]HŤP^$kH.yZ՟ q7(FeP*K젘Z&G @\bW(ʚ;O103T` OLs*X=6-Y6[Y/w*գxf6Old<:FwO!" ք[{*[OۓHJ{/᛻$l „;*X*ogᑐ&hom5ћ\tHLzPr~uixP? R,;YZ  M!<jCM=-u.1}nf> ¹2΁tB9Į Rj^vƛ\^rOkS)*_ZPf^Cc؛ƚ$V!@*r8f[TVaeTS][/%[t%9iƎ6 ^8{JF7ó2/|+mHSKx_@Çf;#V;4J&R3d7"/E4h~Jco_^ĵ9|\:ԒpAjRD9'dXBia:jɞ=i=ɯc?΀tZweۖyl-,ڏ1KZR? վԲ[ؠˢ^|zk).zmz:P܆P5̀"«֫zՌ)l\^t<0Gw)B *[ʀEn mӁ{9A :́ud%J$#թгܚغ'K_%QBFj10pn f|zn a Ztq/B"fvۦO3ÏfDK"IJHbZEܒZZ qWp] ݇_%8S,TZ[:}Z 1l5I3-fSiО_ϾU)@y\F׀bi#+:g]w(ȓйݠ,ԕyMG$*+0;S.vS1'WΞT EPŗot?j;\EezP&"*wEo\xA\UGҡ mFLjAym< 7p]8o7mƆJ+B5,~a|Ucl0dNƶ MLQx3 QYaBw% JkCO?T3Vа_!VGD-C3sb"ЫBOu˟!5 |`yAgk4 O'B>[OdnIʻ;=u!x.T&.&)&Cbۭ;%vuw1e{he:U[׋'7q>uoRĵZF*m=ѝn~Ii e+ƙ. N ЎFJ#b{-(\oѓJ Dk%-7MV܎f??3rRL'XEFͮ6 =O12iyOg}KfLYR[HQ芓f0h4K 0/6 CU}AsA'PNRNd<|"v[4lyc˰{ :%ՉT( 7VDx^p@H_ܖ;*OwPnR^LUbs19a# \̏DXgF2/~ZG.Bgܕݢ~qYýCi!|F$*7157 fs5R[5O:#i#o \>ER8%p 5M| ~8,:&QAړiDqzKeBۙ|FGM+2e/Qp7˽!CO$ endstream endobj 142 0 obj << /Length1 1357 /Length2 5945 /Length3 0 /Length 6875 /Filter /FlateDecode >> stream xڍWTlS@$T1:6QBc66CB@B 4P@N}w9=Ͽ{LHD"B`a,@T @@9#ZP^p$BP0'SqfH@ %eR @!% P]$ETCz`Qpg4.˿^(,##%Cv2B!n3$CcW{ #QΊ|_8` |`_ !ߍ S.p?b3p789x#a(.7LG`C1c k40 Bp8`#M}a4- Bܼ8q.T1@p՝@{ {~u(+ nG5; U:⦎VWG8:jCeQ-s HJZ0P_ͱJ/1@ ,P{A|`4QG8 p9GljaNͣ <0[Ho1UWUH _H`1(_UA8!2M_}޿g,C$0I/]7t?vsZ; Wo4HijCW#?:h*g h["3Fz=(!0:G *4L"KTBA X ܊q7 ?GCG7"$pB(~S\ {~ )Bh{0 A)f&Pmǵ*7|ƀVgPOIjQU^_{4˟gɦ#/)6UE~S\y%32ԕC-Mm\HwV ]쇨eI=ʳQxq`C Z= kyCl[ bK'~^\L}W]K׽>x!c'T߲1j]n,/3!N\bv{){ xޜ"FTQ Mr}ŁŕA EjRi۾b#ȴ-|Z8w6rS"gɱ/$u=٬J]*R쏦YX\ژ}ВJTEO^Nkn'UH~Y?]-V+H?<5+*ɐEɖ I+j"y X~%]y6Amo^^gHxF`^UH!5}R@AUxvV#kR%+HDᆩ(L۾ZHې_X^=Qy5\gBSV{x:zQU+^4Fa VV1a%?OiMv\u3@`%J;x\ZNu^W? KJTwBZ\Π]=s B)E;K3VR&,7S*EW׭<_!\ȥ'{12{{Nq~U;{/ˈ هI1u}.T. ]5͔H9vz/[h"/I:]H";mvX=L^hf\ .\p:V+zmLR1N9Ujp;[),x,w5!stjh\󺘹|mktI:5J;o^"-cJ5yZmߨn>$IOxLRz\G"nr$4B0$o5 !,*h2U\;"p:v17H`duu%K`Pv "sޛ] 6|g @"tQ:糙X  CgL` *n1L)& Iv%[w"֮`vrxL=1#J}fFG3oK4ǠkZyw}|mؘHhcwNE=Ԗq9aA}e#l-}DH1t{fE1SZN6_f9} dzD.HGKͰseQˢ"6f|.˨Kҕ*cWwؗV:y {) jZ\ʎ3]uMA}*`0X=xْ3k۫=ݲ+A_{:29^8l\3fffrzAW]&6*$ V>g]p_tO/*uu0V~jeʷVן!+%e NλpfSI#;TTp6p#uRaގ NbUjx @O?eHiƶܤWM<)(ِJ!|rї#U\}Bfuy#i!X}yv7ъntHtu:_Z__'_ȖfoF%o`I'sS}wJ0&[ 6m--5^?XLJiar@^ R-4,2f;Ӿ;@ʩ8,}Uڒux\n T:>Oms< m.wlrlH)biK k U{^t{jec%QAu+ f0Dտ,&K 0XR滏L߱l,8ڜbpVgWrS8T m I35UX6?*'QPByΔ;[E:W1(Tԗr]^@/ݰ6qV'tk'LYY>+ۓ$ ԕK]vccg J9 Ɋeh&W'4To㍩a}Eeq7P: 3,9Z-RUr&x348uxTk\+ife#^6Y0FVr%" ;aýqם"15KR*o#m1T(d Rtv~ȉPu1WC)͊7LLdFh.b:mwuj$".㒉ğvM(GeŔggcIޡ6o^9|H)M GCS+Ff*dUvV@Ny셼2GKEѮwl '_|"2')*W6XNWÚd1nzn CXK~)vWܸTlOH9{ g'/ۏ)ƅXӍp iNh wWxž{Ծ$bv[3zۤSݟTxE?,z&?hepD촎2ҋu%'}L> T'T98c7SQ`+ħn0vy}7'4!,} S4%=IũS} _j@{p㐋fvkpCِȠ8o[/ Ր=N0Y9;q=MJ$|.{١>5^}l G7c.ۓ}A Cjb6a9}Ssi* KToOŎJp*Vː{kG>(1[cgws7#ԷK/\XbXއZ oj֎ r6(TTT!+s\rzv<pZiRrг|P<:ewm [/`#(=/Ŗo=4cx۞z :dLdNqNqp85zSM!R-Ya\6Ƚ)KM7fA8p(3zgKk޹d̷g5">& rlZ @SZn۲=Mo/Vzcps s{wdL,g.֤G6x~-ܹ&zXav|ՒQ+{C9HD*a{VDMA#CO"-%&X6oLWWPGJf3*Tk@JpN5ϲt;_T,'J5T>|ޛԞn矇 ~#S~ۀv-ѼnۛwD6a:oU So¶D4Ts&}B+<%و1x@Pl@gF!tⶳEk5Q_4+)>#9SLyGXf$q¯ګ,h06#u5JXCf4Dtf[\G&Nsw`7;Mʫ33S!V #7P[u</-LҞuU\Aji_!6td_p:aܞmxV59/yi cLVUMx]ndk1&7A {3aOy`@`7EB\Qܓ9|5jړU)X"W4Ͱ/C9 endstream endobj 144 0 obj << /Length1 1435 /Length2 6467 /Length3 0 /Length 7439 /Filter /FlateDecode >> stream xڍvTZ-MЋ%4'{ޤ @ !"(MH"E"E)R*M{oVJ{f̙=gELL BpbqPTKs X±>4JX8G48!B$ 6DcP? PF}hL #(BeEUp,E 8w8p" 4Cp\Bp0 8#ƺ) 8w) 4" >`3+ G|Q.p,p6LxG16c jq+ (*r"Z(reA~Pԙ`;q(PK%Wu>0,Ax+ 5Q.h$~姁a[n' Y"P.Jpŀ,Po__`<`_1$L?Ac!W88/<ngO<&geOЖ 悌5l4E~JM ċI$@DB(KX;1W|uQhd w~u_;X8Pہ0[]o!G7+?X(OЫ/}C4aPmj3p/Y]0(7\"G w1F`5`^ `qy SpHM k$eP, !1tV0$B.@By!@W4R@Yك 1@y]q?&$1?҄b ޸2"aQ4]WwTr-+ ,XeDZGB/§{=m_5wU&Oo^SD'48&~\h ^~7tUS\e1;'f=\o_9Z|퀪β &/dN>[)s~2K(̸@77Ę3pέ$Y,H<8 \§͖tǫx4=©a;ߢ/-Dڡs7Ir/IyfךzQiOOEoW`HN9ݷ7\e5xOʪμ4'î{-{ {[i[{-'DmBEk:!/˃(mI3)QwP$9W`#w-Y-^:Dq UEGg=Ѱ+(形d䴑L-\EiNkSA; f4Ti}ʩaR:MII#+^9">M&t=RBZyIL~uS[n,\Kl <<6G9Yzʲ >~$q2t0vmr<\4@Cc]*1Ce~ڶ5ÓYLz2a&U'*?+7%G꧘&SuⶼN.pr] |'{+A $WG-*.ئT%=_WJA-u,BuMO&8ܬgsgi@4Skn}3az`=g8M!%w_¬1JQ?ժfvwںun*I϶뜧G#Jmeͫ"Rv6yV: RIw>J~j( 2_KW~Q nMkcx_yJ,/bKF|aIيpa0^H:Si :b.]cv(u^ *2W"BfҞ?zb#-iFTzWS&VBnwxԪt9lVȗhd-ݶ&5:z=?^qn"+Ch5_Bqi~'<ٗAݨ{\xuF3=ч&HR8K2#è;_FZV)maլ]-ڐ ?܋^5 @I{N/ 23=~% 67u߲L/5z |c[uqpDRwA=maƽ^Dv 1]60z{lю)' D+% #G^;iyk@Xn|$VYu%I aZ{QCCO7yc.'L]*KlyP> hy} ||kol) \]nZtW޼1%J{ {@˧ 9t*]6>#Qbxa)zP׵nU C卂 V7К}oq` a \:B:Tם><匔dx`z5Ŷ/dG"j1T>A˽Uwe>l?Ѹa<? kb:HJf ecM :o[?65 ,vhw tT}$+sؓ1o2.LOuTkQ[oŇ;-GjK2}I&djMUWt/_$:?>FfhrMbpo8%8>OB7#w{9R;0mN'֝y>:GPr'6DnD+fjcxLɽIȨ_ѐ}sYbod Z<Ɣ>״1^q,2%ޑdbPiG +B0K187O*|ɲqf5#7e%"7Gm=2/Ԛi^n,H=6i^Aܛʎ 9ޱ$E,,Dq7v/Wu͚OL޹Xo+ͬȾ0"ss4Rj՚Dyś#^tSt5ߌ%r +&*t2j>S78/<W1X:6D ' :>&/eZ[(J7w:r=V|4̷!V磊+D~[JXSβ6˚:(r{+yFBݜ\M9tAq,,~d4U_v?!U ^ubYF>=3JHm_Bh֤ϣ.6*B9='C:|{э7mte ~M SK]QѧPe'P,4?wsE]cIRe=G]^bsLV3K HZsӢe}Ҁlg1Ίs胏.וbgEwM-S+ǥ1I xQC _j"Q>g~urat*7VΑʥw͵՝5lȎ8X~:5[IQROG}9&U785wu;Y%D!WL7}R4*M!W >ocn~ gs.2!v_Aȯ>-eT~Rew3FFg>%QUocw89fNmq*/短&h'Vl/P8MGL0%.?dW?~U.G=N[5xE{ǵ&.W..[G uxX!N}EFΘOλ`Rխêk]_mX^tt\~f^tMZ "#ߡHzJ&qڨ-B,u߳41~)9r6@h :c=Df/ LvҰOc<=xYJi&? 򪭻U5|UeԔk;@pE';"1k㪍ĭ:E~;~קV`&+8Qh)l8baȳ yq>E|dĚWE .UM [@m]f"$Ҝ~+g r[Q+u}‚ +>>료U(Ū|F8ne  ^iMp~_ a|Es4dx%Fe3OGh+\mV[:R":8uV`\!^aoj$I^< n/yTLe|(LHeqoGiBAI|meJTj\< ob ײ͇$,5Xt?Xᛦ1H^ xاgCP]Y#Og)~ƉXY@ ȏ䬢WyL R.QL&ޢՍ;}K20nvUKR7&CKF%zS=\ o7s#]0DK9xeɱm{Q 5.rǻٌ% AVÅM6'zNH$_GgMief.wP$mx£säm+]ƻ-z^lk M?]w\2oNSk6AyL3Eg9~~Fp|qK rRM#ȱ/mig=c/ӂ"#&$ B T٧r\ee=A3D1=iNj,1Gio¸g9[UHQDהڙw`j?뮹 sP9&W^RV%rBL!SjA4+,Yq-- ],XXDy>,] }6|?aWv4_Vft)4H<ݜ\V%Q3H2'kP8 ,7]dh"5>ZD?u¡6լ KO}V"-ԏFWz3}MXUө!b gR('|So](Ubv[@mxeˋFTZdSnR6TcY3Invل%']UoWMɜL^rlmLws_nT1ݣ {{k<}y` =~"J&-m/Cxq޹-Dru~b3$م7 [>$c)ai腘{^!1Mzl%=6N>_sȪLl ՌoX1v.8C9J 0I"# rTuJ3u-b:T2|oH;Ӌ^@ a3J7jEθs9vVG0rgk<>zh>]q3LI,H*tJe&MsSnbo}۰xG T ?׻ 9e|\;gh^Vã"=:ta bpZ; nI$1҇67hw}9 [?5zӨ.4:d&L m";[\eJ߷wC:w{f1'ȟR0֊e-gjqZsˈ 7YKL]Vٟ2\YeL2YH{pʘgO@!΃v ִ WAmz7Y3ȴA0j$zN=\_)O0xZY_jݐKL0ۇ^/}eBbh+Djqo. }CU3 8KX]G g$;u;Q"ˊDT^$\s*M> stream xڍTk6LKHw1ttJt0ҭtwww zk}ߚ׾i(XDL@Rvg +@\A΁LCv%E9: A2 cg3;@yvv9 $]fVL#ngt~#ޔe9M!cgKsFSc),XmX-^30ΖUd.@1Vd%/#, N.3#97@MVde,3Y @`ogcSS;[{cb0ۀJRc/Cc'gcWcɳR*l!ۯ0ϗ, 1A'v>ߺZC ^3_-سi@. Y-E,@nvvv^~ Z a-~`lzCr2v]@>^*@`C,'v?`I[fvMGJMKCwUٹX8y, ;/;(࿫`Wbn[OO`;3cAn?Erhm6} [_2VyD!6Dd v6*5~- RszP,@v=o*;$vqp=G^54f0bxn`nk6_߈ H~f@@f|g<6? | >>>'r>'r>'r>9ygSGW<?LfLo*EXvFhvަ2x-8ܢHf|x%<Љ%I)HEhS;{xՉxc"z?8xkX6B:)c߸uK, VA/dֈ (3ɚ!Dpf!Ed:uG{"gB9襳ssLéPkxKlW5 $>玢Z1zB6XȨ&"e5w&NJ '%j4s'Nچrg,ZvYWnmR}wBǾ%ui{Y262HlwIOi?FndLV#x+')*6|.)dP/3DwyO@$)e Ɉ/Z&2tF1 "4vNWr{I:"LdJrʭ^b!{BG%Up-VJf@}Q=2[@&T } jEA:|{MzQ^uEt1qIrJ%Gfa"tZIV y} ^dC|ZL;.D,1a+ 9Z{)'aXkAf1&}>̘?<\5Эyue7A@Aт^ :b*<w$,,=\p,V&ݪu+F?CDUܩ$k**֢O9JÀP8tp`œ#!{*XjŶ)u-@j BpXrO L(FΫͺVmڪԥ8Ub~Pu}moAj$Z:O:u_#jA^Pq8G<SйDtfbq7uk@sG>C1[??3 [#۸^%7ϙF#S4<o۝b 9y&B(2T(us{G87b=!{0m僽бu<ѶH(C`}C2j"Mw2:o*.\hN ӥP P` qCC[RiXjT_7oFŒ;\ uj w'X?,NNǾT  JA K^Z}ti+M {u%t%..rl%e[d@5G23WGxkEjdi`HxdgFzSC f>7QM/&y5HX|0wKfV\M۠Kiffd0;?]lj}Nz*uC}O]mgwJM,7;B5GwKʩ'uĽU p?h-cv q6:=qH o!=Xn_t^lGl9"bN޹OoK -Bo@?Z*Cjѷ E771\JqAE 8dfF;,໊57xᵟZ[5q~:EWJ "kRKn݈d Z<"L!%+5}\A0c!ҀV:cL,&􇚹bv RHߺ ĆME>SO:,v,:>%HM!HFVMPD;Hjȹ/˶+:(4YQZ|lܑ}txHz+/:,mBpB迀./tC*Ȩ5:h#7C. t,3',J};Oyx<Mήt@DYe z"6#f[pƮ*En\L‘\V)C_Z $k~1j*O@#yo&1˝^& *јsVC;izqQW|^aBr蒁o?K4yI.%"_;߹^R& Ls=cɸ;~6N+deceH]3[}b5~^ BѢbJ]$<[LLE4p6 J;[>UߤJ`iM;ռ v\w]7{T4{{m_?rfv mf+6a!2dYE[Q"QV} Iԟhv~=YO;\Cz[_8jmXߥ(rа%]V\~"pPETq3G]#iO琂n?1VlI6N/ !M!hM\{m΍֜R,`WRO\A1}lYHΧL[~)Yr˴p'- ~Gvn LsĝΉk8 QM* \Ias6nhUV}h)tYZ\3d dI>K hy;j0"(̿)P0Q)<ۛ~S\eVwf&/Sy"v36cw@ڃl}(f|K}hq0L>68́%#9amFcJ^׈0 > O+ehQDmڥM (Nr4ݳج_A( pk?-)vJu{F&%?l#Yܡ #3J'$yii.>e@QK\SsZ  1j ?B iȻx! 6BbλkQ7[%6( ybJIod +/y]?@5}f7'fLg%B_MQIKg *X9:@eC<e!:>j>4$3 jÂJfS,mѮw̴"}NҀSqe3yL1N!T$ˋV֖JRbXOzEѮ4tzL%V_GҋdqLC`LS:^; ʂ_9mLh\a.{DJ| '!LݍHGSo2PǙ%˓L! Ǿ4;tvì^ 4̣5X ʽąVIR5+qDpH߽5ӎE;?RJ)}I`U h]b Wüv3xqn14tOt1]V..֋EԦR-UJ7; 'S i@ɥD7M[_pn#U=i§5r%܋".⅒`a;ZtP|T-K9`ӤnTs8R"IT׌|EzVNӨ+f$/Bو> ˌNMOܓ*ٔt|U_aYY|b B'IN|\V~5a_~Ie-uP]P Hg{ )pxR-p|KLV|@7fچu>|&~[nMy˾mU!bO$k\ߥ>,d;D솒b-#`y'_R^L·پ*\[)Ǣ3Ns<,%*,8&WF(Ec85 `@\ ꩥڼ)GB9b{FSSxYdLSnn1E ;^'C˛fHEI삱t#_S9mg)nGda(}*3#)xk GF:ے#~B Ji8>rţ Tsw"YRFa8<^.*tq?KSN#Hx%5AQ#{[L>{᫆2:bޣ/!H``Th%iݷ6m7KR]=l~?=m9;ikQ b^D?yu6!ֺ2jb7}s縅vsAd$tCIo\tK~Pt.d;Jkw%IIm▼/{y#er_~l52 ׭JKVND&g=O@gGxڡ;t*Fp3zfqoTs!+Ca~Z/rQ$S0*pie-370#yAvn&5yEqqR(O=G[=._K^c+OnгC> ̤U>{tb'cuCZq:3=J )_h3Ék6{#hK^E'񲆋:֖g%' @OtRQTc"Q-p?A EZ%#mP^&їҬ%ro q:%1sl{M0HL;'\ǃnÀ,Qj\jq Ð*7Jۤ>hvNuL8TUmI<F D1_f H~EId#knR9clZRh?-LR^}j2H{ 5bYDplb*6HV-cIzgaޡؔ,P'h>1#/jBѴ5v.6D$!PdhaTjOk,:A=DK.{+h\{{'0Y^X> 8ȴN tbQuH0-E0ўT!K6NƕG/)<ɻ-y0. S]G8f|4LLfDpB-ýe')c+r{N {w)+ҕU QΈmOTC mlRGRXw| {WD)KNOR #t;eX|&1DfNhe3O:j[7n=\l |,4%XEFQ,\4o7,¯׶0/yqPѫ_%baq􄢃4StI5)\'FtdtJ EMf`3MUWNҪ@8V活Q o;9&X̧X1UGVTDʀH?nՌ@ :z/` qF_Q~,(!M38].V,~,xi_tkijΝjRqhtB\!hA2ǝoDڣhla6JMAǜrUnɴʏ%w+ҩ~HXV^7 U_ ʓ[,7;w}^$2oh|8txtbx\Iq߷{jK~9SIW؁]W;#{qB[4pњ@se z9?,: JˋT,j+i8=Uz݅y.< .J*aJAkp{axYPZ[a% GF"~UIkky>)Ff+\lұ:@#{|A"jIqjwV̽ fBa?ƣ'he3SLL5\1U'Z-> `&n(*g\n,%W~S[{*hM;X|ܙ8q_6*ҴC l)CKR6,5ܤaڄ9A7divluSkc&2u9H r2b QʇoHawakQ+bv XAt 6p񉖜㩤ߋ{%;y0aڸ?uu7 PN[W7bӤw6UhnY"!)TC[h@BE6**6<4a2ƞuA" YlO|ÚQ:鞳62cªѰ 1S>噳w .̘j璷vo)3Sk;J(z8&L0#2+32 "=Jf#^zY/05YVuaQh=WDBԯfB[T+F\,J) P&e Olu1~x=+4qeRJw,! AOD ÍfzF3q;V?fF"g&͵aA< G M,V0?~XUO-IYm:)nv͡ dO:}\hioӒH'c7$  ı!cl +߷X;&D{wJK8&~cnbb{ZܙdIQ*L y+P?6{5S$;G n4`S+1U`a*D]BݰJ9}فz6gqzrL0ၘR$? (`رuFmD@6iqW9fa_vb++^Ҿozlsy9tfQ17@Nh)a*,AܹƳ:P_ɰ OU`\.i}q}ѸAFي'N> stream xڌveTٲ-Ƃ;wCpw'N>o00jUͲ>*2uFQsGS#+ @\Q]AC†@EafAZ;:FhILrvVv++7  ]&E&J ИXyy:X8Mܬf&vuG3krsscfd2wertexZYԀ@9w%{?1!P4]V;Zy t*+mOyLߎ:lbfhdm` ܼ& M\AMyNʁoѯg[NQxǓ'2n%ER<"P2ӖW 3B&A@fe 9/㑸Y.$z#v CgeBʢjxZ^_!2v|0G%XlB"3zgR˽Gl>}0_C !ViJ[=˪K^$daY2%RЅ[#ޟYBjlN6^Sh;]R gIyO>whל Go=&)>* DRF/iL[Ʉ߿%Iq%5>ϧ}uDA ҐӪ<@?2 B@*K˛o-`HJitxP/ ~0xW;aZq>\t1c DR0M`f '_Wsr24lè ֓ 9p}`o4ޝPB_2~2_~gO`}c<5͢CX2~qDG| ^"UyQ8SĄ XÏK?s+h5ʯqeT`f0s3Džy+&'N0nB;afTX(sCcbg_~eNӟ7V a{<KپkK _d z5 澏0S3s@ݝÁzMFR9Nu9coӝܒ?E3e &p/ L/$'g0ft5~+|,Rd]T:Gӎc*J@BȄbנk8f ƃAw%lQ=1Ł;|7zL,tkG,h|Lyx|6^G=1~PLUy_XThq(_9 d*e>sI\d] -.-Akwub)bz~YiۍRW['׊>NQqY.̅]V(.zsϨQ7 ,a tgᤄr*&NA+ \t`,RNUîg?80]n$eM4*1W='˲&Yz4ZVUm3@b:ʮJ(_a"K))- u> LZUS)> =+ű>0nG>pVZGv~JƢZY݇&Q:y,B_Kf:?U04H<4z/*7eU>]mūX m[Iq7jA9#dޡ).>y̒>5p<*}r6ٜx٢7ѣ>qUtgMЗマ!:nf#EJ<^s-NYO/Z?ٰ9ˤDFݱ8*],1Y2Gc}ثwMjU2{̸zGf`hfq! A$}*?ɊBwu5pIwv>o*Vp0VQ~TKI^3QX҉b5%@<`)Mz$;&b~Xn)oj[G;[B*傭rTQ ¨d_q_Vsʸ!]̩'N'*ZiWaJ5 XWЋ W7*x~iJ`_gC! ^]d!  /l= Kd[ʕ0jWDk)-#\ۥ X63#\뢗%Q t˂I>ZG7@|9Xe3,/!gi9va韯#D\̯>sY%<%J_l;e/4u0$iv;̊W&b/S{NJ=ckRa;&l oy2=j(?/iOfCwQSd8&+ 3X-{IY;SVdIݮ&Ns$J!Vd݅Us/̯롳F0'(iT-67~ BkL8W^0$(ьjC4CwVqa9}]򩜝 t+f;`WR7DPpI|8RǧkD)໼6"*q9P\M#f>k{CȳG޽ NőJ#33Vk08Qx$HVWJX02k>2 HN4Nf˾&?;6ov%") fBLF%~nC³שz6aQ%2!~Utt9LHTA )ǎFկQ7Ѹ%HuM/.3 T=Eoy4{d3Tx!! M*mل9 >Ɛ^ݒWݞdxRG>%#ބzfCqw Yە(=_5D8ʃIyr㌏N~uAtP/f=YK#5V6ȺI&#,8WvH|a?R9F"_)_3QӏGQ+\]RKg`B/6uBGx8VWHOo1\ +KӋ꣔sT*WiUY/CD|P̻,?e^hum+{/ū왕o ˼`E2b~"Jg4yҵI>+*hK-Y,|`F3 bﳌ`cf^'Z h^D[w\aLߴܼkqlt^>if誜=oKagAvETmZLbqHRX5t[ɨfu5]ꙵIˁ㞼f̍Sמ| a_Xœ cLPJ`>1 *LPF% !x|x-h:%^~(B ?8j .$Ϯ7i;h᯸Ǹ߁쐮,#lVHY -nXmJF72ZETOo:W!\qiR6z -\:Da{S8.XĶy[ 7(rLKn~+wO`#-]g̤b1p1TvfT\9gĮ̏b 5օ|Z>=Bh^(E mrBCƻ Sw$+ݲ]v֖n0C|՞c7xiEasj)K֎( XU5WcflFB#6wo _ں9ϔ 堾-Vn8~[x>:!zHjHW#cu; G^(OsVGu>_FA.[ A[Sr%ݱs&ws^*GjI[`t䁂@E(Jo#F&{OY1!K<|4U 2TuR0RXp[xijWr!~3c9+wP{YyO?=IM'͊O$e, /_-;8ֹX0t92fBfOTw7ihu5̧q[~Mut)Fs{6;Yl%D*5RnC 3m},|_S_1XP$2Z T 4Ha:/BV;̑:GsQ^7 CZaǷ̠S)$>io"᫨hI/3:.OJ4={j $i/Db(/-xr񇪕HH|#&_ֈV<;s}I˝uap=Zq❶g?O޹T8S?u͊_&b)ͬ^uj6-!cjf\ݿC5Tv[>ݔgPFe;70k+w}!׭6 cif(Qy!kZF<`X7ȥv f4-~lW)hbdBxeKW|bݘOKp5yV#^GpϮVa>-a+ڬՎKT?[bY;lÍX%H >>JPn@ӋrU )aD7B'Y7MiqPy84x&ݜsIC*'RN?6Ki2ŗuaj,bxvm,"#BrjCV+γފa"%lRm ocE&[4~n"qo1 PC^ġX.O^>+nu~f=3e1bi:ťu ^r dGؐ6ZNb$ѵjd1Ah?snr#}H|7]a}Bxn$Y%1)Ǝu4❕k poI)'EO6φ`Kۊ>lʱKϟt _b4,qqL6!Jַ"^(Z*6AmN@5% NOӸ gnivy V5Z7ΰBjGzxY.ji6? &W8jZ<9M\1FsEwfKJ%}\,Y*\nvuѯcWB ~fe݌o=RA5BpX"YB(Xأji rh|)_WDzN\B2Թ26 M咐2H[qw4>щCG o 6|gv$(tfT$#}vg beDb]K`0Zu{zjxLD$ uRqX(Q0x9W^IVd_`Usd%ɭ⑛&ѶF?r8F72fĊ"db N=8SHIJH[@rZiX8x{Hc\3$_ӌj`XOC'nz<&e/3Wi"C+5nxAo0Ձ_8a#p3eÈpίhK;㢼L V"Sqg6cV( yCXhGr(]x&@HX0!MyP%Zюq 4b;@}gm?Y.3b $VaQV""6fRަ䭢RQ-妵 +(z-F\ 4dٴH*yZ(pj !0|̎{Ğ$x lF$Q`T3w!6ɏMD$j-*,W$!"U=.Įpl6ł9i{rWzO,f1. 9jDO9,qNNs *>v'MM笷%zTz8LEC Op*^N-09+N;EI_F oO8˥W jvai}kc"k" x"]^/:/R[EMZ8I#ꎏ>L> LIȓH̝~wH7U \讧I0)GI2M,\!ݨ*lM]5ZS~7QAwQXHB9eB(-u00,+)%~ M%Mo K)H\`'83iu'j}Ds ꆨ#u[YʱjG,HzC1 ܆qqYv1σ!1F0BRu~&rRPf4WCf(Y=R-I<[ ,#C^>z^P g#J(v@h|&z> FJ:hHgyVEՍ&IW!<6gy&NȕZf8U@Μ>Y#H۠gjs I}DuC,*:mq %PGALX8kIEך!%MH9kq[ɖ9}FbEe|6 r u0OlNA{"vD !~iA*_?aϼu9 Q) DN/;my멧hd_r8C' )Yљ:'pySx 2+8IO w+hޟ0ﴏ{h3߃x됙 l\G|N>ق i.8E玬+kvWv-Y: A{^>JG=`BסG;TIYe CKӅNP [.tZ. z7^(j۠ݴ{9v7͚pH{CHikk0Ly55vcEX(~uع/]cĄuxW'p =z~t?B 9ӥW."^pvUdz9xmf/ϊ> J"A0'ine)?zYc<3»-)V+ȪAv7^pJ/Of`'O{W㦽ie[ùV@hqr>3H\rdb}Ҁ3S:(ed3웗5ыugC% 072F.dҺWq7ը?Ʊ%lB=3'żcqE)E˩o^|Y^&V/;UKwJC?ЖИʓ3zDRǣq Iah!>y}"clp:źw`=R&Mľ̝y%aZGepڠ>[;%ilLEFovnGBzI+kB?8e$}4f|N|ŌR$=Q9.s6샿 @ *x8"N13HV5TF6uFؙ|St \ YBUhLKZ尸KtY"+JLys? a_8OcgƗc^Q*|KOI5 0 ߤ:K(A7tOͻsQ##)̲9ho :?EVjG// -zFzԇ:v vhz8Sq(/䫝dMPPKXy0,vjQ}IAipV $Nw LG~$ Jb5"<58h¹Hʴv_g@&[kW 2U%`~h7%WǡF/`ycG_#r*~~0( /St.s|7KFBl2} j. Z0O"|A&+Eyk@-%ALe)|25EQy`'h6~)Jh.Cu3zgC'0fF "9qK[4۲/!7oOJ)֙8?OEkW45eA:X'&C.zc%[rVP[ |429 aH}QS':I?ƐFLܓs}'H\z]՛=돐K_ȥC,v')s0Yo˻Ҫ=e2tLgi;0.D1vkuM>,V_#EIGkSV+oXyLN9Eb𺗈`G *fyst.LhG17Xţ|E yH\Mu1h8uy0ٌa|*M/iY .a%xyœy4t.oQRQ[ě2G >N6+Mu6= O1wXsC f鏡ψJ*vxHi fS4-KfR=kpMV^)òK_޻H+%mAb.75bFͿh¡VuhN'9rX :A: ŞHx?rZ5u iBu|%;}tz/v050]  PzW8Q'J iÝ?kStzā;ȯ^Jp (tB%\9$=*Z]A yX7WC`Týo-ʓ;-b >HD-֤v|=>-6Zɮs G[WH{mO[˒aǴWod)[qcVą"0Z8Bl)KRVa}a{% o f/_3%XK1sþG>_ ٖPKdo^&/#{5T+`I)_3^HS Bz*Ytf{aҷ Ja}oȪ׸d2}̖&Daxt3P̓Ih>FN_Wr& JyfͯlsVroAAQ6}Yh֙< RX#E#;w9ԯ^({d*J5~"۩e<sJg#$Ni>1#8&vW.BԱN'n8;zQ(ք4~qZ"8 xPPŝʁn/M-K6%ɧ@_0˻FQ1zQ*"֖H"Z[Ɔ57O-[K||lݾ$ĞIDrˢ/ ؤ3D+3C*4+qMݗc?>]Z @߄$7/HVc4L723,z ˖TүWMP,)3p²$!.>^*ďJAI??P(c eL7FLDŽ(cBF7a Ldi9eަƒnHݍ{ %IybahS44FYXAs("a6*2hz7Q&^]LV $\x;QC &16fvfY1d0t dnK9iTӢ 5)C(ۢcD-TJѸ%Zʣ5]PbLжu6R_l2 `J)3d/5pG2#J+9{A08-|"6!I/JF(wݲ&f-`rk%ģp=wՒ௚沰<]1gk'5VjGZ~g::HrP>~@1"P\BJ.x˖zٿT[Z3[~!2F^bsz CDՔ|+;kƹ/cQr_MBVT&#;;]J3vcXug[9sY#8 RGINpq\ Y@3GCȤ{oL&ciք*C^*0X|P֦N6EiRp2Tť#4;,/7T{7Gd0hV3tzX@kH5dl/NJSŦ*>([i ohj;j۩.j.a[;Z d/k>松:,4s#ڝhzvBkGG`yC O&pOmbfݓtW$YnlF6b1]'<$aX2̡yGҁ:Y8gLp 0e"quʢ%ݹo:vIםrFw>hFw̜tWv/~l j)\l֟Jk;Þ(FuAzX]>wC47ǴYEuC~R?8+qHZ-E؆Π3-  UݣW釽 ̨l6&uDid%z5'w)>pȬ2FLzXm64 HAFj VRj 7/Ƹ+؎ZNC/6ѹc>w`t~U3~#N3%=Cq7gg0O+DCkE&ykiCjlbDnzSu(<-}LaЫ٢oRriںbhc /CT<%v 1 ҥ2&> g/K2N؛3…S^eSۑa<'C2.MbQ^(2a>i8oc [pSEZJ 7 o>o% I웄N3_QS `,=iTMʣk-#񣀣o# og*_uZOx)vu9J2Os}{9/۾%a= 4Dz1G-i uNXmXzȼɨ|XB5T|n: ,ؗB{_nQw:9)23]y[63 ^O0Joݏ"T00~:,N%zݶdDEjJWQ eг.ȸL֦xԟ^Q( &Lx7UTbbϞǺF~N7Df 7W5BP4X:O#?/-j^5FѣN ʮ}2[dѝ]; "Dfm\vyP~g[fFf04hiX"!>rAw^9Ϯ>8; Kl;_=%-饱wAkӡv_WO{qK} 0~K/E'g 7k-0Lj:so~G%*hI曩Jp ^lLkR۔/n++xnDwnڏeڡXѰ6i>V)JB`ĵ0>b D_64}f-/az,Cū4EBhB,>L2ŪDt`3|+c(o]b}ϳlJdEada }foƦМL&fS='94]~Q"5 Ow|VT%xNQtnv8rHƜ̡VBPV}d,VӭBŏQ/H;)-WbCwe3@i!NϾez1Q_H| dFgK^)svteu ?O@n}QRy/JNߚ;tuI[*OF †\OԅY) ?\kěd홉*$Ƕ_[^lDK׮[23" e4QX4E} [EjYᶮj.~Wy<;/w[|w  T/"U>/&)[[+PyMOspJG9k;"I@HX@ﺷOH:_UAԃ~'1%d?y'Xժ:igȺ(CwGI.i8eO40gKMfޥ qumO[+#pu—9\"dny!H%ej`PL t?g۩B3P*3뷣una*d qdKC =! ?ԏ?v 禞9~$ )qʂ͝uQZG8?Uf#WDT4n\ 0Mfl?}U~A*<j/m}K&7mOQx1ᘙ`bF=cО'=0p:IUC!C#~Ewa]{axmpyPB=oɱ3!> 8Bɜ4k>*UkLu UYUAq秾=*GPU}ޘ7;fXᯑՉc$v쵏$j6-_ND:*1EwR6gp L_FQx\I2W6?կFCDuvWw\SРR!a4kXCSVK8~4_*uC.x\!d7i@yQD=pv 6Kg `tZ" 7Fm"(o X f`Zp;5BN:fy) endstream endobj 150 0 obj << /Length1 1370 /Length2 5960 /Length3 0 /Length 6892 /Filter /FlateDecode >> stream xڍwT6R HK7 tw03 ] !-4()%!ݍ}[us]ZD%m(aH.^n @ ~nItma҇!p d `Ma @$7&ȁ=67 A8Lpo7=ߏ5+**;vA0@ 8V;:pk(H'7 wd؀R AC$w񃝡NuGފ@ ~+C )W buwo|+iӿ E(@ 6P_|ˮKiNPDz\ nex@ܒ rYm~ɌOPq@\|yohMcGކp7_w*h2#ۭ~_mͿϿ xAq&ա-gUT\˟0[z"_s}U?q)'Hќ, b92 KVA,qvAhlvS&hQ[$L\ wV\"VE7g脀. +ݺmDǸhdJGfꮫ5w*Cqd۷ޞ|Jp" be(H2(2'c](1G[iuiexE}gmF_CE)"W`|d}hF/jN~0(.5IҪSPbE,f촗oC!vv5!}Yw_,a!o.oqهW؁G[U,JLقdOhBS+B>1| 3^iAK c݇'EB/=${&Q%:(wDq"F4g]L21~by*WH 4:t8|-0B ja)-9'Vuj:0 @{<=- mE ݖJ6rJeCޖ7FcsC;۫MAU-gi@1 ELCӳВe # '%EIP?I{pC2bo7j9>B ]MbeFtsWc ?mO9uJКoD^):4$Fչݣ 9x)&UTǾi1 טmJrHƑH)z!%_B 2~Xrz]Z^|.̣8*oX!YI:4DF:ɢ85鵣v]E+ %r$s۱s(e3C$vol6 Gkч AI9*4Gv;?+$GvoK-$Y-^ayr+!@Yg)ǡ%,gAt\ZM~™ԴzgvQI0l72ʎ_9 LQ`gYS7޴Fwt~n0#7W&DX%/KRTH#P71v,3V\hj$\ۺd`8 XdM:$w*@^EWk'銳#], jL|1܋3iwcݹ7^݈n/Hn>}0Xy'A `?->P*t.WtPD:xX-dL.Z{|J Dr^x@ݻ@Pg ]h9sēSIa/ Id?A9[IP >=~fMk0#(3uVHw BGfo`3ZHڼ)͝۝R*c9kG{?LFOokw-qaKP_з fVd=џoK#3df½̭ eԜC ۂ.pjRUpY˻LXkP~+h;+ӱð<wE&\ǫ8{X͍pNX]ꛃW .s Ke6@FqO 5YH aQCs;N)v x8aN˕SdCЭuop,a2jL@GR+=_v7e2t=3h18P .Q̛dݲ:#cAN([ߦVV=>EN]ZyZL.dk*ƭٗ d:ep9xBr;֋p3V? O&-& |ga0$_/cY##Loz#< a~ɠ?IUD|GֱrwE "Y[7@f|,Lz2͜ߪP dΞ^hBOhggs$t8@6\AubTWj<,Ue_޴ͻ#p_ɂjͥ־3N*C&F:9Տދ:D-XW`/q.R.+DWzJR̾i}.zv:~P/F !-rMN *,P~ ߞ jV_ Yçb4%7h|}Z^O/=+ʊ٫O9XӕnegM^Э2KYTruÛ`T;e U"o6o)cSh4&l&"7%"a wã:mL*yloIkew͚XU@fù))o,].` gmc;uM) _0v! KҜ%G Z\ݯ7GJL|pu+!y]>KR,IyCUrUMӐm3[˲cV-CRJ V>Ԋ Dy>mtU >CH:\wX}s-#5{(^c+)RE;}two$P$$Zڶ膔E0Zq? 2⦓L8uRI1mg21oL)˴R|îrC+`2?,KDIlK-9.hq,ܩ}fjs˨{sS<*{۟:#AZ؏DrZ+nt$% 0Pe+4M+?qbdJѦhi#IXԹ> &CP8vI!Cu3\CVݷ.У&%B]ϓ'>‚^ &sFt':z\͵srKO̺o(J|m=I!Jt.e6 n"V'Gq*OR{8O`̚AYrVD0EW1lL'KVT,IJDlεQNx3etr 8z ;I9kyW++mC\+iy63b6 = ]졯{xlPǽ l+Kz|,G^c ԟ2.j8$hF$\8! d)/de[ o r! mp Ű\2PfŸ4,*8F|Y_WmdL|;+fVll]Wcb$*F/jdZ%̄j,*eHFoTl֙.6ƃ<@;zB~tPV A>/zMY@i.[>wW/ҳ+QȾ: 3𨟿$r bj`Dz0Tq_~0=T$r ޳7 }?@Li eb % :{&22JG{j:&_Q:>/` 5uP]̰q>`}ì֊*Hm#PjV;?M2/&~N6fXHJctFCMʻ,n(ZRD^H3_hI(NY3sa^=nq0FphOLZIL&5Rpv]3S+7a/~Mg%S?Q]);"J^(SJȺT0V HH}<ϗ4Mg@Z/:.{,n5ܘU ?4\0Pb{2# G::6 >[dbAN;zv#&]zU>ص> '^ HDJ~F`7 Ҫ!gC?ʏ׺B7ǭFLZ Go`2*NZ[*&O4J_3֢pؖp]cF+ ajƼcuXameđMAl]5v]2I?T6WTa!+kY7lH "|~1-fv֫̀.b9(&#> stream xڍwTT6tHsA``f`%F$E )) i iRq}k:s޽߽F8Z 1278jD=V qa}tb-5H/I` G2v%H`&1 &@b! D I@iP(~ֿe BI>L!#\j#ZNjT}Dֆ&ZD`x8_TT1 ϔ=x?,{2kӑ1M;ѳ/R A29ȥ?\{lJioM`͗l9u))Q qW3<;Hcĩ}Ƌ^ XPӠ3u@#x1cՖXŚ=R_ V=Hˑ7H8G ë*sV]f:ru Pjsy{nqWk [{8wzʣ7"T[}opNyKSU&kQabBkfi3yi flXq#Nim$ALL j,-5]MH;aKr|q?9#R;-[{#9W?Hnͷg"h%!!3N~+$͝#>|] Wۤ #R!IkiY=^ҥ }/>nuz3DVe_X9d&>CXNvoo~4hUƲY}C"dsN,ЭӒP-$/gGRoԫ(EM> 7CtfrvƳy'iGVFmmaM7EⒶb fcڅHBu6Lc>/:D %8 < E\!ZzD 5YK \)N˗f?Hqʗ!j[{(^0ͬ|LjףrCwdZ=SaNSp*)_@ UWYֈH5LKISn5y^$Ey~AsU#Fo3TJ:Q%x{eULc$e֘K?JePhdAx7dto]k*+; V&V<:NwNa4ve ,mHn֑r8bm"m~:xU 1s,&? 655Q5$9&fD"\ʵn۾H"6EW|SGP+鳈68ˇ:m2ѩOWނtNaZbuLV%sy(]9돤$Dh#qau562|j Շ~6nQ!}/QOs)uUq9;tGQfjޛ Z -/4܏1.Oܠ|&~[; zUKR Y/KOѬ/ՙ 2׶O4Ь?R. Q{(Hi*j?尕Xm@Nm]|Y謴iIߘlr:z1'oS(u6% H0ge2{A P\h~!YRm! \Ӗ9hO;Db̒p'1FV4>\57Nv>;Gp25'MI}<3D)6޲T&Оl<)%R>\5aBY{GI5ֺ:'3͖(P^ټh>A7zt߼p)?|HgEN7nu u8W&vl@k<'r}Ζ2@9]quͭe.Ƭ&?2{ 6d[}Q[zWߥaZ4=(,||Jk@W8Y׳VbA{{?<*K-Vd4uL*ưccSÿ3#bQR*BbxnJ0Io$+։E M?kmA@^N񟆯_ ΅ȩRCMi]O8Hi=='|U qt{UcBV2=̅$|| 2N6P^~u!@6 . G:7^֢}&zno~*9{&P|>یg#`6Iɬ1\Q(Yػ`'(+)c{6D z1e-H؇6"`Ùؠ`W6j8rj$^z!&.JU{{%5CݷiHΒL#o:/jobfzPv9q|F=ow>=ͅk%F39XF7egBÙ~gOui[rt/)fxKkчyJ,g/id팴[3/x󼸄y$NwReL1z(1_c,~TZP19SccMڙP,$bhsn DBXq<\55xo*q,s/lh ̊i#p.:P*}cqd}@ j]qPn97d:,g,/AӬ9^GJ<$<=$mʣav=Y`RҒG8n!nxu}eu1:N|Lc"IF~>BDjEpfC,bGʒq iEs>Ņ?v@~VomV#=ڐJw/uC$~CgW\T<3ː[qMwGoQ]mY"/?/lXZ yveI] *LNt.+3NpfMw=]Dץ@ښT@Fb-lew)LJq{υ/>UeLjt?q*,5cxo azԋg+h̩l);nw#<<ӫڰ/ >T)!Ӭ(f]}niWm-DA2;}fbrdp>[Mvciu']ˆ!_L'~SLS =~np6e.qٙd=,L& NMs h[U){GQMW A KJSlwh6sx&oqD er3\=IF qmE?>ut% ^ga6ƺauݟЉh+Tv\.E>N2u\ D`[L냭 WӴK[c7unufv>{b ˰"#Y]Ν""6uvQFm)A_ u T +}lFd9hK߹i s0g)"=`S~JƮgؔ* W uYA=zs["zr;kQ?PQN5P۵ Cj>n2|ނIZ}m+XGrLQ֬:J9'j}i"NAU2fsqs5nJNLMvFvױ=u#Αr vнk76cJ8q,M{mMJOXx6N^5iyVvL+~"]dl'MJ94*ɯwY0qOʩH;U5cTjZZgLE=-7r4|3ŕ"e좩9J^ʉl{M3:&d?HTo3b@gMSw\d;_NPW?RBrf,F$Ȉm+NTMcqw;NK/k=_4]ӂɚ0!9iһ=J ^45(e`Up?ڮ22ZilϤxf]ǀ7qpDȊ^=?k|d3i2V- kݛVɞD)}L=?l'T̊^:VsٴdRBFf'!zmk s@|gg%n)?5yK4QD4IZ_mS/PJigҁE'enL\[{V.`kX Ѿͣ}/oDl'P nb21Sľ)};IDFeW|zUG!. d* hJ;TjpS3m0kV^D9+,g|AW{tР5\!BLb@K-7m"aAavqxRR=bz'0! T-lvy[uI߳5pT:Y0dYE 925a\eFCH=Nk' SH#} > stream xڍxT}?]R tcC6$KAiFIQnIs}3VceGDG eƖ@a qAONPӯ2t&3@H@MNO_<<<^!qQ4DtC_@ z !><cHLBgBDl뫈ZeQΘ$˾hqg.:;V~j0W99b zߪʡ@fGӘUdC&2{kkT٫ǒݢ/7^\w"7w3r Tr~.KVeԐ۞֙^&ZXO *qtV>~THF:>kpurH N3$6bHEl{Em^z4y#grL iNq}ʮQq6yP# +aw.N#J-u>6? ݘsa II |y"acv2x%4cu]/y҂%~};z*4ɢ#{w'{ 3^u TDOb~tQA>A[=Y+% D3QB&:z2CI)ݾ3X%1L>Y>]*D!^"y-︶IB"V.z\QbIЦݤ-˩Cve8HyxP`\mI ^{>a՟fb+}W a[D1)QUs?uu?H{ĩ;1\Vl-vQGC5m2Ңպ!8fj$ߤn&Df.NMDk0E4EOc)/y0~lc?>.Ӑm 鋐;?eDWG6t[-ŖJO"),gF, uEVDZnU#4StT;\]^tmKs=&lii0:XF.G%A|Q0 @IB77A "iN>K}9L̻6بjæ=r=4BBp*UVܫW?6|3i69R[)e,7 p7 F ;D*E\zEO!p3D4ٴ:O *7gNzёN+ uݦwpm*k]bUggS8j jqE}$1h;h"i/~8n]cYCPi7K3<2ܢW 3 l.˩ޤh Ƞ{dJ/RmEcL륜Z#~%Q-< $U’S #L1Nyr5aKTn( +kE%}xg6M|>RĉKoqnK%0Tj^!W8v`|X{A^eqml Tms8O*fK$G{wەmK'l Y = &1xJ-_cv#HiLW HuNET}q𿧪\úU1*?\ldžE=`GݹbG.&w"B }.OÏk{tHߜǃOTXU9:[?4d~al7V\IDi;wm/T/| 4wne\6Qs5%wes7=F7sr[*An =KFgmE8ȅ#0ȶaw{bt~yYn=JzQܛNxj;EP.j1&$;r@a[&= =6Beڤ7qi|k-f3GKʪ`aN Tv?pU GZJE }o鱊lQd ,Koe||<UE]nnYy-m Y7y]ha-bzl )O,q*quB#IPe9cfPc};dS/X$;>}`2g!䃹7٘m&ѪBG}&q3ZO 5gx|WG=Z905C+l&8Kn²c " + U1"!#FB'3D4sD+4k{ţՈc>mC@[J0輱:bGn.I`1=Arko)X~،S/y6L 1JEn#+^2-!wԃfX,p#+aZINI)3)]]J7E r3]xǫPɑqG\4-BL0(98c!rw:qӖ啢 ܫ5*KY s9K-N*|U3OԗQ _!WqQICn#ZAA38C]/|9wӣHz]AAO ~dB:_Q}Ss3׎%n2n+Qc}~oΦsեuQ=&+dW@2 u @^uy铧uL/ ڴ"#*ۧ,;!•gPGlYg7|鷷-`/}P ДixlRڸҦ9>`dk9MGO]}1*E ~({s.qvCT Mh7 3B1\˟탌??( Xqs* K4{/tk/N/*~H/=.cN'KE͒<bE7B%0Ԃ2Q`YKVE4@k$I؟SĆxk"yWCT;ْt= a\M}%W'N uBv R9%Q(23{bO&e_{m^~2N>^~xP`&)'ma:I#~/ + ςAOCPEf+|Uů\1I֛"ò_Ζmĩ_t^1%aOzXK(󽊵9;$5xKܮ%xh?f̦kcdhwR ՇF֝=9׻?6{ہՔsodX? rAGRZe1kG;Gm.$T5Jp8 [=RM! : -mtVw)Ds¤O-Z &ΧZ2ݨ$Oi:'~nY6CN9n3ûߏvozd4/iIЪfh_b SW~2~iIr3o͋9$"SF#dqp\|1Ab=5w_ċ=Dyx9&xYQ2qdKxV?fVKxU*y6>>(ng%nGq@̶dʢU+9S5M"D&͋`Z̰@U n3O+$+tF)\&l)mݴ._KGSvq( YcMl=U*zN Xᵶ{k-3P 5‚xڞ3/d Ol՟!7*n }KmGp<~m|ݖpx/R7@27]JxJ7D3a=C1(^}-!7lwD2!)|Rc.zo_6 _џn0CVqRj?У*ؼZ=Q_LQ"(yB̾7lVFxFeh,\dVAp+8Ғj8eގ4;Y gwCZKBW#Y$6 `+zth -%s33ϊcoz5n~żn-oQ#FL{ysElHK&|wyZ=nup?}]%'aص~y?3//oY}NCW'H\:Bd:EeڿV bC[)t Ӆ^M]ۍٯo6~(}/Zڞ<7gǪ$,4qCV ɇG=i16p#Iܦՙybw0<*֨Z+Eg}A(DzTw<|bA[ܫ b?nbjsRp̙BqIޑSi$ݐ*51=VN\7~\{!vw3N:;%e|S{FQ}|o"F6ZZVi/};$γ#rIl&44[“`E"XB6uoԜ8zW Z[H5Ը <:;Xs#Q<1Pw0uSR˒ RL5^=1yR}i{|wD7P7cQ\WY0N4:WGMW% RcԁT iZSnhWpsധg;!#vҕGj/0 Si4fbb%80ynNXw<70dtw"S 5)D-&O4 [`o 5rcXS&sk/^xZ_Ɵ}E!ސ{ixvhknWZ&_7s((?]w8 endstream endobj 156 0 obj << /Length1 1372 /Length2 5926 /Length3 0 /Length 6871 /Filter /FlateDecode >> stream xڍtT.(1( ! CtH0 0 Cw7%R*t7H)!sw]5k}{?{y8شdP%k88a(0C%@ 10 @j$* <(`V ~u!G8y"a6(6zpA.:B0l!`<тKr.4}; e Ѕ@nP+/M#3~"-O\ar#t]p+(r wտ࿋ m0(@KI偺í~.t= s['du`4\ Hʅ"W)+­P8ʅ| 0$>vO#0/VN'p+TU/"O<@P-W{}O'$W F¬?"oBB}w+"`P?a50Z{ ߿ߞe;x~zjZ;''xD|D@ !&.gm0U[#L>MW\ g/MZPDn& "A?@R]S./@J\Gs @6mC L:wVFAn3H_@OZiP?j08TmAW W/=m ~LPDF"Dh9 AhCZA=~+#P/$uh04}t!H$b_~B=Ia]eHE,;!xKo[u 1ggVet_ބN0_ {e.0V.Ol,VULqL%Nkx^eP-+Ӽmƾ76#@> ;k\5KJ:~hY%=[@b=uBZ 77w 8+'@LLqb&YXf"RHuC g$/ORCZ`,p Yܟм|\uq*m8`l̞sH7%`|rKS*ji-=ީA 6U睈¨Ɍެz%<4ɺqe'KH?,H$뚳]- 5;NșɧaSvaFm|CS.MXς54E}"vAffZςd)y2n"3;fC* v˛Y~Yg8^$ms/B<|5*zrvfS naGw.!8n:73BWMg>©KgM$7oCpŦ?Eld[{yD=g$b0QCZ^Ĭ󟀬Z?f'Qɑ(WOk"e\2vUV_ch,}0{V""9#K .Nu O.J3tCӵrI{|tčsK1mCCr>0q! LQII`Hgz1k&JZJ.nX׃l\Q>w"(ø=n7"bKv+c/}Va2֣[/@k hXe&VnՈ|PGt ~ 忆Qkd-YRarB@dQً b?Igbx \rs/bc,g~p;o/.f-,AVg.ۤQ{[,qjdCz4lBջ{CJrqGBR R:{Rf2oI1=aLzЪ|G)߯gfm}z˕*/?H|"=0~Xv7u%oòYq#’8;gb{ |_jϞKQǕ¿'b;lNFel *"[r ~&D$&UcFe#qTý=Ufڪy!)s͗Aiq4e.8lLI+T0dZl"s]I6y wJ)=4Ox#ob@fjx}jz(va4LR9'*8;tes :$Dĭ$F*aA]"%zh_b7S O MgVO 'H0$;ޅ+hQfa7~-7Q Eqr2\3" Vb8~=}t17U?#hM9I$ɒQ<*Z`},d-;peCC7oK83u=o;x<7k,UFˤd=˟$'vِ8&lKm.xi;5ʈ;yo#J0Fm<,-mLjtA7|\ROҒvO %N'aRN"s-n鿁GT8 7s& ~c2*bPL_.w=oL~pB^IkOa.K _UǤ{ֳ;"8]JR{z$`Dׇ<s%ML_f=plc;}OڲJV4,Vo$Fpp$oӹ"}tf2\I)M?ՠWftH;̲yןҔ7B8{7)"vj"9>~D |G. dP3N`<įYQ}dcz}FWAJ#*mmP] mb!o HXS`=*CAoO YE!f `Mk`|[Th9hds4B. |cjMpq"dp) hnwxp}I@gAy&<;00] :[r+ULF$X$8atWzn1$)I\%Og)Ua"&TaZm&X՘MOb2+)jSDp%KˋmWJktzaЗv4(%? joWާg_<8ƄV|ZYOeamvu:]WQ75Cb$5Q6;c"1N~QTǂZ%BtF>h-.~KP*, {]E=Tió)&HDe5v,~zIS϶}9-2̧a2j&`bgƗF?*UG+ 2 EZIv8\ lNi [T%=N18غ'1kԬԶS3g;BT^ambCJu>]YGl-5{n8OI~dnBdiux" a+;@srE-y5͒IcU]g,1?gcy$|3*]z9yƽg[^Ho;eEsCb\6c4|y..+L:GH#"1Ӟ +`Ư@gC5L !ovx{T=¯&%F6pi,cɆ oglf~T~.aVqGuĎj)cF)^݌s m ^M:ԵcbRII1sjP-!SbQ?opcxYd}o~T%3Q U0ts|h2xưjq$5Qӫ'eZHͯ|Q|PD9n灆غ2b:_ō&Ը *hf 0i[It;>n Aolq7x;]r{T>Kɚ"w(HzԉUèy/VI7R";(@$y3衛 ;HJq,Ch~ #V6l7͓-]&ckٮ. Y, {eCAۯ_^k[<'U.96l ,}M5R5Sk"iuOH 3ڡR,f%L:hߛrYpm=+.@]'ԥ/J÷[z\D1Zd6C]m[ՄL$,rYmin]%쉰Pe":Mf%=“)m7xVUiۭ7{=c&nQ?u=; AUYoaw=!~Aw5h/$phMcٽ zDzT#ɧ KwA_.z+[wp*THkHvUΡ}{\ :l?`]壸 ,U LIb?0)U<$SG!QjZ<KV%(5ދW}QL$$)"̄QSԪ U_&OՉf˝*JG|*lkɖ.pF| ə)ԡL]-zApN")RG/$lr ׸S>UjbF.ƼTq\2I66{roV[A6~Gǫy/ 4e`RPH[Kdu cb6pf$ /S6"@U%k+"app4iˮFv$A:+ZUE#Xv.^R endstream endobj 158 0 obj << /Length1 1645 /Length2 10767 /Length3 0 /Length 11821 /Filter /FlateDecode >> stream xڍP.wҒ.ZI( R܋^wmsgޛ$[֞оRb `+'@ZE[NK %G:AAN@3ؓL d^;8|BB.B2f. K 5 JCݝ@6<:,,$N 30@ ftxhafЂX0 b9 9@ Nb,W \-TƆN жAVhA`fN@dC\@'Sv2@Xo?dwr688A`kPSfXf`߆fPȓrjrA٠ =tͲ`Ki Oxwwk=@`KmX:;A2<#\;†wmwG_J=!6 +'99=T7BX,`s5ObiN 7['q8~}2zb%lF..+OVJIAܼV.^''q@" ܧ{W.paw,Usݐw+"9g{ f {, {.T-AU=m$Ѭwe1Ńwv)K沥'-r}ʝ>+13zNx+%\x|k _fS)7ҚQ# ˻Si;"te6(0F"QH1Z%Z˥$'&i'#q/vSzxKXAk)wwvŒȕL] ~g-̡CZ銛c' '֍ IҫTGhnL2E_=yKJK D0zfTe)y)W kC'RYS յN=g8-"A,R/6|42"PlgMFaU:y-8 pŽo_QQx n[ٛDzUw[dA9OzMCzѻB30]nY Isꃽa'kdt c馡^ 9Pq}`c@B]/cj}^c !0Rw,v5sۂq_kѧm na޸/(tm[,W8GTE*kc[VanT"Wޫڔr˔Xe|wp<a?Я*JSƲ}إ򓊙w ۋ-^ tVm), -*Lm}&Glkn9I=h-}J2O{>q ^ކҮāG yW/[*YUJv(Ov3tƵamśجC%j6hpbmE"umhe0)KÿNyϝbmuw!Efd4V#H "륹o,]3*/5(;b*30hc*d\Sޖ Lu5 Uu> 1MIKa6HP .Oӝ*:]CxE2S.\=P/5W9| ^$~[7AWf{:tE0uIlENx|y_7 n`m *)dte3!@|4V: PXa#a!^ ~e鴉a?,CnLEpT[,^Rp- y^R(Q\]M޽)On^Q_TДYҏx }^X9vb;jڨ}\W)":mOJH&ܗ[٦ $!9VAv9#fd9{\Y@C4H/AEGs.q҄&[5 QDUcZ (֌Jv +lp2 [_%4m-ҷk=JW d4!F935ejlj{f[=pg=j*xQIVzKLm)(s=-XY}d29θsDuvOs2׼K@{P4qbaߡxX}Ѳ|w<=bi\Kx鸎r[- ІUb[jWj7[yA49763_%'zF50;7i]lZ>Hp(D]^`#yd)"aBv}M7@X%kypX{h}23[e rV,̾X(PiϲUP, B)L*Lnw hFQB|L1yeǾsi 5~)]{6f| ;hȑj 2Oq;bT!8B`;4y@ĽmǝvCp6= j۸cyEd<<1Ӓ2 TKlX}:ˏg~̿wH0|"p\6ljnRu#IS\_o+۞i"k/bOR:NtU5R8^,V{Ud*7Y#[rJ6։q'Gu޷t"i5=AXЗp7j4n!_NN}2@@H佹=hGc«>j,z<G2[tBܻ j.&#騡ɒOw@5slPpQE3M< -&릚ZN㯤oE} seTn oϬc5\-OݍLUtbؗ_N=ي};^\C2^xbK-aJ{a64Wm$um?*iq&o6XƏZT"+Z.ڶ0r-҂pmD>Jj7K "bc ]3 q5$B+0/*Y%Jt-"6J8tlp<?7}-ʏLdd__|kDEH>JUUY-بOYH`UX?*i"~IjrϹ_:|Qfe%+@]sˀ?w;h_Gz\fYR"hG;ݞۘrteN"+_9pag "qM_蕞kAPF)qゼKן5):hD[l^V>#N;|!Eꈉ%X߽KB )E;1mڙp8!f.W9V-|2a+)irB1T(_]x0vʳ-4Ŧ۝)mtN-oшUi O''h"tJr9G_`;^e73G՚ bL%rQsd@{E }Kl0_t zC)Yd$7o+EpRJ8K -5QNd?&ʰyʤpl77V[;BTјh8q9772}44 ݒL"nqz.tK20&wJ~^GdynjYm1MgbgYVuVDK>efkvڿd5DS\ġ)#0F F&_߯䒱"ԖDo2|*O`?,'E%e$Y,|+[ )(nG^g>b2n^^ĝagGÄ5l>FyO)>2|Id.Ēdw(k?i¯M\"y-}Bb mzq g6Àwx, x?G|D3-e*  `aHv;vuoLgQQfŨٝvX^ WOstY5^Mu?zSjf2q;HF8Hdu ż b@ظxz1TfN@98m#"Y:ߤ زmE 9¥bĞ|͊$90u*;ZS3({Nf/3i8!S:_SrshȜDFƟq;H`qqPLR!C' 0 dirӔG0xuYHL7gOlk3wۛdX~mPCCœ !OJUTjkˍ&`jO%iD3i|wYd!QR7W/?qM[9mtbTOz\( -C%qSbysQ/|ޱ,wmt >` ˡ[Q•E<2]UOn y1{$l|~Bf" ڎJ2;3 Yߞ95Gz>+NazF.瑉ە3Wv, _f5~LZ9UMw]J w}q"U*ZmwH転|˳?(|.mPf  쳾c˳NۇDHbAbh$g,/u5(E؋5Z;uRfՕeWj. Y`=."441K5//XG;dLȗ7ߏ2[ `6| wl+גɰO]pz 4+-6T(uAJgl 0llPv+*v1B -)T3FSы!!'UQ3_Hd MTMcmE|"XGXt?o4. '2 ]@Kԃ_2נq.(v>^d|d (fF'B]xqݼ|yV΄mӏ7f.gFZYrp:lj%9*_!wZ?UHr|}u ĕh6dP׾)b5PS$GOJQEr@, xꡍ1LނxohSmyE++aCD+h!7^ f$ka|)\xZWݲ!$xIs6vS/(Sh$ٲ7&Ф״kRTwFO zˤI#:Oqs.#]52̓!@hC9: 4G0K. iHVZ/xOݐ`mY|Հ{(d FR:zOΞa^VoV4}Oe{pl+V>˸k/Cq_^&k>{=~EspjL" ~-k*~:xJ(}1Ad:NkEw6۞mtTb熬T M.R|hj` v>A@)aitL +%NzfV& 4!xIMoK9/|ϱԴ+Sk62JZRiQsıC'%Aާ卻 j83I@N =[/bԅD. o S ~q6Wlׅ0>_$]MG%D1 Iɓ2݄L=`?&(s\cV.GkC]z;XֹsQ^m"cph]Y,.YJ6?>ŭII5zI?~e/"\}cG&R/ܗ7ǡ޶:j2၃OD/Ӭ6Ĥ4`ɪQeGDW03W1斿h5K~PY(&}0~+w$| }g(撨&3pR>ZI`-6unxrsss*ʎ[&>T=\'(o|D/19ebǛd(% `q]̷q6q qT/_wT“LTG, z^&X VFڨWJ>@؏Huжf(;5;lj=]0K J8V&$m g-- NN{-]!e`ٞ D\k͹xxc}mS)]e@ Bh-Au&ssNm(uu PLV`G n3qLNL| 1mt\!_G\wy8pB f;y~y?܌y{=~=V6 +4lBG[hν t'yWm1FoK\T2V'}%=)6YwĕVt"8 F=8i]of(P#w2?뇌f5! 1[ܬvMjf1ݴ\Kkdܰ. ^~g3 >d#XjE>h_<ÎӒj'U)-yFIQ QDg$qS}gN:gww(Wj?n\܊3Һߥ@$Y8#l==| ƵKiyr6UwC R6\'S9kSdX3V {nnkw-, \ᕠ1mO~5:LjR";] endstream endobj 160 0 obj << /Length1 2490 /Length2 17752 /Length3 0 /Length 19197 /Filter /FlateDecode >> stream xڌP N{pgpwww;}ޚ*fWz_(IELRL,|quuV ; %-r@g+{?,ĝƮ +P f `errXXxk0v2(0d.^V ИXyyvL Ʈ@;-@ ?!h,]]=<<\-hVU hdҘ(V.Q9z; )fotj2%Gc9V&W +MM-V@<+/Cc[ ԍR*cPblbeWYLhW~V@SP߽9\{{"s+{30ssdְrrHc!Y],,,sP@?+s puv_ 02u-~Gw貀Ə_ 3sm3kkjiSJ11O# oecSdA]oL?A Xh~ ')aߌuoFRnic74nPpm5gqfVnvW+j Q{ i"e 4Sr5{6#kl.V,FV- p* hwQ%c;;{!& F3C `fwp@:R.N_ .o `x/Y_`Xҿo`@r]7+F vĮ/+F >ħq#o/g[ J7kllj=DbW-Wb2q:؂$vv f!;QfX )_z'7Іvu (]s+?bvpdbi;kP7--XdV@PV@PmFKv!FcjZ?~'rv5jP0GГ(kGU8@pus#>H@qrspQ+HG7YA/t{ sC_RP..;Qj Auz8{A?]Ll$fzl@h9"y\\nΠNlj*@SS뺐QIY}tZFeNGM[є>]I$'gՙviS"xBFu'A6ݲNn<(ʟ1==WU˿3h| *,0ə#qe$øDțz#MG;a/b}^Tgs#;J])-)B9>@;MOW^yWz¯9H|#])"g~pgz38XE/euSޣ;;kb/N~X 0xz| (j}YO9zxuVH daf6qS$brW󶛀Hi29]r(I{ lM*4h&6M] ŐĝW0R.WwO."jUd] |B!װ ܂TH4 jN''89M0J+=6ʮN`QaA@8D$U~ b-=TTa zȉxY7Ը"qoI5::K^՟k4$tf0x C6,X3L䯌'i\?18Uhk95.t伏Yh"%Rqwï\e;5t_* 1R#7im{kF>CNEQNCZ7|{ NX:“2JzVaZ~uXZ7n$_8Wd: 8e܎*1,39.tϐ=;fuNM]![WFTI+2E `Q@9)4+/,86Wcb9.CDc=ڜYZ_I`eV6ώzsk^S+4atZ|1ufiwkRǵwɮSߛ? |eN@U81'%纯 ' ![Osq~^ {HŎ^ +1md3VϠhI`m)A{.ySxV#@<^:=d󅂲Rs3nǂ'+%bj1W5`5 N=dρTU|lL[Li:y0o)Ua(J>3Rߌ49׳ D?,z~I2! 3b7PGASvGzWS{RU.^$ePKK6)Hb_ &d8ث؀t9>szAXhs":[nPz:1bFB"2_{LZ҈'OnIjBsFL9OCN~_%f;&c&N oJI5G<w:аNnC ]z-̘!!`~wbluvXPhR/|DM( Бr|110J H2ōȫڤsqpiv3E3IB~#gQVҰG2b7ss{.e%B­ظAXB8Mjy owh)11lF?e;>q59;jJ-IvK]2rw`.?FIS 6%YѺbr46|f p`-k5xf= 0lLe6۝|I[8`[lu3V}"t$b͍WkHen0o+^Ҩ43}ȥA}=QdUޣ;(J}ɾ:bEuEIֻD=S L&SF`{B/γp#Ջ-l0cx5^Nd0tWG'-?-O$^i@N'yntɇ >B$>Ey,|JX 5um20$^UeTA3 fDBXWcTBY|$ JؒjYmj)nKD+Z@4 w'&vS&7 EG-pX&>Yrʷ~-xG(0VJ6:6”]˺Ah {>.FHU+*xkQJ $C2ٰpVNRX"ڪT{$mSjOI|VRa-m}4Wro[8”3w)!Qj@]<X`tӒ6Q Қ1.L)ۭ0^#|gຑ*s!!2 F~J:\2ډ/0}mP#¾~E>(t}{U i)6Y&hzw.* >MCQ::u 28dX1H0wrzS0Q>I}Mej?@, #hTIA H@Xj'K\۴=)S"`%8a&3 7q۟2m(Gx(t%V~Jz S݌c߂9=\qO,ٵsg} *6Ϩ.vIc/VވP>yg0EYƓ댗|*:z.%w_7W`5]?EӖߧ݂-p5pcF.+ϊ#0,I6eR2ҋBxjn<=Y(`as]-7%j Qh9e+f {z-zہ^@KA95mtCuf+7~O'9AA8#}l]ZN.u;oSƢYSe8 %ھo2U![U)fKϘ v$axz3=48ҖVõ6[K1N sz64ħEҴI跍mڹMr=)K24ϷgG}p@zLGSX7xr\&KՍꫩCr2^~D |Lۗ'0k*\>\JXwb:2qtk^E=AuTF=yb9^j %{j򪯤$¨^CYqa٣?ud&ERT='-XoJ Ph.~`:Y_e"ƞf6b M;i/z?,λ` ۹%_kMA_C1A>nvX}K2y37qJzk؞Q!s6z(З?W+qf4 0~l g 芎Ofez2'`ԋM!>;ClnkhԶ6ǭ&tcZ7,nt%oWy᛭CU_r5}p@$kAPE=rc"JNVk+ۊ*;zg/c1S7_hP^ƻ"y9%'f4j#>NR6p+O27 )o F^~'ٸ´k?S3߸IyF;cmG֐ np"CԄ'Xtʉ: r$!."̌rC[́(][vҭ1^,B% dĬ?2MHj.#b2͟ܯ1G$6UVwg,N*`3U"3ܽ>^#8JƁe&wm=/'p }|9%kRM`wQ'ݹ9RbVN ttFWds0p3l Ys 8PZԀEf)]:8}iYߔ[2dsp{桩 C:ai^a?林O'"+w-lF!$y0!󖌌#aJP'wج K]iuEv}ŋ7􍝹vnC4[ :ģpn#U"Jd Ū-K朮1yHG*.Lӌ}Ldg4BZ<-{c|T/+Pd>î[-[ Gn4Y~YX]JなA K/ !j,e,`;ɸJ)֨vrs}qQFfe$N~[iA'8MQS1v@L-u:rGԺ8؜ A1]\<_ mԝL g^TW{.8qoQa=O-8c5=gPR ۊx&^әj ,Mq_`W_xǝa6ȲM]2F) >5S }YeE Q.Kl֤#̊R=Q ?e?7m \iW Lc Yf͢m:&3PY)F}:. VGg^]MtŻ:bj>dd}:kc0Mz/IsB*_>4uHǦJ*Slix;-AK? dR< -@7غRliV2{c̴7X I ''e>GRۥ™>5%6vӎ*Z^s\eyW;69(lgDBSDOǛ9 M2nWa6]V:$R9i#u1T7{'V?3|<2>~ åm/ Md@3 !8̺خ&i*<{_ZЁˌET{8@,pEq_BE 95,CG)%Qh)tE$=/q Ze0ҏtAȋ~RJ"!Nk.SKd.P~XTpl|+vզVZfY@36rؗj qtгuЮ-`ҿf훼~4WaެUTssd#IFH }fc xw ˒6c?h̀FD؄e B&*z3 x~vu(QV"_4i3qp߫'f'^T^}+:<[F *>%]+̳}ov .z7uOrD3ezD$'VJ;YY,I m0C9i~5hͳ8K}1[Wq싖&7Gx8R2bɯҟְ((F8`Hďh+ԇΙaӨ&E"`?}B kJC1n 7 d^|]S_ː$J"?1=(UWC>?(ZME$^A3c>" )^~FzE`| bP:M.L4IO iBlEڒ a}(M;>#bp,jyJWsDF\s MjƮRptQ4mVF>ACv%H֗nDNOP#"1Z6ʪ֩j͕A1{( 3c_7Sta{kwx{S 9ڦ~^T60 TCyiУzW9, a|;w)pse9/;Q2/s1ƴ77;z\GspgY[ʊė6rOVN1A3w.P~a}ln 堷Ǫ6Kwxoohp.uFEg.NK[tUB+vc6~#hRWSXޖ0U66{ U \u0IJ OG"~j5$':fjMP_x-wzqw.~^!C< (ELrD`_2^TBXj%v`u\%v-AXӁ iJ9Mh\j@;LfmTuho0VFؙM-j>*8^J۩+}9/$Н/ZaG.uIp wHGg[ < ;b Qi ƲR5 >?Z,}ӈp?i&>Gk!l8N1v:q? s&q;97Su58M;ʼny!2̓~|(1: sY%ƍMm.UcU=5TG}$<2JpӦC]fƷi:-y-@|{xS BLĠc_:7\'u(|W*rpL`3iHw> ]/#BCxgN'-a&t,~WkEڙx[ wdL9Z`i5#%z\H)zKT8HFlz۵\׊ڹ7"5LQ Wj~TG>3vV*;gWiY+}̻{A @_ |ryl@VDvqz%rlR:M< `UE]8U>nCb,݂neqj垇c-b( enviQCLOϜ-6|T_^BOƼ)m@h Q7y*e _Np>HRvYNH1_ϨErѳ#"RB}--D }r֤e}f`IFO:..{ՠJ!O nB$bѭ "ھGY+nIXhTܝiK9۳h= _փij©ES,xT~3R|5o2A/!uCp>P: ~,t,(;鋱z@/: ; Z3Sf梅2!Tw6bߗջ]{OV٪(JQ02Džm߇ߪ>N5 (Z?W"țB-mWdH/[z:gr s7e%vX;6G:{9%\ OFNMf4F,mr lGc$Rdi f]iްeSA8!V$a)˄ZZJ_ľ6D4u &3.4C'5gn5p/0Xyu8%l&~uGq!h40>!u7L"C7`Xq(U}%_5f /jj$@owZ;D2|ZH]-_3}} 9.^R\U:?j}TtwE_-RGJl2sk%f"* mpz⧽Jp ~ׂhRH>SkG1{kL9o՞Z2q6?S; 9*oָ~46rqe;#Wn29_WYnJ7ͯ== 4V~6a;`W6ي}) $br;e66;!2-8s[w8z.8'Ж{|G|vKM>QڣxC[]nKKANaryfLV Y J>{M:Hj^ sͤ%w@ɕ!|}q+$ i= %W`'Qo}~>OiQز&,y-EIg&6NM0f1ea.D2jF ٻ7~ &h¼K@pnpW.tAo#8hPWG*/i=[=z{0r&%ж%TM"ыs]u-Wb=C 0; KvOVC&:Je@8p]͉4lXCbFPG5ܸynżȾܬ*@ӨJC 49lQA-c;a= +x*9R(j:y5=.L_V侬WUHhH]rW6d3(_ %3_-]zySc!$H 7*)xl{ۄst Y>(@˪x%5r}1Wz_hMٱM:yf^[>nk$&脑oya:* 3ҸyN5;=S3i }cWn<0LԹ0s׀~BDڗrZBm͜syGgm<\Alݰj K?6̘w? \(`Vn6.+rÅ/ Y1J@:J6h{A зmM{Wv4Z#W<*H[-%DVLvԡ~IHk(@Cyr$ۥYxx# { JՀ-^)I1fT ̮J3c)ӷAhlt}h^WM0Jt M!H9nZH$DWCq0ɁqCil*0^QAY|$]Bvzt]sYcќ( hXDo'~ǨZNkۛX,.ɽ>I"&k=M{WuaJFJ(Ptd!?ظ9E" b#h~SM͸ƒ*Ge@Tm}ldH\MTMm{^]ЗFaQjxdy:B{.׳ݡQSEx_՛wQ:CD̅#?U¡G:Yj6W 4fT"+J~i6nzRLd~hwCbhxqɀ/Bo'tt_SJ!4߈Bފ0Igua V決O1b^2S+_w\MKīluY])ݪ픺>!n F[e;cr2bCW άۢ!"]a/ʣV_Z(`uSicO-c{'V4xPùM5h5}j\mz<9$SK^=YNvi?fƣss+[MK`O0o< x9⋏Vv~Jb[p4b}nX{ͧ9ckxh^׭ل-\k4gن h5F2G Һ( ^Cʔş@KR|U߶`U{a>P~|1 I.~A3͙dcQ:]{HcΊ _AO2}7 hxfMQmId#=r X=1桉''}DhIZqk ;3rl<3Lډ rQl/goՉnv L A YR }/IfO6Ŧ*i虜,!tDF 1ٳw_}MbK[ jm>.Cn/"p1&2hsRvǻZh. pFgYns9 Sf;$6>oe Յ9rS1x&ưM]H;ni8Sisl*!#öz!4Q c̯ b{,Nb)jO`NaT.J6Y:E^,d;\!8f뛫,QTy l 3q.zY>Xҟ PORђ!Ӓ :rgѾk&9SJ;]sܾl4I.ǽwɑDDeSr E$_Oq5ҎQ֯@_u %diY W[0;|"Q@~V\ϪZ2gY5_4 !jc./#N7dk& QW7LYu;>I2|JUX |x ܉[Wzm^3C):]>&G^*wЃZJ:%hȳ6˓H4x(X_(Pdm(ÍL]ڜk4ߩ!hDDT:\0M8ltdh-*տjuGن9yvv]㡿eF do3%8X46_ /O#a/|pme;C8NG.^~j6@*dۄiEsY-iR"{_/ɯho  cb%UkVIJ'<"WQ)x6*b* y>ƫ7Qd0]gM)P:h(.Yذ~YolZ}@V62Zpxr1Mg{?'#33Q|2Fؽ=qoI+]lSK ZlElo=x;^pgHx*׳r֕wsw0g#0N#Υ*,)_%t*I|gB2ڲZ=H[2.? h#Q,8+>vQ߉PcDyz·\ tNy=I X Bk_=$ 6蕝Yx(@(ibX-&up|;϶;:0)NGQZ"D[^ɺܢ6GZO%ʒV!e#1I0pw>Y4'70I\jϚ<7ZHx%stSCV$"q! z(=~̣qa ,P3^+zǤNP[ín~.eA`0{$X#I9~.ֱOvzhL]s=z`'B/Q^/kTw6Imן?9!QmHN~ټq`BeJl@i,J"Q 0ՀwL1£fo:}=[Z;r301;1@Jvy~m'ʘu ])yQoWhDz)!:Jt|>Rǘ'>dL%Jpd9h%^Ye*{XDIiy&jb ]IŸCxZ]yck8W*58g8tBg8SCQgXT.ёr>j+ŲjS)]U<X?ܼ[,*2]t{S 16$7ou:&QT n퓘orq'־#*z; -'\'7x.b'(P# TfcHYKٳlx WeWt- Me KJPͯ2QWnKB9|.rr\s@1X[oƺAB{48= T|j#˫ooN^FG'= +z|G˰{n=3BFC1 Puwzua@I$Ͽ7CewO;ҙE[Ht/gIl7Ʉ(d1tfq{&ZI;](bkj bIJ`ܿ:!Ҩ&<zh]KNBi<"X.0:?1aa/iYL<ħ!TvK\=̴6U,[Bӵ͆*28lA{+D$稝-_z sT (BrFV:ԙHJNʎsȐZ3@2'GнDCRbӚK0ı&^tN Y`& A><#X4˽%R@#Yb H1iY;n! ?{:]Qg{4Fb#֨]g$׳jG1mv iK@h~,CmL'nJQaHy{pKV«pyQHף>Xk6]jB7FXiG!N$i.<[m1Ӿ,;i \~{r55W~vŸ *wt03rC#T`㝭9~`m8On'~΢Z̺kkMf޷nRi54+c`P`y_hb<=eAj[yZd0bI%]4X=gALF7HATh{A~? -{$/w&{xejOOp,=?p1f8~)<60+sPH7:TlEK64 Jq'kإH' O*:_[qK)ڽ )>nj{2} w`P頻-;O35oBM>qo<542՗A;']xe>< endstream endobj 162 0 obj << /Length1 1693 /Length2 4386 /Length3 0 /Length 5442 /Filter /FlateDecode >> stream xڍt 4{BNCeZc:}le013v$)kPYCW )))խy3ٟyA  2r@ZN@d!y5GEIX.s0Xo4`g"K$KMS7bte (쏄$b d, }# e0JƑItD42 p! #mpX_?O[&J䴂ЁHA R@L!,'J0,MhLC7(, ݱ81Sޟ  ϯN8ߟoodih)_Jmm| "#+(J2T w gߞ8 (2 !;[4 %%&w4oEz~? =ӂ[?2eLMcqM(dep޿%a( ,?6{š-$ed (˅\Uh;# ģL^I@ $y%% D(tw`YLq(݅<tՁ;_HYȿP(l@?vRByJDܖx{)}~CQR ᷚ@[DGÅR H9e`rrARNwA}}(~ @4bTnT /h&keBQܸVݹceysBgC3T8_5b^I>?L2czUrh9$%0N_MrX{٣q>ppC5ZC-'I+'fv+?%M}ɷD0Y:C90$ƽM~cI嶬k#a7.Ӎ1wD+OnR%Ľe%l[Vol=:[shi% k^|u}ߥgܓ <}y9P*#9V<ܽatr{>uLIc9 *MhLV/c2>}ˬrn[,~_Yv7_6Km[S ~&yPH0; {&u_^7!"qpСU IϢc:=3 'T}oP)R28*wc]R?&>Ϊ(tYywOs@$݊%I]*g< fRk}tXoU!r*/Ű?*CҊ bOzRjI3USʽږ=$Ii^QzPp_J`n?siHn դb!{N31e}-]oߔ;9t8 O>Y<|J`X"vΊO79?Sn~(D#pAYΠrQYn^3' />9hb7D15S@ct*fB\4^dI'h|+#!!BPXB`?V})']jPF1 tVp!MO-A#C 24%;IW3Up.Tٛwrtl 1~U~[ 53̅8fKm]/"F ººG珲 7DǸ-p94 vBAt>2n9T_m苃{anoV p <{JpH/to5h#-kf\ДSP7ZxXPL7KU ^Kr*:Sc60[ssTDNT2LS9"PBhq)(h#kp-ϯjX#ъa~&;=Q8jriڲUyŤ6Kh͓SƵޮ9w\ept6S0u5ܩ9*-fKTb>gC6,_Xdog4(rZߎI)PґC }/|oPxfMj5 jsM yGn)ݍq ::?=Ѱ. K4ځk0q6=4S+8;6B2}MӸҶj]`S6ׄNl\SarV~/1ñq3 1Lm`M.߮o>F%˼_Y7uVF)kP}(4لrO2:` \..bLN)}vǿ,^We~Q CRTspexO'fOr ̰6l%S"C>}SJp&9 E8z 6㎕.E7ZPc0kdQLмxo4݆].h[3=WI 2&;%r:J ӧ?J5:yyT|Zz1]-{(v a{6ue_wn#z+M7l CN>t>';XBah `w*x ,Hmz qOJ Y9<ܗ|u=yt?NBydc\Vr.;phې.YzQ^Gxuç!^ }Yjs}Cލ 3an3`}&QCu9se>KG@.I}Yi*+ܲB|Nu_y>_&K79I9lDcdhYznDO oݷ.:^jtw izu˲0F#ojj.92X\b8S'vf@Ӵ'ۻ*؃zUn-T*9$ ^}{R@$^P~*5h?,GJhxOv<ʂhsLK1KfG^kH} qeNQWa3GJ1GTO85NYӝf6B{VU̾m>1O;3e62Ŝy:6fQ?}awt7.g,M,k3z|+0Fȯ6zڒR>ʓv6\wtbT'~0JrmGuzr֍ endstream endobj 164 0 obj << /Length1 1743 /Length2 9205 /Length3 0 /Length 10317 /Filter /FlateDecode >> stream xڍT.Lwt )Ht#5C Hw7 JI"wtZYkfy?-]ns"' రaN8, ;"/9(C0?`@razCv0DYD~dAP5كN]5l08/'ٝ{: wj t @\b BA l rqGxx؀Dr:+/c OvZ[C].`;- xq.6 N?;# ~W(hn v󸃝~+ b .6rgg W}`(1vo޿6t؂]ll5aʫvmف`a>>>QA~ ^[[ E4ۂ?8>@8z|o[Av`?b_|( `ʇ?z@\/ _x|Bb]O[@ZCOi;&Y_D_Qo߂=~~?j3oe=`k@G򿦆NVdp_ 8;vW{l0kKĜ. -;כ⮬;U wFkͯ~ B@o>>Cyf0Cl!P_ Fb"^$ " Q$6i'X₷A[i$H=@)a4l$+hZ j@>=ef:YupVnU/ޡ9u;K|not#td(AA[{?кc\e2UF "c* ExH~@:VQT2|5e}&H<'Jo\;O&-RtjLbƛ^N[˻-vc"ycnӆU|hS3-te:{|?Ǩy{L nK;%l;E|Aet [ʋ׶/CMBnJsq.lڊ ?pz˝meׇ}] ̥(|RN5}*O FFl+mg*IvyX|$8|n?)*rFU5(x"t v )Bs>yxh*>(QF=#:"FD^Q^ub'Z.~PFx&О~-ڶ0ȅ+.ud5_+ _27b%H:JPiKR)O bNe;O6n G~Hȕ:ϜԋΗTH_0JUT6Kd~Do! ?;Y?dT;ȧyg_Lw$FVT|tC*(5_OkM?]Rt2,ZfURCV̺3ΆDauɤL`S$ֱICj>T$(zlV~}p1mm42đx)$&jdSc ne8EX8V_WTӳ-0 u!J{*'yqeI>|h!PV9іtԨSFAsq yUxAq'gSq'b^ ~R$H//,JFF!_oog1>-i=ܹ99fKBS*2:\0@M8?xZL;qaȍ'їj;/VFBFd" \-II%oSӰݠ|Jr8!&A~'|w0t7%ˠ|ɉu(vx9HmYz#G}r+R{UedAփ7Sڹk5_.eN(Wb1tp}ĕ k[oA+JMkQgM}{Ę\kJBLL O#Ұ觮M/[!7 fPu]Ta4 Vx>_. WH+~]K5tԱrl%03+( k`w]cڿ5'"ll႖'|>t&f^;riRa ėd1Ț[&f}ػTSH Q|nu\ԗT2Y?|#u$OUBK&.Ac RQ2n46P4r3dkF@` #`oxS/Hi"0B.a+W,ǚWeuv-Uֺ" ': 6\J:H:$HdC[`n :W?)pHbʱW(}3ZDП a69v&B~|";OWTvQkJ7g&0 Esbf'21~H[\FB'mH@dI;j>&lc#@*?c˳ X3܂:7[M&MSRYևh*)E6['Z.| O=&XcZVH^Ua X^f[JW$͙Tkxjl8TWX1N}g]".[Z;`n\A/(qJ %Ӛ 8RcFRXK0g}2z|Dգ]ei!vb*<9!)-)峦^Z wa0ϓu3ugʅg8|iGmv"|vSڸQUe+ Tͭ`yT>866ő!UKځHI_Oxߟ̡l$8ڝP=F"W/OzUTzOX%o|C!K9eS:4 '9Z"Xo1N:j:aZO/cm( ]SE^Ҡe9tvᤠ@(f:S7|ȭIgϹ'yiu]yE9\W^ w3m0GyUMܗ!`;ma]nܴ޶6UX-(Q:š_VY"Cp筄J^rG`;'yy$6zC_?wB}:C)#tyGCԽGM>3AqzR5'M/^mI5۳xV)`Xk^}]̀mա(J~O8_i{q2Th8U-6 aһxUm7FL+r*ӄp^ԜV}#boHsVa;DZf7_[7dZTB7x.U-\TMҸіނĽ/|ɀ0rh2Iԯy+> S#x{xE8 g8EzhgSys AQM*FpPpfb TuwoD%vA>8jn8z_ǣIF*_$8є- *n5L3nk\zJV%,=ӔlpɂA8K/OC r\[=,UwP̶{YmnѪYK"^Y)oGfv:1 I>l|T xsx$w蹅J@uA7c<in礶;ns4&rJ6|4LSqjE^Nx D6tz6~.6I)MBG;/ҰB ӷ/n̺zݘ<^75t[c WY}Ԗ'/}4R Y:DŽ3zSmQwIMǩvo5JbEc?vx$6Y3%џĮ<:XZ=p]Ee7(TkHc6+ 3O\dfYw F ByOwǧڅV-%d4Vh[0\+f3C#ZJ0f#cM&\@ҶWy} icInIVnHp\BWL!%: S QQ? ZdWHkBF;Rn< :jR3KwgS}xݒqs*#:=ݽ>4%k;7Jq9ˬ!dzg#`{i ob[W{B2$G)3[`e2tKmQYQ#8Ļ$ؠ8ʛ6S$wXh˼g\._LGoFC'TzJ1k`*Cc;ᔼ؄>ȦCW{4#תƠI ,b;ՕI]ZWBUC=z4|'YrXy .hO_vgvᮮ:_;:o N' R2s-jppNQ:VU-9E>Y}rٴH:ٵ{a8ix|xjA+JK h2.J+al3dEmO{`x٪3saY-"̺a uJ=%XY]Vv(عi|6WQҁWeExIiG^Z4jDNc%LOLlfE}1?8\yVqPIC~[ArQb]MggAe@2C}5*yľk˴싙9~$|S96-G.ﻎ,#cI?nYbҐ~ck&\.9AGnN;U-ާeM*AԔ1 tLNj$vqɸRM8Õ(NȗssoRU&s7ÏV cmyhtb-eFQ}BH3y&j׉#}^K.\ۗ2175}2qu{/Ȩq9WO4Gd,c+ BSrRZWFZqlo% Xr;N\JE~Vo@`{vDY4suۇ@s‰Uۑi Op쓫`SC ҫŀ4ı&t3*I7b~G#FB5݌YHaԣ?""Y^O1) y l;8s.ZZ0_W·;%8쾓ĐmiIor/,n},#+эU۱4oF{-G]-Wd~3qSiT2TN~e͙Du T]`2xzɴQcU[[u7[>*鳷,? }f#0F)t1dh [nwAGS4|FDDAHk>\Խ}0U%\\Jj1Pz*)RzT\ɏQa0#Ml^Y%|hJ:ΪJ#Ƹm质Ϻ\3!T[ ms;(|PV }KO",7BW Yc@çB|KGk"foJ*PX3㉊\QdB7qqՇeWWzCi< у{VJ94pJ%Y57Kk?╽ȫ^fiA!SpG9̷\&|А[ eT^ 0Os?BN9, (I[Ґ|lvnLtD*M\om%xvh\~~a] /iA%3 .t4`*Ɣhn=%J:G<:^B%cCU!}jNψ0Ȧ,둗˅~pW<ZO?}[}Y%* q9 .obZfμoU:9RZdߴ J8ލTE&W)ƀFo#W\$6XH*1<.e!%^2D|]U4~1Jn > $޶ğZ/=&vyT%7rtle/e=g&~;%I[!rqه^LFGyU[z'x8%xJDO>&>*+D<^cn;䣙:ED?)v,SXECxpDLdQAWbkߊbI;&S j*MpsQ٧ ޅZ~jD;:n_\UeGaA2wh Nv7OGW*rC+ 5C{\|^O_?CH=JyW(b X W4.7q求]:9VЅ'r›+򾴍|Ɖ2#xCH\/ U2H<9 Wk-H1WYZ>q2v4ğW}ᵒN:ZO&?%!"(o6p'YH}LR%Cjո[}W aEjf#:O68N Gw32΍-R)֎(tl#^b 9V@,F& e;7+e/~2(p xW<`f_?ASFDټy~H{Z]/Ag[H.PWk{x%DOI7z$ViAY~#g4'mG#=&.*V)*Fk0]? Gq`gd'Sod)%9eHU~xVgeN&@k吷#PzYdh)CU=.8Wc К%2磙8Rg #{Z `mzߜVeɢ% endstream endobj 166 0 obj << /Length1 721 /Length2 4672 /Length3 0 /Length 5264 /Filter /FlateDecode >> stream xmrg4ju :ѣ D%.E13 3ѣN"D'щ5DF^7]Zz>쳟˥A!0HDT`n `P<V2`pb 2^ `@D!c ȹ*➋`+\7"=`tBTʹ @F`N6NH@ CqA- p'0h8oM8?Ю,Z-A t4x5â>_//u'!p$ A!dM m<?wt-w p f?wrCQ t1p 0YP_z9 $N醀#VB- ]O?ڏcN;z?<50 ⯽bP? \""X7Oa#i|žc4׻9$ #d |r o Y {igKX /(lok} (V{"B-XOΞuZjuӘ'OM{$ަ,}'OίmE3;1|KyzI!TB3`eda0$3;6/3?=KqrytnEGu2rHtn%MbԈpsڧ BJ ;`e`FX(8WD"Q/]*\ұaRƨoV@~CM…bԙe3'3'>]}TJT!{QyŦr؞{ } 2%.Evpz#J, Jc9u}-*;\pf4ѫ&wϯ,3o;!@ LGl** 7$WWpYQ5Ϛ5# o9-ͰEq?sHf =R=]q'b."_{88  8ixxs=e26R>-MԜy$l$Hr*ReK\w:(_``M:ǦBԲmhR@NP >ѝU%' 13atLjgt4O ")<u@VoYA38IG 4_?)o~[u.ᅬpLw$,ttQ[ \6Qb})Ŏ72K@w>T8~5,N乁c-Tlv#$I2<-fJLZ摳lru^Pd<=.m1MMf+km(=[3/71,(m}!\.·ڔe=D{ωM^ E2 !w/3+H6= M4A'Z,Dƞi*s\F. ONޜՍ 6 ۹,W!#%Xfo߷90 )!Us*@>i}ޟ|Gv-z C-d9Du1N,tA po%ǞMݩvIeʾ&Ĵ6flVk;;v^-YlM.#&l^D3 KYOhlu9ZM:IQtf\jwwŶLaG|-;+qm@٧ N4 8$ZTcg3-KVn*?CmY;S^cyס8'"R\R.E(/^,j&Ny[뙧}x0Q;>vdJKo7f>!ʏs5hr\TesnX͈S)lY,W%!%?b:I9;D>b60*/꘤p&8y\/+5D 8ǒܚsϩRXKIHdݢxN m& V}ih6{͎Q z|yń'<3reh;Xy3E ="A`.jbZ_+2f%vI^ف7Ҥz3q|Po_-g畈 eWGߚ&PJ/$/32pDqDwu&:`O#4) =lp7X\~\m+r-]hQ"eG>xTh "#Ud5i\*!' xAE@}oU4gnş5Y,tl:/IZo8io'"v){gdXߟ;ٺE+u7{</&Uiѝ*v|0l (kN1S#k>w?{Y9Ay|'?8*Yf dW(jP ]~:e!=0iټ౱]PEf-|ѝ6%~R)'ryhz`v,z5bphѵ1[$1ʪ{Jb~Կ s;_<9|9t*ʝX|Jy~>M۩^L(ݡ ֣KHڪzԴDjt³ޘy&m=t9+r[lS3΄QDgy+3f^x_hiޠdd357hm Oڻ;=F!}7;\+9n"jqK5T灁?"(l ,A]Dn,,fhaP)Feɻ3o52i@{;H8dg%lo VUÜ{#gZ#K 2f}{UZIݴzEW1M;7I^_w󱛍^1cŐ=!m endstream endobj 2 0 obj << /Type /ObjStm /N 100 /First 841 /Length 4404 /Filter /FlateDecode >> stream x\[SI~WVuݫ&_A h,$%yeVIjᜉ8;(U%2KU ˢ,lVe!+$jPPP2Z UFC6ZT,—4FcT/q 2&RFai EAEJ|:³)Ua1͂pe0-hY8ؙ٨AӖ)Z?{"6o0BYج|/ 1+|TEG3 g {_hxh P>m@4ls8B䧍{ClfJx&6OtoR|Tw@7`n,`ŋ|M8?~>VAUz;VӇZ]CFG~%Wp:|jX:0alaKv41m֠F:,Iu!ףP-T:lLI.6?г =[ GX2Qﰂ6BM.# @BF_υxbY);D5GW?eKC2tL7 >vdeQ+@o?(L. Ӛv]u{t'U`gXHdPњ6:n{۟ sP<g޸x5\L'it$N^kDMY#ϝ[rCS+VxV V~! {2CWR|5$Qmoӌcl|9-qѽG$HU9t4Ʉ2qN'btEDo|UMdq. LFp3(wR>pwïf(:uo˷bup`8>\6~,ɶCb;:Fгɰfى8[k:VO&B'I靉EUS,GgB O2oUlr>hkNIj]vpJ۱8K38;Zz5/r΋8\u Cީ(1n|{v2M\ Fj keԭrfPKJPNSB3WL 8wj*Xi4[YiԗrX>7ZW3Am&h~a{wb-]MG[|"K\p`8rjNe,rΓN=Z:ppu:P;ZFKyLr=HK-Rq8gU2L` j!vcS+;a&@1iHPF.|ԛJu.I$D|j;+Fw߆KUbGca.]!Z1)Sߕ(d{Oӑa w ֑^F`J ,WzG@VGw܄|Cw<(SvRąiaGpz閏(;S4=,r'@siosSX(g}[zH>Sؑ3+|6!I :avd_QɕUO5y㒑 4"I6&H"*rtF9 LQ,iҳ SzG 8j1H]Y.$3?@^ґu#v#Yn%Cjf4v$;WB ޺$jͽlfe\l<1EN3`%=9m:cLIƔD٫-Qn)3FjI-ސ3%9̳\U,cJJ8Xd@|8E8%(nICy4N^kS*MR 65Pk\PFNC.LOɹ2zlsĪ8_8Yb*)ֹLWܻ"%YE`/^l%I̺,1HLV-I+/# S6y) k#Z6Ohz%;M 0>kcJ!m )%1U+cOđUtg݌]O;>Lo|y3LzyO,2\fḞ__3m 4Le 7s\˦bG _;@U'o1UQONVɭ3q2Bd/7eWwL =ǟ14Y#b}»< vNp%Z@E@V7T6L`$ eȇwĠmM3sMB9dm꽑K2(wbZN6+ֵ2{A~Э|eVzF+-U~ƊRŠױ8IkWuu3b4,+Qhw)=e;r0Kh3|mkH@BƃMY%qγRRooI?A˱e#ھp˨TFE'\\ǣ[Ϣq#7j,o.pz፱*F0|Oۻ> OX7bY3?3v~"(e> ]xi;<=xjӉ̅Vމ%J?繗{+-JڣIAAd3E|n[I>P$XHg>pÂ[˙>=zfMҥjN_.ۏlIKy;v.Ԇ_[;|B-%L,oZeq!8΁Ƃh6 X[{|݃}zAނ(پw~!ö[C[W?Ojp?& endstream endobj 168 0 obj << /Length1 737 /Length2 966 /Length3 0 /Length 1535 /Filter /FlateDecode >> stream xmR PSWHD0´*"IJ(T6! ;T0$&O*". es%JŢl"D@& u!әΛyswz2#Iqb0]Aز0>d&ښK@!☷@k!XdLK"Pvy#  T *T,*KP2U! Ġ2A|y  +E2T Q1p ;@c:I! ARb\|eA|usCr#T6+r̒ ,ј5%Ä*&JPqX7_,l=(FC!Q2YP)IHO a$L&ĨNFKrTE2|I!% P2:00X&B$%)IB T)?)} #8&K+ȟV&lI}W=wW&5^\4Wf-KQmˮΩVe[+3w$J)=d@j)܀7?˦:lǚzIzs%e6%nRuFܻǖWE~Qq}ď9eh8št{$ꎿ}'\i~Vx]p(;Cx148nH -5U4pm1t:i%Ė.+w5nnm>m:]d_&5;R@Wt_lj^il~ >i[|V .Fْ\I0M;үȆns_l`WhA`,mk[ෙ V,<^uZ>8\秪^_r;9J"'|S/v6AJv{A/rlqq2MXFϓK6>CwyMB+597f]fiÆZޫ{V4jA-8w+Ny׃ߍo`z=J)%CF+M|_/+LgOU>&MXD㦯$eE3;qM3ٚQq>\Y?|dd>18_b} endstream endobj 171 0 obj << /Length1 725 /Length2 15948 /Length3 0 /Length 16495 /Filter /FlateDecode >> stream xmctn6vضm۶gNVl۶mZ콿~=zUWWWw9&=#7@E\UHCF&lfj`/jj 039̌L0dG/g+ KW տu[#S+;+g%]ōٍN*ffWK3@DAQKJ^@)!07s6(ZdL]̨4&VBofή3wvȉ +ȫDTEFYۻpmfh#d?X=#01LL\fV0 MMrfxٙ(E\͜rfql濮FvV^C2-?*+q+O3SE+vuv3Z?s#gfjffpϬ:z 1(ȫ+i O,fo`jeoPqO#gQ۬hd /f\<:J=73#' d_pMܜ]M?d2343Y_q0 Nm -+1TYa^A458¹Wß 4ۻܕo&63;& [y-&~W׿SǶ3sMXRb9v*C`6,Gډ_[|ң@3;F )6x_ wCm`YPx_e-8%s-J^;$tŲ!r0Y~ë p )SɫZq77K:C# F .{=jϝ!*)=9B_nu2`A\gvLX9 uTl47/i(i[t"\9;#!E>#}@ٌA4Wg A2ĘKFS젷ПUsU02 _5d xϳ${zf6yi^5U^A S!}w)!h %SF;rB90.3=ltf_<9Ka(:y,op#E}r#丂Y |/xISؙAXgbER^9 s-'p'w٫Y5(ӕ|3uVARb$!.D 1@0]I2 g#^pTNYh߽Y~tl2 W*TXQj*zl}t-f:nVMoPX"*Z_n[7*JSkU{uFs'Ldjig&kh֎ wA3tݽJnKn9筼6[o/[x ]V wAeDH~3 }Mg⺈w;k}b21%:woQPK"F\H1^g pHUcf Uovey1-غ aWڠxCL|JRzV>= ;JHA[;`ك;֣'-A!W^ aehīO1]eV O \ =V' }]^Qc(%OOznu<ĜQ؋TIʪ+eA%8d$ d>#gشgAnK}W;2(G5}3.}ysA4Ξ=pdZaQe͆փ$NLjJ)?ɅLo/IKcR!q1hHSEzsu3Mp[HR9"Wq;ED-ˉA0Qkrl(RDRT2;]b׷}7C輀썩$ s4|ɏE]Txp8TQ*}XWױZs۫ozMZǛst!G{~V7N]j[vjxa{L뽱dKc݉Z]`a2&+Wk Mv^a&nhkS/S#7R-nKv՝fŧϴLBCr=m8p cM7=۩ej H 6y'{H@$_MWӦ{_^gf2  B*|Xv-@!G9L5fI";1uCD(T>'p}ua$cc }bu~땺W"tFB@ ]ӶVc+U?0|7$:NW6U 0Oτ: T|w^)3)2ʿLXUܞ~c]'JP2^Yn9g%:N_1P8-vЍ'~{"瘲dzr~a7kTU(jߎyw\t}ƠD񪉸abR3|g$#A^!M{/pU#_§Em? 0i HGam4pqh@!#Eb. .lXp(#\u8"*57ҕ:S):e%eOÆfpgq| gy%CHNmݺm^˭Ƽ]IߕXx0J*_s~.%#]VBoKd-OSmf=mu\> :b( Xs'Jcr-t#wN%TAx @"t-'3<0zCVm*O_> 3Y%rqC{nf \a /E #!8&ѩE(g{`^ay 0"0ۯE&ymC#@;ܝ`(F[.gEq`Sn\^A=.#x腾*/\{9ؾ %:;vv_=}~ZA\7x- ؈#u))I*hof1ZOe43R"=)g*̱$D'Džs3c11զЂ$`LV@L$ 芋R? 9:X<O@WrqAcZդa,̮17yBt1f gtǵ'&"e mڮ 2y ]E&͊bc:xjt:F!3.\:8nty}\y?Z~*gG:{2 HBHU,-0I6v!rQ\WW0qaXx-ؕF(ngm( 9FbGzG YЬ /uV_l!Iar#?Ol\7"2 xϝdwP"/B`pϷ(-jК)j(rgydLlJ^l% ie9,b EU]#'s @{ܜ辧Mv%Rq A>tZ Zjj7?ݨMy+mI\3z'F`rACDiV-!vy}]!h^ UI!Qʉ`Nf?_ E'B_wZzl-ZB _O#R7|pX5J)(P~$hlOq֗߉UI};uA*8qp)/ sna5;]<7@ "{RL+.HlQn5q-&\<2htԹ2z.Ab·uTA??eSC[@0C6T3n&, bTU_!|Jy(9ExףV6e 4'>qR̭n$𨪼S4?ή0LzLQb]{& }qe&U2 ,N2J!F 7؎zotwq1hu{*nղ|Tk Z {hۜխ#4! 42>9N}p$X-o`kkc@&Ds6j,z}tƟ"*BflUbQktw3|$͹GŪ@U#dƀ6oZ9CPQΏG:j% (0knb>f7`*%FXō("یGJ84P~ e9Ϛf*NMW(s &Q ;H膿 *כ>p*,}KUhHJ{寜BZ=p"꫚(0#%)XI|C%[ݖ@45QJR$AU%>"|{e-A; <]brYZpl0C#bѨ cH-'{ -A e%WN" ih5ј*=(VA8;x_jD]|K~= H"ܞqV_Q6O0!ve~Rmܪ}:;3$qJ;*MR*N±):O'ah9 Zsپ|.nЬ#]Y=J{V_DeQ|x\/sr$7]5NFp(mLB7S.4f`=F|D, *l>ELa rC 1",/hR;Mr B4*Y9r)`ߍ!fD@MvHw>X=:rϿKܻ}&Ր;[&~Fiz)v$5BQac!788\.\kV*tXҷp,qX79bVziO('UU Bڎ ,keX*ck4 3ǫE6-3I"#~ϕ&y"`6(eGP{:kiEc [PP,=cVCM=jph6izoOxSvAb7`KidTi[EԛUSx^~Pk*<g>tT͗*υ "`ew9i-(pL~w5JY)l͟-Pe]R,ŝ%FL&F4=' qD?q )3q뽽ob5y%+ Ҳw_ᶟTl/nH9/@JD|#HCp-b3oDǗN3l$̾.yFH:D£Dv"]O@?OSyqd^D?E$d0P?|||Ղނ@7$" WPHԠ=_>qĦ6! _ˋ&s7'VD9!Kf+>U.Ө I.<ՙ@"g}#HkhmA,r3ϛUUUi>ěGgrz鼥 #,dx{kHn*xȧ1zWI=C0{_wmsHs2ء#Β-cwF5K/eI<*~߁_q*.),+w |(-b{2Q%xLaA,;reJ-JusȫxK8RdWS퍙} ^ `ŰFK$s,%ǔ"C%S;5 `AGE"q\UXx=6~^g9o_sd XW Tߴ:gسFlp9ҕyO}4 s~L;Nn Q-zquk#esmFҊ͔?U7drў"kwc)%;Ñw{=LnjҖIxL {޳lیUv`GH$5wtN$ J8f> Tԉ̿sb~^v7V߱Qb}+H1PǤYb1<:,4^4/#o@ъu524Qx13bˉN&%5%=Q$f5d" {^ lBc8I)ni+Hf= ZLtjl֪ĕ;Q P|LȰP~a90y3M8e U>F@?OYxm$G#̲F;i_3@8@HOeC%Pɕv]Y[}`5(qz;^yWmY1`ڨeO9;za0{VS͞V% WkC aBMݼ-VWҋClUZIY$(M IAbrm휹V1l_aAjKC]P \zb=& <&T WōG*nG]("50]QL%W䲋us 8 X #mdǢxgt%WR +t4 0:JV!sjZ,Tv> "[`X 2.6u0V~)ظdp.nRn"X%\A"8]e|X -~O'78vIQkN\G,^wbnQd" ER>-d 8҅AzyXnkfP3AP('NalҮ%Bj_5 F/"I;!(-'U # 懏rΑ8 ?5X:\tL} "o,CVo=Ymc4-r ƕx\oN;.H R@\/ |sN[fv)GF=9G׏~4KMpv]?m?B <SQonW/ʮy. 'Vv"3R0” g/1| ,MK<.j5_(7;=ANʯ`„q2Tu&"RMX1 >rY[P~rnsF'gB]! $i*21Hy .oJyܕ|}vhvax;yY4Ĥ tx #ݟu3籍Z_FgI}] BTllC1 KK߅@HTY>ٴ̺{n#IKɡ(AMդcqɾ)D]Owfen;E~clp 5 G}V7_%%,x%Op}zP+)5`7·9{5Q H2p!Qh߭1N9>^cDL>ezgIrNpՇ;p،V ̬Y}`C|vuES`qc:~X I7Յ79QH:ס\B/i/V&>DuɬLujŒiMwcEJ7=~A=q'QP*G-_ {5Iz]O+N>ӋKN3 %~0qzPieA G>3/3y]M' ˓pEd8щHT5N~ Av7 Z i '6yTt'T f2=4ynS׶61nwGu%m.\SHP K7Zkږ? EpW @x@W#3? d(bAg^r> (6ohpp.@=Sw>h@-Zw* G-:Ƚf3E^@:=ٹCt %A[vr1b wb /Ζj-p |=,aT\.qXĉ.s>mqN;z)k+㊸aT?/۾3tSl3VES46o<`Z*=Acppw=hWciJc8]֨}EM-ȋD詝%فoW-zm"<$7Ԑ @`"Li -3qVnn_DFc )QƲ3$ji@@IP['RފvtBJ.)U1diGRԛIךl[78uw%ϲjK2 pysv@$G™26dpMH*7Ҿ-de QL2;zxTsMv5tVE# KFmAI+hwN/0@M<'-cXH;@҄7J  9ʗG/{*[ӪR@A j(5,!R0H9]c5٪9"$;}O(:a"N)F;.YږKȟ94}NEb錖1 sOվVsУ=4g܆l"`E$1D1}tĔ*MÐr"&vޛq:v{$ ʓт!]c򙬷᭱ݍCs>嫦ByeDli>-eTa;F;far2лcS(ceX~ubO}tr\JE]Æ\KFiK-?R;Jk\fkyWsHFʧrg,3l0B}$(\ޒؿE4 Mg[7aҵ¹/IɁ1iWK fQ7"oF !B)u4f[nۃYK2@(ÿ!+7gn=VZ :kM9쭿bpbiR5Wܓ5-4gʿ"Y $3l ~Ja`m +^%+"G~G=e}QAR&2$Td+3mB&223 ojvς /});;aŧwKaD\mMU|.hըݾ,ߥ4~[_P)+ӻ ed 6.HY sj^?FuC"i?A/;&ăd&L|Nmm3\! J5{ KK6V3Y?sު{hRkG_A V0iC/mCZDA3CČALx"tj\[eJSX мƇӏ$+WU+=׳됰6%;U'R⍜ 4dmj#$i.}ʦz*6̋cA u=ZuNw9?ȣfWW!&NLOlh5FUn9c I'Q W^o!#n@c?%/4}ӈQ6]ݠm&M)Kokq ~#$DfR;ҩ]_ҪۿV]zv@=ǹ19{9fZ"qxlV% 6& dG3@bLzD vÊBmĚL8qՅzΦggh4O͗ [.*(KϢ̃$l~%n"15ܨBKsb_+g-}m\:$m[f݉'Rz&]hDF5T|s<~™`$(ܔ)3ix4 RBPl^ <D uMKEٌ9* U2Ē5KM`0 HlpR((pujh+v9FwGkz%s%}?}A$w^!:3Zj\@{Ed*UKl`vHf4$ PҚ#>a4+ Bd1rqA9_^qZn,њ~\*1oNHg3u <4_0*gL5NpH86]|Aou}Ai2GE"_a?NW֨ dMLxVO'(G5Skz㽷Y3}l8~x1e.v%z:c^|;PZܧdΜF #۵"~VGحnAŌ&9cm 5P&eHxʨ>-%Ps_ɒ5S)p3%A_zꌰ_ UIl7]@5~D p 9$R`7CVDnSC^=ܧ?bk&uY7 3,.cwHCq<`iq,* ['^P @o fx%r˧gmU8 0((˸R\c$ Gp3_p˧ (B`>ч |Ug{Hv$Y j =&M|ˮ5J8]eh1\}hN Zu_v|wغ)4 |8Z0Rʪ 5\B;U7_fi !R܋~=)[Qde]g v$ߨJ-ݖEjiZq2)0;N0z1R*GI{['gM0皈$ 3 Jb_[@XCw]L'Ӂ['qSpL..IS !U]h9 ^^EE<2XRdljog< VE#SQ x{{w5`(,:x,ْ}^᳢/xk 86y00B6ZVb@p$gƅ\x;~(o[_'a,S-w_$Gi)aԟ ~L(O~Jzc}]~ґ»{cE-Yч8~8hmVЋ>5KNs K讁sRnpR4Ò;zkxРjP *L ڇ4\a].܅TW$/ &1ųf GRil4X$0@kN͇ +{咀1j5~ nTmkr!#<`*O#e]IX^\ch ' 7~x$W7>DpHz0զoc@?1NtJMS_\Fd[Ӛ>,䄤=^,]ƹb"F݁_{3ưJf-ceU܄ϯ냚 d\ "ՏT*$ !JAb+%(Jh1 3}L{4P\/D~+I{ubA-FQ >%)q6 0kp(;@PP_;2sb*ˊ_.|.#]<KIVthK+q)OF |?qIFpܖA0:_PCXX\̹4IrOlefB<2YR,cVp9ώn1^|.o>K&Rf}bF]ЛVΜVbֻD$M&)0)l`("̣c H O{'dA&ΊA?W`d gCm)5NƁ r<@Bl4dW+[gBtiּ;LF(TEpl \,jm$ uM/~[6w],}WiB2[#Ni'ȶ[?%FJ`I"Bl,j۝W(cx;V*TRЏ@9[+M10jJ}'fDPP@Y75B6 rbQ1EOQ0N_9h6k,=ƚY^hlCC  7 ?:7$xa] ֺm|O*&ȪľC}_;ɧJZ0D@)m_3Z9F007YA"dZθi| lN0\lsL8= S]s&"AHT\Eq2D 1!菨 fA6& YrOx;AH/=f_GV_00x_C&uò)GgNjyy-{5 2.SPJqݶR8zwu7r|T+Kz6nAYt*QՊU?:>GsO,\1TeyhRSsQf k? nQm%\5lk~U};lSQ69wםqZd>u-vr+ oP$FM]ySA&Ŝ Y؈ ZʭDcb1;KJ2C!࡟p_Lv^)pIN:|hݝ)1z. endstream endobj 181 0 obj << /Producer (pdfTeX-1.40.21) /Author()/Title()/Subject()/Creator(LaTeX with hyperref)/Keywords() /CreationDate (D:20211208182958+01'00') /ModDate (D:20211208182958+01'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.21 (TeX Live 2020/Debian) kpathsea version 6.3.2) >> endobj 170 0 obj << /Type /ObjStm /N 41 /First 326 /Length 1316 /Filter /FlateDecode >> stream xڭYoH)1(>ݶ4\In3Cb@jې6$xW}_U %y p upT+NZvu u &KS:&Lh~\Fݞ K!~ڂ^q[M!u .=ޮ1t/G'&Az禈gU+Hst"M⇅w ~9%tV@ϥ BJyw5mzQsiIF? 1#MyeG]'7z-q)Nx\ ic] .9b% &kv A'%Z5 +K9^KDO}܂/sIce9^zB/䟆\Y5|Zz.L8|x7h5z^2v*ӵo\ r-<| (9O_!Wcx~'g2{Q{@R ^G u/JG݈Bx$FnRI ;(2sb?0VCݕ7ppNPrbhz'twfa)"R$ݎKzQ_/x+pq^+|QI+3}s=3+ WzdswU%s*<*1b9 q^(*~i3:4vyBϩ<{PTQ;Ny2vpnWʯr%&wȘk]B-!Gm^•/o endstream endobj 182 0 obj << /Type /XRef /Index [0 183] /Size 183 /W [1 3 1] /Root 180 0 R /Info 181 0 R /ID [<102819CE87269A2620E85DB7E53EF73E> <102819CE87269A2620E85DB7E53EF73E>] /Length 486 /Filter /FlateDecode >> stream x%ӻsMQ8'HDDBD%q N\/PktJ3R1& cFeZc0 "73Z[gu""eY(2H+II @ʡ$U2zr"Q,X +H4JlܼM @D'8FZ,J@gnFEkSt|VEˠۯvE=/N@=w[1Z-ۡO16Cn%75* 4(o0 *x8D;B+n~8a a8Ga&p&)EgVtFY0tNr*K?fʈyW ϥvQY+KfM=tSvws+{]r+~}vfn(6tSw[ʿ> stream xڍ]sݿBәL$oq{3ic)m$GRg_?>uNlc.oϾB*ӅY/\P/Nef~ko bi2 k:yLj: >.<`"寷?,4pZ:XeZ9]1{W˲:S?q¿}weT(2-U2X`+qn sǐ{6]N\E.qlks<H{0De@x[;\?z=\1@)+r)lok@JO;!)W8\奙6#@d=_9sN Z.r֒eҶZLL@m"#S{tJ:]* "U3+e-mP}iayd6"^l4.2aڣM',8HDvNm'6p =0Zk2uRP}HVfq'.> ?|k,mIۥT"e7'QA q|G9%#s;?5K9O/Xr7qzwTIЁVc{/*,Mt k"0Da4#9 >f 9zp ˕%E?Q7-}sBڨy~*sZHH 9H+[,vh"$܁*]>[dL80Ԩc , 0U' gRaa!x&o(Kz^7 ;v^eȒů=pC)L$K^qx3<[-ICDQDZ!+>n]I!ն>Zrxc祲㶞sίf:}@;o R5E2@6,0Jؽ{u-)?2w;|g  zHsVDKa)H;"5n'&3 %bݬNY0udL^Ө}F~''n|K 8-,Dvի kZM V|߾ /k1wB&/zax k,op^%" F@ U%Ǖޜ eG3Hіp \֑;sRVpt{8 nf՛*; $w?eIp}MAY^F(AI!5Я}CSEДX8ZV)+MMl(iZٞ*X'{zmak-:v,U1$g.[!8=9T8 5o"S=w'n=%lυI@H%C \DZN`96^}%G%)86>ePC=dF:ǓBרOF>×"|t}몪|*fSsm6]>Y+JO)P_ݖX; 5uK]6ΘA\y|~>|zi](T=|Ka_-+3g.U\vs$@$naA)G\|D/COaPVqljv A{_y}?BD<:`9ɻ;HҦHWB`@^^~'cG|À(?=Z~vY>DN>ud!,WT;"4S-=]tH͚:+ zprnՓEW9Ȗߋ=S^祂<,4`} j4 ^^2FznMzf' B4<{=ϓr*/g}phgߞ}:.BC)m %,/5lըUgh ?g{b!AXe \> stream xڵr>_T`i4ĮVjƖk hsA\I2:긶]\yEgyqu;W'i4de0fu5fo۵ۺ kiV-A'c>[R$%I ) aL" fvϿor'GPw/>ܤ*i\xdy8),.K[}(I6<#ĵ1}!~=C$ wiuqM0k6jts6)tvH#bi%w|br$P ]1IitMLOI 2AAZʞ~IyQ-sGVF5e^O*-o{MHW&~hC3"6f !_/ĕl|dU$FEsͥB)ȝxE9IU(v~[l]DC R{ !9'85QFB ?}WK2, 0&+Tl2uZKۮeUu l/0&:~H3qAqLGYnygC:gݺp [କm9mr@^M^ b|b eUT%p@!bD#c#ue"BO,&EҟoUiX;ulZ4O L"aஈ,i?n8<@s~XN# 8G>ceM; jG%( [>X˵KSk2C_i\jVƦN$5ƹx^ /_447qQf*߉sIlLE۔ l&ٓ0.rF&Dbбx L}A}<ٌRB 8l ׸kak2-4V~v^T,Sx tI[OktF|c3r@gq M$z%]u`EXtACp*WIצ)if%5@痥 SqT3wf,Nà9}+",>o|9Np -ڮs )|(,GF UM>6H , gʐz$8#C 0_HܙV(<͘cڞm;לo7pg#plu|$t& yz)M ۜDטKm gf|4mU?&wge#jF{fdLxREB3 5f&#km׸5Ђ Eh"u/þ;"H|7]hH:߹tp=WFy?}=t3R:$*Ϗ`4UDQ[(!#aO:KiTUE3:ʢpmC3ߝ k|`J,UxLCƥu[?q'ANk꾖&W5I·Zԑs_,֎y\YDP ?ɠ~.IRȩP'X#“<e.X*BQ@7V#Ц J]x~Y%E98fB4E"w7⠞9?AtEY_|Sex,4 : #]uڜM:'ͮv8+1cy„{7z.Mm43d*j ʤH!g *Ob9Z]r>p-Ӳ_-g|l+ F83/j鴌qF3_ξ&8{G|tJu7:Vn-zCT6cEp#}2x2Š~e&Fx|3 _m\ z$(`tF> stream xڥr>_*!9$Q%eɕDg@H A7xQ(23~8ȳby`tq]Vk-~-;t-_XgجL|ą|Y adsx 5ok!»s<09^gŏ uzDB;ݯ}EXGQP8+@xyqAlxQ_FOxoHD )&aD;>v'D?,ŀG~]]{M&Xv dO )e1C>l!f`'H$^T{DE.CQIfA JEZGa.oA.Ƅ*$`6 VEɭFrϵYʹL(-= mBH!s!觓Ba_WE:ڔ9]74OG w2f V k> 7FC+V f&ye<@7l8Ya13AJAu)"HHC6.&{$DP\nlG2rdA n4⯗lHaKb :5Oi]W r&@_.;3C#1M ҸsUnW(4?AJFl.;[w`j1p68鑍TM=WdjGSALLBB6ǖ_6tӮmUO/Aj ?-OSw`]2$A(SofU[҆EB+P3jqvY+&@B7D:;no1/FB<'i VG7K8&;MIyD$XkAm(+[X=`@DJm?.QGs^!pYl2Qn/dxZ00`ngi|MK̰{Z^…'ڨb-{(&:93c`g* z ^[~4Dž- @ f ֱ+V&[ݤl*L.;;V=;W |NQeP56ȈN$ҥ{:x}/J1O8`0[V+o{C?;Yg:w׹C61(1hx熸c_ngG|!hj]Y(ͳRފco$$lw(,jE pc9b%eX+ΨˬbZdToɖXL!d&wʮaa5Py(LʠY%r%YUE[ڱoT9jMYFUѨACt'v"o$Df`*BI !N)Qk (pQ8Fe+Yl4sva.|.n޳8"Eh$C xIF+u.} )X*z;LO'~ξKjNWͭcn>5B#IV[12%,v)Ui%_Rlj]ѭJQ]i"$MUٓt\KK]iUU7/ _U?$ZȒOG;wƍɥMmM9͟v_aJƔW~=L=S+ݕt-,["sNqy?u {퓬~m++"WYȝx" FoE(S I: /i endstream endobj 83 0 obj << /Length 1940 /Filter /FlateDecode >> stream xڕXKs6WhR3E|ɮNR%'6=-H IEv/H#5ӃEv~Mz*M侧(zY/羚g?SO.oTK41Z6}b~`3ԮHQyeqI)0-#lzP;|.QPf{R +Yˣ%8*5;,Ao(姑 oz#TIVwf%6 {Ff\bx W@ \oC\3mbCVNחsTuF~8Prh@x~ױwvDw[ ѥY~=ʤnO09 7~ Ѱp:Y.oY7YT cȨJ6H)^`HIM^B9~]hMSv[gװtq-d/ sZ"^VNp4[sf6uh7v#pp/:"LvEd`H('85yV!~> )byRHI9K;eW _hEb dž |3`"+fsAR' -*ͱta8٥e0p2͡qQԧƏlG= Ԧ%/=H#N/SG}AW\ ]Xp+5DzW M.MHq&QHS-F`L\eE$ƺKS=P T N1-$<^-L4qiE~v0~)kKyQ=933?;XrF%VAK꯴|2l6KuשCd E4h9[4 ;Sp\[{~y߆<Sa8y7'Qqq|v4m7׬rU) > stream xڍP-[p4Ҹ4XN!!@ x %{pdf̜^սUھWQkIZB-rPG76 ;@ZE fBӆك]\!PGHݞe2nv*PG= 89\1d= vF' uvX۸=# t@@s7sF=@ ݼ+'+;Z qh].`K?;cGh@\kA<]g=vt}pwjN`?4`u6 ;pyq:8;zCV{0@MNˍ`hoa7x6rss@\]![e-`G7W@\csvPOG߿wN:gw_&"d`7/'''?v@6k{;P!~ zn?{n.`+K `8Y ?0|3,1_-I%e?;['%qظx9@FWUtS_`k9KZ0qrTΰHɹfCQ;@2x&@M.unk hm!B\ ^`KuO)cG:R99GX {)eAP 0wq1F{37Pgss+ y8$D?7CS p84A<೥?HapF;8I|./_9?y8A<϶ωQ=gBU)cZ\=Ϝpqyn9<?Y/_<_~31i`/0mn  i$dKgbsiwDNar)2Ѝ.x!1w9%I4As|mvwx_7 Tr6m-g? ;f%|gwLBkϯ^U. Mojl}{r-F'(l"15 3$nK4_\7?|ksvВS_J*FGχ|MJ:KHhVrmg'(^4 gx 7\*f4p@CkEypu#'9u;e@;KdQ$7vNaAxaM(OMeo#ϊf3AҩkG²Ma[,(6WC͈Pw kY2m:JiWp9Adʮ`KKSu% ۅ>(ZmtM̆c|*^pt>=]nd2/&L*2fj~ w"i=v0d{?-g^SQv/W9`1L#*ݽ{_? ȇ *ɖ4`n0)OB$ kN\8>O>s#8) #QV>Qٽ0)x ,_AÑJ55pQ0ptfSIr!6o? 9׾Zs#گ"Դ)l]~kV!ذya=>N00Q)db3r5[zS5 !y\o"w5&9_|A:Т9U/lj_BqХ4jf,3%pi W(;WS`q?tMĨPwڿoe*!+4&2C)^G1]gɻs%:渌vh~Է@c:xk~;nBXi[8p>kDwx-vG}.EfFW/wƤ3EOZl] kJ&:)@io'uhے hB%k|fRľ}{c4\|,#Ⱥ؏e!ӓc%q"ěh= Ԛ+Nr{{q왜Dz޻;5_yj1Htn9_ F7IHu'ScC`%lYފxrS[&c'"lqrMnzUW̫-'Y%52Od|P6vjjVnAVJCDqҨ:z҅D<~xNOmAM$RbwV@tQ-酟~:Zm|1y̕6m< iSf%ޜ廚Ս#"9"]*\=ƑfRrr^|r]Oqxkv1}2@]/ǥ~%jRKOd(Kɛ[HB}eMٺy7օ ೝ]) k0<=-%+yf~mF[@Y~rPێaIj͟ |bV1]xwoQ'$S,h|M/Px=~m[3Xt׾V\L)y#31`7;>m/Uw_I|{:LȈ mK;zjCDŽP UBW.Fz!GawSC΍ʏ t;I+_\!G" rZ'z %110 "SW+{CD1B+3"~؅ܱ{%r}N{o@~YMJ=ٷ=f黍2ER=9h@\;D'5-n9$3`?72:mƑWKH4ӆ]s3h#`uCjдi%WT:4Y2X`AVI܁m*?(Df 1Qs>RHYۡ^E8&(W Й})39-^_/@8XpD1 ۗA ifWMd̬(*v_f |IL( \@> ܒl@@( aV#$+e2)jv&D4%hs0:ՠ캺YaCx"4w.~^#A>wᦆƖXG (mNsŧ鴿'k&KnE-^2 'º$e/E jXEDSqΙm,f1`N<ӂH&TJ꽈Me!@ "ϽWk41_* RC;IDXHu#䅙)oiϰ5Ҍjvup~LB@,o5-D8Ua/"Sc(`tٲ+0/yLJO1HwLJq-z+_l왨SoAԸFF D>L]m ڒn6VeN͓ot5bAq,`]N#G۩iGbɉr0KooEp&_i-ʦTxrZIS<n]H~}v\%Dh0 [㪧AAڒ^Dl Ȗ>">YN,$Fylg ),'mמఖ?m]d.b}(d^wՕDZ%x׍؝r+L)aTs'bIA۴i4#llsWZ%UEY7Lo}$D|KO...̋{j s!弋akjrIjc}yQw7;BB˿Mhg  # un(v;ӑ P^Hb?T0_3^-E;IǣJ$sK[\mx6o>7cw~?qveFQcH3T6_84?ݳ@F3QTEǁ"S毣{dl~(4_'.qœaU R'JoFx_ N=#T6ʪ7pÆI_ϺuTt,o'c7Rt`NWW]g`D9ڇqjhlۗUMv\g IўQ piL r b!6X,:g8y} ZPO h~(2u%ds =qҰu҉- I5?/2u \S\; ׉FXnmIxoJxXfPX2e#IjA@4hgխQZNhPW#hS# WAÏkaI{u9Yڒ<~]b2H(iiГbs'Ak:F ߝ7&氦/N=@7ޑY~~v+A}cu΁U0)xj}cTJƦHJ ׺؂(?S"X@kymP~\)Sd5h(6P%;Ÿm՛@!~N|xҭqS{e5vzJ|F^%'0$`m58s;F_c벶niI6Ennbqxs%S&|N4YDN̎1ǭBm@f)60xmNb_ ˖ X fY/WaFqMpZy Cu؜{?~TOzp0aPh0/#O_Y~5xKp+~o0:O1q3DwcDg@t\}?-}~XڕOulvht=vG3,:}pڧ/ᑥf tyULT}3ջr"pUrG*^Nq< mC*Axe5aڬ:>f|G^yv<'in^ _~Ad\0a9WaUߚӽrdq%vEwQt~y<9.ƗBsdlC?mh~W]S&nMnpq_ygg20 ˰:nF8q !&tx~5zot¨1bozgACyF!%֐ho Y˃ȤWA_*:a,,baVӈ E Fo<+Pմ0thE& ~jZIB޼\k$<ɛ莩^ڰp}۴[x #ꀳ969~(Ge1ԈNi; ׃v;0fͺhn8RrFѤ-m@6G\{^Qs1  xqMYELg謲]?tblF tE,((=v>:]KcbmA#ORSᄏ|],?Tg X'2wEe+vs\Ԙ*zc·Z/-[)xNLl޶Y `e-l7iﴠroC>,dgd,U;^O)EMqbI(xG83G`@Sf~JF1+Y oGf>U-E]I&}z2oe7][P/c^ JLI/Qk3Dz1ϡPAUUO rBnDex+n+~$]M >WU_W@Av,QMLO 7K~S9ߣO* -U9n0H-^|Ϻ 6|)omzect p!x =A$}~. Ϋ}A@ƍ#kO\UI_K*rUoatêgJP~s+L)!Mp&hEՍFf&pXzJb9J4%Fj;y\eqDɺ,c/^bk͔SE^|ѫ0/}E GEk,S"֨ې<^]vLzeerDJ1d{⣕I7#Uhʆ )*k"guФB4;]`D[2O19`idq N~Y[^cbJyb֣prh2y!|~^u@(QKGf!`7L<e?dkZCmعdF7 ^aS B䠽_z8Ab)72PZqe\30Jr0ʒVDiࢶ R[ԨSQ; @a`Xm5n8?-[ H9 Ƈ[LR.F  bcgHMΡE^Y5eYN`%[TWɶd!p-oډ㦏Babjr:顕 ފ)ۮr>,hBF*ئbz\S< *[4TL{!N@<,f<0ѹ^c4bn:Ҙ \Sz1d XߡwV"IZO㉖T沚~`FѮHsw7 kM-W1 5&i M+X]|l~ P.DI̜I4ׁkô'5%eU ޮ!&؍k,__~W uǤgq* =usgqjKjŔl24kv̳+3]/"coM4e?}`Xo.>+_z&c@.ǨDOM:BԒ00Ws;U~ŵŃnE~:IENeG qduM:lt}) X<*$Z;u;o&%Mԏ>u'eP*C ef Z(ɍ{i؞خ'&ܑx297^-Zk\GͷFgEd=T/-dE|?f\"Xo&:B& GJ‹FaRND!>6L38/*F1Fy#>P\lUzĚG`4/\-9: ƮS콙67&ɽ_pI%<^c`AA;@`K 'oT+Nha 1h˸E.[_E>/H5%7{h½!\%7Ě\Ir>$y$ԏ&)z;ZW?7O>T|sHxGm\ Yߔǝ[/x]'dd$MAd5FZFR9:("qTmCsF 8z 7jg> pu)CJx#Ӆ:pJ66II{]| f ibe+xN6[9QDY}0VMUn㽭c֍ 5ro谑ghT'_ҍqI'n)]0q> l[|#*z:hosHDMzaȊ,@5 ; 85Ki#0 ~/8S%8332K.A_nLW>x%.T:Gp)e'zN/x~q#D9rEN)7s_wׇʟȱi1MҺĸUwꨲnC+ذ[k)_=v43v8`| $|}˨ Y;N` $-Eҧ a}HDL*Uگ*saMA۹e:e4KRTed,xq"`Ld٪z*,ꖦ=6q~DK.Lr3nJcCh~E)֖XS-Bٻ2`FQB1Il:euFNr}' fI7Vz__-,:A}%2d3|Ք|D@4ġ,,-k[6l?5o"&oid(v9H{_EVCp+mʸejA}'\MK$8g_N Z'pj˛Ґ58&Vfsz[" ǯ(fdRH<! x8@]%.ϫvěA3T%KgH,֖\+6A',2Ӭo?%޳τ,UY _P .u8mFDŸ4CZ = iDbSIpbըY5"%;aJB&.3):V‰OgEfR—fJRe|:P>R:D֭_9mMBDC~;J 8U5DK!$ㄿa0+> }Y{MYd\5wVg&Um94J3+MpRU*'JT6?u†'nn.wc-t)dVn!=锳`iλ(pU*U4쫗n}J2lL\K3Ԩ]Zl{ڼT}+ޟ8l[ˆHuTa>oP%h 0#l@G7/[+_Ԫ+РўOs^ 7 4xJ \>~L$HCwzOBM_S}^vSț_Nʙ fAeB;q&^tX-k)@`NK6COfJU E+>F6㨢x:u٥;݆W#00ƹΫ0e|*Q1k@z\_|DC`X-5򑊆 /gq?G7@:kaR6J{梳?O>ƚ8&ZfahfmIw]cR\wTE0Ǹ33|+/Fa{Fo>zTzU)w ؑ3 Վ̦Pɖ!%OjK9 }|Q{Ms fep4>)1d?zNr*w$U ?w(vq `w(8wZɀ])I4ׅT Xv'24` o. -VHo2C(5.!0.nd(6U6X b #6,g-dPY&*@AAvhfF7%źZPR]0hT$"ZAlsO䭧1oJL$Dru$tlߨ!8nd.bJF@%0I.MbwjJO6Q\RՃ<2+ݭ,ҍ [2]l:aҚ ?x]]֭ w^pzl27CY8~d5ԑ;sQO<#.c$D>0 ֺ%v w9y-h|f +{'X4YШY4fhsl-i}(.ԕN}w1ߕ<+eK(.# 6hϥuc~~dvR! + KLXػn6lAr~ lxڳ*S=}u&~U3ih:d04x@W endstream endobj 105 0 obj << /Length1 2511 /Length2 21996 /Length3 0 /Length 23434 /Filter /FlateDecode >> stream xڌPm C݃n%Xp-kdMsjjȉTM퍁v. L<QL&&V&&8rrUKp@'gK{; DF. N j`f0s0s01Xch3r43dpN.4yPP9:Y\,&F6{Kpqqadtwwg0ufw2[X>Nn@S F*c#ZX:#W7sq7r@K3%Hvc@wo o߁,ldbbo`diig0%\<\Fv lAFnF6F 17H+@3៴ uq/: _ {AC OL\@uK4 zMMxCBk'g5Ҩ齗:\'SWgm: 'SxԿoMRn{y6H8450Yx"Ёϋz5D w\GW.$|{>Ioca 31jѺ%syY8$.04hs7h9oD2 p1E[,^_UYppq nƦ)ERdK6yk~{)dD^f_'YWc֧/j`P_\*g}o=q^Lu7/t[[܈u2 [k.U?cD1mTyb:ͱyA)q +.,-Y5Ytؒ#F"pTHa,LUJdd6OǏ_铰tpNQx0c,柍dp\俲xm&q|i)FA~>Q)W ˄gtn[<ǥBl7vד{GA;YhsFĊ¤P#L.:cP3bn<{Ø,z彛*AiQdף<s hlf$S!O biOw2ٚlIR8C{Tc/ {h4f97y[L(ˆ.!}BMa8kLiP4_N%m&1ft+ S1cf leVyvS.iBI@'Dpy\ODSŦ3и|g,/c/o0!sO#"V%FH$1 Ls#'!i d˺׷Vh hX4 * 䒺HCux5UK\hXXEm1JY Gr8:؃׿sUn܂s#t+xNIIXW!ц6x0w@廅x!3lVH6m_P #4O3q2\Ҟ.<^ ^{ OٷUoz@ 19. i0KxLn_mb<=oVPHHpRK~v#f%.28p"ôke~s)7"+Vϝ-1d(H pY λ]d <y=o8/y=¹A2QT0T8bcS9iB^og5؟ZLe!kQέ4^Qj:m3%CaPN}lP h\Է0uf(W]jTs!zϖ9V9g&Mz݈ͥ}w< (Q7 vCR)m\wHfdtzGᾔFZA/R`m:_,ns0~\,js¥㘻/ܗT y^`c/p5 (%ˍ)RsyNDٽ[Th.Ϗ (Z$"ؗtIf+tS&LX8eD^!#ͩ~y`*!Tp'I:7}$xlt>((OQ7E,:vj̓Um OV[yľO(4> -(kAKm"HV3,k}ZìpJA1ujة"E/h*eoj5cHX3uV*+qk^#Nh|d]!! "+1롡'c {\J=HZ+߂ũ$Gx'Z1WŖ ~VlFwķ[s teN9&,9 EMy1v}(Pb#SagI_ Im !l+3:(rk#}{W6"R*[f\c|*PLh%{ /%?2)n>%|YPf^϶Z (Yk8z䕴$x !c>AMckaE $oNSg&g7 IY:c:ay0L-TWMZVRT| 6ޓ0llߕ6RH{jO<فqfI}U-g6&l幚6!.J 2]h˺q2Z`nj|X"JQ fx<1(nŽL[R])rUJQ @tњ+J,/F_1҅M"Îm5~A;5.Niy[ؼs#2l}ߪ%ޯλU9-^v?`tdqh atpPF3e:ıӏe]o>I%Ggnbh*UP1@Bq KV$OUWpvh.yڙR!׮>֨H'yNs#+?Nɖ`-L=,kZ|duG7ʀA[4qeg"$|o Ւ]_bv.>2WE< :@s[< ]?.ϴHW@AI;9^ mjZ~ Y1}q:rL vsbJc: Iᄾ<zըpbg[g F[67OUHl|8Q1XgG`p'4U[ \ItIaYdO{V mWmþL?l]B| a.E_?g~24C+BԩD1.q:5"G:)gk5Rs8,T|p>}.96ɎFP:*y-Jȁ^nb BP`X_Jc}ع\mm@_M"‹vY(j{FH= lrlqxzt^tGSi ߾ jijJ}XE{Qh_vvpW8)pJ=Px.eR[,##ˋ|'kni_fe;o/OŚ%)(C ?zIhdVU8Va>A]X"P,  VD|oiA[AIQ'pSSBDS%6Qr~(6Iy{z/m.)@G{UpḴr"Ã6W2!; ڗ#%!+j> =7m̼֙Ojk&tS˻JP$ MHwx/wsIx]>?>t\8ޔ_(Yy=HcXTxʭQVɛ]d3 )g8ozմ@ P\t7d=@wMI)PR[E*(wK5E%s&$q}^E{+uŖt`YXE*7w*Pv/t S࿪c>Bzn/Ygt\^_ % 2SW]Gb:lZTaFXw/lwGoJ%Q wP['7_Y`V>o^#zpǏʹi)Y&Swa凟X&+8>У.V‡NU]Uc2n=tD>?C'73Ҟ3Cu6Ժ5y>@ ޒož)sw)&]f~zܾo\JUGCvzD@T٫UWF+l*-o Go<)ˆG3(KQ5^%\.I܇շmjfLeiJJLkOcNbM\>aQːȧ240+r>喃 mAҕAob0GD0NIjv^*zJgXTʪE uJ" _49L+SeDx]BTh5u'R"ƳLpD~⼱C 3]L,ŖHY]_7̏M"ϮBG Y5(G+qi|'tnJ{ݐio[nw+C'XK;ShdS71jpĴSgCc~l4S"Y9U?Xi;[bvH,^)nN8iqGQۻ%uxb `FamkiJM ͞S GOdG\ށ>y6>XB1⃀BihO.ŗZ_w{f62iK[oMSύb98Ny=*jo#ynU5ƟhB&T զx ɕwNN\nZ.HLPCԉjZ|]Yph82oUqgXuSoApi0*qCBfF {lXIioKIG +"]/hp Jǹ})W>8Zj^?J{%^5(X'pcKpM4oa )#92S _%#YGWG&#D*Ma`B.8!8~F$&Yc}࣊$5tQs~Riq/%LP(oQ%B236ˮ:N_[ۜ (pRἜj+MkK/heĤk{ Ow.Hp 徽 Yg՟/RE$.a2R /pǾ=()㦰v>3AٳWzi0ߎ$ES?WAgx@,nд!',{nWkL/\f_k.`7ذ&>6;>i"*Ep/*}*;*QM'LˏZ2ҙ"pVJm\i"8sR'nCFe3dV׷,)'M]l69 Z_yCH'>aF{H|^"v# l',Pl Ai`f@#rȤw 7Sw1O>0;?.l=~J@s~*n/Rqvh\'>*Alo/6Xp}Urp3g*Q[Lqh<#ĭ{6sI*3&_ac̲-Nv q}K+?ˤ#WRzI:Y{H J5"/8r|B\B'hy`k%ʨB& [cjZ@dNeE_jHz u}ZSª΢N"B4dsUۗ/29vYKD*df]9G|:3s&!6gɒ'lC͆)1zx__^DiQmK!^Ek-f)箛u/ }-`*9'|gnsJ{uq\ fIv꜌SuW2Ep9V䓝mV~ĢOOj&Q\ɡ$X:cѶ|Re-RF56XYzGI)ɋ 2* N' 7b\>=ET^Ld (Pwx[ (B*[nɓ1PWcUu*1b#ONeqFy̷׾1m8̩~.wе2wabKd*sxv=! VzERCS[Pݏ] ecԁw2QMC^LGg2s& ҊG Ud~ZOBxh~JW9oiQ^c */1GV# h4!?bwseKi)e*ӥ8*ETg խ,_ߝ$xdcV c%C§ .4P\()S4QW!~~]h4eI݈͓_¦mu <xX0OUGTޅ}oV_DZABXam[J`w{E`O05n%C9x*hEe˲n<$p.ʧգ2]f?})Vd΍eM ى?_unmS n R'^)[NUH4E>(t{7di~?vU/XQ @OԠn{ wHyƿfY643յ)V̥wBhΡ9dQ݂jMUJ #[d!}_vMSQF"<-Դkuzq:\0&loVwȍ=U1l+,(텞v8|H=C^SPPv([rL6h?[͡P>f):e=h$[<~,UwsɆa) ~^6T 4M{SE<7poclՂ~%,g1k'JrbZ#IˑU Y\BTOL5҂v+ްnCzk2M7ũ߮G+:6v!d[ԇj܂pµZd{^KJ"_o<]v0e- e>\Ӂ˷+QM=+݂#AF9k 'yqaR%3e[Zk(  钍k \~Ve*^pz$KwC^W+voQb2.UZl "\/a4J':ࢍи*^^Q_70w-sR(1NNYӄ잴Q2*$dePG1coS. ;r0[X[O`NEEBu$̲>*΍)ed%tq5_Ua݆~T@óa2UFoq B$#8S䜒ܙjŋ-L{/y<ǃӊI}}IW[Nz!gw'^~@PFzEY껤Cm$v4Vl/l$KRg~K0tk83,So/PfZ*^/8L{FS!} PE&JgV2 NK>$w{t6^u`W>e9HLO苦1B ׯmƒtEÎ ?\2+Lq?`>HwQe>}o1.2ό{Mwf܎nR6?%:u`;$^Z> NnZ4ޤ#'_M倵f uf;epŲIPy-ɾ>!i:c ?lzrܓ[XbLWH4e_HީzIG -$GK/g҂ _| JNi4.ܾF!. gbyEWbF/&<* Δ9%QTˉ[jc^.<^wqHۙx Lj8fі;H(+!p*ew;#P\ xgrIlTkŨc`ʿYe㢞"c`P@re6MV|x8aI骗Xu7<9Kxg"f6G.J`Z`gS^)GkSPxv͛{' itBIL:lE=}>9K렀 Yc6@ a3HCi% _,@MxK] -eb]ZL希H8橼ίx2uyHA xHΡ~›1zh1V+q lZ^]cFJ-Wy w3p3VFUlGFN\<%]*> /I7Q9/6)t!Qo8J|?X%/ª%k3nDG|g )m;ZuƌKvN|SZ23HoFF ~p0m*8z؉JuԂtLf lnOSlAYPKnF.42Dy#`9CGզU^g8=: xu &>ח4؃3hxإnd%'M7#ñ1 TNF4w\VLdO}3~K[uBChjTf+vr5oi#p4d/JJ\?.)g,C Gy4/Wyj[;Lܥ7%v;Qb+ϕhc3'$i?7+ g,Z:X}O:m\D ڑ-h2exǔO, 3 N"ԯ:Dګ#܌nKm|:y;6cP"j3/#^6Ն+NMsNƴ惻,pgY7'=a}y7jzlEp>!78?o9 r9-#2]%ެ<`&_͉8_:ou ݧof=\`H 8 T+R4&8kPNځhXp)%k$!DSE`wT>Ds/Y enιiXb^V՝c@W=$I~X&$ug7^9}ṽ%o$U[„x-p6o7ҫ/=(!Ǘ𸇈h YSVr\Ğ[']& 'oK?”nQ֟ 8ҾĠ6ZQ5CUB6n@ZaQʶ|#u;yyڄh9n@}~~%5(X1.UeqE8T]B'SuMp4u%MQf:bK+p:CrMrR=n4ӡsN-PKD}BE7֞.#aǃZ*Rӿ\/#N: }g@O'7b!)D8^Y5KBj(.3[i %#=ld\wd_ q%P{c}\ƴ1GN-ݿb=xĀ9 OY,˲ gxAA,jH W-MjGɌbz/#uOYwnfr/OP]bռE\Q77CP[u-xwqP)6ώ*\lQE׊CKI!SҶAS޴i^B ?]ZKTiR|qDQ+S>`TDߕ{pK#lpt>=o#gUzBX]jWe}5d|%>}ݡxZ̙iJoB^ ۤ\u HWKDhH.fD3#mb)^W-ت磔ia13qvwXU*bUQۡR Cܺ|Xed$v4L,!T0ly[{xSn!.%  N]M"a£ey!uFN A*A 2~[Oq1 9? Ki9ܗI_6`#b ;ݜCN ~䉅rr%'cǰODV&^ƣ:La睎9jtJ]E|Rh}pJ}2T=[?tR敦*idGNrϥ/S^*)pI}n\b/ O!v\ܚc_$q|r01j)/nfPp%a;;;R;/zIi2!$j{1륎X蒵ȏw^Xٗ?* v^(1ٮ) o %cwM1„U?5RxNit2RI 6pPGk1<pvΜěRssΆhhH_j rEf_~bE2aCj&,BEqO@[Meoc&e$!Ɇ3+rF'L֡F+Rj?vMU0I"}*[\T9\bnӀӮ2[ 0;mmt%6һax%Qɓ&QjK/԰Չ;VH(-9}4=CILC hF_zף$ei+$dJ PY< <߾5i.`)6Nc2Bd[6&VIfE3o8=ֈ:+ӗ*rRiG)c @&ž1V6:6WyBcuaa}/U8"rY{ĕ:ڪ2"l- d|%Z|{ vpTɖ5e L@Vp;Rm Mb H+/5 /E7¢L;tg{p^A8^3|EeQ% VD~W0@qgd\eMSt%V+`h$}LP,Qfns/X9lK4(wTC(l}#"缡nqse,$ VR}3uw5縏 L&2m>JǦ#;oH?$e͙{Ҝ9 QAߧޞ#!6VN:DpC^QU䮋ߗ qop.i&9Jm+M~-M|xZL߷'eHF#҂WK=4TNm63^N@k"0X8O89 ܻC{<$Dߝ}FZt es7>< E~4bIkT=ZtU#߹9ѤnO )T;~1_Ÿ\XT ljiL|n_u 3q\tM9}ϺPn7,,5.='24q7g[D;۾jR*QnMřiˌ@@IMwj!]-DU^,~DiGwWJ%9E=pV?*;eH`uGZp` .PR!:{T ;3!!kx*E)Tq=q/ @PzJ5'R<]u{Rh'7/w.6Ʋ݅%^_OjNQ~~h -`cFѠ]nI!T9w^L k[YŐ^c[x3MAZvqL\V*|SkC ݰa2HmAMQ;3£7vLvv ӒG JЈm6<+oU #;IB=6C~^}Dg=ޖ)6.+ËW!9WIL;muYR@ELl?׮ >;BQ,6 %mPQ%G֍^eZaw5}tɃJ7m}4n8|m6`_nj.ʆ/pꌌQЇчKO]i@_[Ч#)֧Q۱.>tǕFa|MߘX  m|DV7-Δ[qy9K9T" X2Wvc4.iϐ%eUm) Ѩԏ.hǥMk 6\N`_2eɫ~"-a*9_V4[9pk-Y>1eQA%#~m]*r 2v%ǹ%(dzՇ-7LF[_AnYǤ@0s⫔GDYxZtaQӆMߣ'0?bɚ4}k,Ct]CEDڭn), }{ɆIvC?ᴫE$UkRi[WZ/; XJ!v Y6DV 8m6 1ˉvP!P]L<(-{;\=fyks =:ș?egB>ES[ffI%'wM?YTKXxPo t,'rG{Gmd]+C/er~}q ,E`K*.iT}'Ha&nHauؽ  Ѣј}Xeg~J5oFx;fQݷ \ٮĻyHR s -Ir1tauL!3^ZȄܷ̋Mp/;t$1ƝM$|Q&VW4ahBue1hW&-XCY-HP /Z#3TqY(KȀ `-9~{v )A eÚ ߓJP\l K2%"qӿY<t*ke Xlƍ+L "}mlK<9;Vŀ/P ߣjaկ6TԲ. -E|}i:DA-PzQS!.Y$qRQ5OIJ&:+{!R?$sSWZ:|CXpcC,BM{zF`s6Fr*>;T{o siElfw=G:*w`[W_c}R) وQA shA28;Ɣ=O-N2@|K,ĉ.(N{5rIVP5~O_䁌'),VG酹KHO.zIi RXv:J~d'&sU:0#'] e+Y vʒPFG򌎷8<$p %$Ԏ-^pApޅ"Cs 6! QHCRtxkċ;aiՃȀ| …ӰҼIG&mD0WR5>}_3C%yp۠Mp/ew^Xe}&arቖ.7*lw} Ѭ>8mNY/@1x[/7S`{˩l.o $]ٟw+u" _[iԏ߽ۛz6*-G4z}<7k:m0j,1L|kk֧ԯUiq_}i"lK!ى4:8g*1r!]~*A_G̳͢o܅d(~>H@UqA7:*/2G^P3T!gۓz.&7Ĉ)ze# >S4R.(PLSy(la޾kQk 5f"*cc]Lqyݐ., {y_76ۥ6,>{'KαӁd0 3ZU`o<%ַ{9ho2pϭ= qeW<'?6LX*" B`Em^1wbaHy.}׺4SM"lM f$-b1UFҼh9OFud᷇1h}i}*;6:^lH:^lEC½dyNǪX\m:@B*ƶ}Z=5)Cb+f nL H aPMց,tg*=n0e_h2h`})G0}ĩ)O8uhS b݀4e+lR֕=.pDǢYoE'C8&I+$һ|4:nD/m< R^< ,/#.%œ]T=I2[&~}EVͧ#l& W_gꑂNSIt%Q +LxtOپ_}{=ŝW̭en-'NB 3Aѧ7a^ΞߛKiu~iw%(7g<3/{Q 1%XL|/ Q\$.c hHuQIelGs a'cwh%S @6_C@{. _pp#0 H!Q݅"h9b6kQl tpG3L\ 栮N!n]7c|~I b}"J2.cwl SژKؘ͆/FVji"?5cNz;-3j`z#kj:t΢:84pBrxy^,%%8wȳpiC(uvcj^s 6Z^ /e: њ?LgMuL n 5+n%׹(]ɌHO욻&Ug9'KrnU2PF@m;Q@64ʻfo!9FK^lWl-%V 8`J>ʲT트aQӔrTO^[nf> stream xڍ46Nt[0z]NLf2FF޻%DKQ>9sνY̳be58?8Ñ<@ >pYY aHG_f\Vc A B۔@{3HJ P?Dg7 h4P.y~8~qq䝠n00!N'Ag0 RvH'/ f+ C0@3^\V  r 00pCn(O柄ǀw'N. 7 n 9B:*H/cM9"A #=Ay=C`.H/EioYQtvr‘)ܠkspgO_ngCՕܛpBa (*.^`; ]8;uqv7@p} (.??#ϡ08?P?`^{?i()*))p>g//G@ .&;.WB6?9 Nv-Ɵ?J#O࿳4;:q`5뎼׿jsgzՑ=:}0 х!vO%sW~/^G*ΐ& ,qB߯"|pg}=~D>Oo$S Fq}87G[^|п}|?A}zN@~ /x/m W/( C ޗOYCz:} ezs=I ߰?v~uxyK\n;=YߵUN'pݸ9vk^xz5 /ֈ<.5yT:Z+w,TtG'|4(|JFg(6R8|v/YKpPS񡓩YkWKr*eL=YXR&X' v( 'sೇA^ooGCo`#,ޱ\}6^Y!kj'Vk ܴͩ _1d^R>r$;v~߽;8Q[65Kն+qӾhȥs!FI˜U&ؤ7heQsǙ]1{9eܨN@,v|e ZƘ; ՇqEg&Ugcoώ-yR Dڎ)y: Sq´}dOڹ0E#gQrDZ{ ܲEu¨%͇uϑ[Eh2wu. kQ%^[-AvsRNX3GiWa_ ^<W y1~t6)%h0AE@CԤwzyJ%_:V(n#Uo4wz}D37ew%ᖘ7SvR:V;WC*?mk(/q#/ O~;Vpz_mų ZEQ&Ǝa؞iU?Ʈ<#<5*6~Ӻ^<$O]`B7L}MN*.1.UaWA`b0f]rX(집M&ٖ_OXn[cşSd RCbj`zK.QihtEXn&Kˆa/aGw՞r$p>{Уb2}[y1 y3*"`uTeEI`zR lF6l/#MfOY~S/F:T-f`\eGR 4@yT!crdx(:VkrBTgo,̰_4s<9S DZAs2QM7`\w)\g ޽~4Gi1HB}&*OH{Zua[j#1NYZAo#udWԟQձBbu *H Ƀ4b:V"gi 9XuΑF,)._zE3ZTM~n9 =־;ddWp~]Pݸ`fVCeCqo.Zlvu'dTD8=8EsvUv aCMj:- -4P:$=g2> /D CWմ#ժK`Po850gޅk|Zd=0hahj1mUhQ3,7_( e'>YIQmAmg6si0X.kK/@%Kw;i@Hxaѵd#K"9bYT$u<4&*1bdTіmx Z^E\B:#@PgdhwE-Akʼnz9M=⢘{U+gsQ$‘A$XѺ}`_X-&\i&1ɯljOSC2%=UvE?Jh&Ȭ%x@eC7dԜCCT05-LLAk}h:KGL{L|вgV.C~QX^)ҷx7wlʥ[zhꇸ\C'O}oNV\"i;b [RM, gڽ_^Qvidy3""=D`p4풀-6&ѵGMt>7It?K T jJ˾I2Ji]Ee+is2Rhx:Uѹ$.M_{_ kyPFM?dO p@AsU/RF_.(>j_Ӳh*rxf fT5;wciee^ X} u+ g}TD=1&T"HCQh`]PËۮ\%O IZy*Ϛ0x'=)ovI+^1sk6<)l%Z64ITpcC <.Ju#쫃 W!e9?xQ0w1F~:ʸیX&"i 7GSoMXI ҈̟hϩðC*~$ڦHOY ed8>4tMe6nkmpc?W/ZJ yxVshG^ƇEnk(؄PFÆn17 q{37%kL0:j0O+='T.e:'=;' ?ꘜ;+ W)\vB蚣] "O%Š_cع7O3[c\`sN6eb+#.r$!KC `.-ͩz \P@>s[.>u se>*N>ܕuiݲ@}][A$rؤ~uQ,(,}Xu:L 92;lB,W}&mH8/lWٽ"+BjJ,'O1z8i0&qIUԣ Ik=]ܸ0mz('==%*8eDK<؏ɓ2“/y9l\Opcp uxȕb}RԌ3$&5*%t,͹>gg5&*ך7d\kӡȼp;gb  t&[թE]q t@GfOW '<-\L ,,!J96gr2i,l;WSJ.{ngt$;Ӈz({d&MbNF--z[ڭܧkIg5 1 *JCR:o\)ҳpg'ec5tw▝׿aX?|;p+Dķ\.2u()x%+"Hu+'Rkho@ ڄ[&deIT:^i)ӹ<3S}AbIyh1pXMW1WO0 s9:h Y`jlz7B+ S)j24%hq"SL )Y%gq>Ȅ z}0p 펤FP;c7IT0\yO郰3CD4=ʅgCŨlפ|9U.pe[ѯBqJ'@ O^t}WdL55r\;D0tӲ,F,ýMgP'[/gK>,ST(%#X3Gɔ>Bĭawa{܃-|k [1uvZ}MM\ɰ掉0 xeM}<+ sV̠gRyI&i &>j.Jc|5O+.VT*oi'm\&vq/ScUAJ?R'/_1c^H}̌q16ǣBV4cB,4!~Qk׉`{k z"Wq'f[}y.աmk _չueD*+uH_fM6.Όe_*ӏ˨'5LD!plFe,\P{Њ!bg;+#j$ _]q1([Ma] TJ:vyClJBTSvOƆ\{T7h%<8k؃}r>MD_ b l|1LYǰ4@5v CyVoT7x!s1+X4o8 >"ί#q}ǥ1ٞyKPOʯDS"8;䒙K9Î~ZjE'D友ƉWZ{՛>g pΗ~\:s+~MjQ*nJQAOyr\ds}%J[kneL }&uGVI3ضMEsABWq]BU%ѵ-7A+`2jґ/\Þ/&V86y Q)GFڎRKG7; AZ#%;u&2*qZIOZ^9P`ՄiϹݽ!g׶&VKyG*hBbd%#ŚEG;vsTeƆk"5|uU=AJ: ŻV0嗅 &1(o"6?mڮyPm**sGu=0L؁]Q IzRڀeKv14~.tD!vʸ5mN5_ ۊ>7~s}:p9;^:7lfj"3gCz?ɕY}Sphv{J~M]*YaJj)2|0Ko2ݣ%^CB7dLDX֮ .E7=8~?;[n:eHڌjRrK`<)PAѻw [#~cG@slE+Z>*UOw[t 9J+O ̳\͔{| 2b]OhKEzyUV/I|s|Ay!ŭT2&'S).cMk01j KqEXQ]ÀXdB5j>0Rރ$iZRzֈ<)qEUHm%hZw^T< Ý|_vgݍ9~tNG+i7LJ +R&Gw<]/-8PW_wJ'÷w>Zp(vTbHS62AhgsR6䎔iśy~|*^ė+!ZUet-k"hglw86.{CGRU#kn@kM$Nhw@oۆ8a]\Ή =q^d.6)k+}],l'滬Zr;tCϟ{J!E%.MɅ;-r`gGXN*\VN20vd+7֌>[\6O#z"-l8ϸ(-]똡lz_BR&i~UVR@m.N"ʀ5_gi-4:RkEyg1dSǙ=o92. ȈԜ_:oy/!/WJw\dxD_/'g%[n1oӵ#P:eSp~kMh+qSO ]0B ٢xiNR_+\BlxR{ O˵2>sni8挀?.l0%pěe_UFyyzljY?!xs)s@[O}RNL1μRr%m%s (p^cטi.Kd,HW=<lr+jfwV6q*t[]˥Q`lɢ$ G>@Qh`F<>ō(zD0vf`.eJ0R3f}B] %A1U!_djKȷUCAm<?GC'ؗ?|މ;3Ϧf HfD'kYm?;Ȍt6[ʊޒt-Nl^hzrrdWHi7Dsh֤EB`cBQT$6PGlT`31CMP 7جBΝ"a /yBɲmIJ3XWꆪ#wjѤ2N$ u6b?hU7TeHukYYua^)LTկ~)5W|͉cZ&cSHqvqCUWQkÇAcF!/DuN_&mXn"2÷JL""iJJOJ UHTy|4v|uGx<1o4! hyǒ;S7ڤ0r2d+G7i!:3StUHʼJ 4wniM3m|ܘV^#rZŸ)8{{5O&w[њѾʤ1aYx|y0tEњډ*Ns'_?8v՗G?$̎r};}W$KnDe`-$0nIl[,e*bo)U`E3 ٞc&z)l )&W 3L~4H)H%]*5ˣ9]چ7 S.TVwfJ]f{"fZ4I_dϥ0_$!vH|\#&ݒXkðjfP;^fb9~(*b}%pNciN suב3*"7!R7Dٶ8$z? WHƈ`ĕcohosyy5>F槍g Ig 4JȧyBx'\:s0P1WR=X\ RcNG (}:GB%U |c'8|])[݄K"a~{<KiZJ*Pmj#UԝM5DôO(:%Oa"4Ҍ"Cra1>oddZN9_'iAwb&&"5Z~M;+>gJNTNI}}3y:bNn=8SIMB`u *{̚U$}PFg1h9f[~GHEB֘$*@U`7CN&d%|^8*kw:˥'.Y"8f⏷+(̉Ke\J|v]gSx%7W?|b]~R-dt,Q@R@HGtJ¼)ɪNJn* ɯ f:4} n -_+UOF9MVHT변XvU9=8{H#sHOm=QU y껲 ~c ڴbjm՞={vƲG+TFHHa/[C6PZ&=oMv#踈}\rK MZwsAoOy`ksq_}~+;'?8=x9Z n9CJ?h?ԍ(`!Wf%iO/> stream xڍP-kpKcKt  ܒKf9U[]k7 %( 2$yll,ll(44 W{_bm 3E&ib.n ̄W9g/?_AXʐtpܐw i7{?t?j3_/us}e ksg 7ʹcH< W ?\ك@U `fgcfYؽ./C|YN)X03gg3/"qps|_V,` =?DyҿE"N?7{Af ^?j7 ;zf.62Z _ʰˇEb/VпKv@j/@_2; ޾VBU>K2d./T_jqW/z7O?[Z,C,Bl?ֈ{0 d3,9wݣ#W;_~\ٖ]&9hG oMVk{}4ITmCY(>'E&a}rmyƋZs'Y_m4l~Wmc4sVa`,My%+3)' v3|"#a, 9JMnBjB}R+ѩ7>?|J?Fc6p>F,S|WA<ވz ٻ C@:nG ՓjuP#|bԿs;*uDŽvNE+OcrX,<.t :#*\j&O'jv^i y{!vCm̼ÄR%YM)/} ?k;'\YlC4+'V1[0У;ܴ7:sW\?d2i@DNJT|SIFLM@=c1e੃L@.;: ^1(D~j)!tHUֵ9˞R)~ V-E-&HM Mq8ܖ_{O0{:T@\&ϣˌȫ`W/ P>$'D Ga/1 E|mF43'Z'BBy:] E+S 7: *t!ȝ\C`2NUkMv HAzG./+io9ËV{iu;j&.bMExPL`0) OS\}*IYNG/~u9SqdmRb\HĔC4^++$0.nM74Q1YC2/16+Ӫ,.y{P .vo=L0%!((ę}&* O4M2jkף%ch$y>!EnlQ^ˬ?p !.J,"zIkTt<͖6>jd':qNF#׶R=޵cWsq!FDE> ]/w4lxlTk[2CS~ 7D:Rٴ"`wm)_u)]^/jIFeVE31/Lz:t8ތ`$|ӡ"V#_gX;l|c# ?k (b$T~Vdަ};2 Rҧտ@Tcb>W 颩h#W!rW+.\lɫh_E-yn-BꐋYk>R {7,=~#D`B~p=Lmv,όrӋT*kUl G],'2 Iї3Ы/Y 3kB] z%%٫z1<PlEX3EѪfkt†ꥩ@R\e !{X+`( f@&1+R(H>gsXpK*xٸ,߬tM-\Z* jDT6ћ r*N uښOMO3"H J ,֠]?=]x^um8W+ј?:??z.aYuo#N8e*:'->V{"u3PsGݗo?1VSBW1jm!vpb wl~<3$7 [=%}S769dpfލ }'Wq N]Z1 E@ʲ'քCIH;jZ涱caZ+/)qU6He2B]$wA!N{ ]nzTL9wLlB,B֪9ŕ)Mg^ ȍ "D :h&ESF_EُVp)8BMBV!d4 ,2vˀ[,S{"M;"jrbi?c4`FgN;"to%9InCD?_a<͔ W:ZOŲ9kE]4Gм^TDIb9G-EЯS\ۣFlQ`z%Q:ԩTKμl\-0Lؔ."R*־Bƀ2wLB]A)B+!]liư5͊n,Qp>68qVjlNCu7ӯ<"TZ}ov?tkJr~8D"R|.y/Q \MV|e- F5v(n^!-Ot) ӳ&$&kֱSJS,>U5"\" ͥ. hSm^^7whJHFEֲΒ$ɮ&s?]1}H'úJ3wSQ+yUI&dzlˊCŌIOh&"y=Lc?F0ᓎif^ WciH{ }}^:e# >ִ]SeY_t7L,D7>siQc*ҟ{?U1ڷa+Khr#`]?YJ5&O S[X7>,=jD,*$h/z^iE]*N!H4l( "nPJqێʣ6leSei]Ur-M%exzUF}}Q Z =v#J>&BS=1*+`5ŋQx@H*J7\-`NH}ԫt:e\ǒpDՆyT/[Go1a44@RoAXLe0ŔzkB_SL'$:r-~x쮛6lfءO-D8-L߲KBU[v햢(BM\)䝎n t`@ U\Ip@mpn6E97m)i<7K;s1cW3vdmziRqQk\e:L|9rLIV:O4$j`)\l 3o'x!7}*5BDx.;o9gV6c3gbS4+&̂%NֻLzSIn70?_$G-*?姀ۤ\*kЊyU Ueb{W/hq~exQ;tpɐ!_ycM /o;P`\zx~EQP$ j0%$2& z~뗄Y73Ac_w=%MuZ=B>G^`FO}qX>j1 ȮGڍ!РBjB)Nh}>/'gնcjNy/;*~m*9"a]1szD T+ $Jh}/N{Od"v|-MrB$*"jE\֒B80 /^)eQ|VPs<등fLë/V5=꫒ZcE*TaS}XgȱADLUQōtj:r]bufI@nMU]ϸyN/j`ݻuX|w?acy)V~wsEՔz>?&/$'s;ZAAn/=2Y}i7ꞎd O^S^/T>?K>ek(q-4mHA0w]WWO%nA{^vNn+Ϟ:kpi M4_ תr9UJ,c+ ّv[/f1^UN$ +b0tSRA ]ӑ/ Go1Mf`ϷY!Ͻm4ȹH./ Ԡa¿R}=NˬG,%!o(7!=!)X*N^KWě{svF7liöuii(;~s!05uI+"m+G".2JY|& "ocx&oѨKD}&yTa]Ʃ36]즿ߧDDlOK %pCHw54<1cԷ?O?߇W՞eBIP85z)[L.ϰ}1BRL5@ i@'+% ,e*./ *-8JT/.yP?ڷ'QdM0`5"t ֘l`H9.9k@vJ N?xiۑQ|Xr=Vd~濷GCBfSof<.$(:h|m}XII.ؙ&mDsì`7J_EJ:&/p4c/ oV\nbqFL\ ZEe[Wњ7 $͎ծT5O|6rm og4yx^_pV30s $^%$osɋg &սwg#O+@)z Y~4R-A~)e#v]EgD'&XuQKQ/ j2 B]K4+pt.2zΑP|"u&`;@})@ճ Bb1bM6%j_ kx[ ޓe,HN.tr.OD'(ecO #DfsH`VL}Lc0ڄ`P BozI}x̢>їz\̫`-UoqF~-ȏ y`6$,u;vRȐ$31AZlH4& a/AF@NKyƱ3tPr)Ez9G\/0I,bOJ̭ln)Ցɓ"N}Χ}um+4ZEv deUeKZƦ1WVY[߇}hp߉GI#(9rtA[h )c鵛P1-sur8\tch6 ᡢ͉5MV5\Ǐ햙okxy *KxSU62qEIYE;ؕDL蜗͵8j ܑQ/hINi؉%) t9.ǀ?޲Șv}0Y9 V2SQL`eUL:B C|Ys!*VEvgw9OW~*C]I6;ԃ2չѝ.z赑CB#4 `v~y*d=W cF5_JfQcB2PwlRJ-z#V]xr81x8(ٓh_\6>\mx(ɜXjW?܍yYn]jyM70{PZ#u_ŘhKѥhE"mpbuפctVJޏYd.OћΔtXI5>6̏䇘  E6&2Bczmhƒx+M ڕ10hSFKBbEL% y&qHSI@z}68H9Z {74/k!^Z{^TSo_|%F6`#5Wr.\L%+KUm=y)7_ ¢YE)3Ar(9<ȓXkmཕ`,WCPc{eSXմ2 _{M!eHhJYϪ?zu`+ LYfQCjE8apՑQ[ NXdvLF-֯#<8~DoQ+j{i/!Gx~$`:RCUv_7@0!+mXB@OMzETYg Q`3S ~*QA!xG>63_lF-08( O-藵xSUm^{5i?TZJ$TV?֔zz<fόH;iOv*{Qa8 I䰜7Yx5)z.䳺b]&17] HJ1V;h7MV?>%RɄn]5f ۂϵ|9e2IvTΗg)+6] j6}ȩRS"R/&7?}5r]D dT ׽Be?X>!`&0z센gZq! ꋴWt1.freTAv=.S5]S9,KQvٹ*?hBeݯVCc&2ZC1D7mp7yEN_ x}\x\7dyH]Qn=;vhܶa/[#ԡUFFtR`^_dYML{owKln%sA>g1nj!3 XAјIs)zҁi_ص9#w7˝KTgg#ʚf*֞#^@7GԴu5mh$O)d:YNQW;gu𺺤A@Ix@Lru}Te[Czk=}ޖGL`Lqq⣮TAK *ɸ?;#x o+tD r+j)HV5g'i9 :O=5KPnajQ/J"qھI{87CT\f;6x1)=gWCڜiKfDwW̓Сzu.OѸb*FrI$΍򽘪֒5v& 8vEimruҎZǏWdt.h˔XbfկfFoP 3A}=sa#Fi&D(9H[N&oGoޘߚ,U'úRjqoiDHU&@&SIXUk4d#նyM"TzޥϒZ'9 ]ECkEϷhoZZpmH1!GATY1v5 5 !ITox55u QK&M6:h Od7|:'W6%wNYF >lFFv38?] *fƢ@0 p5`VUp{|?]Wu(JIL,6L%ByB NE yI n^NN_il2 OѾs_& }r endstream endobj 111 0 obj << /Length1 1900 /Length2 12127 /Length3 0 /Length 13301 /Filter /FlateDecode >> stream xڍPڲ.ww n}5hpw \CpKР-}WWS5ZTQg37I۹Yj|vvNVvvd F /2qyI)]! '#`gp@ lPdہi$_*dک_EE:aDPI` CB:ɯX;9:g %?4xnX|%3ejuZ}o4>LJ`axҫz0830nF B}e$9|>N.Ggz(ۗғd:df>nhJ`n7 /{ߠ)(]t- 0ϖtOG޾<ɷİuZX R@>D+D%lB[4i&TZpRnR 4S#gL{<̠;SrۜYp-Qx׷ߵ*ߣ$͇cP }c [&8~4Wh>{Hnl1U7@W12SdȒcߑ<@?(p@KӂjTN ,S!< E@}rNM܏"}dIg;iU/<WڬҾc|GCESYV*FMLޙKVo%gMC"#3Q-9c?yoo"ny%I΄~ǹ~ D Gº]9"3a:]稡 mЅ+6y7S?ۯ8tj_I9:Bnn43r?:R!:LA=f=#GMW,]5 "̑#ﱭq+#6)AFZ+*FBJC>Zڶ$ĊH{6ta:<)x,z8{-:Ԭq_l $b9Ѫz-a* !fK* FaռޚX)Jm^U2'Ž ~a@*lp9NI!QZbqT[2g/_K.x0igkygELJ{/-ڔ<,!tg8O+oC̗m#_ 2^ZsfIiha)9r1Ⱥ-hͰ(nEUu憎X_y-poT,93% rv-׍u:QӍas[daZn?EL*ڕ/L=ďDB;D@ua '{Ep/& ZZvzD^$"7mF/ܮUt"HO G#7u8璖U\-h<۾EG7urq$r6%Z",rK**gq3\Նoѭz!-Ia:qU'6dVܪ" Q)gXc[Cxiq#q H/u d4oG]RZ:Xѡ-s;;YW/H\.:/ھ\V UTHh2.fy[Y4TX>Ҝw#<i#u^Bm7+JW2bǠ=tXF:{ih#@e-3ȩ B?wuscC6z0ec@RqKb'O󿿟b>M׾ `D5Zfb6cf[p ֎3*MQr9~Pxb"]8ދ l:,YOTQW=Q0a:HޏL|?΀A5k!~*sߥ:]pR?a-O;wD}?c=HZECv+^48&-+GɁ'jOEv6no?Jz!/qnNB. 5qu,rN]}K4 Gom%^XCfF_͵GkLn}ܡ*U2IN65A wG{.p1]" w y-[}J"[ȊèhtuFM,pndwMFDrhX/bJc_jf\D]3 u6G^. zkdϋxlavJ =ʆ-vfwkbEƔ Tn46 (9rϝ)"oW$=QN֙J{}}?G?m3}x`fNSLCGu&%?n Qj18o' #1!GgӖL Fڔ+6Xp-EUeg`6'np,fu#Y)"qNWeJ|@ tB _^+I9M;z=xc`Zrگ"VėTSX*d]+ނ}&G&}'mdYDl;MX ,Kr:7 i ؇čt9=3Um G맜ڑyHO?AdA*E7DB+r|א%.M 1fҁ?\pےK<7cjއ?Ƕ55թaNKLmY*L™Y:Be|[TR+}{m3Zo7TK:?6Mh% k]O wWԍ~{2erw7rPA(|.*QrZcCeE1ԬY0bYɭpcUcL xS\{QZ~+|C!8FL*n1hz.#MH؛<]#gˉ>p]v]8-aZkN* ZGSV ^ƷPUw?e~ċC:1s*ci} zror /lX"grHbiE1g3bAc׍?†gӚR̲29(CvWQ]]go`ps&*`Ӎ2+fS%Ҁ#er .N0fin]Dͷ un03L{ƾ%vL6H's3ѦۜSLaI~u4tރjh4D̓ ]U{IJᓥ,lν?=.NE[o,`\r΍9t&'K~1A\n]cFq8q^&So9{VQkVϛ= <Gov_y$hQM,֊\Kv%~^vǓP6uv<_u )C""M䔇kqـmx!瘼l!(Ӥ)IvYk*z!WoՏn 9b߻ۘ]j #ɔ."/*Nb| cqAU{bTXoSgC1†;k<-6 -^B5\h}V‹m9;JHs;*vg&Mnχn5(XKu疸Pi+ Ň>'\:=[}[ٓ@5x,uk:ӶT#71ii*q+W~{El,ta_&ﭚjq##rh1'eAK1o[걌+N6>ݠ:bV{**߯ y-[r1@t!Q&=Eʋ|j\NzpظSN4#*Y!Tp ]${V^Q`1e֤qA ŠӖeYIr8oCEg{C.?+^krw԰…'So>}GߍpR~ }p=ufGKm??NbWm=a^R"4vϟ}0'麁f|zb {W[FYEV+<.V:Bsj[T+檳 7Haå4cTbb*ʛt;,{np+yy‡h[NpJǁiG #8l􄲏_=0-J4ҁtnqBW j&I^`zyy)apv3=pw4(tpe8->e%!Mܟz[3tĴfߙc]BQ /ϓH_qV :+jJb3>Tsj?.m"g|HW*[ j/y$<eg8Ur+q|Czm*mݨ)θTl| Qq<±+= ) )c2C0,UbM5~ 2yMx]6g8{ꛍ<ʾ{X'~{S( 0唳Ԥ96n`2eIPޮcu2AK %8ڏ,|YT~ߌC"4ʶpCDZЭy-67}40R[X Q^*LK\yyU~|#V#0KՑ^PFM#zK`@)|A2eQlʭ.6aMWS | Q[fG6=2 nnц9&*jU xh7Ka~zlq5#t6L2TT,rI }{wSxi3hn!M!Z(&= ? 0Ai&h eWV܉9h?M(k@h\&HW+ j56wzploi[eoSunQ!͙|ȳDzI2j0w:s׎q^>ݥtɝu-oL &L BA/Hǐp c%fÌzδKYI+\mBClhWpd"pf(0W-O%"1År7oȣl1m5Z>dX FF0.fAQɍSG dJ"Tl_~m.; 5#IJ(6hqUq݆P;pCaL]+Wkg^4#L`#H@]I]u Ԟ=ϑop2 _i"}yHh,V~ /؁]<^Hm; &]($:&'Es39ţ3pz!ҽgIn?#*,(+LF9no]N42򫒿]p2Zez@>5py>&NWƫ \a`c}xnͷi# )Ib^ ٹ1lm=&?=_sYj~jv_\1s|6!.}~G[-k@$Aݏ`qDy,oQ `al-Hj#D^/RJs1E.xʌ)5=@_pDAG9qlDEO^1w^؄!sxGs'b\YHCZɻ#A(npH!MEx70Ґ5 ,e f_0*;{}X$˛959f>ƽ畞)5;sR8  qk ? dbOLC5Yx9d؉~#Iogo}XO;/[0W-j灌9TZ 7Vٷ D(JK,%cA u2rw=Yty1 LHN3I*;OG~TR>JMHUtar.KCFJrg}gu`3<>»}@PAE@qxTY/3+Ԍ;[Ⱥpze,6AS1贷ERl+Va({c,V%X*"$!etyw8`$&.&Km~-?Ȧ6r(n,&,c)F #Kh<*'&wDmjF6|R]7DV..^BکǼ@V CKRW&-V]/!*X``h-mTjn6KЋwjP<./3жd$RP2e9=- pJ : iMQ*G X5+kGm~V"hhd.' [#r %0y1+pĹR"Ƴ6Is!F@j|M§,SǷ/bRd R?zr<'Kt˰&2?MoM(ZCFYܶ mHQj5_-=as ɠFY<@ps^iG"0ab>"8%)r[S 2[,y"M-Tz.W_id@P&WAD-3!m ׽AL瞜ldҹ7|4dy\ܧ돌( }( c7w߿/\ѮA ,GpSR2iFATwoHBWaCr`KwZ%vZx8jw?5){}6ST%I;*Õ UHm~4)eW/tQJ1oJC<̽;⪔ m3~@Ab#-Q*gpgM}σ(ݟD'sNݺ{|)b:~a G*jKfbf%@=V~jմAl'Khtv^#R1yqwB)hu׬Õ(RܭUI^xkP$<>î 34In5J"*%NbzX1c֦C&_gwSIb7Cf~79&CN$FZ ōvxq8O0buyn+4N`neSobCYmu%O4G%uu.iKO{|y: PV3/ g;ZJQ\qkM^3/ODWS_F` J^A4X.I~])?#wŀSg%ˠs+ D)cFo3I~R-)\*uT!frj=%cB9MFcx/9]}5IAJp&_@{AV!qf}b/tuHv^rVK_4]{naK!F1 |k _+nxi_VƴMƔA7E'3+FXSLMVbxDZMHhim<Ăؿ]y~/jfjakDk|q .7LK/hԛOe wbG=>M;:' MN>Ē.ǭE^S]k@(hyZsmqX'rEQ+۹7M?}$p(;h8`V$D*`zTo_Z]8 bp:1cxywN*g 1-lڤ9AB}7 Ժ<# $ʿ,HL]~E(qңIA3go+bZ)凌<|m装I#!y{!v% WF.}s4ePZYOu d? N/Ja1<0>s`m\T Gd{axL:Gɪ\)\>1C~3璙+w+PRTdF^rK';۠ kdmYN<3%ʦ A BMbe{:uAQd.k8iu9m㗙,;<b3}mgʬh[Rib?/?y~w&9+J5R*w4vW8 !݃/H| @ }&>0wt䷏ٵY3ezKP_Jg4S#,%˹62!7~Yrwܲz, Q5$74a?zI~] bF4G*E^}{: h-֭}\ 6VE.Nà[c D>lq,QLM 3"Sx^2&qf<"l (Fv wz4VufYo1]J i0ㅒqX|"xw {{7a߇2|`.; / )C 7]qrrTN9cE endstream endobj 113 0 obj << /Length1 2029 /Length2 15382 /Length3 0 /Length 16622 /Filter /FlateDecode >> stream xڍP[ Np!X.-e/j}VZk QVc1w4J::102Tyl̬pnvp@WkG\&n2q3G `efCG^9@ tstvrXf4."@k3cE3;5rssebd4wettxZYT@9r& c[Y#Vsp4q>vf@ws cm<@ ?l W kML,v@<=/C;Wk;7HL>Ouf.NnvUWMp0s: c׽>V[GO--*݉I(#% :^fVLWvdKpsq[ `nm0ZZ;!Z'bch<_>|IKKIAUu2X9,lE?Y0qp.O9}  RtX O3s0}|n]u_Q_#ng/?~uw}Ǐ pZUhnn2n&3 `iMv+[Y*50;k_ >pǿUKJ895]o# /`ۇ < _`KqDI `C&?E}DCQIS;I}_iLcG+_d/d0Yw 2_ZGw$m/pGVNVcl ?J~fY>*WK_ӟT>l>ny;) I9}鯭W,e ?<e ?~Y?R~/(o_oTzBmBjD=&f)0.?!ATgo܉^!~=ib: 450Y|"A]xO3S"ٝIOGXž~5K CF~PEi<)! -څ,Z;l"i[kz:k.9.!-4a,ג%X9L-&;Im.{pܶV0. хtϖ1H[]P'!"bt ^8~%k49M5Olb3)iP➣GL{S*SXoWv-|Ek=G%MDGn<4N/Xxv"++_\I5P[Wf_5<ڐa!y{TMSSDUQZ$J=-C@ -܃k|?a y=DpՈl{O_!mHu&PFw`b7l+9aТ ,O%?AҌnD# {v&f8^.I:aEĺ>"Eȉ+8M=۪u fo㆙ЉU(.Q8[jn}]/zpͣ.ԯ ,< %xHkVTuܣ /@>64no':mI,ӝa0~13~%na$w#xv/jMb_EbDRe:sġF횞B~ktC!2"kuy3 W,=#̶`6Mw9J?lT!'ad#E]TeTH돾ʒpNda'?)Rչ `z<)(}9HeH5fJ (:^t?9,XE64 ,4[74>cC ʨFknygZ:=5h#i%)5 _>'{=Ev F-R_ml&$+HX<r(ӓ5ES CXXZ@ov]]#'Lһ$a\{\$$6♤'qf$ԩ 4Ę L"%eo23*+5; .j+x:> m\P>^4atb6\ *╖ z' t02/]`k5xxZm3F4͉(ٺRX JnFj:;/}C fTA>f)G}go(1 ܂A CuEuHJൢw <;T4bJmA/G: hg~Z VS/&Kd:؟Q Vw[ #%/%R% Lau韘N4`}9?~v_\7d#?y R]H8t"yA&?4aSwmhB߸̈́tX`^.Ut/( ~^]P4BòG<=LP䘚)s,S&.a̟=k{ㄾ1ΙvKW7B: cCs ^efTTnJL=py+ʶϚM^l,f6n=d~kۅkȖl(ԍ\bu.d*2Ֆ m:R\ŷj~1HZu3`7,D>əV"XU9O)Li-V+r\cAU@mºg_ ]>D*'GS뎠_Z f+ )cBʶ̠F̈́*{ϙ2fnN,Ul#iJ˨PBe1ka^C=:|޳Xe?k[l0 Jk=Txur  cJ{$x]YY4EgDrQ Ϻ ԭ}@GJ4jSiEb48Va\HY,{hmc =^<',6^0f-h ΤM{%VFJ_5Ure*q+AP9䴃T,G`_FP>}y9BVn6G 'hNX!c8G|-CM[xOkZM^pSV6+QvI9E[IT0F¼WkggKP9A R?.TNoC5HPv:AuTzDy6_dfCR+[u(Q(#{+V#֍,.[I`4*P;~Ltx2^'lbFʰM[n߸NEtgt"Fхxǀ&Ք] ._`ȱ3S}>O4%!(GБxu9Xf>[eȌgu5s\v& o; f؀ݛqq꓎ort?#D+~SfZơTG.$8XG3?~3wDZl!AfݪxK$/BDnuOÒTVX}hdh$Uq5X1OΆr qH3,ʺgI-[؏|g^`p/꬯X-xO!oj t[d/_\yYڤLPH%M۠Y+I~*'8a PkԶ&M= GFw(*V M; Ҋ'=|1B 1ǷOP}'!Ι;~:RI̶eܣ$1[?U@:JyYO0U6Ub8O?K[1g/KXK_UˤV6&0Mʶ$Jb~B" +q`bVWQ1XWfl1څ܁ L # tx{W Ȝ)s=涔[JBԨD2[UMNXsrToU@Ψ)ݺq.#sX>ӫ@՜OdJ5`o8=JH ^f9Es<=5œlWWY7!AjPtC”щ}]9Z$%N˘&I mv pqNЇb.5ׄ{s*(E ;c9Z XܾDbKM|M*noru7+Pm2tU؉1uK؎{OAqךH2t6ֱ% ;q|؛ A9$'ltJOΛu'{NOH.q Hv=Work S#?\/$1_<\~SIo~v5X] Hv{#Ciz*1[ "j  0*[ثZd.;nӯN(q.'Oe?g(lA -zդe+/otm\T10+O]дC׶-oBa,ٙF7e2yݧL56Fѫ?UNI{IqTB/K87U`B}ͥT>7 ]3%E Q2uGgXFfLrKiNy:D[k_R<]2؁iKq&0MM(13Nkm%:BH:9]ʍmDP{t_;F4>I"aܹUF9"wh# f=a",7 1~G 7c)$vOBG2 VT~[hSX)yi7F`1炸zxJzwJi~^7M%0j@h|rZ2oL{ /frpL\rشJ[~@ki| z&r:GgFl`.nB *R7%̱TXGڄ /UrCJՙY(-*Qfr\>_gT[&%6(RqJhxU1g]}e=Ƚ_ $ K B "xdz,tOXXk_\w]č 8^瓳uq&z!&-RPr bȪ՛^/ oT (Wcus~xyu (zaݻrh 4MDYu"ySj6/~Z zt_;;rY\TW:NtD.[ ׄ^BFceX\uT y_lfQ{w †hZ~tNT=XIG EwEhFl ҽŞq^>M*L ypVtDa\˒59̬in|%]mle?X{{o]bxTI:pŠβ~crtd?ݹ瞲s/21>[Gʝ`0)Y)|6E K]mIَ|;kO#[ݽWFsLa@45"$(u: P$i#:Y87d eHBPEm8!eC:9^OcE+ -;!GsmcD:}"wWa>2bK" <*YүRV_W:#u)UYcb _X],e+/=# ?-!gGcE +[-W ?R],~y~@7@8|p8~\M_Q*#xxtFgP~mJcIq)D8_ o @IؘO7ܻf#kza G<\׷ޓ@٠o52l%BIu 6 ;QW?ɗe>;c4:6ѫ'&o䏗7DŽy4y79$)j7gBY9{Oki.F0rzPVxLvf: /Z'Ⰳ Uk4Q!Oo#1QJ܈j"V_:f}>e~/Ww"#L Isvs/<qd`o;-]an"cxaLhhJQ- ]zZBۓVW%/B٫xKD?޾||$v@99k"; Bx&)J,J]C'T/C:Ndun<6(oQ.ܲY?q=7H2H%ڧ|Gn1kwm,fsK.+}X;Yv_AϮ&Dl|&9А"ur9̌KLu' oh&`!#$Ky/{O&c¼ULٱSe.Jfuq$)1/O/S Ouz$?yF6N6,&ki=ugu۠6HD &>}:!]I" i8[]7i!w?әUMFid?!e RñY0ߠ.3<LsI5i0FU# oR)~>gkR}|PK3;x Q?󌩱SPFq6{7fmҝ~ڎb=nLDz+-Cg(|%rp!ѕ-'{RG+Iio$/Y5yD@s}BNjʷ }-H"OCT3t Is\󃜏({\ ^6JUb;1ue\Ԇ 8/4A,MVS(dGt?bdDkذ))Z~$Vee5{l+\ $u瘡0J]2;.<{#ua#0 T6Gj.DM~ʌϒo%M7#L$܊-/fw`dFtntO+e8C|xd.g㷑EzJm1ivD?>Wdj)9? kg HHG]ᇡ*T: JWPJ8yS'9"=eZٷ"S[с=#1CY ѣӓQ X\43Y>G^#_%Ւ)Cq5 ~]r*@8 t<~k{v;g, LËՊcMl'طEk6Mz]PXգcw{)ןh%IA04K9(0-mߓGL05v:3k70wSNU8C~{9#͸ܿ}eG>>7ʿ^|]& fc;3bQª^8xmVMwCp`ZMpt/h{x̓ә} mѡtZ|W)c԰,q=(@SRӁ8_9se)I)^`hkIتqNQHڶ#/""`beU Rd$PA/sa:}MQ"ٓ\-\Бbv2xn2wI.a2uXh]_Z"upf¾@+ޏzyaka3Sv{+ELߟw;v_ɾIѲ{oTѿF^Z-i8 \w7͗h(jn<rCh8l3ɵF-5襙'Q}y .ԏѵPt0.ZPY,p%y缴_us8]dn)6ܸ4JF2C.:|qDYT\t7[v(읜Uzeƽ!IWtۑ+/xf-KΥ\k7y]asTpˈ iYy~%KBP ( O۠~Dd.ꝝx ʮ9BVn,,Gxd;b잦d8Z$L D~5Zߝ#HgmLy vӡn]^r{ztai5}! f9fE "Gzf9P#Tn^^H63;;[5yb1 De7cɗPQ4ֳѱFW?ڵ|U+-& 8ƖI5GUC :pҧ[NO,r@-\eyʲTW)N64Ꮼ]G^d:z)mq[<-c~e'ƻȴi^fxzy)ڻ,NMw(}HV$$7w>/ضh@Kʈ ܇3e_D"/kH~a -3G%, aOt~_do\v 4bFzU}%*hrlX|( 驨4Ig'w24޽> zs;K?)X|cƩ<]|Z?MGeg_Q@3L 5;*ĿuNAVsu-˺zI}v z.%Yh*[c˃ԢT qaqsQ~k2,晍ܹ'%[Rv]Q@ wjyo{l"wU>&bNEE*Xe~Cl3BY k+ L;@+|QOwxv[`N\#Xs$eF?@_>L<ⷢrwB3Uc2iX첺۴)sH]ֈd@`>w࠸\Sv(e)Mo~jMQFޱc} &1/oé‰C0xM'#oN9'VnpHbKD=cpe4|wR!EWWmT@$c/,RMj3?索Jz5uH:1.rC^u4iTz!Lq*{䓌n! #\h:~[n:H/*E*'w%䌸odVczjYJj!8$ױZ\,pɌ( Fă;sD;2ֽ@\ߞu VX!aD11`K):lw 1ƙ q L'dsHv@)08m"SŲ-zWL9'=~C)i2+@k:+Mf#EųƋB:ijY7ݍCIt]gߌ|7v]Ymw]he5_@ ao_[N :v<魇bK՟εp@^єN(IJXlQQ{[33"鋷]WMŬ5Լ.3,- E:P#=m6kF_\xj2bj3P ޣX_|=I1~Foǣ^FCJ&о$U uFi0ь&%Ch5|rȬxЍ%$~>״JK#>zT 2w5@6uyA!I1)л`b~#.Dssb!&ԫ`ƋR3Pg;RT6V{ y!Yzl EaM=L e 0 MCsiB%K+_tn /bCE 6֙Ⱥ0^j_y aHZ#L߲ 9zb5]QV'`N`޿kd5'SH]gidGfS=\~yQQ- mo7|r:"26]w *կg "qv Kp/ < LƊ5RneM/mKKS9 |W͍ *M11=]v vYq&-QCnK6G0VswatY|@d{R@)%lN]$/F z2F{"qɯaUQhz-z`|$DkLkT\b^ȁR#TDR*ǚY*9 L0NW$R`2O%)j?й7͗83c۲--rPYO:XIRӃ)kʶfxQ֎Ur"ykFNhm>/ 5Vq[ڨQc! eӶ mc5\4O4/6)ځe-Q8jbvJ!~dbg򾕶0i \vjY&(HN:1|´AgD8"Jn3SkKXh]&y8cU+(='wBc+&Fۺ[yC{|:o}4?6m4 t/FE}M!M(1SL0pM7.BSce]*7Rd{q4ŘilmG/U\@ dJl, +tv"2ѸBQ4&p9ܭٴX ({kxףlz( )a }CKأCꓘ=ѡjQรl׼>-<#Ԟ ?<7Y'T#1Hܥ_6?*`|A+:AY1x*p#Ĕ9W"FJ-5 ?KI~T/ 9T#9x9Ls؈U5()lM [T=d2| LW?&teܐօ qKC70XdV UR#TtDoIwDžR)VY]=cB@ ݇0HyNƝ.if}=#RŜ>9ZL_'s rp-ݧo7^#XQĠX~X`S,[i)Awu7i|ra .[ ^{QN3g9T7 QG_8ƭvY_AQ?`VТV|h"bĻB?'L =XAPRk|-`ϛ"+ M@rN3g/M8;L z^"k:{.'7(suz)z Hx":D Qnۑ&o.};&4J@}>mdсk]v:V 15^a[0edMKZky~_pM{aPQת.),`8A٠] $Ch|rw`-'OGmʤ^U.a1Q(G_y$ 7iNT`yq8ǎ!5lAf@֌J #xѹPM7ߏ555pmL-ik^|Q spḧ[2Me؄;PS!9 fRP|2MNZ8q*ִ긳2l'Aπ_ Pcx\xZm`쿳N7qzP*y !Ջ~ 3Q XG7m37YDmښ ¦l?';ՀN#,OmH[cZeA*DiϗH'EHmNۨ:|NI)Y)Z3G2t]cq6"oۊg8 ɩ$.NLGTwӔ'ݥ'=0Ig6ܣSRϟnֻ rT o9}u*r.$kLG\ڵ[~#6x%@TZ;8<tsTnrV-DPE!fq[x.MU|R[ JޜeyX;7U\]aʎv )X!\4V>vG@̝;g+hTwqCŕ\s'dS5&Ok8& ɷh0ի=Z,aC ۦ.YX8B´RcRovsMK5^1:4<(1:Ro77UN{V]=n%{_Mxh}/A۩B#&QV1YiQFE"C'L}GN,[6zB{.DYbmBd$_1shUWDW*w)+\\OYjiK6v kr0@T(X߽([5zrKÏv_n/NI4#W\ %:-,gdИ[GTd7goL -p ](t[PH+5Hg5c縥J^wvx`)Lv7j ׼k2dr-%/6):Jvn $_$!}'%q)Cϧ*z:#b}!.,-g;0(̃7sHx@pZmkaY)y VUspy sϽw"$ endstream endobj 115 0 obj << /Length1 1786 /Length2 9816 /Length3 0 /Length 10945 /Filter /FlateDecode >> stream xڍwuX-P(CpiRww(P܊{bECqP(E w{s9}I̚=3{NUCf9 a&A n,FFM(Q #mR`#U fPppA 7$"I vZ=Q?fW9 KHHp j(nj`[ {/paNN777 seaAu3b6@l9 #@Kf w;A[91xАW8@$+I`=. {!`ssjoB*2@;M:`-G`_:;A@g.9/0;;=w}RP'{p}oan^`KV,\8졎.yX&lV8 >,q7D/ vN.;aqq,p jfQNPwQ\ߌufAsjIjjn ;s >*W! qS_B`kNX2Q?z7߸UGKW$bk?zy q`CaTȟSW~ q{Gisy4Ce U(i=vP{*pp@{57׉:pAG鿳Jۛ,~7?=8? !}0'G/m 8F> /So$#Ge`wg\N?Y#GGCpZ 8NǪX?q&8Tux m!\YV/X9_q]36wqzLc% C̱fa/mj[/)86Fy\hybl>+)=LʒR`R:F퍐D(I.bXRYyMM#'w@W~(*9B #vTA)ϯTٞe""g&6=. KVhbRnػ l#4łQ tp_[~Վ^i넽pbA9ᙈɧHwER2#-g1*FncӬ³86nrb=Jwr';_L6Pr^? ׉ڑ on#?ߐ76'Իy_T."؇c:!HuMS{3o>WZF@ByϤaWк1 .R]Ͻz?1@JODōȧhX txkݚ\8Sr>]e_=ZQD?`T`m^MX|ezn>oԐb.b_7(Ett KY!8I[ps\2x3E,B>#$CEߜ$MW]nWOZHkw~ޠ0xOm8)ѩ$ְdG, ?ߊM) 7(!ȧ*vuKڧxW~D;8d@i[~gx:aPUO+"Vz+^  Z N'~)Њ0?4"p& 3i^I*qBL)DQp-s`nC{$NAâ3S3zn(fZYGksqO\w# f|<8Us?; pMښ˕X D萵RB$MU mnvQSؽE> mkD{pdtZ; 4;M#`fD*Sᾬ(<ڙ!I3вuȔ/D'u`!vZJUÁHb3.;NZ9b1x:E6g\wO.}ze'8*ncO-乞nG[#,5ajXU'2\埉iIz=j@9'd.ȥsJoWL~>i4[n/e_TOii8yY0'.v3Or]ϻn]jkŎi\5 :7bVUVcThJ֖dxjQ}pvS%3ni&ho>nx])I9D[Lft˗.h_۹ J /o[v2ɾ]ImRx62õWKi2Lێ o͊FLk~JһR#Q|W`+9ypP0a9e ,6}&6)ێq˸kݑVn:f?铰tͰ5򶣌<':|hsmy+pJxN#2t_Sӥo5UgYL6$[ d}Ϙ\ԯxp؟ h7ۿܺKЅzL8ws-zt8-οF^$TR13#3 ZRC&2?p$!r̉X 1@J'':N~uOӇq׵Z]?BNSJqf "T?bX!]5몌$S(; ,~q:R39ᙙ82NJ˚=Ҟ{"JnENJwǶtNr4#c*"c:[dPg%Z.G!eF0gEgL+@؃JQGCb؍4ɷ;D7\cp?fGbYk![u/~{f` cNzet$]a sdacK3)oCe'v8@]wѩt\5ͬT,nVyWS&/mBn̲W('Ey5]s%8v{dx+Jn,xTVqŔIyoĻQ^'5BۉF^YlrKg9 7YOzS;,Z+ɍʬ*{ Dg"DFρfpHl poloHd~-Q% R~ie΂q(t]fvIk$}ϐyQh&ioT榓FC_jwD薪R|>ф%RD=MϹI+YΕS!Aύ/| uӢUh U]*}i`@e G72F7Ql81]Ǫڐ+oNL*Ihc7;^S-,Tjf8(PoLvbסuÃ^Zg^h X&%&QxF}g1A+Q592\sgG~k&N0q?[$- EePH?W{1N}5?BLD :#Eb2sQ %#e\^2C%=\k| ( ֚?GeVe%1(j:r6s)nMoL,d)m]̦QT`z G X|\r೩$zMdգw#wLjAUaM2uI?%|MH ;m6po4:ohߚuD ik;!Qp~00ګ)3x0b|_cgbVjPk7ߕD+^YX 4ܵ=amEvr5R3]B=xe%Zް)E! {U]ݲ["397{V< 0W(e8?5NDt(Rl <-o8q+vxgRm!_L)ʕtԦ|4|WRk8K9nxwst q&\ǖ.;kD8U2K <ʟ`>+HU+c3t[!pMk ;/De_58sY*U~)lGz)I)y4 Ⱦ#.%Sc7m4̗L}V| kw/I/KֿKv B|S)SCf@R5 D1/<){^ JE~+tMr613>r}v[[wՠLK @ĝ5J# C:`6 ;8#B˄ˆ߭Ƞ{m W,O@Ɛtngn}i!Tn8؛ /H>v[h_îL5f81+EHVV̛UYz@ar*kA}I`shꯏ ^ӐcuPI0gZ`Sϐ#h_!|7.{-G*4$a,%D:6X1JBjt4gZ3:n-ۚoPV 'ye0 T V#ۮDNuA\T.(b.=hY Mլl}K+>RCE7 k?=n3HjuWYe\; 뇦/p"t>#%obN}A6P2BIlradxHh< U>TLP͠ h?T j ʏZh@bʪ^WO0k\*}}<ܣ1:q xF$TyMebe@aR ˄(^ޠZO R$Oq0E39 Jq#b4"-hΌwIFG_>]gf߹S]3]`?C1!BM=9 Ag+!>ZEgrVУ7#y+2E!՞0zQɍPV ߲id.biU@R 9QW;/hKyh*_ٺZ |#v:|5Υ+', M“e>1t2/P5\̤nx|7tjC'0Ym L%S-Lʣ*+H˔ʧ|E2[dfk#pҶfzbF?xҏ4AᶒWO=mm EWnO\jWC -θWXvX^i_7]6qf^f2@ *7Vӗh`?`?62jwos/PFO4N2\'N*KO/+^ű'ό[@Zn]Ʃ _Α/Hi}+bL8/4N6Ħ@0Z}Leeҭ"@, )q %|d{3uqQʭ[]T`1q/" kh֡19zZOѡ<_B0OJzZ6ݻ4d%f<tpR SH$@z8,չOA4ϔiv7Wm */7( (50wlR-*{][d(zW sn5L=SO-b\IN5<43.rKm%Rcq.F!.w!!+(6dp߃CV::uYgࡏ<^7b`_L^ɚ.f7ǝ2MDNN~/W ^tlBGn*c=B2E<, ssgWrOHg WS"Ū5v䥑ɥV4 ˲rt&@s.j-R>*=ds^8Nc}g[$g $bb6m37Z yY/l:-k\CZlK tw.^)J+v-=i;RHg\l ;FN$L:Y' =LE!f-;8({-rfbx" MuO[+fIt!t /_k,qPyKV43m77x(9,7 Y(_YĠfoWH1XRJͣ K29>]{gOb0Ϟ}0O{Qچox#Eh qF*Q9OS)=tWH׷M93|,Uftur4i}L; к+Gu5+̍UH#Y=;Ƒ+&SC?HN+ȹ_n9s7O"D$HeBJc9Dzןe4bчb<yOxؓk #u~(/ޅ+쐊xWQKgp< "|tX#}IaG4Y $y5f2&|o)~%AcgDRۆ/@:$ MAHJE 3T/F sСхg)׿iu=+e,>sp$~ 0rn r[Ԗ.Ax-k:{J)y*@G0Ic9`|kaBb$紹j[̊'$ _kyHX(UUG`tD]&j_ |9ZAyN ,iż*6%ewG8VcDCGIK&H=+șKTQn* -sI1'bo敻W`]1qED4_{-e~q`{g/ j (ۏozAW-. c&(AQptSxcG8nR+@8d=%.N!~ L a;@_v4\չ͌a"" endstream endobj 117 0 obj << /Length1 1384 /Length2 6113 /Length3 0 /Length 7053 /Filter /FlateDecode >> stream xڍwT6" "0t Jw0 ] "HJI H"tw#~{y}k֚y׮gae㕳C@p4HP $ʪC;CB(.$)@ PuwQI1I$""fh8ϪpF >?t@قqh v0%8hWI~~OOO> p0 AA;ʀ&g5>|V@+G{ Q)p;詨Z_`<UOB0d- =h)<n vF!`3{t0,7 sEP0_;*s}Jp; FO^7u#<[05] 07w̵ >( @ qq ^{B~~wuEk@a|_ `h] ˾$ 0]Oav`GxD$*p{ ״(G?ki" 8ssK)?'Rvwv .0g?k⺣EFwT a^;m/74g@~[^bu~I;V?[*mvd&(" H7>K"" ^i z=u/_G[w$Zkp=oaC ^[1TcEhi'R|SsH4l_[JzNj‡hO[Ӄfe1:wysZz; t@,)jN{eXJr&Ԋ2&Ңe6m`F0̣?ƒ!͒U ~`FbOcϼbS>)3IhZ{hIjrU̞ƥ֢0EvF1{> od$y܌y뽭M Úm\qI2}+PkVaD}lE^)qz&B2'1#']3ʦ@+qX\K"L$_pNrf{|H},6|^ZQMTsiyMϒtT2ThEmURTV<ȥ A&h8 ߺu/$LWf/@CM |w[t35>ODh-u?(xjA4b&xbC8dscQt)n <97cnn\+,`="EL k~S@s5کl&hiBAԇd{N;3F Y|swF)j7UN[o$QÙx-x?i=>O)N9tx5^N)CXS\uBĎEɫ'eoq?Tǽ s0&.ƬcjjL C=9U ¦4oL#-ҝƲh]Wūń뺒@­7j".Zn+yk.p虍O@ /LD6oۯC:}r j 0?pJRru߮4Hv|DÍ{Us[%׊"Lɱgv.G~۟ƱVlhtaJMM6>/5&X\\K륤l~5׆A$qamP4GD74>1_:.jRGd򝈱@frMNI" G{a3og1Tm)Iv^]xM\Uy['IAKh^y-;5l8s)3eMc.oLNj'[{qA YRjnɇ"2_іУwb^)H"Gk< O>՚C^zH 4M(C4@J@aM6UWjJδk.~[%ߣGn<|(`֛ϓuI~f^8%jP2T-ꨢWO"s={aN,iJ?S)sHܮ}۹J,'SNY`xsw8rjX 7Őh@ӌa/ƶhb2~5D&MRHhZ E4~oa|t:IIA8aIQ_ƕzLXMQWb#ˌX pqq s;let;Hϸ,TM { &[48N%[ %>^GdCIJžBz|٦,ʼwi+^ lRyȌ|6cw" ڶwHQ3 %IZbGLuaKerJ"̓56^VnVÀkt}I2I.{"uQvJ,֨Ѹ:bQpQ1MAJv̎*-j)1UeWRG'(<6nK:ybW_TCҝBx֊G-@;[ :?,* #%/>dͱ__ ߺS^1CLVmŒ-v3{wK4E^;9\a5L5Q䥡t5|*O=/u^R̰NwΪ}P.Wa6lae:KZ;q֗$og//6?k$juG?⩹Tʨ |OR"ik(zvrCt*91j-y60:,1u䐊O5:A jCbF %Fki Y[XU$#[7Bzc?gn̅<ʺt`3o?aZe`,e K nMQLPx-^2/1EbҞ͒D/}ayxQ=]y2;IϬ: REt}^ki 6LkK;lAW,wGdib *17t=.q=/60oT%5}U$Ή [Z7"2?Ik Wc>V̄?\INSI9YVE d?􊆶1ӏ:L+ c1Eˏ cpC a6w!$ ݗ" {!4l䜾zX7C ٘I[GUf% 5š,$~)ےMĐlsfM~Uq|AO|X5;AL{c̈'e3EX&Lܨ@FĦҥSD[9Nah\;@ӒTb*IKM0gʕ4[A4A~Zssf68K~2-;Oo0 jUR 毮ߑ0+E)[3_ -6}2_sa=τE;~!CL<~E`H&ay%" {ä #藨*pڝw}_AB/kt5Y;8/8]hLF, hsUՂÌfd Y^~'?4u2* 35YJVWސH QV&YŒ!w6|%EvPN~sC;.<=xSo;ZJ69aH\is+o!q5{ǾPId=$is9ޡ?@_ayc*r= t:@lDݗj*=˹zؚGs,̊IOA/{[5Sk.$6r(9iHQ67c뇀2G38V 8R]5onTI?]]UJ ߄"U02]|G|Qmd"jB[(ÇUQfU7;<%>8S|S\NTjz)I.Yyӥк'˷v4R^bd*GQ(a?;)^P#U-ynȳ]U{P מtΛ2:Xʯ# ۨvz֒4bg/ֲ]Ďѻ/'ڏ+mxE+uw~# tdV!HZepŒI^EEnk꼯@9`5mW\v+l!su>.c7J B{R ަ'a";KeJZ"6EZ<%* .QBRzHlM,,)m:vnM4ۋ8xU6qV*}(nz]Gs&fC5czE?&-ڳ^Wet>-t*g;gwη %H]m,/-RM'^>r164EJH0PҮ ތ{ok`];'zJĻ1{),<2 ~kӊxgCbeR}H MM~9+\tJv<݋=8(cN!;ZkS5 o&%)cr4v\<19Q9y; N.tvv}YixƅVƃLv[B?4XN#x/t􅛆[ N燼X7d]r|B㓪s&u{Md]|N8*_rm9No_tZmл(g:2zn٣FpJ t-ɩN< 3=T}ӄdŸ?v:ѥ70| `5f+>Q43DzAA9pO.h!pը0u5O'snl5\~MNޓk6Jnlz=A]R-H]>8ѪBXpn89pC.;`/y(pq{#bbxU˘alwI!Bհg`q [;Q-鉒c`1Z;5X4U/\fKԴ; 'TiſЛ(/]G& h1ZclVRD@qYZHrgIǠ2qcud{2IYt =,O n`\NbC}nc2DŽV`>Ok|7&˂ T 7w*>rHP<by8CdQY7ħKzoNXYlj/ ցs{$6[sW_0EoRSMV$D3h ;;(92)6b"g)N\4ή> stream xڍvPk-i‹PQ*1  ЋA"RT4A M.H/G=9w2kgN MĔap 4 +)z&&$%I"H_fr>s8 F)/*lj,FݑX *@ @Q 'Fn|ho +G@*Dp  AzW A&h(W AE,EABS&<Xxa}3d|m`΀D@(7\;  .`G _(Ay#P  4tű^XQBnh\<@B;F7_A1kD_ip(8w6B{|:!P0_C]$PWw_= Ȁ@k I қz;̸ }].n?!ux,> ?qfݟ3n`q ~}~ F!ޯMK?SQA{bR $9Y4_mF١??{E!;>Z8 d@PCo EnH?g/X8zGzpXN({׈p@xa,[~ @ n_@ '-ᆣoTGAѰ_  ědI{&1 !Bcq!n<!kR/B1~/W?2ýPchPWǕb$3sQw;#e|tIkYz 'Ç؅fMi`;Tr?9ah6AIFWhlRɵI-\l)8i8uܼs؞h1Vf? bG*' V=SSY;ӥvWȖ32MbeJʺ _EP8EH;޳ J}֪So-[$ j5Wqz@pՑ[ T] OR=kxr :UTPimi2q4fY\.PԳU,T}LJ[PepvE$V>W`i]I[<]5.>]v"KY'`@Υu0mAyW>O_[Q G2a{egTQԐMGb.i!c ֠ضO!nx,2.Td5 lv}Eܲ)cG;ZF2Azg!!Z~MvǗq!Ւ;o5'((?!Qevm\/n&a rtmZj- 5L< O35_u|^d&&>Fs^eɍ؝D꾫)6!oYaEne=lf0ڄL N!aft3]o;|#oOI::ia"Ԏ`E7ʝU}~DtiqS"FM"ߠJI4LyJ4]A9ye}!ojf2fٸ,vq+ߺwqduSrإ LGP*^bKK_BiO\u| zVeE%^{,)r])uh%@4wFŮ$kȏJ=`Y#*zܧ|˱]5ڃ_9<֒^_·F1[5FizN3}!gL;{'sl|G,9so6B4_sb :_SIg)Ặ]j!`*RRc̱VmAڱJ!,"C_,;mCtEIW{PvQ~}qs*Hp"Եcs, :e[Ӂk/VwQU0ue{j83XT Sb[{ LlTLaA:R:v3k~ mʣY(sKT+t!r%?+ϳb7ua佛(fa)\ԡYk"_eVvYta~.y/Tǎt(z:Xڥݶ iv`O\K;c #E>?`w$mno< R7M,)+ i~j2'(SvW3$j}V$c&':H~B[rO١kH__GlFˬ4ԉ*6OXanKHNyyv{zyGc o qW+[ͧotaqE6a KG%~>{qGcWdo4G5KLjm}X s>YZisYky}36G]M]$EԔS GN7.wV'V۵6)od]fbx[a*`#('Cw#1@oTW$qa{(3q C,Qr;rll%;D|- Q~`IjT(GºG0;GjpTI*;KUr-q d^z;RR " 6tbH="%VpA=Ԅؾa]CxLlERe Us76ڱNUA'qqGYUfH3̖UW?}b;BsA& t9dVҏn\$~yoɭ0hA}D rZ 8hkBH%>gD.}{4$^ ?ގ3DE;}yLqTF}8ҠcSkzqXAoF\'ȿ*x"5P66~ Kl~rNM^L$(G_$-ߚ,Nѡ`jQH7|1NP (\FWmI?wAWo7T%"R؉U֛1*u˕o)W8t f-fo}Ϲf_`!dG}"5{/Z^Ƙc}Y}㬙m yXq֐b[!& qމ f$:V ϑ+l\7F.z;SAgoxjY4! *0KsD^;7KE%x%$ݪN^ఊT2ztz>3%|M O椤T񊎩Y*~ȹ}p+{jH#CW*FɝNQD6$I% >~ɜgX0Laf,Zlp!Jt(=d*%c1#2~El)KschO5d` pU`ZˠglFҞ>ŻK'kkhϻuY}nj9rrB)~.x,hM<^$Ի<CXv2#˶A#ڛg q2/-) ۮ "V J0xujYҦzAb̗z wiaMNUngcQ/KS| |# `d6b* ;|^WxW.q iv_$a =2'#i1@J Qx <}(:K($SJIrWHNÝ^9za~ClEavV½|._O2 9rxy<,6-y7i)0~kk֬T# Եx:qWЋ+b 2'4-~j|lYvEt}#{圹6(I]W3!|?O7~~F\o, Jt >5: ~Kt-yLӾ7u=Hu4M 3"}*;FfHf̼޽llpѥdjS(b٥K:[4$H|9RJ,* Z mӃ+34ȣ?\kv/,4yq-6ԱoDŽ1T~INl }fz?1ӷ>fe;r3:6)ӵzlgLjvGHM/kIxt)>F8{61<_ѝlf:ojAQUb)V֓f,v:e(j=6 `]}ҬFfs=兊z^_}p%Ӽf5{HMQ  fiyml##F-s^UDACK{{CǸW8u7H;6vI$eEИDLʏ}j 'U/Ꮬ8ubRBBiC>0Q*ݡu~rXsrsk~3J:62e& 4|Ls`zfbopWn͔Zһ !] yB)8ؑ(4MX0:H'nrewCհO_ Tgg:וּ5i;GWxFZ9:~poI\XJ'O};9.|wIJۧ:(YFt2reJ@8^Þwkڋu0RZ&ڵ| 4m$3ؓqn cg|@ww=U}VZ󚖣\rjRGf79S#~F"a7k^@fh"_W;? ԽXz`=(b!H#Ov/ r#XzS ;˷vFю_r۷5"z]YhVq>:%C&;,.T5*E;6(1MdV_UHޏp ᥅mx4 [0I)"ŕpg_Ug<,VvnE2~f:n 0% 6^x^;b^KH+*X_;&^ty_ijބQ[GQI s t?n@ Q'7ry #%!x&#`9 (a,|T2 y3("I#Q?u endstream endobj 121 0 obj << /Length1 1917 /Length2 14783 /Length3 0 /Length 15974 /Filter /FlateDecode >> stream xڍP\ր4%54n-h݃;ACzr*z}\cjTԙMR &6fV~,+JdJ j/ q ]&az7Tttȹ8ll<vVV:$Lܭ9G+=ft6>>?b@k3 hhf yOZA+ȉÃޕRa ].@s-Lƌ@аvKh0qvf@w7s =;@]VtX/F߇`cfod𧳉%PR`y&ع:XۙY @JL`X;\]0,`.hot"Q ܽX~>! ks?0wsbtvvJm.BGf XYYyy@g̊^N?l{qrtX! 7ϿKllsk3hiOw1/~.֞=c;:yc+fQWR wU~ a0s9<~G:+`sO BXJ 3\f?.(+rSOouo.8_Sm_4vZY69XO4'3+_rkW)kO5ꯩKǾY;U]a޽XY}loS|ߡ+`hDzsqL\\L;q|޷0XA..Xn."X$K|M o< {J  5uWȑݟޏUlކLN ܆iJk(@-QQESWQ!)$8 /5sZ]WLkj\F,&%31!.q֌:Brcam6@4 ;QePHN) |ǥǟX:hXZG0XN?9. h1XDf@dTZW`ynN-8wc%V>cm1ҺG=-^"ۙ[V]Υv[qh |XC30T}["ruw)Wuʟ 2Ih&m]WTrp~4èsZKR5ńP))HA@;4Ri~P< \ ()j㌗*=\y腖n_y'}:M͋%ݾ5g 0ȵ f~?\,E0M&E=iUBTa넃,Z qF?P:j[UZ~5qh"|]1Nڊ"/0Vcj*: Nb3ߦQhgwX!]Vb5bYGck8=H"pyٴ֎AuS׏—%8' [[ZfF[)%(;1v|`h>^ 9b,W3ym_D\(؛n ~v T}:]}2@D߉]?pFCr t ,Ʌ2<,:y%1 b͜|y7T: A\-z$dN);*<`1߻#eBi+Lfѵ,U"TIE+O0lVTPUosx@e,ͫz0 Q{ W?Ov24Iw(ipubSvɡBG$v=H`mOc}yɀt~N>0:+v_&}blxC,쯼ũ9sHpz&r-2)n9؁ߦ՛?|4+?ׯ B1E, m ,һz3h/bA&[ۆ+mNo)4ln ⒵~~dvWVsP;ݸq epw_93"{=T^NM Hs*rBJ 8 _Wz (DBaNB " w>)՘MY^7lvV3wIU&qR 47F`!5QGsakq|튑u0,Z ;p} !k~kS^]9ݕ`Zѷk P k5mKbA VZeF% Mn/Pf|" s^h*ٿ<gZ~4@ 8q*VM]bʚS4ȵX!i@cAS"`jvGC$?$c لMi$!MFҸ`*C8_jC#~ j..|Wu1+mk6ysS[E w]\r+ߋOTC!JmHTTHLzJV^kWpQߺ~N#*zajjo"YXZGNGkM `sI#~IHwwG9@! _!OmGCIuY$}s@ tz| |Vo>YO TȓɱT>;\S BoX+wu` #\ęp-Tj=1axDty6=/2x"1ƋvQۇV16n ,d^ Pd4Y6(H@-0ezȦ=()_TM#QdW&G>'}sЃ I\ڦZb:pp&9M@}QohzJiNT$N2I9ivWYW}aKd0/m+HF9jCx֧r].8cCR|f#ffm] ÅCi߻c27u.BJR+{>4@;Y3{:crwbn}>T,ۄX8<lx=CA^ l Y37vA02]Ƽ@ͯh?ӷ=HW::Cu{͘l6l;`P0Q|b%'LK$ôiO$d~dWc/Ix#nLJpQrz"t˔Mz؜"hqD:IU uI0Gi|~&S`i}BD^B >;:4Zq-p ;8,2O-3]k$]gn|v1p]W!2Cf#ոiŏWSPT\d75rHW'L>AK ~3 @F;2XU\&=vM mJūNIU"L%;wg$NF2F쨫 N~J~( 455~{&r=$:=!@;hfHt=~F t׉ j&:CG.ԓdiʨ>q{6F}T.lXT(HY"g ,Ō5AWk.AK,шW|& ʃ|J=-­Dn同+,/6aMGgBӵRc٠$W< '=NڭB핎s|~#/$3-Q8+&5O#3O!S |}A~싵uFѤ:?4mhUuG84O#"8[I\TAj\;i.#.V`~7F]SReFY{YP\8 iكcM w17B|4&ub:BT -D-;*臝\;;?2\6x cO.} 22(yn*xNN!Nl( jm\&btI(=;t=Rixhe*/Fu)lBYEJ NtF]} !uSLTaY3шoCiUEEU9˺{;S #jQ/a:Kž>7XNezƠ)Di(3ؚ^R;S7XqZDYt` Nbn~fl2N8ж(#Zc,@pk 6a9~E DiN B/]΂uggSh!0sA(FV 8e -YTP3@fY r ?AHx,xР|דfDIUvy掮RID~1)d=0,K*3,Ȑ&@SX)|NAirCWBڙ&5caنWbDMव<=LkEHPT:b"} @=p%YIV*QfTh!$Y*3+^ N aX2gUa/^S-ި-{}+h Oc|A4G F$*9xKx\)6 UeJ/h(QC~̼:~vXoW+WhSq2w D,8/Y "QvgVQf&oFR&I" 2)p-)]%Mu2rmd цh/"fB(?OM_V%RWGL ( _?:\ywy v\t? ؙl҄9haFS<^_Gob;]? L'.^jbr'~J񭵉&*G*\F@w}eFXDCś{ fZ9g~K Z/q O IlX(Ii6SyjC'3n[ FJ|)4x Ŗ A>!]/Bi΀h;E}5-(h=d5ޣorF:zı V>g;Vo/ <m/p \Ul7 #5h_}ZL{P4w-eoy76̥}X*< ] [h(u?6B@ޖ=Qͺg]jChH<A{Ic3fW&~ceQskCin%["zM :cX P]s{lC]Jaߠt-8|_Uܠ^gQL5l^A#E^4H!4k(ȷ]ӓﱴ[!oi0?k`Nҁ6^z Lr]d넛 Xe^ p/0 )9:yȆ̺6F&ҷWE~IJ+{uUD}D4<V1jI1n'G <$ֵ[5xAi{dB 7'a18sBR͗&C&ɓ&\pq'Qٹ'racem޸jr~u 򣀼VI8%Z GjS.k F|'[' ,_$C`]Hl:&FQNS>{.8|mĐg [9CoÃ9hf-kO4*&Mi_<=DHm#(Yl|Q ~XKOIתJk'>]P=k̛˙< oĒc?0:yace|{!7yRb(Jb 0N |f|[4biNyu5@14*X.ugik \Ad˼HR)ʬէZk&%wu?^wE`/ST[p6>59&dGBtAЏ2 sGDmQ;@#-FNs05S5 /A,.=4eBvvY+n|xcMMHXo O*Ħ|[xh#0I?iYofq&FW֓$?Jz{W{?/]~ϪͯƢz&ipF#\]l.$=ٕ߱6o~򱍽Ϻͬ<ԥhAvH *1"M{|]Rb'abT·JSܥuzqh˱+:k Dvj|(ac_mu8"NO1&Q2##,:y3lӒU;\P > E MTTtYN/ĉb%W"#>J|Pa){.5P3Y ؽGMy&}I.yHc݂e8g oS%$2A(RU`nI~3 oѹB8pHV,=6Du,| a1t. {4+v0n١c콦pYo0v_R13tY=ОL>fc"gOlS=X=N-CR53%Q-8uiŭm[ШwΖ%]gJMCIyP`lЈ\}GƑ|j_~R\7as=q_xI)2ILdc$R9;[yX:P#3iM&*緎W7#8@+%{?>ԧ]3h1 }xiX:ps2WЮ[]Lq,tQ׮RKn,v\ީ2p{,AVn K EHws8m0a#L 0񓟥[# Tpo"8ˋ۵QrZijeK\Lݻco+pu_&+"r2C}! {3e}U֢%q:6>? SHҍ ln[mxMװ|zq;P$M]X?l| ~bDX"fUU~4cApBpzh ..GFQ;-;݇gJȿg#yZ. Y,/zK'!/o FLYL0)RǢw?H| QV" < ^1|>[i_C[\m-Xt~âl ~9 7UtD6DN Z 'ȡ/uu.gQO+x]Ӯb[~`ϟڰurL+)r"&8''`N,y٣_P/(-._- gH7&+ha;w, `(ٓ!;T .+tYcƦd~"!G }[BʌUM.+T1%*x+J>&b#9ݼdq PZwYYE‰}*r&=6]'-]xgjaG}kN{ŤiIXx׆-֊RRT~˧qJ[d_es26Q&:ԣ '8QN'^UÍbGL /Izr>l{Y;Wƞg-;DVy*td?v tr֤K ԰BJF߬&:!YsKEHAB[*?cS_km|ƓUN8.Rs`nޠ?@d>kLNLM*i&52$[LKr2xG/,.jUYTlלD D"nd<X s"eYTyyTkNgXMBw#2HI.xaѫV\1قB^<6>e $i%x/t%1Br:I&P'_@!/n?EDԦ`Y9HtMO|z~]i_B*Ul#ӊrXʛ"kuOn \2VJ 8DŽHJUI1ORY/j.2+h٪ff.yV}ZX#>9`+My'4Bz-?I:鵐P\ 5v~{7J> 5eeylׇ<(Zi[; PSLIߧuga%jIs&z4_rRiotC\#FATlЎ_mHc\(6}.׃TΣ-ph7y}4+%ӳ SXPvlԘ›"Ⓘ)-&$8I 46 .|橅sf׮RyЇV f2Bw\&:T1pbs4Sh#ݳL)9rIi{:AomUE!NCg(³ElT@oAcD1UWFݠvu SRۋz97", ajy>AK+W82. #sZ`l}Yg֦[N!kʷL]o1yo=R~d>)j@z]!X9#h3N|=ph zYǞL4:IuыT꽉DD߅.COǙ)xInJfJ]xrhب8[ xv҅3I2 jWgATHַc axgMU;'ZnE6rJ{1!HOA69VX@sR<0b@7Ciȴg&jz)FI'6mVʀ"1ybPгvS27(:f5+xkˈiFbkLnx%e?>BD؜(4V̸)a+@v${ܑ\;o" v2zd{s$,6f\MQi |)+`2I9yS ؑթW}xZbh >j-1TGsqq9!^٥s .=hZh?v8nuk`=" 44V=}2h6A]q?h cxБHS=0[-Co^ӈv 56./^E]꺇-C:F0)iy$m$# endstream endobj 123 0 obj << /Length1 1899 /Length2 12743 /Length3 0 /Length 13924 /Filter /FlateDecode >> stream xڍPk cݽhqwwww/wV]kqww{'3Iֶg[IȈm 6֎tLaee&F## =##32;*dcG==P d `b0s3qp32hc j 2$mpd6n S3s@iD`; hXd ̀V'Xl@@G)AkhBo`@ocoGE p9@{g1/Y+࿩Ñ@r(٘8K=hx?$! Z+X_Drd##+[k7)d ȉJ;: 4ty7p6Yݺ@TP`A ˿82U}"6VV@kG ݍ?dml c'[kPcMpL6FFFNft52ce7[N֒@f_!jaSAMQҷ=BDc"*CWww .ԞX9 FcwcFFz\}HdnsAhK 4.ggyZ1iG뮫R[_ȩL^B 2 z^j=`M:6lW!v Β2+IΈf2ԓ ~ex!ZQ̉&fRJmGV`Tge-2!{w]z%9OƨMi4Ahf46$`i0,mjV#ώfݟE ¤!TV< KypBT1EFh4ҴcrTYME#] nC߫CȿjL4p{=xǬuL̙뽌Ed/ խZFD N4LSZ5bjL;^AA/5`.PusPn9>A_({Rj*Vw\m;|߃h/Y)AFmRl KVp>2̓aNHzX[c5w6\NaxES1Ym/H£8jzɥUiW Fbxoy|s׋NWhf:9]*+T h"!< \cR4[Fڀ8jzMPnlQ'}]e$,yg8rʭò;EŴ|a( ׂ'4BG{+T܅j!`BJpcGsf4@PȁBE{(>c"$iN-g|` V)RRӈ|Y"2aJ,b̊HYt糺X7>Xvf=4., J\Fe؎ꗗ_opUAoaHNo&!: )OŃ4V#帴C|_7ӅFPV(ܮ6{yדz;{; (" ]CUԴ{[-[cX2>1G '_ǠQ)Н7EgX]CwR{i3 7-( Whorq6`ee4{.?96WC_w>3@B؜xS%m4#u1lNl})<q'du^8(hh`hESKOKLY2 ĪPWl_4rA.WÞE2+[PU#E6%a;K_r{rE8sil?,G p%|)79j CE(of3JHmw\[(ٯh jחKα^3͞ɶoif-A-Hjcx<@D17w}qvMo`) 2cyyQ}(#yy9<*mܩRm[ (= [{5hTzcwhqd͈paZ[׷ke>@rLR L7"/Twr53ywQy J2hjL nyYJފ; If:wAzccўzR0FY䉔1{jJ_aTWeiޖY9PĐ)'_;H݇6l=ˌ4_݅v4}V r;x{|$c o0Ags Lj-#T^D%+Iдlu> َ}_-Vs._M(1GlD=>t!pvVT8UhpNR]N8=bMLBcɐ z>_e$PWBX^#x"fi^0v( ~3*NL!8bfкsG_mLk줘 ^O~jkL;Mv* xem `Xzy,GIaߦ{˅AHp(#}\GE$o*x'WCУ<-:hmuMX $iq~[BYc+b㙿Wϴy6C*\Ǡ117PwP?c5M%)uS`A^53ǯtA{ٝoܝ `\kV;$ѢpP?!2)*AzO]~3iCiG"΄Oe 4sSL8p]g' l:J|t]ib56H#z|1/# {GB{,yt4v& .nTߒZ&=ݘ 2⣁m:St p ֖~{(`sZ"I|X' Yрe݈>1\Ez1mK8ޱGkM"=ǐf(Q]5AKWhsG$QkeKhEY5|͇v96ܟkK40j@ bYդpīu Ջ4NhϒLX2$ GڛL&k*yM-#Βb4*ƿ)\ ͊;?ݬ`2\n6X:nĿϝxQZ&L ttUv!X!T=l.ؑvρy],4MQs BCJ!L0fL Zf^ hr<֊϶+cJw,eO C1 \ڜ~B~g\ĒaaGz,ԏMAt;*ȣjAI -\sV<{8ѮȸC.%_ySvxW@JmZx:GrOoA>mNIrm$`8%ǃ>q:q8vF%}]4=0> hMS$w`O}<,1j0 JCɒTod酆Zr=x0]B֚ErI2v<}yfJF@īCPhK=\;x1Prz=`~1 J͗Vc{b@&h)"lǼ4.Nz#F6"%vX=OeUbdž<1P[%  8VݬS3TC(&o A륌nY<"zP Q׻}J9͔D8V&Q:($}vm_CblIY;f=oSpTIqvKp ]`/%7RTc"tSob瀷x _3q>!mLI.ė)!']^b&J62t|X`L!Ɵ$NS$ >WFQcYx+j8C6;XiڬbleLdCzcu4eս=~Ȣܔ62/a)7afCr&1b;iQf%Kz)S>r:  "RhCz. R^4㻕5GQāU0{ߟH SI&JrT:jfrW!3Qo|bԨ 42|ak|g :w8ZJn4,f'\ Gx\d4-"֨\-5Cԯ/wD.݈;h$ `j5n2c&iMy䴳0?P&[ŴMNz1;]k%>EP"'eskyRI&ujs$,_/>"wDmvt43J8PGPj-f)c2] otxW2Ћ&Y(JXC5U6B5PlWJtOHV s f92QW4t0ܢ[ǍF.KeP$VM`9FAel >r=SHǰ{OjV 84aXCmb>Y*%|_xk&$u\CRo|ܕVc:HamY L7gT$fϔ.U ̚϶l3JHl|ϣKnY7v>ml BIxg<VD)k\h)3?-E+:fB?kGc s59Ҽ4tjXy \keJ W@HfAdAp-]&̻˾)Ռ6{*kπX$ղ?tlɢ8>&|G*VGD"vǰ-|CW+̟A :A9w1:AfFi{^;qH5Z&9)e` O 1V99w۟`[;Nb2C_Q3k!vД#eDgd~UbٙhqZdϡ:l",[%#˂`5t2~^p," p⻟sk/fUg.Ʃu?KK,n@RP- =R`]Ǽ8@ Vt+ב($?l(Rs*oL/Oi~pogvbpL^Y#,>(jU3:@ "$e]Rj RϺ3s7dž[Ijv7%k5 _SGĪjjY?<I]Tτzj3t]ո,c9"~(9n CTJȒ@ "3޿~:I-Z}2BǶylQWb6@9m9k]T,vjA]&VL-^'7O]/4(q;Ea׸[}D|L>/1`_5kuKO[Myӆ):IUMSgA/éekz(.SRH+4/ǝ me%gPtE %OoDBPT{v+cM-PaD%C󣹚SGBV?0GAnĞ]IKe+|}lvhO$M%oBv 4I1ځ&t"X;րprX/YIk1V&PE1)󱯜*) yfs(.4~o+V!}zFew#9*7ѳ^i:vvIL59s+G̷W|/e!R,LUAz?}w x/q;x`}"k+69Hx٠T qn׈ ̉m/f΀!y\L P,Sw' ^2M_%vn#*$O3uʴ@~1\SlK7ʻ Wn}Z+|=Y7 $=X^3ԍzIJ##5R߬BXs- f٦kx0i7t}DW g|rl)]RAL1MmB`mTAZ5WR䛁 )z]a%.c4ʀRڏCDJvZ_'p!•9kaCط ;~LUrE:Ք v\ł^hAa@'cd;(}{qn V)n^v^r3ϖ,9A)1"Zlt2 :YC:?~+z W^\PO$7J(ax&S{LϽѤ D[(dLUY tYneϰiKsn>W ͵?19yuDv)5Ŋ.rvCC_wGkɐ^ t5'.2Kي+anA[P\"-[Y{5栁o!6Y~zi.9JMh)}"ѴPfSt^̱Rwa4CKc0&BK jZ:`@O ưXA&ȟL'&يfYYf ~Ń$HgLJffܯU."K8]FǮ3;̹lU`{jNҦA^}g`Xh G : Qp9zCh M14oNt[&^l9uwuA+ [gW7ڮkpR](3c^mnNqn`%=3_1OW_{ڱ٦1NG&Rzc:XKxo}̭C !m7VhEN#KB&gX-31j[PǗ75i(:;&V ܨSl2."d`}nGkXb;L[N"<=&p6#VTؔA, _[&j޾c:8#]!^3 &״UQȈQkS>ȍ@Srwe6ߎ9TG| ZF)cߺ]B︒&Y.2v+ 0".+3_+eR700q?p^f51*dEzFx6yh3; g׶5) 1 Mh?k֯5|H0Dh٘EnJ8m&UAb%[rK:RqgfRbԓtWc\)2YN8 +"kd65*Rw^bwNy1$f4K LcQ N\>*wXgڦ _$bE1U~=icO?V61*Tfޚn$xkGw8u RGV\NY!"W+?p~OXӤ=D`uꅎ?%wvJbk[ʢ.5+LgZmYcBN2\L}^:T܎\;UK_O-z|)5am jk͍2ŕrzKӧ{9Lh+-W3PE%QI 2 U+~ /W݆?fGxDu r~%dd}{%P1A:}w1I>~h1JOh݊,B6Xk[(0>KS;do)GG椐1u@4j³&?]f 3a#g$*^'ИhgpzS jn9juL|%̥rL1YX 20!E@i X +*_xU 蕴34K=iB y晡z Ih숒"bP0FhTuׇ@|'4LΛh.{{>"1[gJJجEo1ǪWhiYo*a9u;Vc(n>VH{7k=nju+OJ^SP߳k xnÆW,t{pG=|co>Qr}ׁ>ٗyXW9 8а޵/%lHcoYaF= voESjz+.]{W?ܤ~f> Ylť*LZ2w1'Ye5@J|RDZFA m}I\b~!`u!E!xV#L 2EPh~7o_DU?&]?uL+q2Ch@'pw:Bx.*w7: -IA|3/>&Bژ77 #|)q*k׏j>9JPɯsw4~r8&+,^0L4܎N[JaKsVPc3hl-VxK0MۿIE{ymuؑNN>ЎgvVфzG$9@0dncԫ_|8X8P:>Ϝ ./1(V\r/Ji>lV@dGULK]BW=yPGq55k- ϞAöfJE%GV|ej+[BCW_MKN1ڑMZ{G[)Rr\þu Yk[e$vޢ3AԘvJG/+찲ZD<5P6m& |_:W-6go=o,Wd}ϖv`G8SЏ[-"K:9VE$&_Ruݟst?U=q#"ZP?q~>\bS Tp o;9Мwc6/rP-bWɿ50[V?Ye'iY '}VnTD1ncrrzF 60V3*ER䇈h2q:SA+7ι^\p?|6r:d;NCtU) endstream endobj 125 0 obj << /Length1 1569 /Length2 3152 /Length3 0 /Length 4149 /Filter /FlateDecode >> stream xڍT 8oNH&Bʚmf B)E R3a03FF%DȯlBB}MJ%m뚙75WS@ PD*!4} 2@eAaR NR4`@,`фJ$ @@i 2HiX0QS) &Ou 蜟Y^躀4KL "Òs*2J!Id0\5pOOO% ]JsޫxD 4 źk) "aN%0<4 dСw 逹1p  (kJ_֢W(X⊥x(Dcc%CR+D,NXVKp?:FreЕ$J4И )x} Haa+h 7|r)TOOD Q6;hdƁL6G"4 n#WvW3ו 6@&B?0_:4woC"< @G;;d ?0t4p V>R޿W ?1Ęȯ˩G|2JPUV̿bIkU ~GQT@GД~챦ٵ (-BWC?d2wEw2y/X{֝ ʿV5$w{Xht)_$1$/oJba>gd4I+/ D 僖 tH.ڝO4%SV`i47 )IYUEBۈVE (T@1[Ru5]1}*bhp/( p+z=~3p8 ]C\WHT 8:"~T|p4HJO"uSq|TnTV᭙h5d(x *-Su$l͖1Χ^V-Z_#GJKmϠ(xGBg:-{)}nKpPS0s6qK0h4g}`nBI=ݖ֧FiƉ;1W+tQ`# \u=20b3/ 틗efd UD ӏݏ d '5R~|`l\-Pd԰_Ɯǃ4/>ѴQ4 ~b> ]'׺̮/eHYnw0)ʧُyv⪓x`÷u|3ВNMK $/mtC&wGZNMMgX߷kY)Ӹc\f@#wS뒽fhjӡ)ϊ7z1q% g3-'zD|jcޝj*-鍙e/`ՅDS*-UWtxti$ïy7s.6mvxf.dWثԷB5vo^9=:q2#cۗ_iIJA12h3 n;pi(ݲ_SK-isEOܙbYGƑn2,'.ǽ=IwLj,_;&)ĥrz8M( y:G+PskBXBk`2nwnu̹X+O ƪULaWVHŚхk}' }|25w&;G&4禹:̒zD/ѽ}>_ŜwU=׹؇"I:*$1|@'צGf(c3:d[te78O/c.9&h6/b .NQ"^%9nJ |xRe}"8Dw:՝>Z-URtgwE']d3k~F,D Tu}tnDX'TⓉ>4Q.z σ L.1%L^ICD#U2鳘/>]ޡYWAQb]ҧElaSZa `o4֙J+"3K;˻zhS0۸}g]2?^XO ҹ3D>G G p^{|B#382~5僪']b%0y<L_(8e^l^y-Y*y4GȭL`M*L^kۜZ~f]b3c3#$R:q5mfM:J$ҫKL;-6 ׼zx9!h},O^̠,mN>xa[ed[%:7rTFӻ}G6 faX<^H 1g7υ܋1qӢ׊Es8b>dGĵ?8~G%ɖN*rN=$a^Nx0KV{)sBOS?Yː[@S}"uy˥{=.=)]YȨNȡ(^n!6h:N$|WGbV(֦"=£9^SK3wp X}za]D]$Rɹ,}c&v>oߊnεYj=}aI{ ^9eIjOG, tP_gB71hJ8VjvU'Sv_PN)JiqzU}@lc{-{(za5] /ʣ)M&:*cEgڧnVQ-5_2a2sʦ8~匛}w=Kɥc] UB>IoX z.aݜ{NiH D1,ӝvm69m'>QE> stream xڍtTl6 ұ !( ,,"!!t -- t+>9wݽfgkn&z mNIK{s=# Vsa11aПf,W 'g=Ti'`xP h$ -\%{(I lm{( V0p lT0CE moEsvss9s;Y?ca6-3d 0@ h3.,&  < ` !j r<h+@?*8W?%C-,Pw0`r*\08Z"!@W 4 >9 ' >4g{N`33E_i, AaX'vY<ݝڻA=V`կ&,]_B. E?)&m @)?/-lqwv6?t`zh=`y8]A 㟎#,^^%0YXg0 y ,[KMF^NIIBN>~~@H)I4?w" Yy,+߹4 -q#A/+&> v`ɺjXYU%0HB!,,50 ׊AP3כ/^Y>z=Ϳ+B--ty a-A psAa!VNX.TX< _A'@Qm-B mna @No~?CzB>TshP ){ UMWTnCLɬN.?X.$z dY_z|Fil1hĚ!:]S &5΋M[GW~-JL.O4:៺647˅o8#_FO0eO38i0؈DtJ1X^{+|Q?&,9R0R  2{Hm'*M{E,KLaBeIY\pqO{䙏"]1C,ΓWkGP4*-D^ryRrUǮ.f)^nO6` bѫg^`J!º.T<6C͓<'n 7[pNBvNk~r(P}fm,&[ž1euE,[)tKƗE.r'o>M&70\Ѝ <}%,EM,8fC~8\[ӷZdɣ]8.QW6{*H$cxi%$- #OBesQ* w-͟F:1ɵc,sWt8o Zj7:?EP4bNɮ ͎J&'Ii_MjlfC1Ur_fk,%&gISUάK65fl8Rcܪe4Nu(SU]p#ִ(<>&  ##7w.QZ"|QDKVv\Me%FFJ ܂,PRWNqVt=l42ppo ZA}i-5B :+hkmuJȻCܰƮ9 hڋX΁5ۻF4'! D'Bp)u٢ )M vdC=1hi)|/ˀyWtrNS[9gҋ%uπ,IoZ|hҴ`loOҫ[3Dj>hk$ϳ`5P=[k`R#>^4@}+0taM1Xo$sXaQ"o Kqf:Q ô`©Iw/W(|OF8f>_`r_&B.ʾnN[g<*ڧGF{sx+#*gX;VRY0n$w&ҽD'?q?3SτQb͓f*IBwiGp[\R@s'&"Vᛩ: SÀiuStYbh#u.oj[.inf{" Ϫr0,p*:xN8\dNWiQ{]LfNhcd(z` Ȣ4>ۜ2%LqՓ|mx~ǜG4c 8'agApJxb^46/7N.눧Yg+2Fbq37qhڰ^Eq 5c5F'jͽãUfr)/ > ',v0/h?GzaH& _~"вLFh:a*G'˺a7 MENG+(Zׅq\;OS/} _q&sJtasrj~F|0h[S[enAc_"kc[dQ{ e2{ iapG&} KFcSh.& #l 紿^ɅL&c^|~cÕ~M@n=5'<;'w~/^R;-:fBfKOv5Ո~Ɉ*X۵P^qOu4(i䷢t]r5'W&G>=gK)TAR)x&qĈ7_d2={$ȏ,%Q_lܻ$.b}Bz?}J;v:ŇU%E3%[pԌؙLlكRа>a \ڈ|&/j13:}3yCTSw $_۰y`ֳ=UVDQ`?7s@A isX϶|O&J-Ɋa#bkhnR:.`[hf+YҶ7q7U<,o:O=*OM?XFFYYOT`| ՟k6\#%Nv_~`\8wrhVشSѢ KTƥwH\^Q(uI6z*G1q>/|0$#1j5^OpPPB&|U߃Ь״vQ̦kvLV 7b]'ixRMP0#C4k C}XQ;Y2CY?M`u1p6 SXd`-nb@^NcCO.̕m͜E(kwn+:Ņyu2A ":\v(g2QWїmCiX?'@/zUdC5KuGSY kqi7G=ԧ9F˴5dŋOT\Ƞֽ7i/kWA@Hn;oS> >/1Z 4SzQP[lʒl=#Ol{ӾsSjXd=m&F 3R9[ #)r5QJg$屽a ZA 5Ռ(GRzL"Vx%up|e/vֺDݝ i1٫m IӉ6N՛VM6xBŻ{'ȏlj:ޮ ͱ ?YPh3벇T|%NEwPn5_䌆z9)BcQ 4 W%xh)m=e-sHSw~vT+/OR &Tk심%Bٱ~|\T6T=axTf5:4ɽb@ᵊOYf\«AiqA=Rce-vaS H[=#η ÑDF%Mob!E!L( tTͰo+Fղyw$oEL ߸cue&=s"l QjI0Zl\13ҵqdK/޼eH$\uk# |K0&1>68 )av|6ԼU2jL1e].i" _m:{xՠ:|ݝ;yĆiP}r*u1 N lϾz8>\WbEyы쉆Y)#Gd¸iO7|O;g4RMS7 fkAӄvc XS qD툃VЁ3)?j#:7N\4e4LLg-lV]3d HZ< x=Β?o[}$-dl]DW6_urNhK"La%d=4҅o&^&Hlݘ6I{aa.s4Y+&K`Y=~'y9OQ鋒8I]Ȩ f Rv)Qn ;L/ޤd @rmj3= _Yc'Phe㬘 p(H5\ }JBH%FP)9=k/̮}= yUW٢*jQ5ۭ{\R_q21+y2 P>[h}N19ppJ%i\?# Du6:&}R44Dy8 7\=WeIQ~p)2In!4(<-TBluS궯i"01~Rpa}9=$e>.۵xn bV' QI&ek<@,];lVnhB`eڨ\ $b5 GbEUSHh~Me? ERKsӧȟJԱFBN^)D tD,Ia68fܩ)KQLS>&5x~ #UF} IA2TT?~kTS7| Ű(@kǺk247d.TǨZa)QC^n7,/Kq0o`9}hFw;GH*%;ۋ&Z NԜ7_޽V=0% 2a㱂Iw,i;=ÄnUHf<6OU1tkCA͠F̺w6W_/|So^ ճi!jg6{z6򾴱 xU@;`X@"v"?i}s+N8|.f{VA{7 Ң}-I~|c6fَ'#TX@rEoe\9$m'n(?Yt2V{P+Pd2 Yw31|մ]j]ťs: PVw{Ae?gy]fzqHssF_3?. s1[셱ZXu "PthHmCgYUFCy\Uc}Z5M,g~M;OF*UR~-?ʙir>Ӂ2Ož Pe#J^ Ik&׹ tJ\w xLdDMqȧD-Uil*@;N"&M aG_xU)l@{!d3ͧƬ0] {&ROp/i!!#ZZy9w3ҩ#PEYtii,l\ϪQ1ON^f|{鰪uT^eLjL`:GG{w+*F0S԰$gQ#JF]k:_It5wE?j8Aꮉ'9؎q-:P0 ~ e]G;]4ԩrCo+2MjVb,* &RcNA96ܯM%{A"3~l೤ ؂IfuOpܣ[R\0 /RM.X]Hܖp0갅~RIvO]HFE^u97SŸgpUDtO {f3vl! endstream endobj 129 0 obj << /Length1 721 /Length2 1124 /Length3 0 /Length 1695 /Filter /FlateDecode >> stream xmRkTSg-T)CFOh$fx"!+ ͽx`!->$c+` Q"Xjؠ P蚵f}gu! PB =TlyhF`B&pHH,$ ?Jt`ht2`a8,EXD(0b1KE21===0=MA&>B @ŋFr '2p …)RXaA@YLC44 0 A[%$*R,O Q1շD pvXr-WqbD5Ӂ ¨o\TEXH]*@ IlD paaT C8 ar!a$`p އ-TmB`%$j[Aa|Q1"ԯ03P`FEFOe`‹׳$f?}%/X[(rĩyn-3F.oS`Y+{ :ڦPϑ~%sPͺǝHddYIEv@n ܆zSL5uUAۍ_~jJENݖO:^ YƳ}"] Y'1jW-4?%[S{!s^glrKK"s=^wo{fPX.5WMwΩ@[֮r{t'0WFO^\5 ^dp7m&+e+ Z^$;s?Ԙᚷ5^z4u1/Q]>on̵ Y;ߌgD jΗԷ͜ͱv2ۄTh>ż|(w韷뎭}O&cvjA۶ᄁ8~m)lcC dr-*TjU#kfJ9kΛ3t6uec:@=fri= 4 7`<谪}n\aX]5^3b\U4xKYeւ02Jcg6_j&cw=CqA3.*9ZE(?ڔ/Q4UD Gd"|fyunU#&]>jƺkH_?`Fg~k~oSCw=#g_/d]DMǸ&Vl)ZgY;6sr3 yKf `vH} MKَp֤rӗ].6]I(ج8>{׺"^p&]_(s MYѐ߃Xm})mLzXc[~jqv/%1GVm /}. d.(L Tn{Zp endstream endobj 131 0 obj << /Length1 721 /Length2 5420 /Length3 0 /Length 6002 /Filter /FlateDecode >> stream xmUPmצQDR];%Υvaaم$T:A. i ogsssgfeTD!]u@ /(@GyXYPKW8 )o @m:P' Xr('/4n#,mp4@@í.nh7I޻&(j(@NSHEC P"hK@ H(B'k&?P0PWЕQ(,65vjvk:n*]VP[8/T0@oҝ ;};96P аtPNnP4@eE#`%#PqAi{E тY DY7}/P;?nDxȻ16Җq Hk i qm/e {{6-]pO ?_Od_,ӛ\#D|G E1n?zB f&Qb)uKGr[qM1ZMH]v64tizҍZI|]RUd%\d 39֯bR;C>~k+-gEJH\cY-!td.$oJ|y+mw}Vj]^IZё {ҷF_M:m vab% Gt<-Aj-'˩5;kQa/_gU(6ō6\L7LAr K\Llb*a1$^>|:v8$POtKhE~r+gy$KO+]?1>Ey>/萱mtzձ6$ZSzօx<=TDM7eSr 4X~ γG <+P" v(WEv<ZzucY,[@fpwU'nx- ݛpƲ1ItZe4$Z Cd"z1ͥ>O @5ťJ=fFTv>S[Ś yw|bJLC,βɢn<( "F$;pEǀc@kI&u?[CVhVߧ54J9h0a=[ȡ0{M$Pvs|5u)[$Ni]yZILې wiU'g'Z4B{oB qˆY n p*}1x+&<Ly(aaJ>@WX D^BbKM !L0HmdкF0G"k>ŝl oxƥ<] \B>v 7HKgzw>bI%&.HZ/.3.HL`:l.eqakˌ h`E `-o-`z`dRFh1N\^}vc9&i̦Uْ/˹n;p,iU+"7e;Bhaqc5>kmJOt _KhK3E,gƁV;1(60 sDlKd5=U:GͶp<OCGM0{3_*:+W2aw?RI5pN6~šu4JWdNAKEy0G|nRfqolS+/+tў’f!i0^oB; C gާᆲu뢦ez5ndӒA#iqnPY1kAZG ͌,x'pQaR *.B%vq7]@D7#&1/x+z\=[,io֊jywIpAbN뗉pN+FqQ}y4!k 6 SPyi2$Ss'`tHU3C [?~HⒺpVV.}poqƄS5"АȬ+$hfF=rTD:m4y;oӦ|\8Gd0Ha~0NVBn\?}sx'զ?Q̷ U6 u^ b X;(_9%|e4`)FA$12osER6YY L #ĵ|VҸKס {I00LRԹ@֠@-zԩ//ʠ/8ZMW~p8S-j]z՝WRε91jq滾r+J?h1?sW;o~}(>_%ڒ$BybA#|㥯_LS|!x6p/xT\V'{X}82tK9e#Id`%Eg 9e1e 0IzFQm   #_{W $LoVcV^ᇫk &Ga#y{# )%<>c/bTz.5][WHzA (O'=rY>쒴[۔,B!I"ƅR_%uoML^ 0A! @Vj a YoŮm~Êb4-"F"ڴ)n d}wbIdRƆ.Hy=ąg-AsL2Ft= gʘZ XpYŔ(oѬ5l̤ 'pW&w?0:ƧGh3,mI*}b{r^<Bʛ%gc<9p:v YotVC<{8H{۽wD 3v#* R:~W4IP DYLj o1y:r7~b_L 6ERW?+ɹ<9܎HRTR ow\yJ=:et@OLPp',tq XsX;gX˵@B j"rNsh}m2 ϧh_Nb0\F^};{/Y!L,y^yDVqquR70f ,*W\ˏ<"F3y2\uxGl龿] @2Sόn0Rι=y`j}I#6#$(&P/&bN9[KzOO˓R(B7xZ^u2 | DD}n#?*[gLAgr.md˔Rs𾉃{`BL;꾇p*P␰d2h3'uJѭA;_@ vB0~1 fhx0vթw׀z^Bu~M2+UByKW=QW>=bt-~_E]L5씢K$j\UQRZuYIBy 4 b1,,k.R C}%}O:ԷTWe&8dP;W_!->?MЏa,\q^Lb>N[ WH} i17\Ra96#x#CKˇ "e%\Ҵ`m533]o8 nG˰Ѧ%[>Tƭ"_xFPg/o <'5Y HkGI d,}&)R2nYI{:m">t$j? X=c/mϓnxC"jrT&۶uGoYe_4/P -se^)*\@qr40F&w>3ȍXadNUl>ZA&[9.Xu:ϡ>~i܍gpK,aoǺxu u_:M>ʢ899.74}&sCHhǢfY7q>4{&9>[ OR 5n\% m}i<ӀWQu%4LsDc+$sԧlө4QM.8sZ=OsZ8SBq=f^f4L?Xki腒0|xc8(:gH$;lTk9d]S^ʋEkEX">›yN)VQ3aEm)uktqqF#1:v dho^EoyT [(;cA&\`$vifN!,jUa.7 !7n\98g.^8R>1~C>ѓ޽tp>E?ޱDo)v7>ĉaH?~eF"+%r@Y8Ep2 <:M0g:hh'vXz}rxw8f endstream endobj 2 0 obj << /Type /ObjStm /N 100 /First 818 /Length 3984 /Filter /FlateDecode >> stream x[[S~ׯǤNy~KR!2A1HD9N~g$ %NTlOO==BUrR\$l ?OTJ6JӲZUs7t@Mm"Oi _259TF3RN *[r*Xۈu58c}" T΀T rMEW9hXN0+ &]a>VI|cn FBO[Yk"e]x,鎩6` qqF1?PE[9S$` R#(,Jk`- EhfhY{"yb11@ L@qo` Q^"Q%qKR`$BA(FЋᓊV4QɈ0k|=|AGd#h0C' d@czDNO⻘atUp 螂M*PٔM'AjP\đE2:VqHq%+3:UbfMap:_ط+u&~r֟LIq4ᤩਙjN\Ͻ0>t7f8}{{YUb{0=$&M%^Ox2NqR~^3] 0nƼ:?]pChZך6Q56g/66n<ųxWvyp6}?m&?~h|-$pqŜW*X#6Qt=Zi )iQ-{``?9'kePKw`X?ĆX[y:< N`J~C $:ZS4Z`\cmE j{'1Z_u(cKW# /W&A!C#RJv݆Wb!񥏸>>dl嬏AH;!53B-_ ( l^ŠW~+q|.Gƥl/:+>k`.+&.2+Y3̥kbhQn9jLsc{WE7a]1 7ʱ3&62bDVheByGe F㌭D:t(FwZJVr`Cp,N_]jd$8rAoG#DtP6Rrd#JxMYrпu<=dK,~$ϛMCr 9vurj:Kk/k|\U{ukV9(X\(&d9C.l{FlkecjڦxR5=px 6.>tp`\cQ09|Og_ӣԻH-ڻKZN=&h]ج'.T8sFym6zx1굡肫ȁc;XᴶCI_֤:hmr5 H)G'*hM5z#t̎3ӃUWzDkzTZLi<ߥg]gkiH6pb*(uՑRQ86I5\F$$V<$/)qvegI\@"2Z}ڶlkQhJG͕(vdMy"pPaf$$2fL0pt*3yH0ۍ{t*h;@q.ւ2ߧVR. ~s 9|w^8I}4f|~IdySΡW=X̋Xl4d>ψ(58qoI!Qx˱זˁ7K^ ?iySQͧ~ȃ'xț<s %m`BI0q\K35 ,o>噅|&*i bGnoqElq$¼9$/ h:2wNt'` -Ȩ́"?us#d zd_":Mǹ.e4md:tݬQW|#`ӓȭfr4\LGdEw7~|ÿ0 &OŶw9?gx)^>z-~o;Kht6=?3\4h~wz&>.@Tqq Sz8x28iAOo3Κ3boi8|ř4c೘].K?kAw dkk-lAGKZЭ4`643 df%.\C ol2a&{r6[3mdmՋݜ]~H7;`[ۍq~|~S~lj9 Cw4/OIChocx2%+ZY\ ětBE\ }yq8EfKm{q*z#Jހmz cڝWNu`@9yW /+կ8]l#[?O" endstream endobj 142 0 obj << /Producer (pdfTeX-1.40.21) /Author()/Title()/Subject()/Creator(LaTeX with hyperref)/Keywords() /CreationDate (D:20211208182953+01'00') /ModDate (D:20211208182953+01'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.21 (TeX Live 2020/Debian) kpathsea version 6.3.2) >> endobj 133 0 obj << /Type /ObjStm /N 20 /First 155 /Length 752 /Filter /FlateDecode >> stream xڝmo0S˱M8SUb#t]7E JD̴}NH~%<R>@]h 1CHۣrTE\l a J||0hB0AAᎇ;JEkB C׺韕Ҳ̓Ce$݊sfnQZJu8 ړu.ۏgك&sCh#Ռ=V^hKtΎ_;cEBftT7$x'^ם:ҝ<ߛ'Qw2tf뽃[G];<)<;,'B?6KsrC"vA<<D#:V p/Ǐ7r*Vۛ"LR)^]k);{]QE͐RNI9}|$:qYffײ3|%R52xnX{֠73xLLcVjDV}﫚P234̔а<,<]=0S+gw3.{UہNm,4Fb&,/ٴuSRU^~V_R)WW_eۖu̯%Ţ~P3ڱ*|W +ת~ oB orR7+6b endstream endobj 143 0 obj << /Type /XRef /Index [0 144] /Size 144 /W [1 3 1] /Root 141 0 R /Info 142 0 R /ID [ ] /Length 355 /Filter /FlateDecode >> stream x%7NQG& &3&眳AP#$Z HHPr*$nCjX;""?Nĉv2ɔJ%QQ Kb @A<إ=g/7@* Y*!8N;l}p;S. ކ> stream xڍXKo6W,|TXHQEZvoIVه!ilyQ}=E əo#_y{e ѩ],:bT%Y,W]k3vaq{@[LidboH ,X& iBo5pه|a[B>}bZ"M R]LB3JۢFP4x@5̓52G-o;xY5DFТZ='@YD8YD:QY|데'CrϗaHULUQZt~Aڊ"=R7{:-E̒n/arJ'Οx "Ե&% =_*SA"co} ,clOq3_VN(T DLaao ^pi8zG>$KZ䙊s\YFI\/$Uy_#u-+{86!- L٤˵,1eDV1r;'x&0nGBn_|R \@c ԔQWt-:wAA'$^94+ 0鈈65᧓ʊR6) 1QĞ.Ork+6X rP5!t 17|l|ÉTyxexj-P|h:@,Kx4XT CιD#E`F,a(Jݻ0rCu[6JcE|åG(aC-[] 0R(#A\SY#\ fk;\)!N CXP9yHZ
    5sFD+ SY]ix)/W-+Q5# i:4&ģqmi@e*dW¯%"q*@9 9puk&PF(8ƙ;>p&9ca+ *LFܝUq: a+~U:[aGZ&*ϓCmʰN@ClPJbv*8f~X GiBM *vt/P zKıqL(gAcc6p=KØ}%fQ-F@UV>E A,;~}tkj&3lKdIصC2÷>&bh4 |MM{&K [0P \[{0ʒ'6; 37;wR!;'%0ARob3<֛C;iYncxZD-gZPᆖ]M>΃l owёEЖaY*ÄrYu)DG2 z9'%$K$Wk9 7uX?21)u0 ɌY2cvd,jm?M- endstream endobj 44 0 obj << /Length 1157 /Filter /FlateDecode >> stream xWKo7WNJh᛻FkkAK䰵1!ɱ3CwdA9Pcpvѫsy`7RټgcRpԻ2#U= p;P >߼:/eRBsKC+ou,@=؏ #vAGqC>3+WsKx?6';ީ^A잦QSҵgMtM/3;耇 0XkL$/Lv'oNe具9N3BEDĩ5 4YSǿ %#dֵb$tn-~=*! K~ Sֺ{=S<ꪺ}ׇpb&iW<7:-WZZkkL+Uu ;lc&fgM;4ݙ U9j҇,cA~\ЎK-ݣЋ:AUGgҚ4vghYI /z!Ǯ"L4ώ-/zޞX ґv5JW =9Q-w}+^Eć+W$ji2=$&4ܞRSc|IM/Na\ *0l뿃B3%aʱ +8k_d0&dQ׸c2%ъC?I|ERyu_sŌTXkyoJ/ZrB"?He;r7D[0o1%XNIw SF endstream endobj 50 0 obj << /Length 2822 /Filter /FlateDecode >> stream xZ[o~ϯ0$,B(Zl -[h[,;=HwA 99s.߹xM}֨2V>J-.g=׳5Z |^;[vhlKg+$7{%+!;ϊ;LGZȊZ5Ix< JoK'aҗg ](﷟A")&Vmݽ^f ڽ)ixw{KE{{Q Z<+0 _n-Vt{+~obHyv x-+ƞ%߯qzw 2koz!Kcwm傅oݦJLTx`]fje Ҏk~u`(t0ˏ=X.F<2N "kB_'JO,hu]c$eM,gUFoEn8({}cbdai_@;_Xd٣}Mm#BHnǞ<7Snvz̆ »z |r4ᖭ,~5=ro zQ`1B7dǾ "Y>Y ]$FU:[deIْQ 2:UAT칥|ANxMd8>H18s|ĦDslת6ӷ/eELҥ/_r*[ ɵf;!LmR>|u}hڃϖ͓XH-ʂ/z56+ ʓW!PVOL]q&d$eAUz̓J֙^%T)`$JG/Ϯ-z.5ز0fW,}h@pxH^aK8 h`D:$-q>c&Nh%Hs8LDj]L׷ 29zk'RS E=F.^7DOÏ. ˰X2rIg&Āsz;(s610xhPoXNٖ,J񬩌ygg^Չ{Q6ϋ-bp8QxUDž>l')5l[xωŮRMh:]נn7:9aET;7M4/C,ʬI[&!"_N5ɾTLVwCq^˗A`%J*V["*~\} ˌ;iAw)*|L^9shRRlrtps`gI CL81 > RZ+ucj(m˗Skndhon%IK~bpIMg#͙Cr!NBD.%8J ]}IcoJs|’ [?N"'E~ xaxXkhLu@l^+="M:Q!>N'd. ]^p9k*+Uf'UʏݰSX8'tAi2d ]&ǧpZcA(UƼDNoAgmCMtc7KdШΡoLЩ]AHpŘ^eM# w+J*BizLп^|_I endstream endobj 54 0 obj << /Length 1429 /Filter /FlateDecode >> stream xX5~E_uׯ}T>Z]Mq_όg]o6w.cxx^|#tT2Shz9YnGͅv4ޏ$VԦ9} Ä[~r+r\AA@[B;@cB;J 4 U/4`IDc"UFh;K0ymzn?|SDIQʜTg\3*> /hi[j`xIC^;/`NR J}GG<ucb ״%VIJw b!N [UD~:rpP嫓jfRH8\^et/{f!/:w<   y1U(<6;8h_AV EP!ZQūIbW;v gh75۬||X_&0@+pYo-eݔs[典enpV!s- finqq ȬE6JkRJ*HCU0]=H+JCse! ~0)ƜH i3f+0ΞM]ut`Yg8X"aN149UR?:oهW9D=LI͊AX}[xXQ ՍO kwi=V*yOE`U(Ztc҈T]Kxp]_v}]}wҙ/'2?IT?d|L䩉s^9+mNl.tbrQGU׆<6d*TޗkWȹ? R:FNJ' nQz9z~W=+ʇNLFJV~e;8nn 9*(4ұ#Ek FjRu]Y#t[- #LxBҟ t8YYP * &ŪwhJcKڀD̀I$(pJ =g%޽r=.JHr;)-Shێk2|`ɕ, AÀJ(BoXE:>֝ׯ"' @ k!ڴ}= UHi2@9 zuD=@ ]H0Ձf [4tğ#VG "zsL,Ǵ·~ ;Qz y!,d]k]4BƴpN&STRi Qmգ' C`^T}P:xl_UCF46B/?u{ےI(rsLruƯJQ;Jn_PW|h✗=RJB񛤆(B҆OCQ^ t?7Ҍ= s55bաSЖƋӋFn endstream endobj 67 0 obj << /Length 848 /Filter /FlateDecode >> stream xV[OA~W#$sۋڢ\4+b!=3 tъ0̙e0;\bmUX'LHkZ-DYIx9ָ-Fu^YZ:!5*Y!#s/$m&,% 蟐$i WbXȮG]ǵ?ڤqDzhܒ- =qnu _v˲{S(g%, l\GLB mzģkA 92ZTϜ%lqǁA]$@w|?/5]E9%2^.Hy|dm@d(Tg6Mv]W[\Ǚy d1HN3 endstream endobj 84 0 obj << /Length1 1874 /Length2 12010 /Length3 0 /Length 13171 /Filter /FlateDecode >> stream xڍP۶\B%ݚk=@ xp@pwwww%g{UUǜĉLIQb:12XY,,L,,lTTj`'kbd* #b/qӫLNb uXXXXl,,cqHMLY-Jb6pzM?Z Ow  4;Yl^3 _!h,]]]m Bt W@rph`l3&d*/*xX [Wg[S59@UFhX/g`ebOۺmf`k@QJ͉`lk#lmljg)Qekt9929h0,ik*:9"Q|=vwnj7mMhَYl Udaab 7@*vi6^ {:N o+YY`dE'd^ :{?~:^[k_f M Eu `dd~0JW?=/c)@^gX8YXGO #mwARi6`k ^u!k`M5A-d_@?vLN@f/;f )A<*FV{],:@{)%m? ``zů d}DS۟# `f8^AO.N,N,Zx*Ы?`VCL!^3?i0 Y̠kJkNkR kv?2k)661u!D}}~-5+9_/|_|f' ? ^g/Cu/|d{vwk{:t n=5$.ٜ1Lmڨ^y[QJ䭿ZAQH<,ֻg[K$az b?6f:MFޱRjA3 +Yhќ!1(S'|ZyrǘV DnjǹR}MzHeD[e ^Q}FSvЌ/np\tꏅ=ܾODm8GܶъeK-mT E(Sd_b%2fꬒB&.euNIōȪtF˜7s'AGTѡ;=+ݙ1iw- G:@>@{]aX_Չϼ^\#9qG=i!dIJ3 _Da&/\|r  7J$̌8|s(:\cP6 +i^7!ϡ04Wf՚K8z?[G-2f:[?ח ;Y_*a<&r0JI>B3/`ClRL޳NͰG rkx6'bia8:?b#@cT1n;K2MѾJE=gƠ>Y H}gɧbGWY؆q^x<ۯe59̖("OK/h_-l8b8?ojf8ԬFNj u,_zrn_;U3۱\+;:3HQbW C":֓c Cmgds9s*k\B W^ַLEEjM(_< 18]ظviL|;BbnȆeQΏl ;/E?'_DN^1lҕ:+gb&)VoSΗϖ_'%p1x˲Uݵf&cǕ=IuƖFFQ›gB39ݦ_upI͌-pJ\{ Aqv;_ iDvd5 k")wMgF4?dq 43cE&,[Fkϖm4[;;iMiEwсK#an~DXzr<7+xę U vy#>j-ٷ_Bk3+eߒSCO[,6:@An?(E/x~!(Ǚu]z;|@v oô+B~f)|a͊G`vTLtɱ*ܤt֫i\9c)O}è-@cb )HNJۂb )Z/OZ\qj|ޱ<`ckm+aJ [Ex ڑfDZ>>x.s?aedCASϒz'JYO/}Ag5"Eu7<I Dq}xyh<|lL[4yJ8ynL\vFĆZHeEOa j~;  a%ea)sC® ׷ϋVNtcG&sh6Pgdҥw2BIi nq5nK\Y`jVӦ-{\۾ ZZb<e^ B5f/4[ѣU i6fHa̢8JlB‡`#zE"=K'x Gža}p9vJ/|;9cFֺPĔJShi\]緒~0Zb666fRwPra"pۃʇ#ļ,(0 \e˂OH( pdֺK/VeSX[j̾IONѣAIy#h:jJ0f~͵.H󺿜m b@,Ƿjqj\E),HNaP.bqzϏ&&٩c\.ZBDN5:_l⢈ %"sZuL ˋrT Ylt!maD9zޅ7-`, QRS >=H&ӻƫ? E#m!pV9#}(04p̔3iƏϨ>;4v8~8]}v#'_O \'K]B-?5 `u&Q4/Tb$+)\bX(`I^XzaKkF ƷjB6j(Ӫs-lhEJtB`o-Z|=E;_f'\m6F"7sI(cTaCQCyO:ZO ]Kjys"|#|3/Ż,hIޓ#"1 mouUQoJsӬ=DCx ް]_ !dDD3 H|A`-; ums=?ݬK$gOg{! f_*2rTÿjTc$=;֜Е{w/ͽ (^F<:(2,2AEH\uv(YKq:ƚmKp)#B%W+\[(:]2>>d75Xn{G/ij}-16ԧY"Xe2t s*,SV$YԒvT鏍כ u?Ȅi1z/ 0Ts@D6фiCIm_ŌI>Mܲ/[* +" Жm^r!rhOUՒo\iHlb׈ w Ӓ< b=Nʉ0ޠ ^ߴ hCCsş4xd>QFO[L\DSgN ;bJ$a?$/2IIn('k-b^\Saٷ#*PĀ-=%<(t5|[ ݛivXg.7!b:PS\uߨ~!eB|=̟>,nJC\{uN-AV%WcZS5b9tY/yx=7yR59+Yx)rYd+TpS!M\ V,J'\,z~# ,e"{9gp5.5ZΘEp*! Rt2чzjJT7O<ԯhU֓${М[jsSpB'VQ~,*Xkb5'"feUhk5~Q5.=`koVlEFÇ"R_ΦMgS {@j]}Ofs4Yz/h|cv݀"*I#{&<7hKV③PfvQTvpN/V-s WG3KQ^s(6o烖ǿ1c{z9Ij.zASy{teM9'~aм͉| !Ǡ*U64KOr#"`PuHr@kf&_ N-drQ?|yL,uum{qxX77/:S+nZɧTgeɬ;7p{G6CtW1 ܣ57Yibd h)).Ǜ6TekP!|٫rcOZw:И(K,e>tz5:U}d@ꨆ{dÄ1M)e:edhv.y'Џ7XcCgpwIFrRɐcNICt$UMՇ=0Or9\') Iss,j[i`N5ENֲaΆei\]M^H/j8H.$ɱT^E}zdRb/Z&}mr ')0;*Pç\rD>T|l [[a5,,~~1۳6٢ iJ!1QWzt"MxRXTՂG,3UG`6ᶟ1lRE68h).9u*9hWqQ$-ՁV# ໙2G],@@.Ja#(L v.m8]<-!rl/./+w`@,a Xo?!m6ڲ99%a5,䄧[R)48{NOBTGö8mY 4ǽ~_Ŝs'5) wn~4a|t_>\jC\~ )NU9>V-S꧝ @:/)Su/bH5҂c,P)wD PEU7bl'*u|>%Y.m3s۳6S6dJ.ER(f:K4x۽LdP;{ӧIQD /4S:1^[.|6@`_bgkN8V9j(h3wExw)w47< ؖ{1ZDx)t/6w=RPd&H%7 !sx8Eo3}♠#bggI wYow:.7_31 A3zPU*Uoo\Lit;rv6j41?)5s[8iVCd%R^ۄtӋ^|nklasotf+N\Aҷa4(d12R&*CY[ 0r'nҳ#8xp:;b6'Ϊ4h3#]EĤץ@PՆK<_x뚌=qop`{U\b\̺hal>! :9ON [}~zh$ٰÄ5t}]Ȏ8umAH)bȺˮpAr]1lo+ď@L?r~i oO_֡:0H&Wz^ZkXv1%R85K/6XnEuFji dW"B vpOQ˙B++bMзE }@\X'R.&8쓞˳QS3#< HDY-=0Vŋ'8eٍܯȮ. rG7MH!5F?HT#$- N3cw !(<*tx΋Eڷ st%A4lMF3sm[t08BZ56ǚ1? g FTb][t#4vҫt孝V>4կ2.,%;"Kxagg.~jBm8Τ jGD?t8x8>.;Kfu9a9P,Xv?険M :q+֢:,aDw'#&Bj)i|醧Zpg 0y5$ɪѤH-:+=VMU MNu6Ĵ]D~}y`B5 jj3S'Qg0z4SSXJ;Oo|0 Mm˖6eݱn<:J֜k̤݊x/"d'#_kƹJ2ι@lϪEPx X4h,u(1{.59 zT͛7H&?n+v3sHDvvuv&lԆz<Ϛy= Ҽ"q,.RgMb5.a_HZN)7t-P ^+{Ƽ@YS,*}*94DW ]eZuָ,& s< Ͳb3jjh -mgћ5ف;z""6IMlҲk5i1.sueٯ# $HgUQƢ.9(56X:osk7i8/^sGB/'2>v/M :uڗn۞ykc~mb&#.F0z'\ί9=?o33TL3w TY. C<(>+q~6Dj%]C0Oaj;'^ ftk)ڮOPd~0SYU Febg[dwD12΍umBj8 r8+IzՕ˱U7J"S(Yݯp &*񐹍ZH4cb_xN:!D;a*`?$C֬vZi3k n^l%ݠUD6c=jcQtL^Ec9 3SoK]ԥrJ ֫D?TYe[> YHEIKH#k5 TՉG!7-R0ɮmiejlztxsf}d7d9kwǧwD2[RJ|!8I > 9"rҐs$u~W7&=3&꫚[n(~_[ėֆwrsumc&:?5 Ghr2B.6t\r'=wl e(xl oXGcȈ%5ѵ0 Qg/$-'郡Y_ڶ2(U7]~VsϚ,6KRWF>ø12?Jxo1bߞDTm5EzMGzϣV(Qv}afu 0T^5F^_{*m '0h ,Fd(16fApzOV 6LԤTk>>nۖd?i.+ZBρoNPOȖ߶9!Sִ 7mUuń9?B<<+[S#֏s㜟{ᵃn'7/_s$qOkћ)LY=åݽy?$r=s O"f wE=aЧ§ҒCiN-3k`Po nvtk¿Ą0S;*srts#HQ\;_#DR"&DoE_)5Hd~U!I u}^c[v,f-ts ƿ@*\GEMǁRS0̣Ng.d=+;k1m;F?S:_|3μA\(LU~[@+V$`҆Q)u!Q !Bg3`r莔˻v8NԲLkg}$Q 'U-F}BR89pRlnJ8,2\X%N8cYoE  ޥ\p T[?E~m~['yT鷼@Y@jd:8CljZ"b_ۣ P柽V@,Tߤ|V¤&H lzQ?7"hݏP=8~zCks&ZeutΩ֣d lLoUIpuU2턜f3t`p!ش㨽 É= .R:6{qjH_`AfmIQtlzOxj~Fu IioFƄ"J|Es)<|5u™ \Ƹ>i ?u%KϷULߴ}^$ 7xeaRy7<4+d'&PGƋUR6ƞXVS}6'` [̐MS>c\ڠ'`R5do]JV,:0Ii$1)trF'Z{qG6F<suZYLo{VqBp%V,RԌ=ɇڜl+XTL)J2_0+.ʔ3pQ#٬ }/7ོlBCEP݋&ktRtE5vK]o=9% 9ZW{ 6 ܑ:.V9WHFRIXSsȬXw*E2TM|wK$%Һ lLfrѦiD2uE?|%<,}+@hOɪAl_Λ6{:IĶ(Z$jVR{Dzcwr T' ia 8N~mk]H@ieNf0%p/Í|uT&;EK#𷌵o_+2K #@dO>kih` e)ҊxP4 4!s|͊Pm9ddg$F&r8' wkҤ+.UN4F Ē*XUtuBGlI}F)٘AR9jFCs~NK}LEWxՊ{ͥ9 ?*Ss`c- =3~Mf9rqaHϪ>Vսj9p]+5^+ pnQ2Fqdu/K{JVMvj"Р7 im+8.Y![Ԝ#LG>FGǎ1?O|5bf=l6|/ fB1hGi&QA%JaaiDil(ջ0ϹA\,]y]yDnDhuۖc/Ii9~-F`L/+OvgB&K͍> stream xڌt.7l3ƶ3mllA4mvs#n\7!%W01X;21pd t LfaIUf6\0;~Ȅ?dlNFf##; mfF:5T#<( )4rX 2@%C3QP::rӻ[9؛Q\M@3WY}+ߕM+;K3CÇ$! Zm, ߽01YYV`lf ȉJ9:2Էtw770WQG.с貈쁆mw{6.fFadKbmfɇ`e```d@WCSlR2%`Q 8;v?Oedcm_W&Lw ڸ qr;_G oo1 `8F@-1Q;^ Az vG)A,z?#>AA:Cˏ/fIoaEHNfp +_A8O4ɘٚa!G@?:fYWfWA6p/G1d-kK0[j_e㦱8>vAnd42/Ff?&eŌ ghßB@t~TbN:~ #Ml̇?1}л~O>܁;Ɏz+|\H]K6܁um5_\hygHR)i=۝>Ja'4ԍ#Bq˿Lq)5AnOI><\Ze}W;OU? _9vNP\z\VF٤^ʦiT"gIs 2簈iP.\gofP' $aN =m2E?ιU(39tb`E" 5 tykH%b•Y8֩@CYvNx|a.``:52ګBcsyE;=MWE)` r:`l@f%pt6I!XBP#g>oJ c~AwFw:G6.C[쁹aٝrib`E;s=0gʂ΄VM1jʼO;cE/.4e¤K2}RGӒcuQZ*:$$Cq&WbWW@GFNu~&E y 7mWͷD >qڎ!¤X߷5MpVHQ(˲rnI* Ģ` ׁ*e,Ī6Mz" F3FaOѨvLvi)_",]quPd́je[瀜GX0M2NiSsel`=P~>VG|C^y[e ]&{ [9#>U@Ju o0Z(_3ơ*bnXg*9:M36yӞ l^-M~"')\ԸUhK Keʨ5òG}F̚Qo@9綝jash! A,(:{\y\,wlh2{¼gY1vN i7E/[֖ln!01rWӖyd{ K j˓{dy ~R7ltz3i',n!X^w¹lfPX7+ז5GFʲLx[ :M|E&DjCcioY )h\Q!n975V+6ƶHa: njKXő/eoFU'k';KDO|4>C S6?7r\RQE]'~lLެ]Un2ݽRm2J9HЭ5*zˌK8@&-dCf#j@sf;g,D(#eË@7 *@+^6yrvPQ:8ybDTL7ۇzIE m{|Hbۉ98OE9pT#/=r&:$6CS[ "cbqA)t'eR;GsY ?4x#+FSE^/s+T JRH"JUjqu# 3͗ (V"UmbVL?մ/xԸC=Ӱz.F/j?^E^Ht!G5~SGXt$}OީYBKc:n _}A>C\gv#Z: \R:" gd2QCJqcB"`LO:_zE@%%y\zcu?%1JCZw p6hqnpЄBBtj>~3`Zm8ȧNiUfI@iFDlh8|MAm<>V@['^5|y  v!GT?{ 6y%e,(eP6XZ壥QE Ar3!aSh?R }PyW_tOj/ +bhHD̂7K/[ZD3Pige|L?_0)uEWȧY1 EH©͆FdVEiֈ69N-׮#d91ky}0x+Xt@2yEwO]'?GKi!^N ]Bt݈IwF!%N|yo|sdp`%L# 4~+pHaVUTIٳ.\e)JW_AM  `p$Y#pTzVcd&[аP9WpiTB=zBiힿ>+@F^Ctn" Wt S#"7~mc{\fO@ӐyHҎ=j2>]7|uuEJղe/7Yr51rz0xjW=Cikގ!8Y2;d[o5_?֎jmsߵ~[ 5Z!ad|FrHXi2rԧYu5WƦf(8RB9w衱h܇!uW>qےιWaI>! ~cM Tzy6RuɟP _K&c|di CqeTL0iai WJ.aYK{;#=|ꑘ%Rz;nhz"g;c m*y: Ю͛uM{.CgJ}3.*]jǛ$_f/We{@VP7-3N|I(7R_Y̼XU'_۬$0hgvWc'^-N2n_}Pǔv.Y`'`k WY5sbиXH9 5}VXi,e Eo\fiJT.󨷨3"&uZU2pbW\XC̩·{m}tEO+&jb! A,rU`t{SsZS*;WYT_dd(\6k|7 6s$V2NF/OSN8wmTXQ߸z' 3jYv~sz8%@_ =lHYf>mYO"h!\z<IocT$+ T |ٕ~ &ps~W+Oi{!ѩ T=>W[~V~4|qF`K+=E6 ~.k(!Kkȡk~0xWY ꕶ,"b6kc1Xќ4T'沊I'6AwLݱ,%cy W:]v@*g|iֱY`%DG|_yP`,5?>Qދ2hMnx)w1TP4Tkg1nn2Y[WQvz &,>)zS} lt`nւxŪ)꭛A8(Ə2&Exz5 67WI%1ӨE䱈}ά9+|t V~dR$6E eՅ j,צ9qaK*z'm6-Rb1;D !`eO{oWA^s J\esVm1JpLqFM /ߵV1+q0 O|_=F;3ѫ:ްG%i 5by8]jO{aMPiO>bJL<w ~rzTiqR\ LcWmNtED&nA;}P0l;DGe{Tg h'xyèe*>aL}ċMIW^w /QЦlP(Y~/gS&VFgԿUOxr(Sy W*M::r_Y A5po1..Hl0K-']?!2-چykdh'*$ά`;K3TC G_6Y5U G1dV#RhRWgְi4*ᝨCSyGtъX* <;pj=#PIɤ]r8}(ӖXu*6 cnQg"sǠA9>0Z\pNz-(We . ]j&+w0ȵ b&͂t*XE UE⦒WםAtL,F_d=|~{O; ~28 4R3,qsGuQ,Ҫ?ٵl!0Y=WF -ۃ*l#̓AF"P0j|lCA.j LӋ"8&w}eF+ 4Foi &GOiVv=K%šh2GG@SAa UbfGf0ݜQlxSOlXch>\FHoS+8X!>3 GQ\DΒ #,\>8(\]Y"R?{NmOJ,": պ܈`\>x˂"Mrb}y*}I$iؠ@+{ՍPJnPn P@т&]8yrP+E|aTnx6-~v(ÃSnt[JtM+"c{% Jv.;mYp;x _Hc8jC'4!U]C\ k=7yVlK511Ag6aibB_' J,L`o\HWv긊arwD_Ll)18RcvgYòԾFL~:GZrt`{J9q9X=tYtW2z1GM\"~tF|ZF`6rqu"{4fnVe|\6; ΰ{j fE+A8.VIBr~_Ya#)˘tC[kJ y׵;!I_(GM ׇHX8GY~|ǷTx2S:I' FM#JNvCvpͽCNiCE W:twwc '{vS78Hi>mͻ,?yp:0B*ҔǢt}&eKs4 TuDOQ͗(yvJqNzYxkům>ҝ@; S1,fge? #ѬiIΪ[k^g7׬F2ZD݅׏?_jǬj N>- <^gZ 2DUlļĢ ҫ$Ef8k'cX\:"$Mܖ=g&DshCkO7|kiE=0e_`Y(" ح1 +M9nf*B =崧ߛB+$D=ׄ3[Wp'_"#`{uia`|tnw*, Daf5~f ABDɡxcp|FI:[ Db Er^7s.aw{eh[.ȞM!V1QEdO|]7s:~$Zd-YS-~;uĈפ7w>v{7%ةS'R4z O/ 6H?IhQI(u-򃵡Ķ׵􅽳u`i=tAڏ T.\X *[RL(1s{G!+\G$= g,=rx!*Rl~Zxr=zJ*YM`ZO@Sve49AULOIV] 2O10 ,&hT;Cs`O|D ;^IZhe"Ma@QW䈠1<+{ro%0ݽzPCyY>$f⺜]xJ ^p7O΋i1jyb̛e,[焂 a6 + cgm!ЭD#/DZI]3wP3!vx|Vx\jzH>B{R˛zLǵ1o%vNM)`T:hu D ^oK/&7u4f^X:LN\Q3߃8~˥FhI*MTO=!9 aV ? OѰymFevu%Ҟ陻rZ[ΕF4_JvnTov ֎˾W>-lCl ˄V;K rPtSy*JA@%D0A̠Y`|҄1/$ӈpT/`VanԄ{yy*7Jj5$>!.;©/8c5 DRT#cRlnK},EnshtpQ/Pe00lŇZ#tQV޽Af% qa XYߣ4G+= #恮2s#NWoi܉kґ̨Y!0fi/䐿 u^csx.( û|.OП8ZpAH[4V Ҕ2M,z'j>S6Js1^1XsEkd(rJ8]exFIE=1c˭SB "QCwr@v'+6ǙdSA'W_b1IT~vQN&xU8?H}P|/`#r΢Rxp_φg[(>ٰa0ԱG[>ܽ[JYS7 RO&L,[¶, z,@@[>}y2 KUs{JԆ˦w'ݓJT 其Em5DN{:'͚̒TЊ;QK? <^L);`VlLiRl(wW@)r/PTy:7MVy]ψ+!Ow جWb`{ `|+b&WK߇_hY(7ě&rn #aќicS~21 (򧾂/Q5*iL 3\R8K[ t૵P;/W^b=y['Й6. @mRFhz oG嵜4[3N̲^Ⴔ}waKmGwe .LD+LݶV$,7gG{ :#r'\.{`4UiLvi*j ١VR?C0}%zq5y-6Z}"-ٯ57\9=4.p $#ա Rpo1)%wj֥wY|ty~_ H {{<ߏ!I`FlG"'99{!g1d13{JZ8 #p\욙|BR^|wdb2#$٘~czmo.~%a7&GU̙5,gevZxVZolo-.פAh2S-\4f Pjqm*q>S$lNp{*zUVBȲE9 E̐8/CQEC[}SOѰXf5hcʄ迒ʾ,hKNJ>}y,Ąo#HIlؾJ},ṃi旟T̢>E++wN<'S qhE-Db'vl.gv>^qA3Q7DQ=w|98! G|Y]I֓Ues4~i8zkFgu_LֽGwQWYaBH^7l; qI:K( 꿄" Mqkm~><\VԀ‹avb:h} H Y@7-)%eVI=B%EUv?AE{Rtk:$K*,F۱~zW2 8? &NN.'fgTؖ#7.I8+s4+G| H^2Sȼi \\HsE=+C A:* MYD"rG"hNڒ6EB\Omt V) ]-5lOb-~=@xb嫁wWzאRl&@QI?m "ٍ]~CV/b}=2 ЅѳR5Uzy?<6 'd[+H<+bO$\;0D\f-!OfiJpArthwjBe= }L z$`վCQ _b*Aq ^45P6`G~ ;XAk3a K]/s^/b$᎗eAǖ(hI2~+U,{ yH^6և5Kqm0ї|:f.</< <-ftbAS612]YMsoD^InG4>F M|;9+i @I=~o1賌y;^3dc\(-MA@]~752&$x&5l41xGV#skoO19r!{^[[9Dux'">uyOBʜ݇2pe~L.Il0YC%Ge%\(&h2(8髽XPt^cJҳ&7LRx529U١)Z==!rڀrvCeݩ['B X8*z \@%b/`Yp͆Wfe}]k!o\~b)S TE>WZ'^C<mvɛ1c/:4 RN{ד.NʽHBjlqnT,T; # ,XP+!ҒtS:e*z/*W8<OId4,Kehz>}~({u܂0|YLgY̙!e)54nl,P% &Aa6shf|` aEγ+Th o2k69 N Q.p6u&`jgJlڱ(fޏjaߠ/Ȼ͓9PTK)=m/]ĵB"ե,b'aADq`'/9֨n]L͓Pޖk; %p5M Q0#`y|kDPLgubaQdMؤ^a7eUF$/_]{_5Mv]yxJPb<\<0WM)֌xSk3d?X8%ְ(Ǝ$`X( J q;MF¯Sj~_qQ4K9t|A INi(a99X554w)vijNg4fl:m1HybMOd#I ɽVlb a~ɥld2[çuE|䢝"eB&H; i,!D>֧З_|, 4>k}f_A 0D`TU`q$Hˆ'{ENs\5+ Rd`AfEStèݸo;tv$D15 &0zYW"0}mRѕkIX1Ѵ'woc xk |zc/@ePI6Ga 'f%B [[Fx1Dπthc✄4MsBkr UO+Ak=S[pZaǮw,ilv]~(QxE5zGȶLWdzG8v8t璠"z}a 2GBST<7|gͥ@ %96ۍmȇF̘&&@"cA+b?j+aڈ l,# ˹Bؕ\QO> |hS=Fx/ɶf MH{6[ qp㣎,7SSƝte`2PD O8;and.EqtB]jL}PYɿ2K _zZ Kna>9ga^$>o1, y-6ˬHC SzO,4l7jyx69tQ3K;AífxJ_?~qő޲J u{ƭ[ ͲXD{*1tOxd_m#Dz!PdcSHe2z*#Ihglt93xnl2сC(0TV)6ן+j0k5q%8uꅖԜX&|~LZ8=ά$|M1[؀5`ZU} n$"p&l&q-1]i({e Gn ``)Mdl#la蟟LkV|a.ZU1&XY->a g EHϽWo7S3(o|*XS;T z=:*I.{+ڏ*CI 5Az¨0 N:=f:w:!w .'npo< 85޶w2Q @XX@rCq, ,]'nMhQ$:35O>l={߬x?[ߡ$P#9c5С/CLŭpbO!H`Q9-tޛ"N5ywd Hft^TW~vmplv.+-&K{/V!oU- S[prb hֳ;wd΃ۿk[; Gbμ8iwW 5lwwh" "+zL֝8xd8aCumF>d3~mM;qlÍ~%@ Q鐻b<1OkH;vb0Ww,"&aPDqafڌt1;vsWTy9<; DܬdEυخOWz⹼L%ʒ+aZm:FȠ Y7eyיu ͣӊc.|h<0 ,824,mŚ`Yu%fHy?VrcOq˿u+p[ eKF#$BWY0v 3-r;j¡gCA;^IM8H*>~/0 E~Jv|MIC벎ϊ_:x?f DM}(k$uG*x5PJunl 0x^;i3eh..4k)MSo(ErDz{'謥oUTw'`DΠu6e%>+r0H_l;ݳ[ZT}AdU~ܡX!s"Hv*ϚLbR bqۯ23Cj.W# ($lm(덼ПqJb6 &mŸONMt IAs*4ʜ۩ϹpݭJ !饝b!p6XI"h Q(R{ "jU]88#TGahYEbJ ^蚎>MR&o6 'ߙ])Ut WtKBJd~̶!V63htY3zap v${m5lY?KdeWL%q@rkS~0}hvU>Lڍ6!oN1詡ۭ,|Ob[dH;9o$@-FfxsY 31ߠn3+h>~i 䋳^@Rɛnε[ׄZ ,o;ȓ½7oJS+ᙰ.ǁL> WFfNk7}lJb/e<CџV?$vl[:::R{Xyp G2XepVeR^ 0Fδ ]^' aO'Jp,<$I~A8`!Mz;I5a;W" %E5/ތ=&0Z܀fذQ4ۙ|݈f%$J[#[#&wc.&ш ǔ5!.@4NhjguKE7gZ &OCM3dǜF kODp&z($غ9߂P>!a4]$ύ~#g1EL F%ȨzT)E|َoYw *G}S6Ǎᑙv8_&)Ĝ#dSG B^:7J wVytkb@ɍac8.^ vMF:,L0ԉP_4iyۀHEl@ݮAm+B7]%yyצKTӭ Fd'=:nzv U|{pis ,{=z%eF8FrFɔe;Ϳcn!i杖qЯԧ*9R;j_ߤsϡ3'۳0hnӦ/5/\2i7+E5g$mtT{Gz[9&nfX&TKY\#d%m-Ie*e]))EGΘO F4yNA=Tp߿Rab8Cox7SSC n :ܞ+n[`bQj~ @$(g& 8+"VFK ZAn)y 6afƎy.JMa:baЕT5dF~d%ycNi:Btip5 eM'Dbc ɒ,s'E^'OHCY|vK^%`2 IaǠ+A~#@b=Ms|;Scy* k0>BI^m[AvlV endstream endobj 88 0 obj << /Length1 1813 /Length2 10942 /Length3 0 /Length 12080 /Filter /FlateDecode >> stream xڍP-ܵq hiq.n n5@ᑙ3sUUWu{m;gCK"aduCY8XRvv.VvvNZZ-V r 4>ۤ͡W4wh:YPJ l B<<v/?o XVֿriAn@(&l6@(Ot=-m~pr6?Oq?(>@ o# ڀ(d6ϗ?k?gyY9ql NOR `x~EW*6|Jigk7KY@?7ba|V!mH7Yng+;=o?wVhrs_y$6#U RA-m˟vK՜\A_ ;7p}V.wI {? V@?4 `c;AC\P~(//MO`ؤF|>?'M`qشFq ߈H8}lV6yD?/si猶<6пD89KK; >O g.;醛/7ܕ˿sWSC~i6ǿ ?ۿ T|F@? K7Flx@O%✓P]CHMgitFE.;twAk.WF0Wd.ŗ(}ۚۓ;}L5t,|4Pq EK|W' [6ٍ]c@γqby/@95u`KzV+ϭm}g9=RBmx>J>A &% y;y|>(̥UUw%b?3Se7-I薰=Gk้{ч\lV&MpɏIY9a#-1?զm9UMw\q:ƷX[f"<%'VIOcň$|Dx9%S4PA:G?%,"$JFߠf`􉩧gq  0zL>@#XhοC/ Bt57cɃTܩWbCI6^N$JlT!_ g1|TDE-]<؛x[z}MYaL"v/dMv0{PBS8B>>x)jHJuK17Q"1sze2bGn&vd#I,!%$gFu{g{NB}*zVy?λP' O"  xBMJ!^c#1JXŪ68ˬZ|Ʉw<&^Xlg_* UYBQIa:+GS~}7+iHÌF2m&/!2Zr uwMN5_ZFVtǟ9d"t({Uq!dE I^qľ>AMii|v Hiď渑hO|ܨO0x߹H;YE`&(rl!US[̞'ĢDZ渰ӂL>7L%0ѵqB\6=c6x&Y⧚q;R&&~KXۿV;~ Fy(G$[ 1l w gK.jNX'X=8݌7Zwi%8&*ʜbNŐ'tgwڑNTkҾn偋[h281:?م Y/NTbQ' 6GdKthZA}Kz!b)<92 үxfɂͮŃv`F[*QC$ѢLJi*g%mS΅W}yfšza1#j:r w|~Moj`)x^'b2gޭ;$^ӧ~Z1gBPSnۏˣb S}$H*d(R4`bXƵIkc嗊SV[QlQp6!Ϛ6op:zwDTY.`^H'$t3땍A -$ g1ttыD6CʙCUy݇|C(S|gT#>Y1V- /]>Q}0wjd<8®Uk*e8>]%V8Lw`S@ Am{p_JA2S?FZ@Oٱ$l5*OGWovN+Um'%22;EMJH5V*'iAE)J$V])YL5V8 I4uw:Ca&Tn?[`⪼Jˀ|Bk$^bI,F,0KԞ0ȣZ/uvX:Z([ >z!wQzϯϳ~(C9dOVj1uY9v *e#w+ ܷUMTY}N̟x<Lm,(|з${keQX(|f~~P }dL\ndXVjcIU'U7nSFqTVC2LqV8%{$UHRʬ}6=+n!J_a )C1'eZd,&0w*2N8fʽH~A-s՜N4'lvOÏ8DU+x?@z:UBŴ)$s%N+s'$ڞU\>2i/WSxB7&79d=++Sg 1.X>/5kߜƐ \: 3"TCIrZqgV2;^"6V>%i*wֻ eb3v~~A6\%$DfިD鯄 ]7ٞ vc"M; )_|SSHDr#j[$’Dz( \U-ՌCpR_bn}J96KDywJ'#(}Mj9m(lhEmwt1jx(lVX!`Ÿ4'RУ'N-opCz1=MP. iaޢM %|UYd<,4]%62(39m~½{-\_@tIh;[N%@Zr4vpߐJHoxN3 x6 <-.A 0T.GCR#+3))GV`?v$.hp;jK\ه)ɭ7:4t|tH`jM^U6eZH^Jo$aCkCiߪ-X,m? d2#CS#ٍk `A|8yJgJvKYwRO7?X1 >]EĒEFb !ew Zal|P| na(DcFu&jK Dw&Qajj_k,ո59:긱st@ ʣ\I$rH B>4sl!n|Qv:*o J4$j(x+ HNŏQyXT"4e0n-xriWM+ۍySU"jR~!++C38tPr|I 71]ֽlWQDk'Y@JM_θd/Bs `.K9kƷ2%K5DHהMì$Z<҇rL'35c}q|௮iUiċjfF_׳Ny`GTkc)'+[,$r!'kzȃ!~Hw^ʲ%dX50$av,'}Uʘ۴h\,G&Ԑx^`i"#F,0CT=[e^\vh 6`ekr.oQPުfZ+ CܫY2NpgaQX=O),Am)JZi!|婛mQBaIlvd5+~wEV]dv(0Eyǜ2F C:$; O5_Q79=rr%ÌXW&KK񅷎eRFpB^ЂǛ`/ AZ*9? RWlkxyՂo%Ǩad+d >,JccWɻ,e¦<l8A J=`^9DN1òGq{϶bzB^P+Rg0tk=ʑ$/ǻ2^Ht~?HU)b+J_^a]fi-r| FvWdđ}Q#h6WǷl:XwJ#m`n4S}0lizB(?ť+cD<P3w\@@3 2(vqbFj,u0dlɼ5= )xfG3`hb'svZEs!'.qK[>0@M^1.)ua 䣒j|($Irȋ #v^(D17SuފJG(Xu@ ?NwJY㮅,d\wWw0Y>°s q&І8A#w.9 raԨ/F[+Fn ~Yi,yIɀ5i {Lo`fgM>h p%~X0ƞὮ'R &Fe6ësS J '~8mI0g%eJ 6vwΡ]6|gXGF;X^ק,"u81老%˟2V[ A{Kշ7/ߑoL#<$ujpa IFDH+dY#Gͅٴ[XJbÀ}O5 6M/r$V{ںǞ  ^2I%$8˿~8;âNMpjv#sGB0K*a/wHVJ/"a?DU1` K,5s(6$#iHbx(h@M򑘒*)M*7Bopyv75;0𛾊Oc*3drO ~dx9 hVE{JݿtX5渵S1=k pGsDD\~,MC671RΞ_FuCkh- l;g>6rKttsK}u@ qU4 5UҘ4{s-ʀfY. .ŸcK9#ji<$ozBٹ6 %aNGˆ}IuZ]yy;.3yiXoEX_YaKm1ƚa ?|ܦrJ=ĻF3w^[o &VP#}?g?&wE*m&lLIՄLBdՃj>%) V9/*f+¯TZ*r6W{32 p?[9,|ipT^\HCЖfnxTZjXa]KE`֒wy3,?Q5{o}'UaS"]GS} ɘj-Ǵ͵+|+zLάe0A>K91puE:Cӗ5X;Nd)˝V3 Lhfزb#K}۱6" Y EpV”URQn,?h)YAA]Կ 5;^дs%vcGms)yjྲ}3Hn_h7y;w!?}dx6XV͝5ꅞ^I fa%]߫?LbC)?h%f. e" ,ɘP-(Nc#8jgx 9aoyh1Z_>'ݬ: L0=,X~dp\xn!r(*_w%ȿ@Z/\-nw$r0|w.?+ln.19GkFLs (!LPņ#kVflNL=1Q)JP0bu ޸E-+|pQAK]改QFf\j[)Vhc4'(-GI;Id {2ؿ \iS<[KTO$d=F6XbF;VHA \A sbl:Y>YW0B-t4Ntp3(zL)Qv9V+S%MQ`.1UR`TW\V -|MD"@0q&q}A\H>q+ 8w} s z){:l; (\ƝxfQȹ2w|(/4*%ZӲ^HKG&D" =R謁]E1jCz-izPb\4k)EČqo}wzK3Tۖ>rlt Nyz B'D\J_5]C!o] s 0vfXk5ԡ=VjѩsO<Gg&iEXjJ\==g[k}]ci puJ1<ڟ/aĦ<\Ñ? z_"$w< )ڔyhtp_ EQv4}}nQO8G1G%~ߤ=dfeֶHu@",>gM&]R[{(+Q݀\ZƧ,8nsrj2^K,Chi~Ȋ ZⳝOlfc>?q%25eI|$ s. L>vذܼ[}x(EQr.}lc|-wU3 V[GUxŽԭ5#(Tœ<j]XWs}"TlKM֤EAj[^v\9QK2o`VX"ع;gIg 9&! 0{~-TO#CgWue?8P,qJ݆udd)J. m>qo|;b{F#jyqɚl2gh E{  *v_U:p*W2nNe:H~'PF S"XqnmRu c @hMB)OިEH^\l߾Ȣ?Ki&6GpZEVWB}@Ec'N\@ư&!P]zLvAXpN3y|h!I^{D pΘ[N82?%UxE'`)`@%['Ѭ(ׯ|QLT* )aa7cۅKBg#ճ~ᤵfLy5 PQp•~Ty-Mp9S)@GwkDÍl=mr*/le I"LrInkڇ":$6_s!TY[Y8f}mMЈ0V4"A]۟]#3PYvtABVbj KJũ֥W/:w%4gl&I6*??F^1Xν|SO^7h57^44Ys+A?9Z5M"y{Z endstream endobj 90 0 obj << /Length1 1643 /Length2 9620 /Length3 0 /Length 10676 /Filter /FlateDecode >> stream xڍPk. ݂K HHZܡ@)VK~h޽gΙ$ϵ|ZQ>o `WU_?HnLvKA^;_%K /vK"ȿ _/_/RK@^/?z- avua75$;cӴ;i.w)Y!k.W)z1d.%(}#Dl{0MԚiC^/) UGbO/K6]]ƳOsj>e)ַqogh-g XO0f.sǟ)r5Zzw;RMDCdDHs=2I+A`޷S,f30WRa4%N_1ë:/`Du?<⩏\t=b~Wh&)$+L.Y# |EGjK;RX|E4[eұ'b#Ua,{(|b #֎{TϜkc>uL^Q>(1tz3qE$NW, ᯩ̡h =aG%/Yn 5z'B@ ao&ݤgFqӿv0OUͮy!u<9 WO1E%ʬyǏ}cbn1D=Yž b}hFL75V"^#~Q/ăw :'W@+W4>)p%̞YEg6IlMr$ŠLG \GF#6Yƻ1UZ] |Iׯ0P'ÚsOV VgTzU!wYտ!h]lo5-NQNss'T ,- 4)nH50U1]D4+22yE f_NEQ>4늻 %BfPn`Ga)'a&3 ?7p8) 7c\]~kn72LjC0jYJ+pJȩ6Oq|^ZjԚA4M:FH,-ijXPwu t+؍̘ 3 7oy%7G,ی#U~;uȦ4N/)JЂRzJZ!mWN$CHvgz8֙%M wﰯXJkȎ{Qx*%A`o| a*PI/G&?1|3zm?e5S7Suc-g4E}ͯ3ÓpjcFåpmV6M"/T/tebVgcFO{4;sj\6b t;¤qQ=o bk&׶2_=], [q49jaWC,.ag@Z' O#0q$oJsЗP*xykm|`m*ƥ-N/Շ+!aD (.Y,|"Pk; o8%50/yL g"-ZxF|wwWa?vur#󉁣pG@4hW@p=U\^%.OkszBu(=B(MK#o5" U?gY![wB7v1|U,\$w 7ZBƩ,}*lqo1ՂϘ#fW4ai_yS$g@y'z;ٖG%+ t˷ibΗ™9De˘5R_ڈ:3i@~l2LOrԟfz22@*0fg*Jo: vʶG+YS NCrfj 5ẊA菨P㪩̀tBcv,>Ey12$YwiAbrր]ëqY:#Y8@e[4m%]42؈kj8\Aqk !X h՚l7K-7&LJ *֦_==/q,֞;:?;QK_;>Zug坭r>T\ *~\T;֩:=Pzi^?0V]V0j Q So"ZW3I7޴{R='u6t7q`(ԝ/ CS+Qn'3?r)Mӳ.AeiBNAvNpM]l"9Ě?8z/D(Nnu<.cM|m#]C}:6kI[7c{76YEMgތ HLQ;mh'X @q^飂6&tZlq" *eNļ^5$ ,0sO\(Ly ֚3:!qcz< a4Ihk3Jc'B6\;IrdPxKgR"Bﺑ!GO(l;=0g g9aC i7s}9fi$2 1sP.o Q$_/?0E rh2^/^T-{%`Z2V~b%A nJC}P.*{TZ;0 As#6rocĪNymELbtkvk;luqLNCu7/JC!w-̄GT%M[w5Tޒ0%We 3סWs\)b#K|3/K^ap_e}&P16mhL䁖!0^KLܳkX V&u)ߘr3>X*&~8)LY[KOQQF <>q(^>8> ~f_[/aL՚tکɩa"},3|(FyR%^Poz7\ɡpߠ[: zr1BVhZW']ZH/ m;냛BfF#F!891^5a)i=G0Jװ#-a*/`%fS B3;#Tk[/ÖpSq'Euy*?[ |!yi*JhLTO~eS^_U[2$L|vf~f/dj| Qe1i!-| T< i4.Gȧ9a3] 1P#mPϵp4vϫOA2p_ۙx4"];|d~Uhar,LǴ;\cvhPM8y@x $puC!TPS2$`~*BP_ƨh*DKd[i8 CqﵶUcd.eӶ'ToltQbYl,ETE]}д G TI+.IbJ yt֫坶6g۲\ ty7obC_ _iq"my5$#Pt:Q+3 m}8f'TbA[7bIFxKN3zi3D ;1mZuMD"-CzXuwRx 7Zɪԅ?c_T?= )*bD.Ek5Rd?&\d i-yPu` %B|0N<5*m"CzOmEgvm&.>EfIg'}k̤E s1Γ8c恕U6xE]#Z xXNCEc-ZJP :^!\<K?W9su5V|_rCs-<"AD+ cDI,Q̹2xkDxDAvd5=K>tȕ}o-fPz+A?+z,ENipxTiq}a]_8t\ʔ;l::X:z {'Vb@} )HP(0Hn\m?y>CݯH ^={QV5ZA>K5$W1hcL9Abޱs~{UUΘ}.d"r>/\岙`m8wڈ͗+&ܣr$Kj7d~o)Ҍ/+&|ߏHn#` 'OwSQC#^1dbCzCc&Mlś+.%dUtFQ} ٢ E{V';W2q܃ByV#?Y"D.:k$PŝER"4E mߘ$fr5Uc&Q<\4}Εnm,nS~*©AKŐ V}и=CI)>Q1?Ի2O1nQi> ޾sGۨ1xKu=\mx,iCj7t}xxaD s8ՠ1Zx%JcMΔ& 5Uw|aYnRvf!/Cxz T)\8r9Ri/G!BD>:Hh{WCw"\M~@CݲT\jLq(߈dMT?2 ;޿`;ӐZ}7ʠNGWr]jXU$efvqfo?':ZܽPt+k}M\Q5Rt<ˏ WT꟢Z7 -h:R()72io6OWЩJ\zEHi9OrY59ǘj 6OüMH ⓒJiRS(Ԯ'd6y:i k!vF*i2dKJH ;O&hDr81,gћ۵UxNgѲV2{o-vw,38ZzM*(WnGZMv NJYש!)~y6`_sls?e=cV7ts'kɤe`_=r['kzb׎dcx~1XE"IS=]Sm~rRxrV1+uQN|xDVٽ+)zg:,SsXzhs~ E0M-oߨ}Zz~{% ފKO5Gh&ZqINY)8y"@Q J=⥘'KLGFqHc81Qvq-^&JcX+ϯ>g$|)F#=ۓbE d;Vyx69\0^05kҥ4K 0d֮\۾O21`kp#9Dr't?U( Y,^=^ BCEB=IN/V,b{X8eDlkAOnBqQ5ynN5 o#eS3c"=&'/Q:{PϞԉAT(@ƿ{# uWk}]q&XxC9`oVJ衰 !e#?9sD;kىV2PAc3@j0 {Zʍ'I~PٜZp[񲰅 9$fhQC=]q YbBl9aqz_&8G֡4W\'e3жh|'|kO{Y\zSJWOސ=FyTgꩤƌ+&فq] aK5KaPqm96ԆҴncZ2pUR$1FPy7`Y)" ]cn&C핹yw+e)l 1 a.IsLJ炻MIT߼b3 /L=\mtĴ]uZAOO[U&ko3y|ݐ:\HRrk aOB1b@xbbgT5S{'Aw[)E_ruq6鳲kԅ_53Lp w`t!=:x+KUWG"t-yӢO)G)G&)J|(NbeN1dY])Y#!nlz[0iZ(QMڠL ~0c4oqk[An~boGtSo[b8CET??&v HrV@>c8SME׮;.yЫ09t7> W΋>8nyϔ!O!v݅^Q_ {u3S!Kd%hͷu"qo3DrmRI%E]'>EWAd.X)Eﺗ4kjV_m[&}5V(H;$E&7.5 Q;r)T,lVVҸ_Cku+ . ^<["ms}_3.lj[i5דmؒЫ د]nOv[ͨ|uj9Dس; O,UʩS#àM?}ν]\uFu 2ul̀sdBN|n|%tuo}afMY~0&L$NmO6ݭ)ES|iDqʙ Odk[3ot%N #%48ct޽ݚ47[ąr+*V(d&0?,Oj[r~Q.(eKuo(4~`cӀ6Ai9D29L]_8uJ'?2A8M#;j lUo] )XGO[lSSS;QzxD.M_ Aq0o٩:byCPS5<` NHyEq 22Z髧2 M3<GmڑTpHFG+Yo ̈{tiF#!"㗛ٹݥZ"!W U ;%9Z2(ED(Šć7fzfnsvAQC 2#+ Mū^H wF֟식&'2@23;uWhR'0eQH/0U7[]!ʰ8zv~hh%][T\O=ŵVxV=nE.է.ڦ-y5+)#?zhȽ,r'/LjEgz#n֎JQ1r:bmekv+mYws%д/βB|J}UɍR(xfS/i[m4TB3بb]ϋu yORkmHxQ-AsGC:0d*Oϳ6f^;>2bl){vSySH8 [ }{@an C۸-ͭ/;$} B<> stream xڍP.Cqhpww).%@ Rkq(E;ŭ] oq{Ͻgޛ$[֞0hpB 0[B][͋ :b0=@_0fT<<|AQ!Qnn/7ȿ !9+/-@=0^@\}APX6,!?; P:]`m:_!PWQ..oooN+N$ ;uh=^@[v/\`:<@V@L =``[;p2Vˀh<<@ g+؁ 5N`mh[yYa (h`ݝ;r!0!˃m_@\\`@@}\ lnӕK r*ma#BBc;+V+`k~0='0?0xx (hc&a7pÈ -[?˥mcde!>n7!!hZ_e W)`o`wcn-m?v!֣G[Z} q_ZWu-P+Ȁ=Dh 8EzjB<@삸G*'أ4Rl]+ww+_ Ð@? pq!P ^ >\rE YD\6F05Kx`ls5 `\0r!ćP\py%'1lZ\PbR ֦/;l^. h0 {XZ›c{\ba 5*+tR&yo<Ϩ-Zwۭ߈QSrJ<8!6w0y h^{*/کTż/ы6 )f`=CJBc%;}q9EJ<Fa _: ]^.2z2cR* F9ҢyfxU (pхdk&~­ĚF" wZgUQ>' n", gENǡBD8h?\,ޗ,TdeӞL\ջa?j yn EU_^@F⺗isn8䖈8 RrΪyBDe-+|~ AX`J y/]mkj9B8tIFc$H#aL.M̊H䅪ၔ OC9=K>JQ ~7N/p(# ػ-s.P=(bpx0~6h_ōư_O/wvV)]ob 4M -ude"}B=8(eߙGdpS<o;I"GBLtdiD7|uIB3+V\ǯkϊ%^̀TWp{ڧ'3ⱙbo%; ,#k-C-_r$T Rksxx1Տa1$N{?W0xo)=Y6?/͵BLE"t.o"Wmmu q]y&Gclyg[p ۂvej;YANX*d՚aw6y }Sc#=@MvKխ6=Jid-,6٦f2<T9&<`/qii3j[Z#yZ 1Q*?xVDb0F&Eqsy$蚠/TE6Op;d.fo"+åUWt``\\.L .L@3u-Y/3 y*6owrY`+n=w\̙Sp F+TQcm4eR_ъ%s$x2cʼ{M'PZ=hhȭx Ź]nRyĴ5}VD,DXP2{Aw$I8k?gϮ2EɞT58V}W ]9ЬѣSU~Uv~;>ӯ%xA&4P,wcыѳBٚ{iݓ/2>5d\D4v`h 'j6wSiu@N"}EBpCu3`wZ֤x<[5Iˑƫ!k5X|z0Vm"N\_aI2X]vͣwg oqL"MK\N,nNۄh+4)!mwdxk|8b\Gp_鼗 oLqx\~bbIꢪ20/ظ7PA~_>Xg@ZVs˅Ġe)+QτƻК"!)uY?lhƽ8rؗwl<*,jgԕM)bLz )SDcNyF]}TU]CYhMPO Q8\&r'HH;a?*yB؝>4 ˇ|, / AZJˡCgd)zxd}B-p82gJTۍNK|dX%w mpJ}+n5s<|hNMRX=!/\/'چkHpc7 2(4݃XC;i%дaD@b:Z`=<-^oL76^?&WH /#;WVNF( g$V/JBir䓍D[K3yn3$)_6j̇7UZx2/hlv|tEB#vy o*q+]Eo;5[1t̸͚Ԙ|QUll%J-`m} x"wGf6/&>e0U #˸&Ni.8tIua B<*G >;l!Vd;JK!!ݻu!j_Kh5#jN >R>篹k%;B_mjAފ7O_A$\(=źn 7[`bgXZлJs%1)UhdOn=rK݈?q`iVV}kukMcػN^mcwRO>bnjؼ_lCa&*Nozlnk|&!/sї1AʱO!pFX{ɋ7uG I6m:i%14k. 2^E%89% na Q4J-==+iyNeK 9~AA퀤LDD*GXxKQ|P-`r?0Bـ$gKъ6L4B`vW3Tx{Ř)R4|0fh $ih-(VRŀ BxdoqDvG.OI+;R fnt:Rdfp^OZ V]b'u׆:EWB]N.uxXO|Al4>`2`|ř_s<~'< dzڱQăvm;ۺ|!mk(sP)=#Wj[p%њN͋=T3h,PkH_<(NUŁ(!'`ia7 'U2ņ v .:%IA!UhMc5jD$U:{Uå+ԐM1^zXhvߎer/S{1žnʌABvyndD626,6C{*%׺ I1Qh}f1m޻;{k$vDaZ,7|NLyam"Neyĩɚ\`oɩmӸ>ٲu'1pFiˁ~I%0kABKx:]W[=;9{!"jТH3*-L(WQ/v~gӂ1okCYl!aZMjm/X+߽!<운_ 1Ƚ'*3AG=~Fu{R18 \ ^I\lJ鱵Hvs1Z䏖-~Zjc#'^9L8a(JhZBPg_-m ohj6'u>PtSl"3hludA9m&`-UVΗ+"ā^8232lX?޾|e7VyQY}7#B]8ɴV,ފ{#?"9mdp^'f\ SOv0zrg+@qjJ0mF۠>s?6ck8JupfhōypOݬ/oP:]m:ïBo2W-(YK(l9zH>;B -h7:@{Ks~%>O'J9~psE;~Aemv^%V-iz G>dQR&yԦ͖UEvKԼo'^٥0QIILN~w=yBRЊ9pBz${~@)$J|S~MBk٘Ƌd(\z!fNORbBSpBy2z Fyz$ߪh7˻28 $sQ'I:T-#d*o i {*/h.oy{==ԥY:.JӐㅎ.֫ 'r8Dic OӪ/UTǟjuVG^|,>a71׵.<B8r6Qwz*b$:E|~X5n6V<Ētpt*5?ިc}1  d!kpgd88_h.gi͔7fdP3YUI1¼YwQvhO |r҅ AX^?nY _nRItYffW+zzwOߠ-ZGQ]wp3t-HҞ/XEUI$-0]HŤP^$kH.yZ՟ q7(FeP*K젘Z&G @\bW(ʚ;O103T` OLs*X=6-Y6[Y/w*գxf6Old<:FwO!" ք[{*[OۓHJ{/᛻$l „;*X*ogᑐ&hom5ћ\tHLzPr~uixP? R,;YZ  M!<jCM=-u.1}nf> ¹2΁tB9Į Rj^vƛ\^rOkS)*_ZPf^Cc؛ƚ$V!@*r8f[TVaeTS][/%[t%9iƎ6 ^8{JF7ó2/|+mHSKx_@Çf;#V;4J&R3d7"/E4h~Jco_^ĵ9|\:ԒpAjRD9'dXBia:jɞ=i=ɯc?΀tZweۖyl-,ڏ1KZR? վԲ[ؠˢ^|zk).zmz:P܆P5̀"«֫zՌ)l\^t<0Gw)B *[ʀEn mӁ{9A :́ud%J$#թгܚغ'K_%QBFj10pn f|zn a Ztq/B"fvۦO3ÏfDK"IJHbZEܒZZ qWp] ݇_%8S,TZ[:}Z 1l5I3-fSiО_ϾU)@y\F׀bi#+:g]w(ȓйݠ,ԕyMG$*+0;S.vS1'WΞT EPŗot?j;\EezP&"*wEo\xA\UGҡ mFLjAym< 7p]8o7mƆJ+B5,~a|Ucl0dNƶ MLQx3 QYaBw% JkCO?T3Vа_!VGD-C3sb"ЫBOu˟!5 |`yAgk4 O'B>[OdnIʻ;=u!x.T&.&)&Cbۭ;%vuw1e{he:U[׋'7q>uoRĵZF*m=ѝn~Ii e+ƙ. N ЎFJ#b{-(\oѓJ Dk%-7MV܎f??3rRL'XEFͮ6 =O12iyOg}KfLYR[HQ芓f0h4K 0/6 CU}AsA'PNRNd<|"v[4lyc˰{ :%ՉT( 7VDx^p@H_ܖ;*OwPnR^LUbs19a# \̏DXgF2/~ZG.Bgܕݢ~qYýCi!|F$*7157 fs5R[5O:#i#o \>ER8%p 5M| ~8,:&QAړiDqzKeBۙ|FGM+2e/Qp7˽!CO$ endstream endobj 94 0 obj << /Length1 1947 /Length2 13270 /Length3 0 /Length 14469 /Filter /FlateDecode >> stream xڍPX.ݽqwwwww-K,8Ahi D sS{5=-@t/4֮|Lv.LVB 5@ tvZ(dj0&xJ5/Zx'lA@{w7{ 3=6@]VKY/Z`ebYd ` \=](ں8ۛlML % 0}_չ;]]\@T&K[;]]O 4jcadoaG n̚ '7Ŀ4)9++ t=ͭpS#b:|)o ̀V {@˿;<, `lY8z2)IkYDbbFv^#' ~o/*e򷭬d߻u4Z ZRrxX 7`d1b?M/|lm!HM@^ϫ+:ojZWE; joe&\@@ _ǂق*.?#+ ޷py?El' '} -N0^0AA,fѻL?.38yޑ{f88`rf@V3 l`|wgx@'hߐ=z_\f-]fYwhaf_.9K4+뻅?{\cS!n q|7d{/:5n py?@O9wsЏ{ӂ{>+]n0u9?oESQw$inDVI^|ۛ`"&v<>'u/)>2DGȨ!d#GYƃcPPd=:.y98XBE\2hWF"X:sOy7Dzx8-Ej 6^< <=\"Y*49%ev|$uFTC:Z}@J7nA* `c7ؙL8õHtm)yg1pw`4)/cjC0XTib<'K>$cL;UO渐5= b⽝Ȑ#p%~ū:v?x h l>md. o-Z͇}"dmH}$5yң*,DRQp6-"H ^N.GJÅiX=IuUg|s $\(VT;zک&-1HwUO%C_Gwo~b7Lq`)(9^vY;66Ҭ7O=mvKLV*SڻYimoCs4|RG}e#3nl GCnFb?702N'vRa )& Z +XnU|Km\Y٪]m/1jܝ#+Kz 1n#$e y;mھ eID\L!^#.viZq\˜aۨ^6oEGb_ T|q$ǐ,;o@ vi3PRp-ɒ i"Εg;9SY fGu<#Odq< `ݛM NS4@Y`mP. ƛݹUd̿vfױ+wlxۡ?~Ҩ,&du'̥JOI.+u̵nse nCȎ(SfIOjC4adZ}Xfšw8A~[ps! xPwPTJ HuwB(O<'>jҗ"Mh..(?0P);7!gG!4KmgVJ> +|B/%WSii7m|0֗e%YUj2SH51 q!M|hZu(eXuo%!_gXzMsJcꧬ I)Rjg7Qqf_jx^>3_ \`'S3DΠo|¤19 R麾LL9p~-Mgϧ,CTOF-nlzbs򕂍$[P*TQV=o؃ BEuf;؆_hEFD&4o#a%LƜ,E]=>U ^?K`2˵*yQmVZh2&Z{#nx O#xsf:v VRoҪx{h';a*-L3+(E+icL: [M7H** $xL.}@Vx8=th)Ax.|J׆Q6Ò'~/.<ac,ϠϫzxcF+!Vר3HNA| /i/!$s2do<> \41Qmc>f$27izȯ&0Qe>Rq6bh w5^4҉,K5Jy|bϜ/ (7:X vxauB D@reIEj zPr8 Y @';u:{ezTʵcR/fgÜf;4*j%2i}waĨhC=l狣Z'rO)FlwbnTc j^Fn\S$7rA>ɨ<5 oB#N2!n.K#&\i? U"#+}5AMq@4-t=L#v:#:bmjn:hRi1̢&o:&>=!h@ֶ]=t#v+kKR6!$CzǝM-6Hl@s, 9l>RVšj[x3z=bJ9;9H!u&x Zd]F$q3s^0լHaAeT>{њɿ,W6>/uJ"||+_]0 *(V3=&\a7M(xGí%_DS@: nt>(fXlHTKb/Hi3=s678vz_ EMˬ>AdH>C 59'tӐfclN#ٽ:m1Σ>7H͉;R[.GOjrTQse{4w<@OGmʀ4v3%_؜"~|AM&+,y | 4RY0aNGx*vg@,3V.+R%%?XW9Ǝĵ,jY1> 1t)UGsr UqhU#?Z;k#]V 0$pռQhM=_=S|~u\'>o5`Eʲp[m_04|ߋ[;PuAﴉ$: 3VK/ Y&8'(gb$ƠtɐhFJX,c :rt2+܁!jy<(ԮsfboAqP&BU;Jɦ3鹍srxfjlN¶tH8T^/ Q'=NG+I+>ƐqsȚ _ERsǐ.z<Uc&-GEbԸq=+huF{oQt#3LLBnh.ae}qnA4NY|\PqOHM}Q^)).8ɛ$L(zJJD;$ָXE$Bs1L4ۏXB0!^"XPuI:SnઉMbSR/IK}+nԴ,(>UyĝP20^"&Û^D6%سYPg׀j[v+ntJ#6<ͣs3ߴxexƊg/>O_^.,f_a RςBN455QHYiqt%26aþc^R"PܙmoDRhC!\flD;qVVUW\hh|u!T9HF3g8{A2|eS8? a /V珥͕}1yKH$RyJsN]9林U:K,M\۲"9k0XtҼIO`}^ttI6|. "xKm2^>> vUخX)nGȈ%?` :d9JڪZE 䞐1CPiBLέ/(#kD'>WYwy$pxz)2CPP0硘*$Kz76]?Ejg6FL?d/^O'owdQ:?c*/jiJիLD&pMS-s"wLΰ% {Sn59.t%͆^{8" —z*h a*pfܓp6F>&%RǓwtm;ű>B[Hd֥ PDYRI_ɴƼZg `R֠8!K6T=.Uqԅ\{smʴG]i҈ψqzo ^%jTQ- 1tm,wۭ%NpHPG0޽"ۚ& USCT1IImX؈xD j&z={RلӐfv=n(s:kk_Ń SRh+B]<2 nL mg!SlA&Q!\yKQƉpUQ^ }O.䶏C  ~)˒UPY[ +[1NW]AaʠWjks~o``|8NŒ[Lb?ɾ+!d;@$@PȢʷ3uŔ(d'zkdVs`sB)0 /u o8L G5} Mci221HKGGϖڦEmE**O2XWW{]³Oeϖi ˌ3 ~̫R4ާ]T60#bIc;іZ.}h߼S[r ܥ*rw9M~(`%,5 &qKxUU؁'Sezm5TWҏj\qleˮ&Υ~}QcqCL.Ͽ 'Xt4.]d(:QhurC^{eFUb铞ɉT {]ZM~:z_wu?Ћ.Qv.Y0[q*OlBii6Z޳Y9 u!b ^&JRd=xP{"s36Fb_u>L~X$IhwGTFRY}׮%L|esژ}6纛:X~"NWop{/_A?NZS 74q^~HZRiCSR=,;I=,6׳?jAҝװH r[׍PCEAo0˄U :MॴE 5,u-ࢰ~Xh7C[uE v$X{cEF%RN0%}o5YYθR&FG>`d }iC$j0Hs՟L__Pd9!/ _KҽudWA8RSPJΓ@ʶټ&ZeXR o9_Ӥ48̔t hW%^O:e{% f#ah̸?^g[f}Sq!5=t`< с:Hrx;$>QǞAt,vMu?E jl  vl R! & 7ހVT *%W͕O᭕C'3Dlvp<ڥ 3"][ZԧZ&Q}vUg4Uԛfz簶;)9&Yy|0e|5W*2+Gp:/~sF#fi!zjE\jpũ j7TG0MYO'qcvؒ;| ӹt/ M~nmkd0MODdodX7Gm7X gSɈ'm*h88zIKm|'M\D ,$C5vɱJZP-&0X͛X@哞4oCټDaoߟ|Rߛᮇ/5[;UN'  ,fDl:OR+r7}wh~LJޯB@'qs j7CG7'^E`*a8H;\,uu67jcz;oOI[FL ^z bocD2owܱ!R*bڭѥa6R%׉i} ]2݄b`/%3 ^uu%%KMVU Y 2]5ċkJ#OKTǵ׌f]Żazj*Pg lCnՎ6m&\UL]:RB7:,N|58;mYVGJ~(-fаȶ5ĦK2Q:,is{ ~"E9-[e(l-$mLjaݛ?XPM!sP>H:bƈ|吁$\wP)dѣk9#@|9g"? 0j<2> IRڽrٚ-; NjV>1$'7. 4<(,$ dK-67N^hXn xhbH-  B*X"9NBTbr^кhr_UЕW@R~N*z,} E,DžJYt~%޽U3BNJ Ahg+&*GBC"1 ,kѡ1T#~eKt\;N9_ I.,3W3t1)һ xGO*[6I+5FUV5ʤF|RfMU}G;>Y@(ɎQx5b9k5>]하"`(\Pq8`1ɔ!eߞ1] CÝF$),d$]F{\ҍEQ$Kg[ baclVM\*;of'}G]7 ^:0 ʰbhgh6"G~c#0P@>Tc%%* #ȧ7%) Bb":9 )2jafiZi]zWyq^"ŚB'rjmc+S/խ\&˗.ctZ[}[") W4% >\*51VLmQAF ʝzYgB̚%ֆjHySy"WNaF_7.Wí -dOo=|3Юۣc24Eڄ B*hT,5lM0F7WI1}-Iu O$u|3mVc/\͵E,I#"MPۄJ)MW6|̄J@4H\prLJ*L\p :ʖH&4^禖=Bcu6~\"؏|pFD%#MXcyM~vy{WYt}Oge-H2sUeT.JDHwBSaǚZI$7eY셳;?tep|oS+l ޜRc 'IB@@*ddd ja*PƎ"n} h^-p^q7(f;C4ɔoNŽΒ]';_C! &km ނI#HRb} (tO_!e[@Kg8c?+W|E%0$-]yWb~d9xR1|޿|]'"3U˥Ib'F$ɻțA拌ˣ>q5hx3h Oi;iG"4cR+t|gDuJMȜc4284pmfR&@+r09gkر AmJR@;4kFCR6P.Z>4\oF?sGn13\ERg> ;kH:̠;~RzZ'?\0sK "deU\@|thzH-0AG_.xC]&؉#|o%4Q"bj& c/|)|6>\tGoc`zLRqݧ,q{)=%uQ%-tBQCf (p]Y5ŵT蘆PFagFҷLAW y/tKr \J=a(7nM9 Mޜ|o~ƔcNt?O endstream endobj 96 0 obj << /Length1 2083 /Length2 11959 /Length3 0 /Length 13240 /Filter /FlateDecode >> stream xڍvuXk/1 -H Cw7=4CwHwI ݈tHJtq;suoZoCC"ndqJ  qhں;hPhnNHܡ2)3wd @@ \Rf@%VB#jkm? @v~~^܁`W[ 3PhapWz!wwg66///V3G7V'Wkf Pv[ T6s+ Po+8Z!nP'%ԐW8!+m x@,, >k" 4X64spsy:C * (#4,\mXl~w; tKI'GG0 w}R` }9b{XZnÙM bTGf vr@ >]`o I4})}9;9l?73O0o#vv;lm A*[,p$d~g噥_ͦZSZ韦QKH8yX8@@NN ;/߁TlSȿ\!VN@j' %0H n;wM2Yeah(=ܡ] 6J`K[w78Jm~V.Ŷn2`KU[w hX9BNn ;t]^'nPvCW鿳JC,,7%77Џ` dc8C]VN(&[7Ix9lM)l ~EnСں1&2l n:Bp8: {Tl@6R>w .?.?&\@6g0_^P AhkJp衃p'6'44Z+%fasS4 /5r?jhHg#3.H]kjP 9CϤSqvS3'l\<.;TYCKWи@o6wWj^ZlP ?%@ vZ Wh[M [,;YyS+NŲ=ǣuA΅ Y+/5[JuF^ 6,X:˞_+WprDG BhHg>>r'Wz4"c4œpHow\T* UTsT@ٽ OCUiSGm>Ʈze:7/4&^jNW+=qgZsQT.s"|R +^GsJG|,;yt;d+"q9eoxfO>jJ -'O.5a/*rDx쐸-ÓhlH02侎卦v.1^EwAɱ?$}y@iMN63Mł9iO#ʝj )v2]ߣ 2 NUOIF dwg3  L\۽}'h3rm0_}:"ըi(L;t 8D+!i| ]%UlƢ!+?]w" J$t&V;>ކi]!,EMt$#11{10UP&#ƀ1<8ؿ$$IPF-t%}!*$o4_l/HxGQqlj^DAZI8%VB VY!EL. /Y(Ceq˫u_klNNJk."g$$b׾7WAiՈ%~-G0ltwjFJ~Ҋ*YxmF1[ʼnX1nzghּ_]U7p+i쁜̄➆y&-3uwǗU/{):(K_\Sďw;v/? 6n,wdxf|f)Xb@һ>dg$Á˃ J[݋U}7Jii_LF)@N;/h^cHVm{Qk[tbZ&jZX{Nї"'_^L`}l4'D|At^%ub]qX?H:?zC1@bU4<53צf]X03pߊe@/6yޏcX'"߈|^#8gȚ!x+I5U[q&bt#{w^.m/o$j_xex;=DGBsi7rhf[g%=ȸsF&>E:}C0+g)a ̗Kx4 _Ǿ`hȍ!p׸6:%+ /4pmo5= H"^~-'{.cAa%d"=5PHb&ڝ wdoq>(EY߆ttVY Cxrɛ_Dߖ/yADʄp(?:$_;ffFvǼ{ ycf'L2KԚ 17|G[f-ė>7CiU)|9T(~R#K׸ph)?Ù\"Q56BΜ٫Z >x"DE=5Ke^UgHE;PjtG1g>nc<EkavjTz{w^X,>yu- iFά\Yo#PgLhJ9sƥDŽ`3=7kp |#$0.?хװh-0#QcN|GtJd&; +"bH ̂^`owvbjH> Ǜ':X~ x+2}'deƍ'XQQhDrLw#߮]a.,\`HaVjx7$w#6x6 4v<~㓤X< r2d`;>3ڸq gl|`^7<Ă폺k#tR /z]dmihXN `LtIop^ UŘE@q RDxm/ԊD N>$]ԝp~?>܀^4Ñ?M]@.+BvƄIN`߬U`Dv7m cx=Ƿ#m4 ]g2E"'}!cv#$h-J\zs+#h$TŮjD~w>ΑDliHSEоXU'Q5>Wፅ5E7y1{\TznZg =V85fs$lhWÜz+鳁 Epgi} Z=WsQ q$Q~KwQUR(2>gzoDo7y.xUb/"%A׺.q+UFR튃9;~v3$@`/%(w&F;L"Cܜf7k;ϊ*΍V<&H5(Ȱ]W4f,0y'DɸTo0-23={QP#QbH jwh |O0)Tx&*Ճ=̏HvZZAdF<՘_)'Lf&<47}]ŴwPAijD>+*"$ mG5gTZ);uU qI[Ө,ŀɉq?ڴEg TG^FyfF`*X`v}An1` 5F. #vÓ6S8̃6g1Kmy<_&iaiU911:[;ycZxɦ}UX'1rұ^(n)I'o8~#ƺF7GHdxhR<3'lbO,S[HQo#GWe;?ml R^ >\qQn9_z:,_-鎽dWF(؎B2{U-Nzd:ȟKUXO):yhpmDP8U9CvaErd|[dtAwߓݎr Nq_"21n*Oׅ59IJՄ+:OqI)'{ܸu u@g+< OU[` QۅhN(L3@WRJ/ntb%J%qwo-}pJwқ} f~txjR Q:q?t/†[7' ?a\v?X qjT}ܬ+!u=IduQoQBZ WU aCk׿{°C$We^ȗ. \$);T%G0w֌ sm-]!wWG Xl5&1Oz-)TZLޤM~DV9Cyw1R8?|uFmTT1+}&7%S#G *X\Dp5]~h*^z+]#/Ybƒd(Б@&JW@XD:L8xVMu $gTNje'36+֯䟕HL|8D;g+Iǔt$kӹM$WJs|ʔyϪMhfAs]A]ߤfG~` sUܯ.u_L cپb&sSkd, v5,| Bv1; *> ~M]P&*Fh:8tp :^e;_vCtʼn?uBag`T߯P`J3O<7b}8T_P2%-q-m:8JvC 3/zBGAu߯A1{Ɲ'ztI,--]urn1_#Fڦfܚ-KawX`~Ks 'sΘhܴ jTܒ?& IYx`dY݀=K!^ȧ9r]܋wam'vks5c*V|w +?g#& qVG yaBO/ˋUD6欣"y]{Iט;:B7_=apZT'=:M_|G6y]ʔN=/\HopPKHa,5TpQ%+I$>K)ϵ1QM)oM,z8ãu]IOg)œpSs?X07ڧ>G!+ $JTڄ鮹lRo>AlVW;Aշ2{D ɭ)+1󉫼yײ lKoUf;شU-}oWJ۩GK{fh-sV06ju\@huiC@,{\;,[f"3(}'kb9'[(T !Cfߴ\$V ZK %9g#a1Ԭotک_WYnR53 {}y5?qV4IXэY\-aٴiө4Be5ɔXg qB&7i=SmqB[KRCCB/SsΩ/EC^Rh,S>k% *Ը8JGjxk7f)Y; i Q:t`CkPɫuNvo.5QDq}ZSo(l+_@xDJ9VVՈH];'Յm| `5nI y%Qn#ZL(L>mЏ ͭZؗA$.MMIVIH׌U<H#ATTWnEv>8/~C刞Kt4kOAV6_Uޚ)Q-uQxghXaIT&¤|z8ѲŪI)('~vfpztÎ:uW)W :7¬n/ cvl%W$D='^K8u"W4nM Z3kbBh 7#yI m*rN< H۷,P˾n |t 6|F(6u27Qrt4}%kjGn 駉P[Y#OxmK @U2alOq뽀^k(cKi|K¯/hUB;Ƴ$"9A Q4M5Y E*UWE7p+'IR[eK0 )ѥbȫBfV HApw4b񽧐hᛁ`yᄥ5;>Kq뫑. dOⰍꗸ!aX\gUHmdžzk_|@)T/ endstream endobj 98 0 obj << /Length1 1630 /Length2 10344 /Length3 0 /Length 11396 /Filter /FlateDecode >> stream xڍT6Lww CwtIw4 0 2C ҭtJttHw#|9s[3{7#.-8yxDzʼ<~.> FF=/9 EuZdrV'Cu >& Թ*0( qv;`aqqlu+)3@b¼+ *e傸Kr| >Ev On!?S|OO|5Tw7/?M_ `,BlBkCڮe(=9 `Fnɓ{lkɊߜGtMY'+ylr2"q2_K%YoC ݃P4ړ5|xY33c+W/\S^H(70R_Ofh2\=^1Iب{;;i> xl3@'} 㜳J8FW 7z>Ƞሢ(8u䎻3A\!`mdlp8B1o'}m gI1Yvc?uCڗ)tx"2R#o)? ղI5nR'As_zLq>6L} }_3bY?*܆#TcoDGkRQ*e}u Iu::Zͷy4 V~^^_2$+0IsʉJ~Ֆ;Yߛ "qӻHƵD!K02U|e;6XYr.?N{dIׁ ?,8Ae6qFS&[b *s)QǣraXHjӟtt~-[zXZe0 v3:O3|켴-00l,7.  H_kV_0;hE1Zp;U0exO´q;[KwSl ^`/PkVJs"mZ6Deg$R#jZ8M6 R3oުާr B> a&vyC}h|nRjc~t՞/~dTT3y hye_{t^ pDS8hLQɍɄU$Im{\$_PXN$$v&]"|r5# ( pq 3qxKȪzEx4'9jqf+aymNYQhjܛӏA:CķKc{"ڵ(c3uh+=/n əO/\e. ZJս?)O/-p J f J-!HOyװ}Y>=᜿~-TAowft׭I;yeG椌{R^fѠ`}ۣ7yˌ_LvIœra[!q{6BW*vec8-%(HQ+VX1kID)J{)nHY|\=m[olч3kvD=g ,6TNT\ׇU=~~Xub,|Zf૩k g>u䍷Y~S PYAx\q N>r|1(*'O0L4УB2·0zhmULE%c2b]a &30-36i.z;L*}Ov]$YR6"H]Q&yo/hŴw->HC k/ͫ7:n!h<G\m}zy鲾QZ"Ht}̓T|ZJ>,llBI:K@L|_ čp/&Ʈ:=N1%RN(6`fCr[zMn[\#y_j-#[/z1,|hmiTZ_e.f$9E _ͼ1xMrE"H,g;+xly:]ʗ ]W:]WsP#v؍tI^d/pS][Tkmk̳貕CڱYbqB-Y:̳Wk3J²ZKCGcKlzsNTى33^kņu["#aA˜=c1>%YՖfEDBO6$':3 oC:3#0=vc2Jle.'r8~~3NIAFQTK\7X]fH>~Hr9q-Yt& g4n†5n<E|g:q_ͬ_]ӮIE'ja nޟ$t}]v HTiO}LV'2{vL:;g&KtRqpd<c෎bX̰ʃN6c~:n~a$0#q0"-")'#, ..E3TtjRZ fKTzu<Axȯsiג:I&&*eT⬋j[v[L̑A> Tg9 ŋ@ ;5?:/:\򲩬igY#`P(_ښ+=G.yh` .*)p]hf2z*\]ҋ ,|*&pX]mxd|8s`#3x|aud9c@r)Ї1Nh C3|45~{̝JͺL^bL=tb}62Ƭmv8ml_V!IL>!f=uqiɠv'-a;Ig#zp| ۝ؒkbRjt5{$VY#h~C5(̈́ˢ%YK2ȶ_W*16 BsV}`.G) v=OK^ "'% b1ʢnhYQi.2,.t~VW>>ԑ?dc5[^VN]c~?^S0D)#v},nڳ~ plޱ݈f^A 5z?ז> J鐐R\͜y(3~zvV;"\h=}p]5(čOVݿ ao2ڨ:M @~FR T+n{OjC"VJۦC~2Tm= /F|aثLb7%4¢Y)²Gw<#qGE^{ txvɒ}b!CSa_ɐ׻]y$K7,la 솊$w"G }nҗ(8Qmq{Y˥ ~#R4;J`dZ EK#!t'XȊ-x?H ')9 Gu`1Ca|mfd\L[I?{z֌rU:XE; zD7`[|K/z5]f3YЩ;1`+QuO=mKJgŰ ?4n+WftKej P,r!2]Qtk6^Jfy)gIX>j+UPO2^dˎƋ2wӮMoǖIt)\R=# U/W("u^z?O + z)y.׶ ќ '^F&h98 _a[A黐5aWc]U} xZ1_ ZU¡ZJJC* zN7uׄ>ڻ8C|i0eO$uɰcZC;rρ&@_&3ƓjK'EW*Yče5&qiHd/Q&DGNW{/ՙ;,Ry U*Z=Rr|UpY:=%)6(L'Ntq]drRB~YɭKW "6鯋mlR?ͦwت X wGg:$٦07}d6F.|yL]RH1\:2aڲtg~b5JlIDww7yXؘ2bUWQ8֏y|KqPVVs’eKeijt/Ne?er*.'d3ww"uo|nD`K0Guliۋx!:6BTU6zwمZaQ!OXfzQA(`֑ez wwϓ]4їr)٢:-;ˌae.Y5x9 4LR/GƃI#U_ 1)۹N0.O^m&.bCz?\E܈MI_o9=#+RG#Yt~֏y=.8,wr}5o'K(M*t-j"hvǛ!dU&2ϓTM(S\]O\nXRl?#Y0ubVndKf=ve&>ؕyRZIY>Se )@}|&rH]f(EI'!6oi/5;j`]XZs}4|oKNA>:gȔײAώ% 3{㑰ćRu/:;޾'RO/^c`|o̚y&-> 'D2{=W fЦus21eU[XdRO] pjXQÎ4.W{֏()1+0<_9GzdȳP!g]#~dIEf"}}ySd7mwy,Q)bT+#M&) (T8(r6RzcRGӄZw?P>~@tH)f̊R".Ptf:~f܌w6NA<䗲Jk~kx]5VoƹRxUf MKg@xxfITvAXQt V&C_hiVkn;~vZ9fOnMB9Vr#Mh Z۽7<^wU\7n AF M?/ၸyx~~l9t942 #vJeKg~GʝH]"2\Ę_ [)d=A ]sBY`{L,caMZC ƩHafewu~Qzz :REP mo_]X ~Z!53WmIkM%)z>?+o&0 %֍KW+Yq$fl( ½ڜ+iL?Caf׊enэvG]&wm;8?}Z#4U,#6UN[mKh2vCթP7jQͨR> /k䐴 1} MO4E܋SR?w^M'ط s@{ #b  , 陟^hA(y){8٦; yV1"Ԙ,>B%rFy7*f8!{&N02 ~xh2 JSW>J'-{x^SWD!^#` ޽ a4S"7<'X]5U&߱>ZI:|z|3q7\ԒpF#t$LLH`FjlUvJ|CZvl}7A>F33.Ù)ۙYji-m.#&vyy*8WIp4bzwZtQ:1`X[/7RƢX24E}T^9:ӎZOH %`=Yc~AU^N0p }N*Q[hPFGLcHA-D!-T~6Yw? }UAcP*lQ4o$d?-?˸lM@5Q j][{Tu_v qCSDp#,Iy%)3 XLKYRqWg.wl1Ϥ*ᦇ:) =+ҏj&#^r%TeZ KWPlѴM^L.ջߧTF'Q P;)* tS[rÜzk!ZHV+#YS@Pޗzf'(ֻYɯ- TzH|MIBeDGV|!asݝFڷǨun2TiV%FcoѤkU&ju7,3}*$@1bO ?HFto(oSGQXt%nmpөfކzR!Ξ>]%=#[7^YY ɓ#i ZU~˞ FG nkdoRpC_vah\0hW-ztZ\`{hTŵ9}rT.d죫G"ÚB-,j E?:k U-j _%^ù[P1^-_'Ͳ}ӃiZ1i"y(<(I՛7AceM7t;zJ  )NtZ-JJ-Gk u紭n6J 5.Qtne_6Vڜ@ϵU>amUj-V WHsCxi0ftA?0Еlԯ]w𼷊"F ` .%bY3k'FȿLlO+N s9s` ?Qa BT<&SWδTen&ѵN#WJB=*;W.~B횎"0!)2_$؛j8HgcN$i^=^Ȇְ" lK/tTyR@Uy.{L׼$Bit]rq$@XSiI5/{jLGHy@>E'_j^۱ oZ3t?ítc.mmڋ˒ԑFǖp#q}7 _4w 8ig n?dBim84hE*(^rQný'E.u PJF"M9o+-)KTR *7DK&mlux񼬄S}JxꖡS@*?<c&h~ߨ7 tRSC1Z!- \rAVm6YǼU}{{hڣW`$)n6 p etǝ=pk睊lgCa2Hֵ~#_S*{ ’xqGAwtA疅gwXu_c &8<1d08^ˑ 4#%Yå?F/W`qD'U~L^\;9D}7;R"sw?gc%I}+?Mp48zS#-KpFc!/@*L\tE_yyd\T?k3/~Q5E\UVl/fCx[vĻ1/u VzvLv5}bp~ꚱ؛rix9ٲSn>acw%ESYN^QhGS HERU b/+_4Lua>9e}1ٮ4|T 2u~-@iXޣꗣ`BOv?@b7S֏ufѷ]_P-{ukay\Ԍ'|`U Yf=ewy\lcK(:\5`zV>tU}jHڢ0{fν D ՖjWx<Geڽ),(} Lijʅ+}Ll,𽞞Dž 6zz/eujl۴p56ܨ*qOC=9*> ?E%XW-kL`Rsgc tB)eOj;#~߳Q+r HSDl>Ջi/lFV(QXN=[ 8= endstream endobj 100 0 obj << /Length1 1458 /Length2 7197 /Length3 0 /Length 8182 /Filter /FlateDecode >> stream xڍtT[HH* 9C1tw80 1 !JIKwH4ҩQ߷Y7}γ+6 eG!1<@^~QD/"deA` Yh )3B1Y3=ܬ X!0_M\t'8D/ʵo5N ߯:N/u>^(Gup u0.p:@ aXH¿_V;#wez-/ i7))ȩ)s}(w$ р"*X S1b׿ppK uZ8o [^RS,/wA.ꀰp-ZT}U.`׃ 3P_Ga5{B#~-Q廞/K}.{_9% k@B3ԃ x=0o%x(uGʙ׵|_/C> >@a:?uo-]JpKiXmepr):7O Aޣ|u9Ϛ2g93Rgd۠:;{vfK)fq,ָGoU\@mmFO0{Z}n'TN7KOb%9y#-R-Rn}ͳj\7b%nkQ$}INaZ姣 N9X Xd}Hh=# d?jp~47fB?|^G3P4?=H)ֻ@q. wr%qD=Mߗ2Jxb ߍM 4 ^ɂX v᭖ ~(D <8ְ5tzEIk%75dwvz+V'l#GI[z_\!pZ/,陣*8GI\$4yRv}X(8n4\{G]+CW|R;rHx\V$nRi XTw>g K)ߙQ55/\p!27hp*{60Lh'g=6r&+NO(=ތ_^-H U`dѩv@ rj'rncIux/G!vWѦ֪k>p03䈾,卜6Awdo3ʰ@ݐQ%]\:,*#!ZњIaN&;(}Y{m>[5*Շ)䊴7MUD1}Uo&=!YyCbW3؈{IufxlO^t54lCa. OS'*<*7ebޚj*}:%Uy@Pp"uN1Mjz?>u ^L>'yne풺pt@ILOcbRq4L=PbC#Z(gGַ~]e*IK2"~tcgշzɵMi[ᅫ}G\YWs jOa߻7Wf3rl$Y㍺^@z>_U{&(=F4U`yBãy%#&0x&His]Z5 Y+jp/{:WB5Eo|*+e@Zy?{ ~pi-NZ ۴|F,Qy5DJZQ!S w@}ʣ_܏d_u#eՖhܘdP4JYY;^LbW.cYTd{-/N<>1+`G2Ɓ+;/j{_)g LZ0L̫{]:$b0\ ދq@R0Y'P|':oF Y+۫$5}+@ANү]T@Gœm01Y7UM jjVopTC"mJCטnuUGdom>,}EZ *^tᠬ!j9re#XVY]2<]Z$F|Ϥ㡝 ۓ}n֐'9i6 Qp;9lV>ESugOl֋~- r'ؤM5<?T;sbb| |W_Gc簭BGI%A>E(1IQkFmڛvnw;)ٕLbeS6=0T݋rңȞV2p?'S c),kTd9n*3'&k$n(ɣ?LsR;+,wtwN`yos,R;u0>`;#>S9VJ@Ǯ"΢>>Ư=qJh=6a/[]DJu24O?h齫EvOLl?5d1LhO@n@I kɚgkg.A^\'5'mChr-I-sU1H^<*'t#]-\)d~VCB>Rσ"} ?K4%=2W/p-ЎdhZL?[XI.úĥzGz(Ӽ^x x{OT<,gRH?#O2  1F !i.'o.qi tn7w^!=^3'JDLt*"q]O;j/ƻq0C`"TxxjRE([IO}? o~67,~"P4(*+aDs.3Q$e(HmeͳvShwU]VE:$DA0a#^)%esFc*_ҚvZrԏ)p$dQTh6'j&O}#SSVTq$R"0,OVIbq%)l j1 %l K`RhP 3?+0%=0nTJIzBkE8\1}(c,I- JN= 9[&`Ty̻|g[V>OUP웂oEW~KX^(Cd.|L\77Pa8<}S+HYU ֲ9?V H''{OtA~ 凗\nGcĸ]##BlǍA>E};Dt?d³ISr T!ԉ!ն_oդ {H;AҷEɲ#F5/w.)g%׳q(HfSX\Hp7[{-#33+񾐧 O&-e#`|}(]ygI#eFh͆HF0PTPw(wYъ[h_~gpNt3IRf]NsiƞyN"]sNl8#A{.J:<7?VY#^XH6|qzj+PoeyOȴ&W[lU#F2]QTC,Cn_ \Gb˽ >$ & kai{~BTn tFwGpwBӐ/~gFf*^;$kzm^(zX}b!@_cܼv`ObP ~|H}h2 ؙ QbÍ74J .i@*9tS(aOP{aiErzWTu-Z-9mkrtĞ9kE鍟rJ NB R"ޓaw>^84݅`"zcqʔ]%vB<1"A 6G˪u1"*ރq$_ -y[0*b5Rؐ!W{.Lb)PXTj2';j+Zy5fp6G7BH2o 7ګc3kwCn^2AXR%)0%0 p& ݍ/棩8^ΰ_>#y'y;gO|WD*8X|埡v3o7&޳NGث0WTe)OƼ7{2A/kxlZZbIYu[ݜKS:"ܐ&5f5KF' s0XC@Ejua}E{TKU#ryuaH>:U,(_F+~7dCn+8q۷ {w2J(<}%浊.Ż{{qyVqdb ؽo؃'9H9O/cWJ:tj>Į#zoV;8–=vDUNǮZ鍲+nz'{jMbJJ}%iR<}|څޙ uCA/|gN]uۏ(LcӖݛO99je@D`"}M^lQs#Y?*g/vC]$uibx9^~JN(,G ʊb B.aT7G*,\@ 6,bA.ž.=*)t+ s)7,|5 `\ R_g%XπVGի6/cc#B#_ˏյ.HIՆ$"-(Bd ^}TLNH,U~KHtiԢǛOqEd&^IU^\!J2aϿi^>F 5XFdPO m[כ>7J }L٘c k^> `-,022jn(XY|˜fߓ+ηwEk}3KV{m ձ! nFB~PP~jWE" d4;Ucͬӵ#9'2$dQ@a,Zw1yϒ/5:ڰM;I߻N44ؾk4bz5Ƃ>: b264?< #W'wh؄,e[.GK*=O,fBcKg;Xa M8()xtc7 n׆ #0]YBVwUtb\-IۖAxY*W@ĊJt{iYǕ'vv?J7F5\bYآ{V^σ7LUGQ1eEY ^bC򻶼qo7dlC6`Y߮J>k;2fԃ+E:m,@{ZB/%B?Y endstream endobj 102 0 obj << /Length1 2449 /Length2 17198 /Length3 0 /Length 18630 /Filter /FlateDecode >> stream xڌP Cn]?_'I'?s8דy-kv&fv4Ҩ輖]`o{PV(o^aZZ㕧wZ& `Tw_ ;\8 $~(V?QPݡ0ػpG9Xy%I-X-̕FUї0 9h].BR^c]wrS$8tdŒd75謟`Z`?uS .w}e=NytsoN,b3Bk$4?ƬxIȑ[8?\&S}QP7Vcqn'ԏf4G|Ga~M7lZ ۼڵaXxb_uF'b{XnA [6Tfa ?\V)˔F(6u!V|)M\ҭ6=ӭ1>T]V3A.?sIְ2C…;mx3oI2<*I԰jwx?;<#8Cn4-cxq"ԋQ˛]|/ G{rXYrmZf&Vo\c;juЋFY9Av}j'\0KVWA,U'EHzϫqђ#459<> 9Z7b .Dm_[ KmGK8cX%gX]tݴ{S2rvt~ ,0Nl2|^"xGg2 BwQJ[ml(]e$8"3m͏{%G7ّ[**.t*ؔC)񃚻f$gL_jR貓/{aQ31w26t o}iy8̈́@H~~%E2Tvw.ngk>=oƄ|?o+Ty|~aTES1Y}!%Wi\([ʮ 0SbtoyrkׇN_xn&%]2;T(h"92 \kZ<-p3Sc(~m5PFhv&O}asuKB1Q*\+Êx;e2"zUl/\N6iHVj)5(vi!^%pTC簴,!i!JQ&H2].Z6K Q )+g(m e(ef)sQ6i"UX$?nНaiPܿǢw0O녺˽|4,+q?^lPYy!UKC쇑V*XS_$J.an b]?|DRHh s=UXr[ z VooV%H|ZLͻyj% Ppd^82"2\t[bϳl;yK-ϑ}9&[lFF)}MXyy;>K(qywfO& aN|S6[:G: pL>v2`ǔ)g^B 9 >(hYh`h%z?):]s5,!3-ܮBGKpC]E5k1A[0 ]寞_8e9ФN.&VaKWiHmdO >Y !~5"Կƿ/XsP eh(vϟKw9##U"'zFl{gZ!$<`D 7OƬ}Im%EBȍϱ(c r{UگީSm[>7j9U{:bwiqJ|tgZ0ug,=@rJU 2"ZҼwv70{wy I*,ke%e ܐ!YN׏+9Ԏ{ÔQ4mGJ`+X()YzS_A(Mwz[Ff@@y]_G, @$BSO0~. l"Zx4tO3'L 9;͚ǎ8P-2D_R{? Aӱ_0^ΛJ(U{?9虿!*P.P&c٘fR $b70vIἴ2%8* +qV̴\ %|9rE$$Wb>#xfY>0vH s*N1LaCӠ۔DbsgF9(MFpvuRvRF u&- xu}`Tvu"_Ei߮{‡A~r[edt>3VTǫ)qVE]lᆋf,e)$!Ām#ɉN9kgxZ$l6׫܉4'1707QSvP?n` 5O%Gtu<3r`!>usGcKǐ} 7.qFAQ?bqcQ 2@]hPTL,pCEbv&+NK}Sr?ϴ43ʑL4yOO ׽uVO=.ޡ˯_ӝvK/aX1s[chCMZd Yga+@ãQ8Nߋϴ{)@߇&: ĩ+S\{kFS bOSpE0kRkI9Ľ3i!T_ϊCeOP2Q2Dk˶ }j빆.}$>̂bid΅e؟F \Vt0YcC8z>9K5FM^WZUA]v(XvKS07T*7EUvrսS&}~1YmQZ K]~H?ӨxL Ըqj&ױ 7,5MJf/@eBN0_mNi#fsr%jJe_K~)uTҎCUz3n$W8;)^~#}L]Jv6Ee..fmXi7Suhb }[ 0Q;j[RMJHM";Mqe%/ *m-|nSb/YBYn*3[ N硲ofC)x^CaۡY#~W=[ #)$JxInsLwu<7%SPzEȼgW~l]@N8 =x<"}XTrU/B j}WGuXLSr̃[OfԘ.DN11>hI>v )+(ZYi$!n;O('(dXުzQbT'$^ɓCbLJ};y=OҬA\^{M27 @slc]H}0(KNsbè{wؒ5Ui4SxTS35cv&?'XeanwJbOuMX#P'Lg(A}^uWrM-C6`2X !rXxI^XK % zK5_0m"<0<|)fYnQf>sS>3fCQ1: ǖ߾&VPs!˅ЈqFEC4͔m&cLj!|6A\9mX8}ж!-dNQ~1X{*l+?46TʍF~%ݵu.3W]gl@?谄"B\-7ŕ_uc&3 Wp4"6nU/ݩe;W/UΫK,c3ǣ: , >=(B/Ӿg[ަXfkN ;J⸍y9&m ĠtGP%NtJkC= TIz"{r5~+z]Qjf|Q)bʴpǛf6^9> JV1avE-\"QE[,_Z ,+EjYX"#EI1=AxZb0Ȋ'׭ +1.s yh||t~+Op ܜATuObU9dY'졯5FU27l^}@;8cӟg+smz!rolnQ&KIX*t_~eC7[>WbAijfSŇPM&;tN;Jf!_ }Ŷqύ#e 4WY*x=t$Z,7lًߘϓhܭA-ŕXY}D=wSk)u?-B;˾ K/ѷTҎ wמWj~xq;AS;߯f͊IpI su4=d?a}e:c=TD>B C `a+n. _9)~bn& uЦ@-(c-ajn—/^ ;^%HbSGM OqJa޼7j_h'XfQlRx,^,J)fF3R|/Ӏ'Zk[9_  ≴f^50/Q}G4|7uҜSoW?yV؋{Mh,OX7WbW!m ָ+by^:qQX׵uP(+ >ַؘRr+0sIlSjEsZܙǫ?cT"h$]F+j[ςC{Zy[umoif~$ )5wQ􎳞_ z^J İ#+9#hƑ6vUrg;0}1fҕ1KRgT^!k wSLQ`<T*G+j8l\/кhB/6-NQ .q+iWO&olsBtk6 PY+j-* -L*;w$CowcsE*%J DHi *O=WvoD| zO%>@ 6?Ah_$)Z]x+|9[9MS9ʋ4H}Rس^G]O&#U'Dzgfy7:?LPf=)d!fS 14?o5`7exs Df0#$|da.meOEU%6O1˚81չL<Èd#!|HU6#*H9zPw[[~iE 眀EZ.Fpd1hiFq5"f 蔂@L!x?l@G y=E|)b93T2t`ȕ(FΆ`f f jbT$6s8J}y`VXqb՗fUS"XJW-.ڢ́}dF*^P\y,hhzjFr3W`/Z{g>NzJSe;{%!gx1PA$ r~凡yJݮ ] IP3 h20-īKR$m&{d(t;£@$s\%Ld$5*AR^w֔{_"2p2{Fl;奰@¥8\{sO"t D YEH7#Ό@7`.&I rqnC Mj\8?8yĹ %ZQ0<=HUBC:7iE.N.hUr^>Ib\~ K*OlmS ]b7x#"W2~xZj wl9`>}xݮcËT" dKr4`_Ϊ?1 %3:ͮ& ɭD6s־=~} 1'Rێsj%ܟ]ż!?UqH1bR{s2F+*JiȽo9V;Y~SW?v1|*FQT4O̘Rjplu֘:d(`T$*8vƛ_pA@Ψ.bLʀbK ?1ftҊ]$0 ~qAoMȨg8C );)r&J4NW6[8~(/j }aiH%1Tārdrқ.tbi9nrzU_`46~.@Χ/pÈyFz .Ռ0vC<  R]MQ6FG.4W?β<:}%G @JB~>_Dm~yo-ٛqb9(KIB/ԳSG12fؠf\JVMj|C4K؝/j`ȥ΅S{`cX^xzV|G!s/xȲ2HĹ +\Rs/R~GS~T:*U ?,G߅y`lڎӶ&ou!aCeXQYGuYkwG<6pV'gJUTVr\;8Z9iEx cz?|i2t@_80w4>Spg1gH!Wޫ r-Gueʜ ly(Əo%-b_WՒ<  ^{GFe]2ˡYmB w7|d ,$uto3nWԍ#żQJJ:="jE4[LdɌg#2 ~4$ґ->b*VMp`` #5F`Ʒ|ĴS-LȌX{Cnq.(&_9!sA~4\no/=韆( _kM 7,:Įt- ̈R! .0g^!7&m|PU'KYWc\=PYb"VO-i%ĝʛUã;Y;u K /hVqoSefGqOe cy_2PBF_\ӯs&j-HIpU[ cW Ǐ'¼kBe{L1@GT/RrmGnB\dw4&nh#' zHxfvnng޸ Rԝvz@0bVeH|4 _CkwpEu#'d(о =ڙ? XxHAq6ۦ 'kHgr+v+@2vO&2܆J>{ lʨ.Bh8Vː&cTkTL{#E-=FZ51%>] l5۶Wqs ͻ{W;VeS:Y? ,BfX%QQn|4lY;ku'GfRۍoICF sbPefrz/HMv!V,j;YGskEAYF|W'%&s*O0E6t'_L?)CjEL xf\NIpz8|#=sJdq䖺%b vx^z-n_9[_^3B=}ȸvZ s&>~ Wɦ) uBe4+ÁANĤc; !ň2/4 Zͤ$БYgH?#!J'..3u_Sbg+sgh#-n$~gO-ΉGI_ml8X ts?ri'jb v\\.0H!`-1ez)Zl"ZkEyϤiW~LTDuo]@C-cp"'=bgJ3  .X+Q)GW,kEE#y>Ƭ @0QixR R΍)V u.kk$P~eP_hZb.d4EOq VZ;QU~E%)P5A1#=T3oC |R 3eg'/ÏX:W/"Z_DsLK{zL'>+nV o{\C:RO;}B>!IQ4VDa8yQ /U"V̑NDvaZ6t*㶬{\y-^} t={Z?l wb򑼔"h X[F|J*JC]vb}/JrbgV`("wFl` i|փS/fӛ^"3Q>4Z0rUAħ{gסSݍž7 zwTά&zY\ 2GFc_sT /6ыVdn */ƅ )7@NovB=3KZUd<ʬ+ك2Eׅq`y ~I?*Ǐh횐jO$1>5J R}@mYRxjGn]z{uixԐXFW/ū/>6G n25q[BNE8#L /r[,Us:. a\'#'YED$YjX;2PM) ̽iX-ś9/lzmeADyU21%6=w1C/[CT 0~YvQkmE KA6 .7'ӋK :)dc “Rſl+K2V= *J}e4]3ShG,s`sDm}?3.jTM[aUeS71g77q: us~a ӣ,(pF4&_0KXe9R?T<;Z}҉ +߬ͩa`$G=^ayX9 KAK y&cL#WFIJ wR֧~mѪTYQ-U)|̽M:ΛOώpJ}` I|Xm<ҁ.IVc?ctE˾ ,]֜εج6,pd=D /zJQ u>/٘<' p;T=-k@ ~hTryƩfe+mS%e $/Z9 1q"h/j=( DTg7s<*"UU5u+t$H!ٴ12=GڢHBU+$lh-0o#5 \)ob|I6(wn#!̹g{凛QEQGrXYtL/{VWD4vxOɢ-^lU۠.'鳂E$R-m :%,=Z}Yb/7~T(_Ȩ󄻁!eA !O!X'n(/ȏdջ}M)E\ݏ Kvys3(axrYZOYpV>.tR`axCoM6:) ]PvM_ehBܥoxS8 LvC^w6|fz}7`<# 'ˠfg!PeC{A+1zɦA]"`uqΒ:>q#L$՘נho򞛹jvCBSTi \[mװgۗō^ʵS ~OT{O 9;Wqe+.glɟ<1F ,JxF'ii+|ކ?f^Yï1F> H@ͩ!&j@x3irG$-uN4J  zlotq t% (ߦi؈ ;݇mc(/:'݃M˯avٽ/W:zڦxSեdhC pp4l^Vٝ cr(s Arf0u(H(dy" {h{mGȹٳ$$s+͂W, }  ZGtskNb{>%dVYƼdHf:ʩ@a3։.r.~$#`yVڣ~97ę%s I$1dPGK>r^ܲFP$ ccU%06pkywVv/LFyQ ǵ<ِYZDw :C$$r.*][~1"& '3R~P 1Φ 5yoN$0Lt'29RQdT8~ Ȓ&3g[ Sjʲ*'C .)] NlzT]aNN xŝZZ7M{q.IVxD§i+ ;1p91B-˜EN /(Mu*Xpǘ bdGb+WoT)I )# ?/F;:XUc.pـС@be'?`5/Ws ݗt[#H1 5F11:+ F4N ~}E@^ge(~K3$OphM j9\8TvcʯǃiAq^=2nW}Iѧ} J/EfphXTVjX&GWEk\ P#.']`r<J `4=X{8=zIۓ0GHa'̹+(N J<≙ hؚqDZy ±1Rjƞ # pRO2?e}+ƭ/}My ˩9vFY +InSQhIЊBio/džȵzJh\OH [3݈Ց&}^^ Zmm5VLg6eZ|nulWxvͽgi L$W,߅5 g'$XJ)DMНMk_9>vQ[2yϲHH# &gT>Ǯ;0 SOWx0f߷B.X *5,P"0كh7TPG@d%wv94Q! B' ?E1`wh\#s`Tj eoV@ݓ SG^*[J5r6ZSE{]!TEc#3Ƭؐ>E%! V< PK<%6H[/K3X+}'Ӊ,¡C8nXA/w*c3ț#|t3`P-~]qįS~'dX23Ieni,D[7LrP8.-` J"ăZroTwvDh}tOE#"Q[@g-'M~/Y)cQe6|I 6 Æd&8ƃĔfX (]QhޝƲ3F*x, A42+ %uP̷6XFo2FOnX٪R"(GRD^"U1:Ʋ!\MLdDnƱ7.$3PO J>c _r5qN ޷gVHDBLl3 ͧuG]ICR<7 1'}.G/}:iPo?鏘ƋA endstream endobj 104 0 obj << /Length1 1629 /Length2 3713 /Length3 0 /Length 4726 /Filter /FlateDecode >> stream xڍt 4m~DHٙ͒e(c23fNEG%-U}o)E$hs93suosݏA kym<řHB5AB@ 6$"nGI ]mzXH4co UU@)4U@Cf0B&!? H$}Xn#$H8,02\ `EH_)] * zaKbV:C#XO`qƕDX $LCx FQ*l 8 CJ#z=(T,ٟDv$pc c1,Nz)`<K:ֱF :NX}oTo%:uXH7F՝pR ]M3fF %_No,qmn}BFZS B6wHR&&& ͔FeS%>ܨT(:,Dʙť;?+V!kTV)Hלl ɛ.DǴ NJ2^zDeRjĞV.E608by9'D67Zw3wY}S]{I,֘1Nr3rvYu0В iv OXjDnbQgOɯV_hi2AZ1n.y8c=Kɴ/p͎֚>\a{G9^AM3'C 8%hLCX|V>`ceCȾ!6֐M9/>Iï3\xs`5bwޛ)Hqq.9OV% .DM/<6f8h7'N^iͨ"J*(iI>hOWj|ç}BJe<33:^VK ymhT?V|ycƢEزZʍ}bt]@4ݫ&Gb4 OT\Z#ַ|"zSi^3v5xǽV_upH8m \f&W2&`@d棪oo99H+t[kPys\y %"*g[z9[etU׻T'(J̤p1) ZWEm s@4DC*}&$5Ao ahjbx[Ĉ@UұYH ȡmMHՃo2oA-npD ! jӗjlEv7OC?Dw5V _sXCKaLk-V%RuW ggi:`sNc[(f޽wj{0L+Scv^  穗혯Reh&9s}p œw.2崫:bFNOQ~xm9~ɒyOƼMXy¡oqs{аj њ,#ïg\R#2پlf2ēp_%ȝVVMKw8|ޓӠk-w"_kmB+R.ۅ4HwVhKn3Q1@ײoшW#[7ˆ'oh&`j]8}C"J? u͔t{sO74"V5O1 _/?څ(+ګȞ#rrI :e;9C%?N>s%vUv`ok7U 2f#EIoA7j^e:q _vlO 4*Qt0|MSJQ;ށOu~-$%Mo/[x% JNu#nSu?F1BѦ2 ^J;I|b^% sHro>3v2x8T,mj;#L}v;j$=1 Փ-2?V|uȔJ$cc9GmKV1s0-;^>I=fטPcVFΣB R;Q =vU&DPm續 v4yQߚCB_0 Xt~j caɿ\t2z, aԙZ6)ǐf.w+v4` .q٭I0,:,o$Yrp9~墥lg% -axzhuۋGfƖ#/=/:G[{k\\.ޥiJ*Bhp c{M]4 /c?[d[HX.A񳦗:n7+=Dq X"@`{'{{mrT^6տHa |x5;`RP[+DDZ Խ.^RhirʎFXf'bDcW6>W9W%S7LUl=DW["ߎ5T;:C 65}c案:kP 5kp^Q[q|:mXձ1v]W̚ov&ߦ]v1gƒȃ˄ӮՓYSnRjlo>َΉy:TGU^rKf%eX=c(/hܐں) M *}$]3^cĉƑ#ʇYt9ԠmN]yiӠx|B.W$Qw-~ooF5MM6aakoĵҔ0[j"dh269!/~XRm3Uz\ׄ[M[LF|idA5?Ix>l2ƓLݢHlhl֝sդZdfJg6e9,ZECSZrÖ%5.%}ק3hLls+Kmv rt7%riZu߾~iEa<!*dEq逦[ʎlr>i[zV"v΃;qG|U{k DKV 6:!_qa 6q!% v7)߮26몠Zwj<\݉nH;%-d>OS2ĕӇ?4g.D*-1N4)أ+x~)vfn(D endstream endobj 106 0 obj << /Length1 721 /Length2 4672 /Length3 0 /Length 5264 /Filter /FlateDecode >> stream xmrg4ju :ѣ D%.E13 3ѣN"D'щ5DF^7]Zz>쳟˥A!0HDT`n `P<V2`pb 2^ `@D!c ȹ*➋`+\7"=`tBTʹ @F`N6NH@ CqA- p'0h8oM8?Ю,Z-A t4x5â>_//u'!p$ A!dM m<?wt-w p f?wrCQ t1p 0YP_z9 $N醀#VB- ]O?ڏcN;z?<50 ⯽bP? \""X7Oa#i|žc4׻9$ #d |r o Y {igKX /(lok} (V{"B-XOΞuZjuӘ'OM{$ަ,}'OίmE3;1|KyzI!TB3`eda0$3;6/3?=KqrytnEGu2rHtn%MbԈpsڧ BJ ;`e`FX(8WD"Q/]*\ұaRƨoV@~CM…bԙe3'3'>]}TJT!{QyŦr؞{ } 2%.Evpz#J, Jc9u}-*;\pf4ѫ&wϯ,3o;!@ LGl** 7$WWpYQ5Ϛ5# o9-ͰEq?sHf =R=]q'b."_{88  8ixxs=e26R>-MԜy$l$Hr*ReK\w:(_``M:ǦBԲmhR@NP >ѝU%' 13atLjgt4O ")<u@VoYA38IG 4_?)o~[u.ᅬpLw$,ttQ[ \6Qb})Ŏ72K@w>T8~5,N乁c-Tlv#$I2<-fJLZ摳lru^Pd<=.m1MMf+km(=[3/71,(m}!\.·ڔe=D{ωM^ E2 !w/3+H6= M4A'Z,Dƞi*s\F. ONޜՍ 6 ۹,W!#%Xfo߷90 )!Us*@>i}ޟ|Gv-z C-d9Du1N,tA po%ǞMݩvIeʾ&Ĵ6flVk;;v^-YlM.#&l^D3 KYOhlu9ZM:IQtf\jwwŶLaG|-;+qm@٧ N4 8$ZTcg3-KVn*?CmY;S^cyס8'"R\R.E(/^,j&Ny[뙧}x0Q;>vdJKo7f>!ʏs5hr\TesnX͈S)lY,W%!%?b:I9;D>b60*/꘤p&8y\/+5D 8ǒܚsϩRXKIHdݢxN m& V}ih6{͎Q z|yń'<3reh;Xy3E ="A`.jbZ_+2f%vI^ف7Ҥz3q|Po_-g畈 eWGߚ&PJ/$/32pDqDwu&:`O#4) =lp7X\~\m+r-]hQ"eG>xTh "#Ud5i\*!' xAE@}oU4gnş5Y,tl:/IZo8io'"v){gdXߟ;ٺE+u7{</&Uiѝ*v|0l (kN1S#k>w?{Y9Ay|'?8*Yf dW(jP ]~:e!=0iټ౱]PEf-|ѝ6%~R)'ryhz`v,z5bphѵ1[$1ʪ{Jb~Կ s;_<9|9t*ʝX|Jy~>M۩^L(ݡ ֣KHڪzԴDjt³ޘy&m=t9+r[lS3΄QDgy+3f^x_hiޠdd357hm Oڻ;=F!}7;\+9n"jqK5T灁?"(l ,A]Dn,,fhaP)Feɻ3o52i@{;H8dg%lo VUÜ{#gZ#K 2f}{UZIݴzEW1M;7I^_w󱛍^1cŐ=!m endstream endobj 108 0 obj << /Length1 737 /Length2 966 /Length3 0 /Length 1535 /Filter /FlateDecode >> stream xmR PSWHD0´*"IJ(T6! ;T0$&O*". es%JŢl"D@& u!әΛyswz2#Iqb0]Aز0>d&ښK@!☷@k!XdLK"Pvy#  T *T,*KP2U! Ġ2A|y  +E2T Q1p ;@c:I! ARb\|eA|usCr#T6+r̒ ,ј5%Ä*&JPqX7_,l=(FC!Q2YP)IHO a$L&ĨNFKrTE2|I!% P2:00X&B$%)IB T)?)} #8&K+ȟV&lI}W=wW&5^\4Wf-KQmˮΩVe[+3w$J)=d@j)܀7?˦:lǚzIzs%e6%nRuFܻǖWE~Qq}ď9eh8št{$ꎿ}'\i~Vx]p(;Cx148nH -5U4pm1t:i%Ė.+w5nnm>m:]d_&5;R@Wt_lj^il~ >i[|V .Fْ\I0M;үȆns_l`WhA`,mk[ෙ V,<^uZ>8\秪^_r;9J"'|S/v6AJv{A/rlqq2MXFϓK6>CwyMB+597f]fiÆZޫ{V4jA-8w+Ny׃ߍo`z=J)%CF+M|_/+LgOU>&MXD㦯$eE3;qM3ٚQq>\Y?|dd>18_b} endstream endobj 110 0 obj << /Length1 725 /Length2 15948 /Length3 0 /Length 16495 /Filter /FlateDecode >> stream xmctn6vضm۶gNVl۶mZ콿~=zUWWWw9&=#7@E\UHCF&lfj`/jj 039̌L0dG/g+ KW տu[#S+;+g%]ōٍN*ffWK3@DAQKJ^@)!07s6(ZdL]̨4&VBofή3wvȉ +ȫDTEFYۻpmfh#d?X=#01LL\fV0 MMrfxٙ(E\͜rfql濮FvV^C2-?*+q+O3SE+vuv3Z?s#gfjffpϬ:z 1(ȫ+i O,fo`jeoPqO#gQ۬hd /f\<:J=73#' d_pMܜ]M?d2343Y_q0 Nm -+1TYa^A458¹Wß 4ۻܕo&63;& [y-&~W׿SǶ3sMXRb9v*C`6,Gډ_[|ң@3;F )6x_ wCm`YPx_e-8%s-J^;$tŲ!r0Y~ë p )SɫZq77K:C# F .{=jϝ!*)=9B_nu2`A\gvLX9 uTl47/i(i[t"\9;#!E>#}@ٌA4Wg A2ĘKFS젷ПUsU02 _5d xϳ${zf6yi^5U^A S!}w)!h %SF;rB90.3=ltf_<9Ka(:y,op#E}r#丂Y |/xISؙAXgbER^9 s-'p'w٫Y5(ӕ|3uVARb$!.D 1@0]I2 g#^pTNYh߽Y~tl2 W*TXQj*zl}t-f:nVMoPX"*Z_n[7*JSkU{uFs'Ldjig&kh֎ wA3tݽJnKn9筼6[o/[x ]V wAeDH~3 }Mg⺈w;k}b21%:woQPK"F\H1^g pHUcf Uovey1-غ aWڠxCL|JRzV>= ;JHA[;`ك;֣'-A!W^ aehīO1]eV O \ =V' }]^Qc(%OOznu<ĜQ؋TIʪ+eA%8d$ d>#gشgAnK}W;2(G5}3.}ysA4Ξ=pdZaQe͆փ$NLjJ)?ɅLo/IKcR!q1hHSEzsu3Mp[HR9"Wq;ED-ˉA0Qkrl(RDRT2;]b׷}7C輀썩$ s4|ɏE]Txp8TQ*}XWױZs۫ozMZǛst!G{~V7N]j[vjxa{L뽱dKc݉Z]`a2&+Wk Mv^a&nhkS/S#7R-nKv՝fŧϴLBCr=m8p cM7=۩ej H 6y'{H@$_MWӦ{_^gf2  B*|Xv-@!G9L5fI";1uCD(T>'p}ua$cc }bu~땺W"tFB@ ]ӶVc+U?0|7$:NW6U 0Oτ: T|w^)3)2ʿLXUܞ~c]'JP2^Yn9g%:N_1P8-vЍ'~{"瘲dzr~a7kTU(jߎyw\t}ƠD񪉸abR3|g$#A^!M{/pU#_§Em? 0i HGam4pqh@!#Eb. .lXp(#\u8"*57ҕ:S):e%eOÆfpgq| gy%CHNmݺm^˭Ƽ]IߕXx0J*_s~.%#]VBoKd-OSmf=mu\> :b( Xs'Jcr-t#wN%TAx @"t-'3<0zCVm*O_> 3Y%rqC{nf \a /E #!8&ѩE(g{`^ay 0"0ۯE&ymC#@;ܝ`(F[.gEq`Sn\^A=.#x腾*/\{9ؾ %:;vv_=}~ZA\7x- ؈#u))I*hof1ZOe43R"=)g*̱$D'Džs3c11զЂ$`LV@L$ 芋R? 9:X<O@WrqAcZդa,̮17yBt1f gtǵ'&"e mڮ 2y ]E&͊bc:xjt:F!3.\:8nty}\y?Z~*gG:{2 HBHU,-0I6v!rQ\WW0qaXx-ؕF(ngm( 9FbGzG YЬ /uV_l!Iar#?Ol\7"2 xϝdwP"/B`pϷ(-jК)j(rgydLlJ^l% ie9,b EU]#'s @{ܜ辧Mv%Rq A>tZ Zjj7?ݨMy+mI\3z'F`rACDiV-!vy}]!h^ UI!Qʉ`Nf?_ E'B_wZzl-ZB _O#R7|pX5J)(P~$hlOq֗߉UI};uA*8qp)/ sna5;]<7@ "{RL+.HlQn5q-&\<2htԹ2z.Ab·uTA??eSC[@0C6T3n&, bTU_!|Jy(9ExףV6e 4'>qR̭n$𨪼S4?ή0LzLQb]{& }qe&U2 ,N2J!F 7؎zotwq1hu{*nղ|Tk Z {hۜխ#4! 42>9N}p$X-o`kkc@&Ds6j,z}tƟ"*BflUbQktw3|$͹GŪ@U#dƀ6oZ9CPQΏG:j% (0knb>f7`*%FXō("یGJ84P~ e9Ϛf*NMW(s &Q ;H膿 *כ>p*,}KUhHJ{寜BZ=p"꫚(0#%)XI|C%[ݖ@45QJR$AU%>"|{e-A; <]brYZpl0C#bѨ cH-'{ -A e%WN" ih5ј*=(VA8;x_jD]|K~= H"ܞqV_Q6O0!ve~Rmܪ}:;3$qJ;*MR*N±):O'ah9 Zsپ|.nЬ#]Y=J{V_DeQ|x\/sr$7]5NFp(mLB7S.4f`=F|D, *l>ELa rC 1",/hR;Mr B4*Y9r)`ߍ!fD@MvHw>X=:rϿKܻ}&Ր;[&~Fiz)v$5BQac!788\.\kV*tXҷp,qX79bVziO('UU Bڎ ,keX*ck4 3ǫE6-3I"#~ϕ&y"`6(eGP{:kiEc [PP,=cVCM=jph6izoOxSvAb7`KidTi[EԛUSx^~Pk*<g>tT͗*υ "`ew9i-(pL~w5JY)l͟-Pe]R,ŝ%FL&F4=' qD?q )3q뽽ob5y%+ Ҳw_ᶟTl/nH9/@JD|#HCp-b3oDǗN3l$̾.yFH:D£Dv"]O@?OSyqd^D?E$d0P?|||Ղނ@7$" WPHԠ=_>qĦ6! _ˋ&s7'VD9!Kf+>U.Ө I.<ՙ@"g}#HkhmA,r3ϛUUUi>ěGgrz鼥 #,dx{kHn*xȧ1zWI=C0{_wmsHs2ء#Β-cwF5K/eI<*~߁_q*.),+w |(-b{2Q%xLaA,;reJ-JusȫxK8RdWS퍙} ^ `ŰFK$s,%ǔ"C%S;5 `AGE"q\UXx=6~^g9o_sd XW Tߴ:gسFlp9ҕyO}4 s~L;Nn Q-zquk#esmFҊ͔?U7drў"kwc)%;Ñw{=LnjҖIxL {޳lیUv`GH$5wtN$ J8f> Tԉ̿sb~^v7V߱Qb}+H1PǤYb1<:,4^4/#o@ъu524Qx13bˉN&%5%=Q$f5d" {^ lBc8I)ni+Hf= ZLtjl֪ĕ;Q P|LȰP~a90y3M8e U>F@?OYxm$G#̲F;i_3@8@HOeC%Pɕv]Y[}`5(qz;^yWmY1`ڨeO9;za0{VS͞V% WkC aBMݼ-VWҋClUZIY$(M IAbrm휹V1l_aAjKC]P \zb=& <&T WōG*nG]("50]QL%W䲋us 8 X #mdǢxgt%WR +t4 0:JV!sjZ,Tv> "[`X 2.6u0V~)ظdp.nRn"X%\A"8]e|X -~O'78vIQkN\G,^wbnQd" ER>-d 8҅AzyXnkfP3AP('NalҮ%Bj_5 F/"I;!(-'U # 懏rΑ8 ?5X:\tL} "o,CVo=Ymc4-r ƕx\oN;.H R@\/ |sN[fv)GF=9G׏~4KMpv]?m?B <SQonW/ʮy. 'Vv"3R0” g/1| ,MK<.j5_(7;=ANʯ`„q2Tu&"RMX1 >rY[P~rnsF'gB]! $i*21Hy .oJyܕ|}vhvax;yY4Ĥ tx #ݟu3籍Z_FgI}] BTllC1 KK߅@HTY>ٴ̺{n#IKɡ(AMդcqɾ)D]Owfen;E~clp 5 G}V7_%%,x%Op}zP+)5`7·9{5Q H2p!Qh߭1N9>^cDL>ezgIrNpՇ;p،V ̬Y}`C|vuES`qc:~X I7Յ79QH:ס\B/i/V&>DuɬLujŒiMwcEJ7=~A=q'QP*G-_ {5Iz]O+N>ӋKN3 %~0qzPieA G>3/3y]M' ˓pEd8щHT5N~ Av7 Z i '6yTt'T f2=4ynS׶61nwGu%m.\SHP K7Zkږ? EpW @x@W#3? d(bAg^r> (6ohpp.@=Sw>h@-Zw* G-:Ƚf3E^@:=ٹCt %A[vr1b wb /Ζj-p |=,aT\.qXĉ.s>mqN;z)k+㊸aT?/۾3tSl3VES46o<`Z*=Acppw=hWciJc8]֨}EM-ȋD詝%فoW-zm"<$7Ԑ @`"Li -3qVnn_DFc )QƲ3$ji@@IP['RފvtBJ.)U1diGRԛIךl[78uw%ϲjK2 pysv@$G™26dpMH*7Ҿ-de QL2;zxTsMv5tVE# KFmAI+hwN/0@M<'-cXH;@҄7J  9ʗG/{*[ӪR@A j(5,!R0H9]c5٪9"$;}O(:a"N)F;.YږKȟ94}NEb錖1 sOվVsУ=4g܆l"`E$1D1}tĔ*MÐr"&vޛq:v{$ ʓт!]c򙬷᭱ݍCs>嫦ByeDli>-eTa;F;far2лcS(ceX~ubO}tr\JE]Æ\KFiK-?R;Jk\fkyWsHFʧrg,3l0B}$(\ޒؿE4 Mg[7aҵ¹/IɁ1iWK fQ7"oF !B)u4f[nۃYK2@(ÿ!+7gn=VZ :kM9쭿bpbiR5Wܓ5-4gʿ"Y $3l ~Ja`m +^%+"G~G=e}QAR&2$Td+3mB&223 ojvς /});;aŧwKaD\mMU|.hըݾ,ߥ4~[_P)+ӻ ed 6.HY sj^?FuC"i?A/;&ăd&L|Nmm3\! J5{ KK6V3Y?sު{hRkG_A V0iC/mCZDA3CČALx"tj\[eJSX мƇӏ$+WU+=׳됰6%;U'R⍜ 4dmj#$i.}ʦz*6̋cA u=ZuNw9?ȣfWW!&NLOlh5FUn9c I'Q W^o!#n@c?%/4}ӈQ6]ݠm&M)Kokq ~#$DfR;ҩ]_ҪۿV]zv@=ǹ19{9fZ"qxlV% 6& dG3@bLzD vÊBmĚL8qՅzΦggh4O͗ [.*(KϢ̃$l~%n"15ܨBKsb_+g-}m\:$m[f݉'Rz&]hDF5T|s<~™`$(ܔ)3ix4 RBPl^ <D uMKEٌ9* U2Ē5KM`0 HlpR((pujh+v9FwGkz%s%}?}A$w^!:3Zj\@{Ed*UKl`vHf4$ PҚ#>a4+ Bd1rqA9_^qZn,њ~\*1oNHg3u <4_0*gL5NpH86]|Aou}Ai2GE"_a?NW֨ dMLxVO'(G5Skz㽷Y3}l8~x1e.v%z:c^|;PZܧdΜF #۵"~VGحnAŌ&9cm 5P&eHxʨ>-%Ps_ɒ5S)p3%A_zꌰ_ UIl7]@5~D p 9$R`7CVDnSC^=ܧ?bk&uY7 3,.cwHCq<`iq,* ['^P @o fx%r˧gmU8 0((˸R\c$ Gp3_p˧ (B`>ч |Ug{Hv$Y j =&M|ˮ5J8]eh1\}hN Zu_v|wغ)4 |8Z0Rʪ 5\B;U7_fi !R܋~=)[Qde]g v$ߨJ-ݖEjiZq2)0;N0z1R*GI{['gM0皈$ 3 Jb_[@XCw]L'Ӂ['qSpL..IS !U]h9 ^^EE<2XRdljog< VE#SQ x{{w5`(,:x,ْ}^᳢/xk 86y00B6ZVb@p$gƅ\x;~(o[_'a,S-w_$Gi)aԟ ~L(O~Jzc}]~ґ»{cE-Yч8~8hmVЋ>5KNs K讁sRnpR4Ò;zkxРjP *L ڇ4\a].܅TW$/ &1ųf GRil4X$0@kN͇ +{咀1j5~ nTmkr!#<`*O#e]IX^\ch ' 7~x$W7>DpHz0զoc@?1NtJMS_\Fd[Ӛ>,䄤=^,]ƹb"F݁_{3ưJf-ceU܄ϯ냚 d\ "ՏT*$ !JAb+%(Jh1 3}L{4P\/D~+I{ubA-FQ >%)q6 0kp(;@PP_;2sb*ˊ_.|.#]<KIVthK+q)OF |?qIFpܖA0:_PCXX\̹4IrOlefB<2YR,cVp9ώn1^|.o>K&Rf}bF]ЛVΜVbֻD$M&)0)l`("̣c H O{'dA&ΊA?W`d gCm)5NƁ r<@Bl4dW+[gBtiּ;LF(TEpl \,jm$ uM/~[6w],}WiB2[#Ni'ȶ[?%FJ`I"Bl,j۝W(cx;V*TRЏ@9[+M10jJ}'fDPP@Y75B6 rbQ1EOQ0N_9h6k,=ƚY^hlCC  7 ?:7$xa] ֺm|O*&ȪľC}_;ɧJZ0D@)m_3Z9F007YA"dZθi| lN0\lsL8= S]s&"AHT\Eq2D 1!菨 fA6& YrOx;AH/=f_GV_00x_C&uò)GgNjyy-{5 2.SPJqݶR8zwu7r|T+Kz6nAYt*QՊU?:>GsO,\1TeyhRSsQf k? nQm%\5lk~U};lSQ69wםqZd>u-vr+ oP$FM]ySA&Ŝ Y؈ ZʭDcb1;KJ2C!࡟p_Lv^)pIN:|hݝ)1z. endstream endobj 120 0 obj << /Producer (pdfTeX-1.40.21) /Author()/Title()/Subject()/Creator(LaTeX with hyperref)/Keywords() /CreationDate (D:20211208182944+01'00') /ModDate (D:20211208182944+01'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.21 (TeX Live 2020/Debian) kpathsea version 6.3.2) >> endobj 2 0 obj << /Type /ObjStm /N 99 /First 806 /Length 3770 /Filter /FlateDecode >> stream x[[S~c]RTj&!7 IR<O͸-}1rém][MdYs XL &%4_Iϔ@/c$S^ b*Lii0ѳ̆ c*0f̳,cAKBp!CƌbRvY Y-@g 2|,ֻ ^3t [,8<, 0&H,g BI  e @o!*( "o`4=`UixgF(70AB6L2*cg !f΀?v|0:k;!\a(YS)@A#C4[X<_dp&hrbEB{MJ0/ kbEb/\ t FAo - Gі)ZB^A r4eJ 'd &%EV>15T%DؑBq= 4u6x#_ΏGE>.'P{"gr1QQ\\E^쬮>].MFho\VQiE%x1_M.MҞŘi^糎 ׉Q^׳/%1)Oɓ?*gy>2Ja^̯JC9&w}P'0X`%D$۝JD顯AGjY _g BNHqɾHTC(}Т|XY]Nf'Qߍ#5}]&r?||1)Q9.yyp|泥Va詪U: JWQYc7O|{C%j#Z܈Tgna߈֋aPZ3ęh3Z qd܈Դl3Zhe&t6;Y&|negw~QEѾgۭBja8|߸ %n:izZR-Q0YS UE$ъlӑB׫3C:Bh"kڦ$I8+` q=E|\C@J4ZW"IbVJgшxs-nRlGhOk!<ѵY6PF0Kt%'4v::HWWcqmNġm)Rm&֍V ȬF^T5<*W.uЁJ/95 Htmb[ۈ3F NaH"(\Sv8#2 )4B1C6xmnB]&ھVmEv}5i_,JN]]ӈ! pw'B/RqaђH=,W 1F|Һ9]&XWqOt*&UgEmV؀KV|rzkƠ@ wTLmævr&-IDHyh٘u٠"KْQt!r*qQݤ܏X-oWEhDTA (m3&dl 2YS:åT%$ DjxcV<-)~9cNk,(dڪTQ>ʘ/RERrjbY惣zFMR*ZULyv{AўT]W⨏ L!X'kNk2bl7sɎԎXw QssrxJF+G4+q?Iqk3G/bԚҎ6.MܰRbL`gW 8Iǒ&_d;; # paт~Byw3_~ȏ1S>g<_9]]3>S~g|糜_|1/xˋE9?wNzd]=s#j|D>.Ѳ s"S  _ |:zy9F<<@  o[l8ӏkkZȲwN$KMrR1ż5?~ukwġ$1Nk\Dx)}k`il|^UǯGDccu';2d4mmX{tlSX sG4![{UrRo89m>|wtk|ʥIon\P ЭM\Kl[oGom $ZJAKTR]T 6[dshJ?E>švi^__br>h^K7t67V͛w@:ܵY*p~,l-drcVyo.cMcE2m{p ޿yOd1)y~PlvR/>85*Q[^د)v6NG;3[9Q+/s8tU1]Xu=;C狼)l-pǷ%G9aIrpG[3:(r޿;kv_u) ۪VЩ|ch:Iu&tz]ڲUA}grt|-{^q{2mmKbL bB mU4߿]Xt|E <+Ex~R|#1/:#OVX> zHp|dQ>3H#X29+/ zF_&wܓdF^v';-ڲeen˦SFnDwgb{H]ѪvՃyOC|+ztm#һŮlzhVP~{]_w1/{q/iVzsvCn}VBQBԩ?@-6Ї,kHLΊccճޞNf)ŪGaI-ze$v \8Δ'bz^9IE=%.~tD9wDbwHIu'XveZH2Z٥R7;IFvtǏѢܡww^FX+}w ovMow荮rRT'}ۡn~kWNVe>5'me_ZRMJ'ڬȰJT5#|)CPAV_1}j} Igէ,Y)XV6gcZ)opRuY3TV|G[e,(Yzef1 endstream endobj 121 0 obj << /Type /XRef /Index [0 122] /Size 122 /W [1 3 1] /Root 119 0 R /Info 120 0 R /ID [<5F638C539A947D6AD1397F10A57C7F0A> <5F638C539A947D6AD1397F10A57C7F0A>] /Length 296 /Filter /FlateDecode >> stream x%I/@*UR[Q^j}}*M8IA$88z埙L2""NĉTDB8E Ȅ 8dA% | ~ȃb)Vav` ``6a6ʠD{mCKa Uq @ TmP uP!hFh]hV hENn0BD` aQ+T=ۏvYM^ZMXM|[M~&fԅSVfoZͫKp 8 H¥/?) endstream endobj startxref 175962 %%EOF Matrix/inst/doc/Comparisons.pdf0000644000176200001440000100055514154165605016245 0ustar liggesusers%PDF-1.5 % 23 0 obj << /Length 2075 /Filter /FlateDecode >> stream xڭXݏ5_&뮽׋ }@RN xK6lRi{3_޵ߌͳе2> |ۅNUYl-_ؿ-vfUTe;<_0xIg_h=x?n~x2 UAEB, Th4@o@ /% [jYR 5Һw}Xz #ʄ^e7 rp(*9<*_^~?Q5 DFϸTnh;l9gZA5S 52c-{F}ZPL h^FmjÓ 4=*}#pT>k\:u1vĜNj䃣^(c.R*;.l4/L<ะs> f~Z1BF2&;#wNEb"9,iif(Řއ } }gdilՠ>48j03*u3)mKP::WLna)b ])3f+쪼MMmη :R9tX)CO"{ wʅG1ҖNne_BʘH~Et;AOW=MrxCY+@_:˜^1rr3޴) B$y%ƶm?jÉ/{&~a_g\v~}>4e=O"%u JhEo<35}j1ti?ݰ n+}*mҵo⹴@&oF&&SwNnطerL!eL3ީ.kc-&,Q}[np>Ă~7qocu%!&ozVux\|G=t M@ xf Yqfgǂ_"bO%Vd#pGז{hnslbnU/ΕKNrsjU8S^iZĹ`)e~"eH?(O::֊s8}ث=hǧk9@6cb̘i_a_ ~S[D qS+_ ƔV@Ϙ:r+CN2]4/a]>·MfGy:'z õ`CS(1/@х1хQ,rͱp]e!鯞}o endstream endobj 54 0 obj << /Length 1411 /Filter /FlateDecode >> stream xn6С E!J$K])AX?v%9i3á9 M_~T%^\6Qƈ"wIn M*uڤJ+*݅0] 706000YX0= 0]4Xcx5sSU\/C:Jd_A Ii9@ (mS*FJ-BɬHn\2 +yО#^!W@9+>harlo=׿ /Nˍmo_G75+ÏlVvcp4RПwg{DNWlIu~,[&[V`6* ibJryC `\B_d C\;%ZhhOW̄4Z0M ]y@ iE*!Yl̅@ 25gԿ8~ 7.6E xdm|0|ͺDi \u\Ԯvfrh :~Љ.+"5;[6Sib3#}Ǖ蹫tDۍ/n&|&"HzRBDN3f $f")BQ9yic<3l'h@QO衇:e{AV!w ZQYEgv$Cq*PGeKNrrhՇڽ !އɆXh+WxʱKŽgCJI%dlhɄ/C/$F䊥P`;d gDj !S ^ox=+WreEqY~rRU@,ye#:8Z4B%z3\MDH)"}BiZR+@P0ڗlNr i]ë=%O/^Ov#aexN(>q.TyDFQTrjkfDKv& &)Rgc'e c(enw;77كĝ+U=Vi=;u|$N{HZw;8`iYW@ٷLTCC]@Pvka#aK uȜ64c,Pm x2lIcTq7/BL(lS& ]ΝKC+z07ڣ&+iW2';lMPRmh8J]GY]~_r =+eGnfLC{xe> endstream endobj 63 0 obj << /Length 2177 /Filter /FlateDecode >> stream xَ}Bpl2t$ x_ Is(z<$J$h<-tKQ6Gx+J/'TʎXTF]]rNEqXsZا@ OHr:䕶9eESduv)>ؓx]'& p^N1ɼ`KqzVfYOSffR\'YQY:z9!=m3[xdSDdA&*3SĻؐlؔ>Ц9]vIb޾ϥJ=W -3E(\V<#-'.@xD 7Ѥ$W-J@Bz-?4W={.rkc:E$߫WJ?.6՚bukş-Inݯp zhnv Y^/Kg(wg2DLXMgj() ^ʸ:HsҮ~yl%hpI|=/ t UPEg&rv |»X[Ph{up'&Җd[-;JH\ ^؀OcQz@c&$3 *H ,T/zyU|-fHe!70Ѕ#u,NS: K ܔǂZ#O FYO:d(Ɗ̣ }& Z&|G+a3duA*ÐEH0#u$Ɩ-i}yZ="V~kV$iCz ?Fy:uWBǪd 8J']2_xp<וp1xrG)VIJeء"qm+i*N*/Z-U/CP!oUTb+n5Վf0 UD_k-"$Z >AfĶdl=gӾPƄ"L:NZS¬hbGh=>& 6zL낉@Bpw` Zۋ10 ^NP&b;;l\i7Sb25YiBD t(v|4qjv ۇAd 3,R!7qU<;_j'P\ ϜV3 1>NצF°>`Fj4liK* ":=a7OB gYZF\۪G@긺xӠ!|N(_CYy]Gѧ3d;;$xu+sDI ~t"sOh55/֚WJb*ӧӓ Ȟ<iPg2E:g` (,>q3؍ endstream endobj 72 0 obj << /Length 2227 /Filter /FlateDecode >> stream xY[4~_1BB05 " [6m_ϹNtڇ4s|||nrW(UbжP6Y+ѯ~hl4 j}O;huw]˟_Qy\^ļ& Y*YGPl"Kh^_:z n`%,/|.^'k76)7[D# ~iZ?~ ”m> 9HlCUS JGo@Z^,[#dc =DF 8``=`~L߈dI¡@놧pފ*iZ/lIF~ՠ^I 25]gl>4Vi4 7 !gC^66* #͉?"]cT-<=1sѷ{~H:Ve':[u% η^ f1p;~ia9fBE~aj$}AMR[(UVz! "od*`qR4MzJﱷ_qjq2,ܒmہ*&'f)'P@<rx TڨBFw.L ]vK eb HԊ ߍҌ<[Ս0 Y?Pˏ9XaK 䠓ъj:lT$ wCkg{4ڗ-O{8ş^$U}\9#)S_앙<\ń.lws3ɦNWRv;!&p:A]j@w-,lx*~G8UMre >fT}}&)Fv7,b6/%\BW-wI5u;Aح2wbt!vq'icvʆZ'~,JkstSX{*(u%_'I~< G7 K B? $a:m+t)'Ey <@\ҁɋ endstream endobj 77 0 obj << /Length 1299 /Filter /FlateDecode >> stream xXKo6W=@̊hQ-ɷYqԵ-גI~}áHʒ51E9O7W߾a6Ydq)Yd$Nl~/b!0]iƟao0Q Zx5C8}+X: g Y"@/HI5Y[YR#2E;BwMߕUh?%{Fg^@'1$XX1 H$( X$eJD9 ^aBT-XTDK}dz&x\H WYjpӝYUQ,}{!*XX[*ٚIA#6x;ݷNsk/> stream xXmO#7ί/ʚ׻=U(-p( R+$@tyS(_oC*hw<3cg,aI}UQDDԒ8%,knc#YToDҽ^#_ƒf3֕9C'm\R~Y!kˬ|X-vEsI=p 㻷2܁` B%uELI5S"Ȩy =mp@C.YKARҮ cCcCB>A%$SG ipe%YJLg-t)@AJA"AK#i/{gKFldX# lK]ҩ}I?s$gf 23+΋nBԫ C&boy&$<~6YFOD4 G OUE;F C d!`r!W-VyLndǒZBS'l_'h׾  Yq[>Rb`\ erӈ"Y0&Q̗sF9'P/74/C^q:@8A Ec*oO:G#{,^#tu=RF⬰\3Е́sll#Dr•-s3ۮVCQ~1u<74F؊$쌇 zi[Bfc4,1k€l.*:Uޞ ,uK7^>> 6:Hb*ũ56\?7+H컢5tu^м2wry]r#h Wwh㴀DsgyTXZN#TGJc;huvI7h`F =ߨ[˨lw"b[h5t:æ?!=rNto>c\Knu+ঙxNC5ØVlt4a#A_:zE[f_'iˈh'j~{[ endstream endobj 87 0 obj << /Length 450 /Filter /FlateDecode >> stream xmRMo0 WH*nРhr)qv~H^1 H>=vAZaXoATG]PXx-ol6|;ɟ;DR[ZT֨cɾq7 U6o%+eܓ/i!l{0K.g2"פ'o+z]2;l`TrSWu1TXժ29HvDͤŰ6kk9?rC9/;S,u5+@&?,C[oyn?lӽt-<D骈h-NPN9p4MZl$dLzfa=F|eDW44V -iJd$ "XMעr*K_׋쾬 endstream endobj 117 0 obj << /Length1 1797 /Length2 11226 /Length3 0 /Length 12348 /Filter /FlateDecode >> stream xڍP-0{pK  ww ,q䞓{꽢 ս^  e513)Hb.P`ssШ[9AQh4ANV;  Obs8<Nvv!IW+3+@brB{8ZYX:'e3 f rL-A/&`hrBllnnn&NG af%@rthb k2V_v5#b[AvN/.vf GKq<@dY/3pr?YlBlM<,V`@IZݙ`bgy7q5 -0y񜀎VNNV?Fd#)KٙI@lmAvN('i_7kcq[ٙ1= HVoʋ _9@@K?ҫ{؃ti~b0cezd 8;|~w7BY +;Awr豿h?_/2؁=yl򊺊LMO\bpr8_|we-VۗcOǮ `w.EȋjAE|,?CG!i0O7 7E./ yYjZZq}&/k fgAfV@˿][ف!NV<*v,pz.wI); 8:x\ xqlO X /!|G?&O`(_ `SqTE/qj ɿf/A/R~/Y/i-~ol֭~/uB—}` ԅ߼p_/}~9B~c|i7Қo%?e؜-A{\6g7o/'|_Bw./o៫?^DY;nkHXNlk1x-8vc &3| \sKZޔ]$:hm@ kKTi~4WnGVt V E]t[3K&C틌{׏K*;xޣ>~bֈ(7NHBszUgrx&hb/1w=W*9t `^NzyDፈ\ &2cp9L.\7`#XM@KG^BS&cXM5TfMjwDE mX NZlB+yFWݿGxY('~iNpnY GIژGys1{-hcPV%wh.L nv=ĘZ3_^Ilr͖hbG [-AV*lZTE2Yޠ=D)-LFohA\WA|i˶Ƿ3esY$AEҫ w\M?|R(mbXoI#~0 x \]pä䞸x,y4dˆʂu?i+'we/W:Mܣ[A[$; e~b lG}@A~ mM'v_7fX!z P֬6t{ȱ`L 8Hcxn[ ARLA&b|Rk3eA!r &w%^fLfrSnh߬g=# ᛸsC\$\9EN͎L\1N߈}Z>x;2p'j45oΔ#+Hv*4_O$zކeL;s9p3`о+PRcr9}-}\|ѥpXUDs%[MlMjXCم~BNclzA'I/r) ,[j$ UԃruR_\_\0Rwa<w:8m6RE7󊓮N{2߅ͥXnԇ>$rNfG$ r~}LwFQ3C m~ȲUg0ʖyu(?) CݥyrKDlmNJ3\K ՚QoApgsL9t8=cFE/m)zcm A0 iHTɵ'ƌ!z32xs.-eK9a!!H|%MWû كK$ S z~AdظGF !KKl,C]dj-lMEDEQcy43,IRd魽ڡu;EqdTCRQqD/,O7uWo3$` #qa뇩34^s/4g;K?5:~]GE2~$Lxw.u֘Zu؃=DԶl_v\h+{ğļ$ԳYcM%uen&͚ JQri=,g˭C#Zَ kjZB@=@iP=;wFbi P}.wzzUtgZwlvw9J\2qnqcJKTWA<=3ZԵq:F1?mX0_CGrћ{|Ê;Ř[N4!ٔنΫj k՝rׂtѯ74K5Řrr1x<&L"lL}'F۽7|݈zReIl{SUCe嵣0RY":JK$,<~{-XHzn;)%Yڈ(laW5ϢWk?}IFW4t x}}&2rOޢLAgΒo<9Д+ уc.z6J}B|3W]8E^7}$FǓAĕfMʓY4J '*i~+:LSP D`C%cw{wK1p']J|ZcݳUť,ڒ<ZSEa7E}oauV%3qbn_׋x!Ll#qKyW8Mex:]M q=P8)`m ?2Y"﴾n*,7 튗Y!+)P+p7ᐰcp?)e,EjY /"V<#ʅv~cůdJzw럂4d|h8rh:ߌn uJ!Sv"k I(>U_Nl3&gEamKNfp*+@LaJoH7[gfa2\mDIѫ'J0@0ѿN%xېr7v(kޑOR%>1H х $nt2"[Y1\ 4u9T!RՏfduZKȓ\3D$rP*b# C ^P{!sTeEGrQ#O .256t<@FAci{F"2(+4ZB%vqL u!R? e,FW&E_O>n}ƎV @ڌ {O?_f ɎLus;Fba<-X&Y^s]b LZ_@5bxUP8g)5Xp(I:hT2t, Ba;F-Ⱦ[;!Cm9!&}8x/9Xd薠QNҼJL -C:e%`GFqPXNYvͳW  L `i>nِ}H8nJ*URByJCQخЫ@iTs%j*׽vjsqXg;IG˦['؊op[] Tp(Nmi,iCNB2e| V~a*+_L~bmJ)*ۍxȈ,B'rMkĻIkŵjXdfn5Y_ ON !‰N!>T,1,~] įo;y OПB^%(?n9LF<9?DtG'?"pT5u+m6eRr1\/?QCsH.,u 7 |/h/Mƻ}I1}ux#iнr:ZW;ăwZeAȬMiȖ~BkEeccU[ F,5`c^$Eቿ̲NTNwWIMvgsG˃V !G1̎Y04q@N)'͒I[ȟ])"&dnO,Tp«át$Zt]I[3ԴZV[?Gg4s#q%õN偯w|cX)+gQS]]w K ACZ %5oeSG ΄ESZN\xi#D EZ7# 1rtwIx21/S׫Qv{8a FHYr's$?-uH\wSp΁wCoXۯ͏[p;ĄB6ZszgC  H~;ٽfZ!)ָY ekM`1,Bϛ}+4BJP- ŵwZf !Bcl3:x$@l4Sӟ}G`nbҚ߯8N+]pF }OcˬuS85NIS".iYPyhߓm{S_*C|)8_)+ϊ7K϶?y {UiF]Bug599 B|3c_"}Ap@ r{د%_M&WMGAњڟWm^eIuKEۓm#Wƪ,2؁$04榚ϭpgJmȚC L$Wb8{[] Id#=4y3aԘRU!evQ4!fS]|L:ʼn[m D`q߬~;8X;5(6|gz]Sjԫq1dl *nj/NǸmb' L+̻Vpe}Ԟ%/ X<@ƍWB8!UgR6s29k>v/y76MugRJ^8:vUŲ!37%>z `a͇~W @ꕶ(Ci]Jd1_$Xzs1M @CE4[w5W~RY1Dޯ,ߣhVs9glrx7^* dS~R|ޯFo>!Cw#33Ɓ6~..Ӣ)i \ws_a.Y~(\[y%>xؤ=z^~KSe~]'Z<$@\<:1Y_,k̂fQ3&wwrc u0uү}$p \2D [ȽIQIISPU:l2i5[ζ9A{N=ċ ő˶, e' fd1srkG4'N/E"ۡ@o.9 .clOqrQU71] 9 3V-G@<EXC;(&NP=Dz@Q'0s3z'`qԊ7V435q*ҷ7V;/1S"=tLA:~pHR]zB8>|tuyEyΒJ hZXK8jL "gq:ڪL_9JW1f%M1;p$1;ILr8 .#~`T,"sHѐ9RgB<ѾVOGF!ؽـi{IȺJbjb)MB'2V@7!߾ɛwc/t1]G"7@㣎zkg%ob{b:vhWTvPXb ̍bM|(tSTr6FI_QL亍fz-=)fƇ`OxT iѤPdc]8+5i{zsݧX,7ho mŇj ArR`˸žE9H/ǧIF }߶vɻr?֪8{kK/)t]m4>2hV'_pڏk=-@&xդA:[oq^$BC_'+6mfV܋ڥ" tݎ%i;8fG5,X-i!}0 Ko|ҍޅRHȧ.PNR l?zTX,$hOe^.ZV0͵] c$.O1EU FЏAWOY K~AL>`H)j"x'sY+*-7{HځdQZjf;EÚV=Y@%va½۸`eg=dɤK|}V,ЃǼNۆZ߭BNMWy |ѣ?WN'Tf9Yx2pP#5Jl˙V%49Ѣ>-L~s[ػs)4#|]'vޟ3k?/Xg/͇e(8ht7Mw!5?8N&6AC[{R\YF>7CVI+!P!C KSr4k8$H@eH΍"F="c<0F\dQ,kSnPٕ&Ũ4+Gzqì0m T 6|39̗zG)isDbdN%c"hbP}K5l~ijE-XK ;߭_%uɼkEH|f]1y,ǿg"6|Hn9TLI+}m%> {WU1W1 tD;Dd2%*0MH:b߳d2z"S*^<-@(%EE/Vhd+AA`d8دK1q\mw^}P]z,?hתꊐga|+~=D}Kl< ҄-7hw "fnUb凁)$mͪxIN3ky׹F_ٹ~NpdB *l'EFk+xk^$\˱[ (\¦dK,c&Te29%MP[dC͡o.k֩:\btҭVs=l+|$cڒGg-7ffO$ 6+؁Miivɒ%V"[׻r|_;ԗ.=5#f"wEsWW>Q_.Y$ ՀOݤBae'd[˄*Hζ}W̲wԁ+yKSO֨Ґ ^FaWup yZN9&j0@5&ꏃ͠8qFZoG-D3d[PRs귾x"+R0jA`es|0\9RMqЅd1?=n'"o@.=W /< 830i-V)W+F@$d*(7ndjeDiJ<(iRu2VܢvAUwwQ$Lmook_k>&jR=mH~c ͬBQ4ܕBU818 8Fk$tK #{D#F*N"mFNi$N5u 7&w\SODuKF?"L}O|2&:zT=,^~tYsJX6G-_XӍL?2)aqvu^G&gn'{20 ܵZ7TlW@ 惒`2k.+u:ȧ_2kѬɉn4NگSK>WcIov%#jJ/eYb`#AbqQՃ.mXd%SrRDk@JlP"u,uQ:7G*.z_5rI h&{LF%ItV?]=p s87MTl=3ˢQ_wQ~2,MW5`9!Gs vUSRSk[5gwx]} >kqV )۶N<{ؗO]#oj2db2Q)ّAoc~Ml=tpFڰ62Xw(|a]S.q !#˿»5?*rhIt^gPrr^OHx{W}p<;f"H*w6{JɝDQסiC(~?Nk3+P|e9%A0| apӶxn-=өZclfrݒ%/3ma]C|ʥ3y?(:SĽb ;ˉ4B2)sE>,ū]9gC̬4S-~$|6Z[ڷ2NT :trG{@+ZJBbqp%2iJB'Ba.jy@{-5o9Ӹ~0#{`~S.2( SUN;(Ƌ lkP4$vKa3SF y9sG|C`KC:$P'q2ϏadO)C{K0#7(rWTOA^JzW|Ro]cRηh涡+ Rv)O0F<чN:E?ᕎ#ӻhap.a:s|c/5>ﺇG% _R8תw{0.Qb.f2?ߙ"%P)MK|-Mpf9gq4cU$ЍםoUHR-Ppu(5RzG~6[M-^=K=4O&g9Nyc.IB7,%z{80e;+)FH8j\Ac婀ڳp&ds#P 6̰MFS6%<{,;ά_z06¼TR_$b(UJ#QM$@{cGǖR3!JXƯ0K/?)bYL{[c5=l*JA覙F}Ax6fJuo0YR'x"jǪr=lWQ N`gمedܵA;>+ϧ7"Қ`:礽~?K&wbz3lD 4)p#ahPm;L'0@gد]%Ue;sˆ[t@X|EL^ѶJ*r_-v*eIi?$؛&rpt㰄~40sfeBiȡ|*E=v]Yv<[SFk:EǬl?ZP_ӂؙ .{h .ӽSh= `Qޓ^)M"(%nf&9OhIv!Ycau:3gBbo4cӶ7pAn >ML(&=wZ7r^\,'E2A?tXs_%xL2oU<tD}<'+gNqt7 ܕ*lzSQ5Jh^~I.Բf)Z#ji58Pmdl9@!xgCl 57 'cσ @h衍"k^&c endstream endobj 119 0 obj << /Length1 1427 /Length2 6141 /Length3 0 /Length 7117 /Filter /FlateDecode >> stream xڍwT6齉H5{!$BI z Ҕ&HEA@@@EA={w3{kLPpj"(A,@@(%4<ۉ9-H_. 5$A( yb,PJVD *""7a@s!0W7f?<`^PFFJ;@ Apy`&7.9 x4P]FE`E}d$gs#;Ja ׬CwSѶˢigS 梾=LwlYpߍsU7st>/>dKsR;1DypK_GjUߨf"DFY"njE>P|\f#eoc&z АzTB%f7PP*El^ϰAuHJER6zC9GJK\HÖW G|R~_TƝrM'W[\X,/M6cY2. {,R.[&N+*"̮][s+#=s4^z~9{~X퀇՟&-;WvtHt=nyNm HԋRZ!=WMD[]YS=y!DP2qE>.8^nҠ N~:T ]t F^}ZQpKɟ?hnEwMi7N6Yd;KτmUnV] ;"[쌉x{#NRMǻ6YU5 >Nn$>i3pCX>%`ś2? ?^07ҮZsO΁vfrmɎ(x:L}0}9~L~r SŞ]ݜ'd Cv#rLR%y51+(ʹvMjd&Xz䣔6 yhXRCxCӊr=k_,qꐻ5nk@u̚XfIcXk_ޅ .A"};FJG ɶ 9tkeޜz Y}kτR^.EcҽRxQǼew4txgQ,&:_옻P}e-|\u#2jX.1/M0͙PE3ö،٧OX<Θ .Oy.¡QGoHX:,l(L5l;6w ,oҝSy9F3=_UE_wrpnEM~hxr8J `ޭ=4"bTVVB^$=ɩ]S<H~8W-1= C9~; o|XoI=jRHZ)h(t|N}.7:˜]sX@>PցȺ7<\e%zgo2Vqg=nzmFa ;F M2lr$sKd#Wsm G -ZqT_WFq9 )Z-qP.M7zpoFD76sTL70Cvnש" 2=bO_[mMagMc5']]. UT%Q<a(WO+i p6\WpY<)8=6G8REdO%Sr:eC*y܆NGuV53Lelȕ!ɓO!((p=WrKJIWu$崇BA/`VbD脔wرh䘷>\8T9=b 1poX1fu@^wBV9ig'>񚇫uə`|OvѨgjQ mZ2aMCOSJ+l4mA$l|n\C/Ej*E% z Y5TFeM'-ح>qX`%1fH&; w$D9~DK?, E&ޞ^\5oU %px1vq784omiB(!U7MZÊJ9'MBIUaz|a;,Uh ."5$NfiW?爓Je$i/ھ#=ILY'{.%e݁eWWz풙iO2m}:حn&0fkڬ~yU ;x+mee[{Jd*|n,E͠(^p>9&n{ aoۖ>`[0P/ۚ [nhdVMXz?]phT5ɔ)մԡ¥Y Vce.L҅L)Jtr$XWWH|e!D]H#acOcxpA`nFh>1V-I=!B!J:Qf}B}¼LJ\nj:nڈR $*཈ej>+\|mÒSSjY`;N *v0vKc0Ҽ?@и75}N&%hfftkǭ{ɆP'`ZCr˖2JVN}#*gyi雽>ɂv2xcYI%.`9M$h"4Cؑ,_pyLvḧ́;yAD9ٌE0 hFޓL"?sQuy%@K]2ՊsXux x s.Сc^mM+\Cu^kiP\1'9٩~{i]'w#) #/,RL=p3zi@hy5Bٶ~5M?n>O| gaSکn:"fzR$=BK/| C$%(mfr~ưimPv~ .>/ͱo2h>ϳ;<$@ YwnIdg&m2KMٜ`6E3]`{yiAvoN+[+2yUI-Vf0;6^$WZ%e6kW| B :{MهΝ:e^ùBCNL_gh⹯6Q) G<}foՊyDfb݁;fWH'$|ll"}Wqr9F:%EGU;_85.dh%22--Ndczk*{K]Yѭ `ty'w?sh ݺ]vt5~rEc/N{tA.4oU|Zp1H4cj}wFW5{DY`@#~MdіAPo,GO7BPUWR^OfC,ԓD>V}oO9:=sXDrEj!2Sj_t6<vw j^!_y}q;,~Sߔ0ib`lqGWip(-S!q*G7'' @?<ߒ`YzL+ƒ:¥XߋCM8^8+YskT23=:lezU ~(;ƒy>>cne k,TqI!xQ,[p촉Usf8~QJC w ȧ"Mi=5ckܒ̾krk<5ƪ]73I7o|QH{N§hk.m:u1лlWY|7$N%7R7Ėџ8i|{yt>i][EۆvOHƞSpXH/vK@(;Bi;K_vsTŦ\i_ѨZP2Z-~g%qnw5hK]e-(9ooNu(W$e.T% NVȳ%.)d-G3 GTjεzFB-*^*Pay+%+V 9B]-f5%pTXGĊα6Vo2 uqlyX)\Zg)z6B^؝bT\BXzPo7#+JuI\㗛 . B.i_" E<B7q~kܳ* F {+7=b@DR.w2>{#;0_j>yragV>iCнDݨ:_AY $!IkGn0 ݬgbnmD D;. ċD#T|gs{oh5='P" i:Tm Pݨ_MDu%zU`s )zh xLa5_&Ɨ WNWw3Z5+P;_<6Q /??YF?̮3qKlvIs$nb&]mXI> stream xڍwT6 E*QCHh{HMB@HB ޔHHS(ER( |{w{f=白p3䓷CA`*($(jk P$0&0 BJB:%0F!$*/@(@ h4PHCq}^{.0  F8G ~G(0DA0?BpI9ph www~ qp0, ,v)`6q` W PwyaZ]4 pp ~п BQ.h0t0?wFX#O}X(ap~2NC?Sc`P{ i3[#a-`>+U9p}!1:  eTkF{|0_= "Ƃ`!? A @`p$02keg 7Wjʛ)_FOH'(b?_u= 3|wnHgB S7-"@(/F_cSYu`Ď]\M>d3vi-"Lku;C!5:>%siim(Ԣg75Zc+˓hˈ;R=}44Cq4ʒ,JWMQ)rH^۰*N>q\ٰ͕~6>똕=M[c#I8Ět̖~fu P3E}w0=xK_}k9ZbC HYR^z͎Ț> 5Kul6)n7tS ~R`~%|lUsҵ< C5_=퓞d $VpS`*-jv6?N8%`~qtj3|KX;bܒwݨf!r t9Ƌ I6ўg]2.4k yz[y7-ъ,.N\ҕw}1e ~oZfƜ(JoWHşr`f͔bha\lnl+ϝt_1p.+'#_Z95|:fCŌ2Y]Eηʫy|L܏{2B a?y{:H Q Y\NL;}=xtim`tYA!g?V}bfe|)ݠ7Obi~J=[2GWdd69]/i',ϨڄĽ7P'N5zpcʤ7Ĩeٞ$R v>,ž9ـK5FzQ# a2`[;dM,=O5PV&͞5ݹ ?m]Jlh0byV*[#蔤kݼD~qVSȼh@.e Kߧ詛v_e"i#X+n:p;!yZYRU$KUBW<+VU;еr=oyX7?Nžf<.| $U+e: :3Vr`EBf^l ZA -wWnS<4'*},>G_eS&@fEQps |-7HfpƤ~U"vB|x9bS=~l]곚yLEe7ږK*|w2 tj 85,g%㴽 'y [0Ud\_$*)قѐwrG5N (g?Bc eb0RlB 뒚~ \,)~x 9q/,ٿv'J9-s/ _Ͳ-eGnukŶ=3N8Xh!NXz0ә!A+6@U WcNgSGc\m(8dϐ*^셭Ɵ4 dUjj<'S$敞(uNe)yU-DțM&uIxz!^)<3҄ڴB#ߟQ'("n{p;VF7 F U_ DW@fPę+á3"?2K${flC'WwSGlP#|#LM߅xƝvd)Fd߮Wl8gZJyDn^הauaC57m@'y#~WY ˂Rɏvy".5ǽe#2JX"7CkD';HX`7<:Zz FrWj[N&Y]@QeٰbʶdJZtׄdј_EUkG!3s4d|UE|մԵ*A ȥ EqZD+HJ$AN wփQ2!*\T KCK]|jdݣ.Bo+J\Ɂܪɱ)t̋Cϣ1AO1Dv-HZH埠!q眏$@ʦ(uhRMO/΍ 9xND-?),$LI/EJۻ;p!YxYƋギmySS3r785+[}ǷȕȼūiD/3?yCsO>R$M|2N .Vî"^E-ƅ{lKܜ2<p}&/f֐ܗo/PJwZ8~Zv.hAF7_l('u;e)6J2Q|VCcP>!+#6-2%_5=\: XK3b? sWʛ19\j2/az3գ凟zƟf}^b!g9:laJJx[5x7%)ͨYGKU[ȥ-zvٝ^kc5[wJ.ڢibdSsNYGWDV=̒je!-U*(9^mi:@OD*4)aT`{dm(1{=ɻnůb4%FNgoء"_g7"?OʅN[R"+&yӝ]e igq53ǫ^W$cl1~?j :VT]Z&e"\Kft`Yj֯EhPw *4z~lҚ3+ռyKvA2vh1P+gs/]kyms1 b=]X4*1r¹"4FfGz-jUs퓦Q1$D{_V2"!eZDFD3nXN2!I⻤MJj9^BhFz [{=5gjU$/r>)#g$i;+d+ߒ7՜.!^r `?%=EaM˺Y ÇIwhPp_Y^f&8f,$ߟeqj;5=4 ӍWյ<Y}*Hۊ2u(9݂?[%'e4^"_a%)MqYu#/14gh{;E(tw`>{Ϸ(Ć*)}>G[uoqϹ~XVI‘%I{T4uGMR~*Y钾H>M)_`xjIi}ힴMcWO瞊ꒆ9)L.ɆYV"~CbxS)q튋ixH"ǝFvZi wc[5wz8Wea{W1U}L %[0]RmZQig]'GZW Œ鋤 h4~vgdk2-̯#ܗbt6c=BӠ~Di3cFݿ<Ǻlu Lh%pJGv6^jDGj^ɠ;hi#!4/ksƲKITtL(bgw*nlTޜFZ~˴.ozgVeJco3 Bu2 x x(Uޮ1 ٭hr{SFnA61X[om7%&?N!2Bx3SԞ\0`@KMNaﯳ4~RU ?sۥw{TgRk X9 ]ByLT0zb,3x5?rxOKެ Y8`XFbI^Yv2aogVd˛zʥ.`d!^?j@FWv"JlƜ'Qz\euV ^E*Ko1\?|Q.oк 4w;nοk! (񆝕Ga~gAዤʒÈH;iw ']GFU?JMP NP/ӝ._]䀹Dl P%Gx1]U%id,Jj%H?qR Qeإ g !֞ Qkw H9)x>pf{gSm 5;LϔmVKEp!卥']t5YcN=ROo-6l~>~`p^O0]g endstream endobj 123 0 obj << /Length1 1375 /Length2 6603 /Length3 0 /Length 7538 /Filter /FlateDecode >> stream xڍwuTT6)! ͡A[:f`.APBJ@ iRN%%TE}k}:ksッ]X@mSC< i@YWWS @ AH၄@e ø#((c`k FZH,ť  IDc(;12ptN`)) ? BP. r Ah(_!xe<<\!.h?p`04qӛ 1`pb{xC00ZD@a(kO \5u}W/_~w 3 EBP#G a?A9Bk_ u7 \=M s}Ϫ(e N>x_FK#Pߍ8x G!P')L|]a.]ѮX C``a_ak `>蚁`dh?S25W4QO*)} ,`q@߁ _M HUES4{If/ 7٭Ab M?.7&.I .ߐkzz\.z!PjkHm\/"`QA_z`:E32z?;* vHb_ZCS@HvKh IJBU$0 d +-kG0 J< \|V[`ePXVa1ٲ*ךȁ#WqW~,Pn ]?4=HiƇ)f@H`}0w`e"kC]in[g0>NRR'E1\RqlUPapƏ>a~lb:-WM 1vU_!)e}i'Uh֘V;wB<ΉLm0"fJyu1%gA};o$\o^}EC]dc2G&!z4ݎ [1iKӥZ4ڂ7t98f ,Lb+_$n|7oͯГ;'yӦfU 4ӽTY3Y,.64dlYBQEaZ!-An2kȇ.)ʽ;L/FI~WPC&fmY%cY^5MWLZϿ\>.[itdEF+1"1h r5o!~lYD<[}o{N  ? ;"+ ?/ƍGSޡt*.9\!>NmNa%\AgϾ>v&#?̶~./Иn<$zn2t*MGm=;hkUQr¸s?])[ ;|xh#ŲPSS +u1y*hͮߔg^{7dS sú JQv|#wPO&>:*Μ{ {1/;0ʻ!z,=_KtMG0цGg ŗ';hcRZ&VTg-4<::mL=(a64}W|4ɴBZ;i7of~)GT&mSƙCbCTD d0FŒ{2g6,ש/_۸9AmgAw*Ck-&ߴzbH8xj'.f{koůǏ'|ܹ ׏9":36m%pu wnW㼟&v+! R wx4\ȱ=PTLbu^Fg:ZxĢO6j+vD=:M5w[(1]G㩕o*0'7YV RpO)Z9A(Zޔe_3#Ε)QKMi> Ѕ ɉ|ҺSeų%m_E M~jnfA?־o yËDTM %1 N;M= ߈;6 'A&"ùS#LƖ$>dY#/\UOl5j*#<hlb_*aM|,zu&-MA4&4oTgN@zh\B24Z=MȎ,Ǘ[ nL hBsʇ|8ۇ;՛swX~΢lXfݾ^^q;Ij{ 1[%B?5+`RO8BuOCdEOo jg~O˫ۭ?; K۰MAklZG˓55h}*]OR&O-;¨G op/XqR叇Cuiy~ uud_wj/1w;ny})c>y܊l<tM2ۖ1$w#e'ZDh($Ů]fb=-SXw=\>hf&ozvP89q~6Kf1P@Ђ ;pK$Ҕ~_hpSL8滭G?mm4qCy2MWzF;_'mbXc j'7{7xV[۱ 620կXF_QzigsfIΡ`b!/tkhLS~37a!\6Q.6ݭ-`ɹ6$` R0e?w Dv50~Ozrԥ38EEײl/qW@PeKMq߆0>m7y ~9 r-HO)O^e*7n, TLR 79? J9:y4 HȦ >ғ(EFwG֮CV)܍"8/QMłUi6F6Ir6|+R+Լ>؞VM6zlj2+Q|-2Ɗ^ڱREa- `,j6xG"|rgN ;DL穊}f̤vr5#U 40T|D%fCD$$:A 1!cOp,q:LwLIaóXM-n  k܃'<4i빑BS@) <(Pav/{kJA?7nП& w.l lvZն155IhĭRg^"/(Ĭ޷Np7*rrv+,aNa TxFrԩ>C╌NC ClI8N9`4D@FssI~%MY(~dt$$&trkbQ.Ry'~7 F%Yh+Uqv+PŨOØbyW*/ZR'i@zfb~툏_m!liY])lB&>zQ+4j"Ruc\ݩ/)S8.ܖ~PaPDrY|"K$vZn+ކq7tg_( VAVÕg~*Ov|<{3%A^R xsRuּ6/oe+as.0/c9t .՟ pCUxXTlgx7e|O㫙ͣW>"~b(`٭wsǽlWt֯R/wYdw:Ah9ꭢcYvYT^뭙;nOYOٲjÆ=įZC|RE,2[jH3ΛS"z?|)kW{0 ilA}WkBxoΡA őXi_Cvf~3IYL WH>cx}{3;9gdBK>ʦGĔ 9^WS|eZXí 0,"T!"'xÜcΉO+xrj;Y4Vnfd K4;Rw}`֫YGZ,Wxُ[5\oJVـb9P3\ #}'|K//T^uuq AgىXAG=C:+]ְQObB:)Tz1'&תhOsC*"8 L$%W h/HU2OEA IQ;<ԍxh^h|Яс5U%t婉MVO4ZYF>Cj:iNS5 Ѵ3@DV;]H+tdDq=ϙ) -fo3s!kqoN111k4?0?LD('.tfz 8I˭{(Ds: |M٧ Ucprf^Ncwx5T+6Lٛae]k,R{*bM'"SPq}p_@$ 7vʵ#h>XRqQ#O5˰U"b: %-%46ʴeAYR{BE pdҀД|A*MJVv:y^ҟfN<~oT_)0T(!o%6oœgإW"h|^z%= q^ Dm#lH<K72- 1 i#c ^ 7pD@ \Q,-BZDc$=1Op-&oAtV>6'-܊Cuc>=ͽ)"ϫܫ'sm͸T9xdYOyzXv7,jT!o<wj%L1YG}s RVLms'-qƟ3P)L1&YS,.o(Vyh A(7Eѓ;[㥢ҾZ9:;#egChR%P5n[攲NU?MZQXsOT<FY=ߧig\U]M¢+<Kx@ ;޳Q1]Ӗ~9u5a"a'+dSAqgܜY726ZR?R[`fY kn2&:(-FS=3M"<Oɤ endstream endobj 125 0 obj << /Length1 1338 /Length2 6202 /Length3 0 /Length 7127 /Filter /FlateDecode >> stream xڍw4k׶$Dm^w ѢE623F-Z-J$DfAH D&99kz֚{_k=ed* vF: HZT(00. yyhOzr^s/P_ iBxHH$d$d qqH& 0t/9wuC}8 $eE~^00`^NPO) C+R`0@/"(n/ 2``tAc>0^ w!|.~g`zSp C s9  urBz@8nApz"P(. P|uо@_~_YC}է 9=Pp=H "opvՆJ6Wsrr7&+Y (K!4D\mB.0<}`o\B wBap?j_2~>q<$⿞l sF"<JO1#Q8RY!a?ezU- ߱ xF\Z #.7Wm ء^p?>ԿGO{Ua I1ڽ)G##{<ɋ ywBE- r=KqEK@m,xY\GqϐSt \'ql&i?6Q3Ր3vn]bo?9*k?0|6QּMdQ9[X8Me,D@=up8I{.L5Y"zr<4 Śnt/X}.ӻG4m!'ۮ_YaU ]%"(!'ATe]O,'#(t>AGDloPiu!O=2eXL K?{`x2,kEmH6l7n46]0+ka+Pp0tIbҲ^][ {.K]e E+w3t'y"զF -5w`UqsspϾm&#Q Ra^?sguv9R2޽lq.˹"]*)yIf}GаL(\4J ef^cE| Fj`!~h@/r5Ϻ1-kpuHDMKӆXϚ$unKWFn^K >N(rͿ!u$Գbٹton≙sJc K\V$z\6_V뛬)$?z,-Uv_-^Oi635{In@b;b$ś_vDf삒z3DR~2~APʉ2#"2ןҜvq M$eVy [´1OkydӮeڕ$g70'Í%:Npn0-ɽy[)ԛdfbyйɈ4 ׆'G8ݮB(=6ڞSk[;o -ê$)CDz StFWJR{Ӕ\5rdoHީvC~ܾ=2 0.ߘwWs_ \+WOȻͱӺ1 q?[>`Oj$ 6*̾)"W& ~` V ٿz>"]px2LXJVc[䂾yWjK!}3R# ٤oiOç=rqC!8{lDh$]*F@V]`rr-O˂iAGUBRKRTc nwL'2yӆ?*"\M{4ZGT.fgT]BA?;ma*85ke"P G!%0e #%DD*zaO*IT G?؆0M&Ya#^AkH$'Q| z 0gc𢤦Bz&Hd95n1'HM;NrL0G gwSeajqHWQd<[%3d7xG:^`#grDŽMDֿJAwQ%?gzPdqg,TmY /˶鯹o:o czO2?+u%cw#>/~ 8+7?kDv7. 0J,^uR˚K}5̑uT zu56:zOsL`KV{,5X,oeZ}_;$COّZ&e &֌4؝B<ga2Ě|ќ.:POϪc Yx#k]N8Te{?~L2iC-߅TRʳqA,xb'L-tBNADxCo-D oPlh[dAF9eU`W? ϼq_08sk2F |"e'M&V6%lg &ړ/f QI/qnl#aA9:Iz3O_^7d/+1?E\nZBHm '2thE1 :9hsY7L"ͯbR{ _xO})%_J<n?q#Q-A-d>hY7жV%H_s_ͱE.L)6_ܒ h] 9 KU8^,7k t *|(Uq >&o&kߝ/H;kG Z(`B -$'L<[,-b/Oc*a9Su)'3q MRݯ8|AO_T?a~;1*=G8"V"*DBy-5ٌ sEQV#pq=ϜŦSx1Nq  D6urZr0=JӁ vrS'>OX\%&[\phROaIh,33 ׉3$Ҏ~z/ͱ uF2.2/pwiO]lHOUJR8) ϻ&7 UG!a!To-J-~ZܤRwR4M۬μ1OP{xk32v%veΩfcYoAk W7WBӴ[m帮 } qR>hFHp}R7zPU69dl/)Bxp9qm|}SfdfkBr?cet&cW v}xq r-s.?yX!ٿvP?P82{(Ѝ l,L ڥF]:ѩLlXL,Ы\_dp 1qa~D3v{}m;)EA_w0=*O8)¤ޥs1GkTgXG8SOVXg ؤœ:/?{0łrM̈́-5$MIǷ"&*L86[iQ;Y5t %>8fN_^5P.knl3]x@_$4hҺ:Uڟ +wz46R %FzC!ѭ T%V@\gm~Zg6F6wQ4}z!߶ww~TΛ/iw_*jRuѵaڭ Şwt&yd? ׇԀbQIJ~p>>pMQbaH+,[ 6o!$57 ˯v/%+طԁSF&z|A{[ͫ^0)C%+~Q4THDbe`lURpGtj }Ok-ð\}՚j'ousMvҾʍQqGfCu9# >Xdyf gpH!%XHtnLcc@z/tx6y]scEhF?}íF=s]z摒v^lqP[ޙwQv*ďmW=zrbjݠ*sOG ?2-RV?8t[[1էKV+_OPbyC,u%u3+0;[81'c_k~3Xv~=*8^bKg=䨠aPeB5?|OF%]7Ѥ.R6e?vzb\iMڝ *(o|_nA^pq{jV~գMc*T.$&p.cg{'*[=fQ{|NyRwjC!w\⻜ҞE6g) fwi9 f_ب?hۗ_77oUfT9KJ'l+vSƊӃϏ75:hm.%t'ϳ~mZ(3]eٵoEe@0]+UW-G -b&=Ǥ 1:N sҖ)(Cc5>6 D2~_Ȣxȗ#sThkfUue"F '7D V}w]cBhf9&=Z` Ψxpw*-ͧSӥO?T]c` X~ytnKlM.Dr`U`aw'])#Yy&Kpv-*#sT#׼]g yÄU UW(N<QF_envZDcSB1#-gTߐ50\+!St5M35T2WQ svmXi*!zWrUA/ )rQ"߬ϦwHf nN|\z0C2YT&2)GYZlϷc*Q!dr"5D>,eN9kI"lׁ%1'又ʰ׋*X_.Kn3䶶AèĶHj3eqEm,#x;ERY/a尸gFd1ESيz aYGu&hOV#h-"ģ$U>f4I# Xh[LqliuJ-AZ^ 4q$5K4eDI ܠbjo5ʼn2-tɞEB;O2g_v=zj")gB&]թOs]io m$] W?T@<,ĖZF sD}#1Zqx.祄|M! endstream endobj 127 0 obj << /Length1 2479 /Length2 21632 /Length3 0 /Length 23053 /Filter /FlateDecode >> stream xڌPݲ-'Y{p]$kp'hpww;ﳓ}ޫo=' ʴƶ@1['ZF:.# T o1,ֆ/aӻLN l`d0q1s108ց bbn HaImM͜'ˆN/w5 kd~hd`P52:W 3'';.zzWWW:kG:[S>J@ tp~ 3S,)@.278{8ʒ2y;?2 ?;Ϳ l lmL&V@  NnTͭ~H;;ˢ6¶@'G1wNOg-ml]m< LmM~alGjcn ɻ`e```d@7#3UR2Wigk0y/mn|h898=V7ed9 6&;g?_:elkc_VPѠ脄l, Z&V!c0 >_6&NN@w,9( 6+/Q߄} 1g+) ͭm>N k6T͝V}mLCXiG{ˬm 濯{k},߯ 9R1  aߛXh tll]yLl`w@/[b Az?@/ߧbKAz?@/g޳Aer'^?, {v?=]zϮS3hq AFA:#[v>?Cw{&ແ_74̿_m nb|hẁ6YJ^_>˿;GN_'2뻫&/aޝmK^{0 hPKgS۽_IyζN@cCGA9o1&8;~wrZ$;{wO$yn'Wۿu /~׿dLx!=Tue9;SG>@7ҼwEmP7O{3{)KΏ)36~ &|\X&xqѐ=j6ii(/ųsXDPNxT(nHfP'RzD1zjn2E?yU09va`kbߢNy $Ia.xXtk)$FI^Hw^mi[2ɸ"u7 MρHM/թwi"K"ws 0avTo64.$~ix[ԕJL+bu+/i K(f% 3RqAt52ڻBssyE'-M{E~FEnhwxz "w-a6bNԝ@&nurERwoj(B;3LR-5_p$vP(0r!]C[J0-N%.GTqH^CS!B$uǝgW2IR%~CP%E^o~M~L עI3W:._q>){l.LLxZUj5Y[}%#\KjѼ*X[>q28 !DoDPPJ.SH6e)H[]v\ΫݥJ!z3̖=&h3P)-{׼t>!pa V F++ fЗIhHh9rژK%Tf\ ZdrIAD)j:ȥZaq)2^OvXXbɮyOבÈb Db 1a$^o}d/_:ÈkdnK4۩t'zJص#~$XN[9`|Y@:=t'c]F5/B57 q$w~}ߧ]ַtlz7Uz/f#HBgbP\ ЋIХlw]<1 ,V+WRoY%GXq/fr(Fp9ktH.A"ٓ#>&JJUCRHG}&V L\jB2WBh(h/PȤ;萁s(9p}Sv {] t5lwƸ Om}T0dcƑP0pVC=Clw :Fz/slƿR@M{1},lJN>kӜ|?7$4WwSHlQZ^%)kiUwteaA\܈˃"#Q@9綽Zash! Q48:k7\2Y:epye.r"$2d񂋦lAC`bxa ]B}ק~6k-ԓ//Ou1K^a̗a pza9<% 粙Aa鮴rZל+2'X ]Ngr@,3\5~TB|rnjv;W7lmqX5VѪՃxtlՖ$񆻭C? |Ax&ԩ3FUgkg곝%k> _)RX۶7AAluF1ك ר75ۆeL"bb;nLK8Im5+ʌJ8@&-Bg#pw[=R@-~(*4~y:A(7q5 ܱA<AXT?X0lc]1~\Vo{ 9З,hNsD3ʑ3\aYK.dqv @$>CO}-ndIu-lj<[|Q6z/}{mĞObTe*Qr_z!ʤ*ur1J'Zσ@E\ȻEPq1PUѼ/3ҁ]sH_k@5Ƒ$6Hwߒ2J(:sm2k5gW zUz/?;n$KbAS$ LlkXеL7\98՗ׁ^1(Pm|Cq>XmcaL!Eu|;sLDq}eN[z7x{af(}PX NWn.Q!ŘvJWl: wf$+TxzGFj@-Z!&~vh(ۅϠsְI+XK``4ܕu|.R+l+a2]"6JE7 LX$sн>?sϣ}@%ba]~޿ߒ&)ׂgLO=5b,cbjznp?h4)uCWAtӪwo"P"aC# {v4op:^)ӧ$$d`حN/gA#Ubcl<jt[%R'ߒ'z\Buc2u\y-$P?F$ *a|4p/m>ݜج@#t?8 A $E&Cc5da6yZ"-~k^% ˗p`]kNy eWHcCC}elrxݖ[]' #4@Q aVE{ҁK򖋬YY ҹIn|N(\)L `V) |pMC"ywV`z'竫s',ɒy~.}RLy7 4H(K%AǝA]l@8P3pwjʘ * w.gѲ.  'd_÷M7ҏGvK+:N}%Y!JovblPwqq|'? S%lbZK*ى=EBx虜^dn,9%?ęfLoM?pVΏZ?s'Ÿ?ȑFh)vK^I̎Ltp ,c{{lS}ʿŤEL,fnNRWr?.LSY}RN.J 3낹}ZqUcU?SG/ݭ;*\5+s\@hG6I8mԠ8$1f<ѡϙU=~\9e.*l SƆq <fx"Qm=6669]1^kuG3.D /SU!eVΐ:Ш,:]]R~hZ*WJ/;hrũ) W*M::FLݬލՌ @8"6a%.LKkG50Ytn`VރۥE4&Ci1z};U8rP1jAjpMCJ5 Z%C B#`ȟt.ZKE3ˍu2%%~*nT [6)rpB.nj)xŖ?Ɵ!i6gRmqWzsxTTJ> wpǠAY4^\p 0Mz˾d}cx ]`p+Ni^i2~צr˥n]gQ4lG['y4I.RI3YDC2pC0dC]=' f{ֈ)( Zݶ9Dާg WpM_={8D6 , 35d Txh*YfKWfu`)|I2r*WVY=b=˜ vZԁiK徰+u 6$^zTށEYa7㴍{%-t0cgC\3o%PGQUx9H"bb`P!V)EJnv#՟Y6 ѩcK^T] II]\we;cY*0bד0$r ?*(?07n[RϏx--sdOQdDmaE|{U_ɢq|$P4n|hGX]>&&JfEp)seN+(qLzX˼7zJc~dAM^6oܔpAp )I|d@s1?6F?mhvhY=J:ST72? wkښAKl{)̀9V 4n(3 q>ưL5[LZxr>rcۏDu L/HHg_q.OOGEIxVel*ܢ(ƖSu"@Ji9Ǐ$>qXv3˟nC%;ǥ(YV1+{s9R@#CaY &9g1w~]Ɠ>19ߢZYX nc%& Q3p;HȔjaq@5QYapHEKV7LT,Ϝ6LYkɫZC17YCmէ˙Ar86t`>oQg1Gej@Mɾ!&{V?IgwIAd5b Ɣ`ŕ\$^ ^M '5-ad h_IÖ]dCܥC{BINփL!B}dwtH0J}Ͷ",&פ Egc3KP8G Y<_ O֓U?;:F Yq?'fHK!vHq?_Slw!ɏW~Ho)S0vN 9c'g%nFfu˻oXog>!!8mIv9zKI$΂DPDC:f!-DOnsCuZp8~c$G6r(͕/O1XdbG8K{`>m.x$^J#Yb94Iơ%lu^f׺hK+ܻu ư%Msf]~)_㧮Tv^;AIxa`#%]q [kf\+݅ft4iR u51cB>VL1!}lnH\5-9hr6{еq :kFYoEyb>A3+j-Qp&JuߕBjN )J=P`1{I2d-wQdQbEO֦ |~5:>#pP%޳W4HUp(g~]9B=Q`*JFn$m,I&ti5N(TDtC(͚Cy 0,V*9Zђ SӋБ)@ 񅲯S%(r=1AT_,Yl윬96٤umGҞހ>~lLQZ[g4jV]j5fIm2VݺG`?]\g`j Y6}am K0X&h6b!l{=N\"ЃM4fp$GT*}d>ϮIVebEU$Ů,b(sF^0R ZA5tjav$JjSBV AUs.RBR3PM*G)X¦ /:>lT]5HÆԠGllࣆ; ?Gp,E. & TBD~h.l1glq#?[YO‹vWIaVKb1WBA"^—tv急Y^K ܼ{yKhѢGSL7\7")+0dq|7A&; d6 =g5I&@.g|Fj/-6"akbd f@@]QK]CbߠY Hfo;'@l0>'|$`:٢EY;yT弖\䯵Q/ÅLB1H́La\TG"lsf8 (gKhםuFNR4SxK9Ј~=uSXk~A$L[A4q-%OكS]4'2tp}j#\fIW3yȷYM iޑ6}PA?ի*uO/"ZQPֵj 煋4~Jmt|Ij>qZ[<e26_~M1'.|1$9.~EN#/wu 6Q(,3BϐcC%ՠgtMm+eEϠXiWBASD~=HV? p@9Qˏ;>:R"9$8 9X6^ٽ^p"G6Y2xam<u Ehta2F,f MCX]"yGtPܗPwlHY ,uYPg,>4Ӵ,/rCS^`Ynm̷TZElbDJF6'x U+Kv֗ :܂[zB7n.~|#7V ,08/EMjJ}R$$&:#Ͼ'~@Ŗ_x-{A6%R,f"~HM.&c. xbʻǚ瑝ykΝA690>|86Z∴TSo>cK &Aɬl@Ԇ5o` K$蓌_˔{^\nCԞaLUYy1 ܎ Wяo,f&T@YvleOR d3 ,M(#c :^PM upW\^c_E=}gE[ζ9@09St'-]ᝈ@v 2TG(yVds6᧞P)2R`bxLFM1MR NGlLU@c59Kv S~ʉ1d bNq762JЂp[ٳUZ{%#D,V&CZqzk*ؾuh#bO9PC}3=U]Suymy!,Oxf&6ٕP>GMY-"/|O Q\UcM2Wb;pE*C$ œ՟Rj"Pu\t Ȃ~ /܀u ␅ Nzi9ړvVZ)˔Y F /O ;=;  Q_|2,Áf=UqX4r}7nW.p7Qi"I "1 ]uQ*cyJ7t,`]^8@Q4 zkD|2<:eڨV8lGTqV H T8*y (||[Cݻa@WS[2{o'RKǵpS\=g`崲[ Nrbtb%^h|!j Q,!$(z3LiL]/#L'۴s#dc6߼'5\YYi.V`D;\bUx]nt 9bo覃*'C}乸,_tbڣ>F԰idErH M\>lH+=cr6'0p|Ւ'z-1U{?WoUpg^_ovY!mܲB 7NWN]D# #MA/)\?M * d we2H#(>˅A->AuŮ6El\_IwQbImz@MwD_^Mdq˼I7Y!nhӓZWr@SfC \19t3A:.&~>bP BÈM^ W0/4+yI,&E}H>-g,vŎ@vZ= yBomH?Oj.Oʅ ߠygpْ e3^غ'\?NƯ}Nۂm) 54T˩⮹Q6fqStBn+4[T}yd5]N-XQTo^%$.3+{ϛ=ZDw m 90L($#3Z tQowQbb6sLv7;Ot4hs Y-рio'xYuc%yGn!{$ַʜd$?, }kI_O<}Qp?yW(pMItÖl}yET#.CV ΰ՞,dp8_7f~yޒKLkԴ]4~+0J~I1Ȩ}+ѓVTDWMъPT>V'byn uHjЭImE j*0hYL_jǥ(ƓmCCdW~&K7UR1[JAKcM ҝp-9?FzwT $֩C ~HvR6#4| e3c,unXt0he VR5nbr @}ۊ\r֬{ rJ>˼X) Uo %iA=n'ڈ$ÿTSC%\ـ*};,%OH>NHJV:VEQ)*#W* ,ѷ1RMms%sdIpμW/}r{X][iF go_nTRulBfcn1 Q7MiOM& m (Tc+$W.y)ǪM Ϗ+o5:*@zyf~cYEj^a]'X@2W`_q?؏͙GB$ETQuZl/Ou6uoPITp :vb??˧ vbl;Bx0X'eQ+Ey!R+8GV1IJnʭx \wN׈1V3_hq$(]fq3d$OR =o|3yQ>Rꟊ%~RbY]!Z"#I1־H'+e;yOs > ޿9]I.G&&<QIJ:)"}b_(·&>QTi\D7o1sVUiXZͮ$G?] f Y֖|FN wx{ 0wK163U4',s #mQb`_WޫlV1qs/s%Q.Qr"9+'7vs3zbt5M̦T_htDM-ǩN𭔯*;X(CMȉ4J%V`գY bYXMK6{ih{Ub-W}mj3ͫ:8gK 1YM:,^ h4qg=2Srun-_i蹁vD d%Y~ E /Ǟy7C46c{|rq%7wF_84vG+[0 tOjq?wnT $b>;K-ꥳnir w<􉤈16jo>Ǡ~Ig,RQ~d6כd!((mk#}{ ػ}^~+mUn#vu W|z 5' /U]{1t>*nPӒ&*?x҇fIv F_FgTY>!X5w"'j~OCgsX?U MELj} ;ZuVcZ\,~7~F6 {U8ifNK[ؤPp# WA25_USR=i bظp ] E'Sq='F :/w0kz@lZl$lPKA#{IML9-~wakc||7"sYĄh92ړ¡9H^]0l&z+Rń@#jD#Io;vraKy*4SZL 0@aTP|wLu3 aC`~!pTF80ֵN|9k;IYWiL*,݈fn}*qz3j sM5υ4a%Fc#ѧ~d2h3eMbbw[gb :u_>a[Dp w׀]9ݑdy3wիޱ fWT`忚]~n 2maY_L?Hg´;+8z0@)fFLY7wM}QK1H<Õ+[ec11C2.j8 MKkiiC9,+3 h!atLCvW:t ǁO|'9u9ץlً(BWc9`)AI; { Ê)V"3sflKYl=h]fxLYd/߬)F$I* 8GVpPbJt}Z2ALcGfg8>ԫZ{$iiH_-o3/{[ 2;$< EɦIOS፵% BF_OR>??6, F]+ib SK Q jCҗ1^,8CyQ ۂzmWP @@L qSiݷڻO]f}7 fx@$tRRU>w~A<9GsVz27 \Z􆠄tE;rQlB$W &M'^+>acpjIhJ4٘p_H +Z"az>F>gtHK*W_OB3>9#'ſ.$Ne\@lOV=MMK sFCoϲ\ѓC h\Nޢꭰ:dCmh $Z6m+;m3`L `p`s*zE?•x-Єѫ> zUQR{i-/W6uD<CCpx ԫwC)E#c|>AV9ΈvOOtG<̰3w+x΁;wpUkH$ɞUR7-Jw' '=S&+Od&^jnVgVi.s$1̈́XqZ^^Lе%J`ꖣĕotC_FfalI=,hudsЮAఈmkf9Rk Z}|pPCٰP-ؤUr`L EL(i~ 9Vd{d2./nQ^[AMy/JWP[Qu.!-Sjȁ!e[ځږR"ܐ5^aт&8 ( <p. ۚ]RVA X\HX Gl#QoyA!.Tp<(%ҡ]i_(!15-<0p{Hs@ivq0{h= \?%|/nΌ4$*s z\Ttx%7$Vxh/h^^ @&ֳ# /gƬG_қ]akSpz^7)S5Kr w[R|G\bC:>[f*K)h+gDpyປ$ԅPP2=Fw*8x/uudvNBQr@tY5q=@'kvodW˅ zX&ؓ?aw$7gE3;$40A]B8A{HJbBmo=xFgƴ d䮦­OY:PB@YBR'Qc?%V3mD:ϭQDljeK‹Qֵ uWw1="CSxw?Vd&V=AA6ǻ m x/*E@n3 1dgZ$uZ HRI;;߻Jt9fYt\$k6BNq"^b~y'0B#9PP>07U3Z$&XnyN{k{d+[;}͞qStkQcy]s;V"Z4TNJ3?%d,Gԙkd}}@d^*/BF'c ‡s-]lk82r|gCM/x{Wc8.iys;YɷUPKtzH?՛' )c}\`=tsyM!H0FK+J5WI{#~2f^S4cDqjbmZgME%47<> I8YܵUvU;0EvYjS wCXF@|\5f~YVaWzz_Mc,5>ۛ 5y_eqazEG^iFEEKA*2\FSk GUnѫSb.9 !p@:T+aň &|Z94]}W&7>ke؂\)D+9̚pOBZEcA m5Td&Ɇ/vXӵjKN"E{Ul`k ٙNalb9M=S!Aj/#qD˸R@N\˟uhWpBVK .A ЇֲffF sLa>KC&O ok6l;€Z0M]*&:;xKnd#`O;듶YU!,ǦJ`]eu_lC;EHN$EP;2h>λGE> )KQ4i2"yo^YZN^Pyam@h9X]r&G!*؄~830 Sdٯ,`+? ]JenIK߂1P֪.a3nyx/@WS5eTd,F,sG?RQ`g\\2j*+v[?eu{,pfr50Zg) pF20p!i9N#4}4yl7Ĩئho2 |c @s=Oi19yalTK깑W~#C *MZ]N"e=Q#թ@w1!OPg[2Tȓ *!r|~jDFH^sD]KfhA;GUtڀ 9<ԥ@󹅢""u.ĂOcQ6X2W@gHn=Lֹ?5NQ-v1w oCI!` M>۰^4'%!gkVjwzL]DR+@FAE\+)"am}M?,.xT'ex%qGi_X˻SL3 ћY P1a3^\Bt"gD;HFEX4ZU .c&ʟ~wh ^|/L) ,|4Ղ'hH]Pt5"2zskųň^:9 M{Ay̸*{'K\z>G5\` G.z4½ /s02Y͠ 3QJQ.mC8XAD]SS٭ړ3!f̤?ͥ5uK#!GNE74T;S_6FQ[s\ūѿ#^cN5&ə}}AU(qLm-Yg6Tg BpVV> stream xڍT6S݂)ŵH ww(Rݽ,ZH(-ݻ9wrNgygye㖳v)9A<|y ]~ &3>ed6\NPa ɦ?457_/"/* &P<5'(Y ?6+v(9G l4p;ӉV@@ {W 6);8YÃfxv]+j t&3@]O u}pZ`z/Z  tEJ rrtBP[ h){¹@/"t!@'Jr:Sj;]y\_-JtˊPky'GG>0 dt^N ؀6vs5]@ QLlAp0yZJ ԁ3  t07Ͽ0`+8d b ? {?OvB1_^u CE9?;⅓'[P-  ;6W|BmtK)Υ$ZzV!-H :!^4ҿ@jsg5@`7O{ }`W%'Z S, ~- i;*n~>=m?\#VNֿ6L@X^|OB?5 xyNS{~'毉x_2D 1HLğ88o$,8R5/owAk// >%w'K/SSOOSDxNr?]ۿSA?5A+7 cǞǃ y0W$CC;ok<&1sqSk7a7r)wٮeW~5G't|}0Oԝ\&z$0DAͭ/0 G9M WcPٳa|m<|qOgFD|; MPuQs5HٕUp#b sSS<,N 94n7mT)ٙmMX#{GXY5CC_w jŲ cݵ ElO*OoK(|"V^xiT9}yjZ'Sn[$W+\A0xORvTߕ0C}勊\]:ȤC{.Q_Q|u}7[ځR-5N8ZcrRw+1m)@'9ptz`KO2e;'_3}?ܓxӗFdpm&,̰*^) Ȣv`@@'CEZ7vrcs'+"^buTgD )+.`G70Vd1w,EZ7J t4 @⨇RftYQ!,GBlIԝ<LYڱ:WpzO˼'P^$PH 6ko*K`i:w^}}!Ǜe9Ȟ뙏CV]eg6A0d:~F{hDÒ7Ivs:k$SEGTxZtWU; H}'8CbB*t{Q!zӯYP|92#IwM9n?;վՀFMY0P\y( IJ.Fk]9aLP N6ؾv.r5U,B"?F9xNd MdC |jkP }v|pVC.1TUť'IR'"+XΪdU̵lW)c~∐ @D:bg}[u+sKTiu }fx"ºܯ]%PAr_׋ƱQM~*6j86ZMIcGG]dKDQxVyCq{"jm\WR~D9s;sCLavpIA b Rԍ )ImmL9>eR +IN!| RX^_M"C)CkywS#X*"r"{ȪuyFЛ u{(lfv|̎⵬|^nO%~Rь TsinSlO@ ³0C52z0ƴsqwЫ5t{obtћx/.4~#>BOVx(l[Q;r .᥅}) ?fN~ ړ?/h(}}[(DSEdaƽehL87}ba %ɔ8jbqTVwj)lM4á!SgowOq2gGgr>gkՈX\n6I˹`ln%oѾ/+n>ZLaR$Z&;6e ѻcPE縸m Aa쿙 t*l^6dVdOd5| h5T C Jb/rynAd#)h?J烘U׎Z+@W$[2}ۍ?M94kιAkXO5vW)rsbWw5OؠGÓؙyw1kf؛r΢$lOxK-6!*Zm1„RSᾉ+oC`$v1-#z*unh-z%.iމ[y;'r :><$O3̮L _Mg[Z<_=,]^{'l/f67e ؞!_| )ZDӵ]%Q1lB ; A4}Zܤr ??12gC j|\U [i]-)KJ,J 5Yg7qEQH`Q,Q |N9@f1"1ZDF[3),mM0 O^Jkn_D3lߩ)Z)m 0Sc֦ڏk F{8Ot?{Lɝp@~̃UpܕIptQ,MT>8 zv'(vsN?R8Jpu4R5@-]7P)كV7}o5\F_ޑV6w;B0ã3(aIG`C| A1za&+;1I2V[kQgcw8t計'y : ݤZHDtn#?61_ t5V>ז }X7XwqMLr4u( S]JB-VMӱmONGy +4-% VO9*tMWZ}S4 V6!|^,/SO1X3&P]VS6=8M]EX j83u!ḡPZNB"F $~v(x83THڟʡWaLZi~[3롹EC.aϋ !hoWV OÆg9黒 Frl Ozh>$,[NPF&G?.&^PՔEg S#lJDTB54Ga"m33 N撲 =r[vmZs9s y i݌抽}w U5vjl86BEIǭTIe Os{Tsi-G]`#dv ^؄S }vUl;1ź㖾uM޲g?DgciejW[:GXxdʎĎ:%LLw)RfJ&DU&5g+v8 M{~K=^hu尲]wtq/! w67#F. :T4뼬h܋Bj-]״Nfc gQǾwEV3n/TXȆ IbEA~^9'lk~Q']|+鑃hPȾԺ)xEyO&IJL?ރEozBY2e)aڋ6,]"Gɐ* wD5;{x6ZrMB鏋yaMt~ͲS-;.Y2M.f,~, c 6"ԂTpԊ 0h&=#d쮩zO3[қџhNtkq톘_w^,COY`q+-9yM\%쫗ӥ09m!0%|,j沙QTpJBLָNu:jICJ乁v-1T[5$E5}l/\9u<Rf@=[ZC9cW! ntąXmH*(&XwSM MGF-+Mqn/(9?~A_T;VӼre;8ƗeymB2% q2d!.`3|,A-\ѢRβC#띃zwՍoZ t?^ *pZh'ݜi]oϬ]:QI2hF)#'be#K_5Kb8~Lp<}mle6OC~\7o~#NGCKdH j%^m )7tJ˯M3+Cي z1h} . +4S9o:v/vE}-}F e@ưCb\ uYsT[[{dVR5;fq\sx {XjuRuzHH5i^ n pjX1|vGPPNz}ʃW09g@EΎ$ȗL[a6{9iNN2O9q/~5F% ALJԻDRn׺0 k&o ʼ6f xo2h@dMc<Yl2Bw?i"\ 'ru@x4,Tw~@pb)`!0'H/sL+:iof}b|I6 hB,v3JweZŕ{cb4'ly4Q;rL1Ӧp/Q:KEYERFWoL&ƹv`j] e1mage}<R⫴%sSg7}b-8c"$n#OBNtw2+`Vj2#V)f"U+zs[ޙ4}-Yh6]֜)}gV"R9Ͷbܷ7̹.ԻжMU9E}++4˵f̞a6.Lu3MKF '": d4#2UcD&4gp|/_.ю^ 7®j%jGq]ԻU H"OACqrϻpJaO$lK}?ZBIhE v!Bd^;LMQ dojKک< \6m}J1SrίntF?F^h}?[`҅eO%e]L+M#XՐHT-/<|&Z\U8RɹJۏL%Jpy\iORP7UqS b lwg/v-, ~߫pjt-ml2YCiF^?wwC)ŐQxl!6ޒsXc~VǡJWi]BU%ޥ-'A#`6jB6e@[l&VU*Rj=իGNj#+E*:"~Y7g `y/9y=!ƗF扂k'JHBbŝ#^cE/ Oj 7E.Ft\kxzPĹ]+do C}Px_U4,ȣ&k]R{:Lr;2,rcjrDIiE-N.ɣ]έ~o%T ̄kKɋ8FiG_#l ԏ>:'?ɟ:#^tv,Ak5šzM ,lϟkfWu}PfJ9N~]GGs( p/̐U3+gȭΊz e8ybBWn.UNj8ҝ䆵׸%O*a/S} `qbo[(.6 pu9s+L}L 9$lN!<vCBj<*'~a69BPyƣV}P?VV\qzר,Xm S޵UʓָH6,ocPA,t{ %?;E*)>;;{dE =xaǏT}H?)$DR {2]dmA8I.~/)TR%Ƣ4Y(-(`֜[nN،&8C:rgin"G F (x0#AdWEz@*2*zo}ǕEe2[;K,A+.Ui+:g&QU/h7k{thMH[\%8h s#,UC y^|UB.Ո5(ź)w'QKR*%t=eQnGm :ꈿJ漀/j3Zۆ-XI7٬Gz'_E 4dyepHFJ5fDӾ19J.$3_\^GDJ=ɲ!X-'EL^{X\Ñ4\껤V:aD\'$}@:šFL"3R1BBno[}d_3zG\w#":b둖,!ԡBЀ1w-}!Uzbzϩ 欑;*V.èެ:SEީ^ >F&1E'w}&`G-?TcgcO4]qȁC^{voaWdD/ƂF_;&Wg yU1#Sf̕Б&  ~scP:QV{߱@nAHh۬eFdp}$8X P^O`Bl4~e.t"A 0 AR>' 6MwjHO85D,#\¤݀BCrX!'³M`FB+^V, mu5oF~ T\UWЭIRᡡ;E#ʼn!#-X'`D@ /9ĝ4iij3mǜ_4مƽn6jg=ˠtQ"_xRLOF+ 3Hmž"65Q7Asz?Zr='V |乕{eևXe>%8_F|!<,K,L\\[`:H(ځHNzKg P~:D-M=L!-s7KSǝ=7Z#L8y* UWv$fq|4C*7wl,#fw" TEɍ DP#my凊N‡*hh3F8Q;L̓qd^ nޝq7"Nl|^g-Cka؏D X}Gnh_d*FpOk{]r`WzyPI7yX]*ff~C\Q66C"y1=aW@ˀd7/zeWG~nE,W(VAW endstream endobj 131 0 obj << /Length1 1613 /Length2 8970 /Length3 0 /Length 10016 /Filter /FlateDecode >> stream xڍTk61 R 0 %Jw R!HZ߷y{׾Ri2[20 3; PRYՂ؁huNTI'0Q&rySA v@vN ;;?0' bTf*`g$ be?@:sz ;??/ow= bA.`nj ;&vtB.., {g=b ;_ U@:c!5a. '0Q`1C=\`'crP X/&߳o_ ss Z-!v` es=@;٣A@qu s6w888C~+㔥0{{0>)q재-XBpu`ՆB]R<ʬ.@n666^~n 0f^[K؁hb ~|An`+O#;;b4[A?wx_=r^0ϗUF_SQSIH<̜@fn6 ?7Q@`Uj USOn; 쑴` ݿ7df3afo?$jg[M[Q!vΏ?.,~m7=`@a..|0'JF<@V'Uh YAd=@Vj| e/dgBa@ 1 ||ؐo_5wurzS~sq/00lX Ԇ_V3o On3{/8u^c 'We:'}Zڔ;[Rޚvsk1?0Q] YKϝN-|˓.\GW> |K>Y/as_xnK_keR!009;əxPc,6X㈽Z.p&!2 $?|-@ٻ]4V3GB~$`^x;͸bZ pX׋_$^2(_uCe=z[IaY̟bw\κ(LCuD>wJ derМ/a/AB[coUmZ4Iv1? Zo'rFhmD81샄.cd7n&tJ垮So}4H4?Ԫ[Ouϒ!w]q*q)rzpbSwv+pcz}+L=pP}N];yr[اZ#eL{1LZuf(+,ZH$% aqlE48nj$+/x޷Vrt 7,yrBkD(cD|mR + fu3/B?l a~{L c,c)\pBx}}Sn;r~t-pKLO8`g2_H6-U凌\n9WsCK58B8 Λ3\^oa=(*eZF:zk4&D:kZۇY, UsV|:+={-|_rڢ7.;1-FYɪԹ%.2ej4]Ⱦ{i#OIنrLnv,NrҋVT. :Yed/eWKYxU`%lW0 wr5ޞo;pfq@n3Ln ;`~6~iSo efNMU.T#b3`ܡñO(4Y!T?lNDy!Y†+=vVmLfp=Mny2ѡFdewn +sJWYdۄinJո[ (n͗ 9Gx?>.rl T/֜;8??RSWMΊkk݄.:>Ľr*^֩Z p /:0߆9-`l#[('4|_-fLWԻN9'r׵9dqGw(T*LC.1&3xxL8u ^(|mlP.S‡Biȸł*TI0{!Awm} ֫Wz)QapvX 2 =P#D_uZu~JMe7K 7u\ƹؼHi;EgJĸV9 O7qME_^ϯxCA1&֟w@]5?Év;#Wm)lݙϮ(Cc#$V{?6v NA='vSKbYb5b|`P:ynC7bF,*V_ 7bIBSPoJ:Z^^J]빾hZBr-q)ET^]+1IAnR}"@wc؊VIUiT8|t+Vɸ UQ nCU77r]g 'V>J|KflpKͯ1f/Mg:78DF,eel< b =k2zQGW>>խoD",MnB64gU_[m6lcq{;ѽ/EL_ͺ=2wӋhX1S?oڅF"E@ZVh׋4R @Z9ZbښfL3* #L*n7KW@YowK<3LG"ԖK+Mjs%ˁr_J,bò ^'R:ߺ(~(`J9@$I[IMn;FS*Nbqx9BeE#)½ATKE =Ϧz#K6V{t1`q^Ԛ~[u[Pt~_csFΘRuS4&-^[4)үK1d_槥mXމҩT ~5-xVÎRE䶳6ĕL@H cIR o^d%lir,쭧JI\NVX8[o*E!G;OmG *\s%BR2HT.۠ꏃ [cӍO_B%aGQZ%ohnA/ψcj:#xѭM mQWϖnӺl5dly= ' M1xrxHgG}&u w9kX'QfӾ967w_E\kOୠ#sj*nYv.O$UKb+F̛?a 񸨺Z }7䫾ڪ)3<7ۢK($hw_n?L(^=9=VcNStkUi?!c=L-K;dJ4_R){ WP!Pf-&* -h~ gtddF8v(ŀ&5dj@L{̈́~<ڟv2:c̼͉=YOY%Mk#2.MK܄I@i[huA0\ ~{e3\ËhB>aQKH5 FweRߑn pKg̰+2?X^ѧ9+x~D 4oʰK/e>Κ! Ȼ!$fB%/ly(_%n_Zᘑw0}2u~7Us9"qV3gǾlzTl4%""7@LX1HFhv$M{ݺ)FTwNn ty}ZvZX zid ~)\ǎCS=m ,)՟8u),{UXB@Jţ"ƤqBDnp-H>kc)Ϭ-ȽipLDȖDg"hrP,$HdGkԫʔ "}zFZgށFmc8CJb$e,!(Ls']y?J?Ӧxg;+Sk*:OԭN7R/EA0j4C4E1k22R7Kc"]ؿL0;1E{&aTlI)'v05&wEщU>5JzL~|~n9b=(`< - $,Ti*z}%\(@> ~v+(Z1 _vdE}r/d֒MkT(6X]:7CI2VD=]VLB#/^WOD7Z xZ:8(_:3ba4CjWeC$~M̌#xZ݃GQͼЙt!Hnc靘U=;9<sK\}Mzg=As>d)R2z|j`L ?faa¢txugs٨g @!!DbYAlVg>rҙ@'MXM泡ea51Ǫ@78*—Wd>Fgs [IL#DTp#(t$Y8Q&2V[ MpDF`cJ QZ2-Ǟ\|c⮘lkB#3gyQH~>OfGP8^Xґ?[^"i<*dx*@:,LEbr{'>[W.[> 6P&)Zk%?PIW}H?w2p,?Yհjvmu"l9샾۾4q gJ7mMf!vhC-$bbU'9;Ïӊp:R>B@ \4,Ws[?940tH8SQ5>n,n׃Qc&ZQ՘`& DBBn PenZ}!ĹgD˭](O-B4{Zձf^s 97ft@Q;W5&#B,{9lXz+Uhuֱ^5Q%$a+֯C#A4w|䖉-;sIԑ6vxHS[Y8N/h[rg \F3Бcu |yb)$pBܻJ.Uj6_8x9! 2S/C”Ȯ gO*f-*8ֻT_ uͳn}p6%=mp#i7"TMvkZh|1>dOyU80wP|39/ӧ)}ςܒ#4<}:$RxX9([3~J{&|H Ud.Vbif ^Չ9^/D|8'wl}; և95d:cf)O)U{p}YLa:Co2vZ!ct )Ahz)#%=^$9bx[jUɔCTu˷0]N?ڲ6m =da-} eQ|}%6+!aq0W C;{㊖M~|E ;[,8vr7;~C@6*8oa!5H=~嵡 n-^> #^MZ@%}笘~Ӛo͚~#oI^TYe=jElVeJ^4B҆MR.ȿ@ ح%WmK9DuP\#on@$Y |6xF)v]9 3 ǎJM 1%ۏH^ʍbO.;9"mP)"3o$~Ax Yީg~@fq?"׬Vv,56 @ U׈*qH·锌mj]߆qx|rhzODp@M&z=Cu/1cCNp#v;ro4x__x4OmNğ2*2HT,iZ'.8M羗܁> i1xjJL~ bӈcG+ UCg%(#¶}'*t}ct~.UbR3[x.rFoqgm[teBA/'fhv]]>'"Bv(=-)"KDZ1D dT`k4b̧ E-xзK;krDΆ| D2ײY/w*? &R_rݛ|},VM2U\0Y z{'{ EYH$}#~>DmVJ|2/}j4Rb}B_Jﵮ=zfM?rv[Yz.It?)QZiAW"vŠÓ+9тNvS> stream xڍWTlS@$T1:6QBc66CB@B 4P@N}w9=Ͽ{LHD"B`a,@T @@9#ZP^p$BP0'SqfH@ %eR @!% P]$ETCz`Qpg4.˿^(,##%Cv2B!n3$CcW{ #QΊ|_8` |`_ !ߍ S.p?b3p789x#a(.7LG`C1c k40 Bp8`#M}a4- Bܼ8q.T1@p՝@{ {~u(+ nG5; U:⦎VWG8:jCeQ-s HJZ0P_ͱJ/1@ ,P{A|`4QG8 p9GljaNͣ <0[Ho1UWUH _H`1(_UA8!2M_}޿g,C$0I/]7t?vsZ; Wo4HijCW#?:h*g h["3Fz=(!0:G *4L"KTBA X ܊q7 ?GCG7"$pB(~S\ {~ )Bh{0 A)f&Pmǵ*7|ƀVgPOIjQU^_{4˟gɦ#/)6UE~S\y%32ԕC-Mm\HwV ]쇨eI=ʳQxq`C Z= kyCl[ bK'~^\L}W]K׽>x!c'T߲1j]n,/3!N\bv{){ xޜ"FTQ Mr}ŁŕA EjRi۾b#ȴ-|Z8w6rS"gɱ/$u=٬J]*R쏦YX\ژ}ВJTEO^Nkn'UH~Y?]-V+H?<5+*ɐEɖ I+j"y X~%]y6Amo^^gHxF`^UH!5}R@AUxvV#kR%+HDᆩ(L۾ZHې_X^=Qy5\gBSV{x:zQU+^4Fa VV1a%?OiMv\u3@`%J;x\ZNu^W? KJTwBZ\Π]=s B)E;K3VR&,7S*EW׭<_!\ȥ'{12{{Nq~U;{/ˈ هI1u}.T. ]5͔H9vz/[h"/I:]H";mvX=L^hf\ .\p:V+zmLR1N9Ujp;[),x,w5!stjh\󺘹|mktI:5J;o^"-cJ5yZmߨn>$IOxLRz\G"nr$4B0$o5 !,*h2U\;"p:v17H`duu%K`Pv "sޛ] 6|g @"tQ:糙X  CgL` *n1L)& Iv%[w"֮`vrxL=1#J}fFG3oK4ǠkZyw}|mؘHhcwNE=Ԗq9aA}e#l-}DH1t{fE1SZN6_f9} dzD.HGKͰseQˢ"6f|.˨Kҕ*cWwؗV:y {) jZ\ʎ3]uMA}*`0X=xْ3k۫=ݲ+A_{:29^8l\3fffrzAW]&6*$ V>g]p_tO/*uu0V~jeʷVן!+%e NλpfSI#;TTp6p#uRaގ NbUjx @O?eHiƶܤWM<)(ِJ!|rї#U\}Bfuy#i!X}yv7ъntHtu:_Z__'_ȖfoF%o`I'sS}wJ0&[ 6m--5^?XLJiar@^ R-4,2f;Ӿ;@ʩ8,}Uڒux\n T:>Oms< m.wlrlH)biK k U{^t{jec%QAu+ f0Dտ,&K 0XR滏L߱l,8ڜbpVgWrS8T m I35UX6?*'QPByΔ;[E:W1(Tԗr]^@/ݰ6qV'tk'LYY>+ۓ$ ԕK]vccg J9 Ɋeh&W'4To㍩a}Eeq7P: 3,9Z-RUr&x348uxTk\+ife#^6Y0FVr%" ;aýqם"15KR*o#m1T(d Rtv~ȉPu1WC)͊7LLdFh.b:mwuj$".㒉ğvM(GeŔggcIޡ6o^9|H)M GCS+Ff*dUvV@Ny셼2GKEѮwl '_|"2')*W6XNWÚd1nzn CXK~)vWܸTlOH9{ g'/ۏ)ƅXӍp iNh wWxž{Ծ$bv[3zۤSݟTxE?,z&?hepD촎2ҋu%'}L> T'T98c7SQ`+ħn0vy}7'4!,} S4%=IũS} _j@{p㐋fvkpCِȠ8o[/ Ր=N0Y9;q=MJ$|.{١>5^}l G7c.ۓ}A Cjb6a9}Ssi* KToOŎJp*Vː{kG>(1[cgws7#ԷK/\XbXއZ oj֎ r6(TTT!+s\rzv<pZiRrг|P<:ewm [/`#(=/Ŗo=4cx۞z :dLdNqNqp85zSM!R-Ya\6Ƚ)KM7fA8p(3zgKk޹d̷g5">& rlZ @SZn۲=Mo/Vzcps s{wdL,g.֤G6x~-ܹ&zXav|ՒQ+{C9HD*a{VDMA#CO"-%&X6oLWWPGJf3*Tk@JpN5ϲt;_T,'J5T>|ޛԞn矇 ~#S~ۀv-ѼnۛwD6a:oU So¶D4Ts&}B+<%و1x@Pl@gF!tⶳEk5Q_4+)>#9SLyGXf$q¯ګ,h06#u5JXCf4Dtf[\G&Nsw`7;Mʫ33S!V #7P[u</-LҞuU\Aji_!6td_p:aܞmxV59/yi cLVUMx]ndk1&7A {3aOy`@`7EB\Qܓ9|5jړU)X"W4Ͱ/C9 endstream endobj 135 0 obj << /Length1 1373 /Length2 6090 /Length3 0 /Length 7029 /Filter /FlateDecode >> stream xڍvTl7%1:I(nI 1 ch$$QA@$$.%E@RywW_}~uc3QUg\ ŠB@uCS ,!XO_Z8F/:uP,z!@.X(+<08rc@3]m/8/gD_ "w'BCa04 D\.O8𶖁6+;B=}x u;i R5B= <Oɚ(gu4 Ga}@`0G: P.GpY޾p]=*tp,P ȁpo << B{]#C.p_x) 3:](pd1]0x ';<(Y.HZ[B68Qqef1"X] (W[W~o_obG,(ۂ0BoGUBxb7DoWK_t5;#|mBPEz>Z1 s *-~}( /U0ODο%.% b0@~xI i ` H CB.h >% [Gab0x8 aI4=Wr)Zf 1-4d/s"1Gt5Uf/pobRMςRLGWS#mpQp_x߉ n$l1.d<驘=jRZhEmD8 VR(^C%^0 d+Qg t2幹O; +!Ç8 =O⹢q[ߒ8vڡK2 W}\nQ6 Dcf2]TUyIvp\ uyΟɨy|uI:.\:4=̃?nn jnj-7=. 5\<~UO9s}e}6aHB@: G!ZX1"-(q;E}Z5eРrz-i,l%mղݚr1SB sZmB8$)UrI1՝2v/GJފc{vmf |[˃(~)ҦPݯt/}5$Lȏ2l\}%6r:JGN~%@8>.X-z˰f7*sonή?,ʧ?tXFԐ!uxNMg@ϖFy=iK3n3CHxN~MsL`xm6agA8!ZЅ@q.ȧv!@+LkFm2~ϊe- ; , O}]F64]a4M:՛ @G+&IsFROr!_q*;0Z]ǹmUJM3 ΊMQc_SNF%ED"ߎ5+L㖷24jO+9kD 4w| $o"Dž8a#Ӌ؛zg]1<>^|HNTQ|ƽjHp8~D/g;oI*oސ^|bHC)پˡ3+~_: )Ip^ߓ{(Ux4ei zV[b[hwe9&Ӳ_>9.X4VwO&S ؜*> g}YsrN%XA{]c*cYJŏ4_^? AxBCy޷g{(rGBtY!NvV컘WCJ+ܒ7ȵ{1Ŷe4 %)Ԅ1jɰ|~̅o˃qlk]#fCpj7~`d.&sC'-M7-*2tS]mepWץ>D,OWniLT@FFD{kqOm.pf&P4J_M|EtjqAyM⊒UMTj~#.'1HcH,.[(vKl4i$1&DϘ)6< n˛][$g.7̓?>n~`Go*q/͎;*w5We`GuX5Zv("]zN|Hsu8nmrF^ɯs:Μ]~G[qU+ҟy ޥl]5jkܟ5ѻL&ܤҪ2#ygWxyAԶ._W}`2[hV%!Ҥׅx0;m lew|CwVs k1md!2U*f[GyYa;݌:# gD^`V gOl}wX`[^jo L6Zaumu}x_p$t\1x`Wcؓ`ܫ[l<{ySPen~ƀ(=4{ޕnһ6gצ,e9Ijl,_n Onkw^ޥ>Ǔt%G^w~_8?_֢[לT>͒@)5;J?v~ jcSۏ$SLʁJ5@+联Z=]Hxt50ꨢ\_|J>kdsۇEW*e'M}eRt8ݖ)"%W#_G|يVWlW;Q)zcK_ pu ;- D? gKB([;}r mEJ4>sYo0 ݼjl3r m#^lS4)JlٞPxy@c:xFf̽$K *!j eȀIe^+qzo3i);\bG?ӓ o*(>s?@2*1u>M NI6tB:S PBq3EKx_K^抠-/WCI\Ow8׼NK\AV EwMSG'gP;bەQ{m=X~y кDP˲B'XꝮVKZ&=߽'[vody_=0֛i27KUΝٵx/~MUCgiKyD%,, Wk;{ME^${3t\{͌TfKI{4'-Ʒ1Ē!ܳTŎFm`JHfj Ki Sh1z/>ɉ BJ{2 j~: 3WD m{1 ӷ1$桳! cR%0:߯:|^4ĵX: ;hFJMh(f7ɬE_6 鐤=!B(ټ nER 9N6 2_q|=9k^LuЉ#nf&/W6$~ ̣#̢{u=Gb# >=\/. ~esmZ ә[{wZ ~ p[<7?as:YgAh' {!Y/̻|,6nFdjxߨjK)q.יn9o gLvt옇麵j#ҫ3^4"rli ԣ3ˀkbgӃRk-ρu_2)K3&C)!1J66΁~ۅefR%|*\-ռJ՗ #^8UVWsJ`u T>&gb^pj娑dK{ugke"Kmi{ҷP_) EbVY-F] :qto/guxB3hFP%G`t0kˠ -䍝hFWeYOMTq:&[ovt% gu۬!'?gBCՊ.`)(p.iG:I4.#dŽdٖحbԝXpaAybFP,r%[L-x\^-eV吔UfޟIyM>ЪWgC?)$K|FTop\NSܳE}8 > ȅ9J*~|"UMcu%F%\A ]Uo*$Hh$ve{E6UY$erXIX!|?Fyj5`eBEd}Xܭr3Rl[5xZ=J?g^ 1JұI4B.c?3{ʽgìKmϝw#zQ.l[]\Rt|ҍKɭuB!,e>ʒ_%g>2>p |mS |^K-/kUj_[vd~Q36[Id<@ )=)5Vxv׫S(ȪpEHs\`~wdpu-.F>CY~MUq*kw ӚӖdZ,#9 wҎkz o~F_vzP܏X lzh׋LsNsig#:0{~D^ΌUP] Y,gu7]DhUrzb;@}M墄. _sO=yQ$% ewj:ԑ6#ٴ1+˥W|p{7UV^0k'لZNTC.#AlDu,"Gn,p|ωM0fy&)+n㽝pa+`Bե,S}w۷'[э/z!slUj944! JnX*ӝ}IP-GU):=@?[|;bL#Ykv/3|kWDtY h՗NZ!3k&5c:$j &.k@ǽVPfH)~ S#^ݭ*y}G$D B*^t7J5kǪ/q9:F1=P.O`$D,X-\:~⥙_mK BCL1+4:JJ9l7"P~g)8{n2ɞ N⑝4'B6RMT.XJVs09L,ųhnW'qG.Y,Dݟo;B=! &meE4E1RTmw$u[3xtGB<vMS㐟߹R.ѱ$CDE%~zKg?1P endstream endobj 137 0 obj << /Length1 1755 /Length2 10562 /Length3 0 /Length 11680 /Filter /FlateDecode >> stream xڍT[-8w hhw-Xp[pww  ɝ{gVeԮR`7C\X98RJn6.::M N C/4uy1uy1S]Nn''C߆NB7n @tFwtYY#ќ )( atBJ.@M {sB0X89;Yfb\@g\Oal(tMk_b {KwS' E!/ n"@X/pljnno` A 0"0X64;ۿf/7HL_WuN g6gwü<4BqqF=bl XX.Ձ] rtʽŋo/ :쿃kz:(_vwXY_PM݀'W?P89 s A;h~B([o+vk\˹Xgd[rpq ,}!X dߛY%[`<}C/?G#'XFmeZK?'tHdnuU}'X-3uO1L%}$8}P,P}+ި'D`&EI38*d[ n.Xx8x _ NC=1vAǭ2";h>㿾 8ւnki4)0ujDP/[ Ijj9j:fK_B~Tg]Jv/bd:釲4/u+OoZ? fM`q13 ,Nv!f$g۰\ ;z`?2q7 x9 >5DX4:]Bp2~fSݔoʹ8>;ŒJ:f4EVk!qDѝ7s t`2| 킧 2i7%AyV1Z25ߕĸ&MV4*n/i&s D*IJ-u~VuV,pHSSƉWN›F+o8t@p(y>uD "A@; Hd9Th¥RLR}ebs{d aPwth< R4~v,9ZR]!8rKј~<4|!((K&@ԹюHVC+`D3K6;)5b#橛nRUqWwr@seCJŨ@-MQGDʨe ڔcfKŎG|qW1kS';%P/:3zrNjT %a2?|_3r;uG#>be},TZeCmuVؼ''(p| AN4 #@}E7PE8`1M&Nl+\^vK􇵮,Y(5t #y1Kk{0ua!QTʌ7әՂ469^GW>mf g;v!_d&ںHz0Vp=R4a6H OM; C}gFYeȤ=oc AvuH3u% tVS#+)ĥ˛f7+-]W kY46BKx($qaw߫z)p=FӒħ9dV*BI_Ǩ`Τ[4'1,43fbL -e݉;B_ʷP)P xys“F'?g쾂P8YclσK5xald˱*uc*ON_QSAeDӞyޞƊ۰K}B0o: 0441Omz&HM4Ң/×uΪB&# &gڲP!hm'.aƺKaSMNZJl>H|%5V. )x-]4pWE`_;ݧjM1Xm΢j_W(i BHGK8d}۟&AwIL# ,]ܨeT~3z)/3J+`_[^ ^| #_/XJdfZ Pkॴ qf.2,ԛƘ1FQ<zxcW*DAtNḨT;>sX).p(eXEO)=<%FfvԗӨp+^bzAc,$ŦWb[%NS "fZG >NU>Am9.<|Լ!XZT"3nK*l;52 5%QutъO. 1,2P;ʴ` 'f:AXQU\DRk_qE+J˭M-~M-YFZ<2R4N#4ꂦP[onJfB1gwTV1*{& _)CyM!BY] ي;jު9`5Ke3ź"/ONA:R4MLscL0M)][~n|Uf`ǚU];CĻo `k$]2S_I)xV2H'w Wo%E@40}Gdy8}u3[ĄW3 T e2sA^ hˇz?Q i9/ /iNk<  (1a+lH:dYz@*JĮy~"0Su'+SsW Bw`Hl ٶL۩t?03ԇaͳc]J'_$! F3TҀYӁq?Ŭy=?4=3ԝ0wyS9dM 9hxpm >Ӌ)E<݈ŽU.]e.U[Nu aoR 5bw rC5A+Ë~o,7@ scw9m*u+%/*(5YaW*Z]HÑ#|`vCz$lf^bTÊ;n֩=zq)}8n.*$ByD<ħ]~3yhe`էa O9*Ő"iyl1m4vf1ŃNM91݁ bW[>> fPdG[JObwyMmdKܡ>|ΟMz4X??4M遖_Zi6;3J X0NjoPxlCYCBϗpY#edrtg[GֳFv`ICLͩvE[-Piͥ(mHtt"ʛl3rRK9ݷ8ҰLC)Šbh4.@[%kLt2|D%(> kΤQ/)D$~\i/e-l\;2J#"Qd#.\蝳o;t!AO|qg)f:Ʋu?Dž xaTceOAU~┫4n t.Fn}JMeVze(þi(!.{ Op׸6K_?_;;&$}7u{r'y^]ǻ1ѽl*+C~ qp3>_QF7+=& 6:^)YJʠI7$F['X;y25e÷MzB;-zs|tͤ1k;QX][3nXBFQCHL&mpb)]$RXwN,Tj8Yяs`(fp8=nB:A\AL\Za i8y&c&gMDQu'9^ۋHl<].G≫MoW˄{暭_[oO7kF(ӒŰt_Hx\ 95aqk6ḏ!D.aRC3'>|V\w /QC2Jv7c Z8IU~)zTI0ř1z ťG T ۵P9唖ač;!l-?uE`B9 -swzq_-e6v+ jZ|:?c QSKⱬk 8Bzͷ4NmT?yx~ȱ )L=ݦC#- L i]t9X mql#S9=FSRʂo ķ4BG>0m!wQ /cOl_%)=CD%rdDݨ"B^z;] Kq8`w+ tqClhO: 5Q EWW; ~ `MP'0H~AKUj^q'C,/? ]"|) nl^;F4qߑ~ƌKȓhqX+5 \\4[P}l_[lʭ} I]r[99G=fR\5n_7j|2 @?9cEK%IY$u# {r 0]Rd+bl)^ t ~ȬIߛiBVWEyeKAAogK5p'7i)̶HIKZ D) mwd7u֊aDb_KϠzS f Vz,lTV3\h PouPt0{+JJ jAf/(ҊT_ ORr$5ugOwpIg_>S3d}4bR0vgMiF9@%,HTHdc s{Ⓒ}%^=J]bsqR 0awx~(DļynJ?r)ih'_G^(zt`~GD%F>ì57(QG0Pᢡ/<5K]lDə(i/aE薶ˈ+Il՟lGjOdY *L/IU;\s(.}.:űhꠝz8Nr#KytLQVk9{kٻ4~UC@a:qY? L 11uJ-2MU2HPEv#t( ٹٖ}Iø3 V 4|4E^8LRLqџljlW,)۬Ly% n CՒj42%맊59E,_+(zT* +ծrH_>﹕PASÑd6Ⱦ+UHpuM*/okKZpQڪy,hy4 %*ʢjiP4Ů|(FSRPRIaDOڨN9M# |ušku䎇*Eݕ'}ʎPŊUӹMl1U_E]J'"Hss)ޘCQn]uK˻x W?JY6^t1D"oЅ٫Ht͘(Ȇ?#T9#\l/̼T ɏ)n+|"hO{N8F>1oQX@iD.P?ykG¶:?+?J{ DMs)=3v]/lZC&] ".Uʘ~ݮjf_CtZ5M-Tj."hZT;ܑ%%tҥNo?L)KRT|^# U;5Uq pA}Sxɢ,9S{*׹MP+r^q(1вcRg~S340lCӸIɜ+~u0W9.1>DrDmA$O S !!Emgu:ZrA t L̒ tED8+),ɼ"_{[zօAxe~V.iڔčzy=MƯZs3]VbBvwsE͍ mZ/K`"'jTjxߘ;l%u}ZuC#<1 ZFJֺ @9ahRX$⺈a=zhM}UI*?rkXI k-qLgt:f8OUu}լV!`\A 4)/pZ> :w.%ܡ;1U]v]=1%Rdt(vVPJcG΄]U 糒s'e| ޖ-;ǔ@ǭr2dƁNciĝ*D<R endstream endobj 139 0 obj << /Length1 1840 /Length2 13313 /Length3 0 /Length 14468 /Filter /FlateDecode >> stream xڍP.Cpaww`pw Npww'ޚXAN(nkDD U02322ӓA6EN2QCw3Y[`fdC[n  K:“ڹ;̝w%Ҙ A;@26:w46(NɎՕڑ r2(.@_ 'FOP19Klkj @@wg}o @h/c}4&z_@6;Zڸl + @^\͉`hc򗡡!oq!E{~dH+C¼5/~ 3}66ZlLLJَAd Ż n WqdK`d |t4tޞ*31L@N#b;ڌ`{mXc2 ˊ T¶nO:.3#( `W/?]}n *ǒ}X adc4~c.](|ĝRh AVֿ׫{ھw6U]e& gt2|!3"Q4Q9T%W@6@[G_@t]el>4oi{K1c[``~ ކ&@+@ocxO`j}rpd8 J V?R?8 F .{!`_y2 ?; _`|n^l}Zc.ӟ`|= ;?"71?T{n?}`swupuuuމ߉ v'߽^X@~i֘'Т&Jߕnoo|O=sɡ2lUeýP1;eϓ:-q^cZ'&Nj ?Щ{{YB6wJg;s"+xtp/Y6_.d.B5\ǯp<(cƉ e~=kH*4%Sk9icLٱ O }tS0Q g(u`ѭ7( 6i9f[2?W]܈@"U٪Tb $<0^kW6H"X暮}qU#eipw!dI^$KJc[l=yxJo"22VQhu~/gUXmwp1dTj6?\@|lI*>2JX/w3/sGQn,r9v?CƾarU\MomeR$m=}}سGgK?'Ɖ}V9eD"41n(du^ϫ,2DDdUMl uyW7ɕtjy.Fx'&2+7r~@di0寭ϏXk gFS URvd#"7wat, SNIP eym%s{ 5Ys?B|.)İ9~kq|9&oy@Ӯ֯1;_6Ёs58{c%ݡ'f#M&gx . SyY qʉ;dEڢIJG*&N?yZXuFo?,76~Xl4 ϝ '`ElE8b Dy(QxN>ə &bu>ƲUqOCz|"bG2[EPܩҒԮUO0h aaM>~r&p3:H{׽\=ZNJ%w謥 "dxvݖkX?lwb| \ ۫ jd G#:Z"CllYE]ǮS<2y#%-&ˇ %=JoKnUc#@cU6VlNݦ&#Z9+xFi tK=UDy;ɲuE>r+cR< Y @3EhXi҆O2G Ç'-tbEQD\L!]z T"V!]fM|G`/}e-vbA' -Q kB '\ -9'"$3tMEQNI11ܡtΪ{&==̴h$Bս#;֥_gWzV)ՋAMY;2JILbzfwZ?p7CKYXL媓1dP$ũz sƫh e gfa}qÚ45a 1ٚPJ-/'Q)s OaS_:5zQ؟.C`A3#2oEi~)QfgP #[B*)({F)5p:ռh8YK`?o5#nV5cLY14k:|ɁBf-Nj\@0p<~Q}S#/*U^_ u#Q}cJw^<04_F}3ĠfQlZHdXƧ):zp%Z yҡĉQeYo#̇9'ْQòm'E-Ȇ7'tF/~m6>9wY>5׺$LqY_@\e涥'Xfj bB r_aW>Rh N9SX8*?|ȯ` j\ wK"(1QJc1iq͵&~< #[]6r3Z o'SRR|OԢ *] %ٱ4PpZb}^+)0_;T'R}i"tФ_XɎ'4/5 ^߬L_)(:2,ͺ< HxEˢp= =N̗*|ݬ}$J< }B, ? [sMJ{::67^ .(T˛EV2 r``d[O}\PQ0V& 38V9x`uQ"@<’K ^ݖRW"1eJV^g$bynW֌p[d,[֪ 1vsR#&qV9SŰ[5d8L>׾۴=*%bES)] JafU*S'CIf&BCS%MNJ+=rg5!J;\(M pCy V- 5\o2PX”}s&vH1ȥ ?xn Lhpkݵ=h)'(>'y|TnSՍPոcӥ mb(n/ߖgSA),3hvJ,|Oʬ]Ľc0UoAc 4FvákvE,\5qXQ\DdvMIcrE뚐=Vh]v#4:Ku%랞ۘ/#M<"7E_?PrD˛JG` %Eqb<jQLHg*痊x@73-L0JHia/cktwQN]QX< 欙q$mO٨L`)lZ6hT̂ %E ƚ25 Eh1T|^"iO_^OpT{Ei ?EGdQx%>BQh23GFH - jJ/B-dM.O8H'n8X)*EM)y[ Y5x- `۫31xGF{ 0F"^DCZi7[K9_QF)mN&}>O P<ۨ/^le7v꣼U h}Mem䰹n ADyXU;qyz{+Xg5l֑zr/7;{Dq24H_&= < sH4SHPY0m1A1SM)yƳzHf;c[ڰ 5Jߚ+aGmn_5:{"*0ycR Yv ۀBpZ"/Z60o]jb:z'UE`ˈVJL(SS qQ Ц=Oϲz8EfIQĥ8SK$Vf(K`+ŦW]kF7e^VE73'ԉ,nt%>WyeU$I %$ O ?J|uqo *JSWñ\(S&aWdwtI=xѭY /]Oa{a] zWMeгkP [r8LiHmM=7?$FWiC{|<>ͦ o): yn&6 CTq 6X~yq^B &ڛ4'Vةшgy]j}n.נ){@j_3`F"W@fB]r‚aDǿ,b-(j}7V0כ!Fq۳^D"歨fP ^Qb%L#`rB&A.V%g|FKN_p+<׋Rm:Rz ? V9"uIsmMetBcb 鼊d?YD"[fvs}b7rczw.Gr*  J{hNߔnWF|%,sXӨ65x1:;CBSET(]C z|HlNO1"Qr+H~Vp]abǁ~эzZdcmQp%s0kʹGFTɬ𕕦s'(CW XáfGOALl+8f)1 bl߳O-CWZdOw]Xۭ*t`%u$D K0=K=3wx+g4E;Z9á m<C9.ߞ>R1Gٖ 5j,NxUaM?t$h+X7>0J#n*t5D錼ŗ]HZ\L";AK {[$^s7}-,rn8la߀FǷ%C_R,BV%OJpÎF \64#@!sE4l:dJZZG.b1D! _}O>'}6"S9.S\MDق"P-IRˏ*)՚MhҦ\+>3enO-)/EVć;WK)Qw% 尹D\v3NrݏX6_;>ķ%fߤSyKZqaP!4%k{z; 0@jqfhV~9$ ]Eq7#zJTA ~; KUevT V5f'(ԲΤ:CjCwI?ڭ UR`uq 쉝؆[2ؚL/TA{T*PM ;՛ 2I`? +f8k=D!}ȳ cSØR>JޘvڼOD+Hه0W/4Cі?e˘ob,1 (" g O .~>J֏Rwq4Jy& E$SH':K:i%:;?ۺk~UVc| #݂ -ZuGu?m1)m FK_[jc:s̨=I_1v׎/ߌ~Mܺ#t!l[s$'-0CrRal>i7Ss;X풊\TaBjF7PP̡'W!|kعkNE`/$.K5EnB$uY2pZ(wy};CYT4Ȍmw X=&!WC UBᡔޱޯ)r e:,н,񀘃3ljkmYa{tȇ X( >G%3 FRtt:qXE?':^MoʼQ{Ax^7a~B<ψbS@ӏӕyB4c`\kB9:r[׹I) x?~~zDې|)d~oJ9n;ŗ&Z2&96w qv(GԖ0,7cf? *qZT4#߽n=KHk#BR7\iƍsLtGa;Vn^&[MxF! 4!|' < Tr^Pjü{59-JRׂMMmQ%ғ{sN]`$Uz+cWt5r"(0{v0HDZO9(NXH@-ߕ b5so"q-Sqe-9C㗻H-'E/A\hLÁE @ SzWz 29bm6.-h njJ,tg+E/np+m5\4 .z+*Z$K؄Tn<-wDa;Q>W@jZo[$N}a\ȹMV0\;sH8#1՟61z! A ȿZnaN=Hm8GȄ9yo9xsdEjf|S̖R9T7Zpl 0jGP&&Yʓw~=*~Q4ܐ [zfՠ e(-z)\WF6c4#,&f2͗˜>m<>M'Cd`V#Ƒ3ɶٽo1zrh=pBSdjw% tiM+zz k)),=9$t tRE#G.+?֬^,rggn4Ձ<@q+Tmc4TT1%˓G`Q'2Q@ oTVA2!ܒ=R N߼˳uL%uJ߈HB{YٝRVf@c UJD6R=o f(dh_LTV "ɿIG8jbD"'ٖ"GNc! 鈞瀯UG5 W|A8) '=5 #oLJTKIk{ .\]׼b_y 3tްѐTy7'pL ;a^m{MkeU.4TRB۠__14~uC=K)\j/:pg&+TPmh"V53pH4bWYdïnjmr~بfYv 4`=̵lzoAZZ-#א2rvO^:9ֱ#K/!AZ|J\OvB(i"553|19z6lS܃vЖjRJ5&!15%OӒGcarzcI\o ,?Ʋ6|ɠ3҃6&kH<>4Џ˘o(R >OGC_&F0 q jcDPLIGkw oVU+H]e~ BOZ?iqsr ^N0/c b5R O}iX0kLyW*!?u{ITJYȒGؕ$2RX]qY?aF7ؒ| i5S(oE+w9}]JEm[{/2aCx5i3?NGL(aS?hK>GrސZ,~ђ%=e%q=蝺;7%Cg8iĭN")C3o ywŬ EK{KWkjVu-+vƬGrdr7~"<#i7Yny }r=I<.ݣs/Dr/2.͇1&'TWsb 荺8yeN}*EO235S(LuT,ۦB#7'6&7>|å"3Vn2Ql$)[oe&Q -`WJL,XEC)ބ}P/[$S@gW39ɩ P-g){ܦz>H#BAmdcgN*6r;{؏bn *!MW%o鋻;#=/,C !"F^8|w(dr${;(!MA̓6?ȶFL/M]s:Ni&`CBGH2s.5â&:}[Dg맍-ZUKT> S 4EJjp{L|}EP f(S/7؈;@ f^Y`:n,wq-PT:|YpѓO 6VS󆾆y$v/H' gɆ! ArHTHI1#,fIS`Ĭӥ~D yNl' |#Z3ε2E&d*b6Z;0@Q*yuJ*jp(R+G QzɎ~*#+Ah(#D4&':}Bä5R2 hK(+0Y:ў2Gc{*+l\":j/[&(-xwߣ4&+ýCM,I†-ە]Dsb$a|vF>/05B('ޠDcfz譧Ѽ 0a^8_^# 2pS2x;;ՙ#\g&k粰%UW $klwH'geg+֤bQ6uڷP6~V!oI"U^M=`5mk n6hS Z>zC^HKR4:ȸg F~84;=`Fk, թ-MUZP {[ydF {?IH,6$)l@\%q{aXV8^Q 4m[Blmgod(wD 4b}XbPt3bePcٟmՠ;T %#kKlb>1dM tr{|KD+H * lx."Ŭri/s DM" \ !YW$_Ge#$ yoM.6c-gЅc.t'%=m:'\>%gOk8泟:wF|x><[!}`0-P_,|.hsݖ1foL Sezʼ ڧ05nG. CѬC{ 'TVUog..o:]uLn{5˨1ߐ`l&tr/ 0zdǘ?,ɰH أ%m9Z=c4! +k=\0xMr ݺ؜D38o8_DC ,Y=GyDt`cJ?ڦ(H/{MnWmH<:V:DqishVXZ8Em2p_&E/--Ӈ$&TFCiN#+^O-i%nFD x[\QQ%qk&WքzsX05ܨ%u&3#mTMo zZoFqiN:0ɣPlu]j׬,>ڰ?=v~;bmBc5-c UduD_\A9vX? X9<8=?I=y,O 'QhGÀ}r~ݾ!$:FP[UKkWxuq2kLY48ʁa,oJRC)V=s(_׎,`8<"1/Æ|lDh1RRt|.eVYLqB ]{0Slm!]}`G+OmJH봾cz߉Xj~S̩eZjv䔱Qr3)k& $kJ#H핫d=uM]G'oNAN}K9h><=}hȔCT͂ejǙnPڣPN Eᚒדka-0֊[,Kec<8_(֙~cSng^EϜ1<]gpIBKw${-q\mW H\蝏%0=?n%U3 O+Ц-BU] PLa0T~Pm#QV[Ы77cn3kT&|!TU(8 6 \ uzQk4:kPBʇ䋬 v԰a!*No+s(riK@v9vBiS s_nVQF:b&- Лw4T:bMCyb5`/ ZnoiӫCs#+LaIHڝ5o]&VO~ :->J,A-wvBignSU̵F3P MyT^x ʱ]a_9 endstream endobj 141 0 obj << /Length1 2356 /Length2 14894 /Length3 0 /Length 16282 /Filter /FlateDecode >> stream xڍvctn&McضmΎm۶m&il4ѰA{odM9ڤ ʴ&vF@1;[gZF:. # TGGttGh.1t~\F6.Fv.v\CW ,@G*lghaf?_ƔFNNv6@G cC[9=5@_.(x̝ m(in%h]6@wqtps L w1xPmEvoߎ,l264675ZXb2t4C[DCk'w{CWC kCw_5B'cG {g':' UvhQ[a;D,ll`S [ߥӫZ8%Ez  tݍQd-~`^ pvtxS`ba 0Y. O;@} >g&v42Esx21hl6N6;R0w"05p+F'gſ߾3: Sk{I/(ߜvq~_Y_:_[, 4p_Zښ6-' ۿNb@ gc_bkgma Ts}hGkV׉tG53sLlCGGC8bbex1/ y9+9>Z6No_@/1% f 2;^8}*A> Aoo,P}9[ ۘ_b+9{FﱍOY~Kll$xM=36t= ߐ7rpy_?M߳3W~tޫ77.|?{e`{/<ѿ|f~wmbc0GːOR. ~wij0[=u/ݟ泼7uܼwhb3KZx`ydmd{?i0?.v|?|yv0vq|_ 팹-qh'T\XbAwaZUHQ3 awꦃ L"G b;!3-Xa՝&)'P;4?#y(XEJN_?%}GzD,z[gɥ[Qj?,,}`sn4Ѭ`ee--$2d~Y<їב]35TDl|Oy]{7y`EtKXSs#lsyf{-f !xC $I„#̎%B;ΰެ`5UԪρ4"}s҆EcGۋb*]ɻE \Z}MS3 g3~S̺5X$u@ ]IQkz ?Y0_ IthU SxtAUQQ:p;c6MCm=kӐj 'v)ם"T3v!IdAdx`'į YJi ŅȌ۞;Q5DZo? ^|0KK\嗢,bTvZ |V6EA| gD(vAl|JY:D݇&%M92MOOrh]BNeȻz. opih*)lה6O:rИunFݤ8ԓLgWpqjy^Vv#хZ SDK_cm3n=1gi<妱Y!&<GJŸ7m̉T8N1zۮ-j[ ;3)\hBv1YN)9D)(M \YAPC^0Oٴ8f(A=lP_U؃7 Z+X\QH D#F4~zEcu[vZgF;VF6 m %،) *X__KGq Tc]U\TlI*^mR(𯼔﬛K56A8 )DΑj?Բr)+TgjkbS8eZ5ǝCkƝD=ቘr})ݮ"cƖbTck0bځ:GzHJ_&ERN\?/[K'$d3:"kVBVwK$(T>6hbmIW[() 7أY܂ D$*T͙trBw^VȸXs&O)52a]fXS@Pz^Q[ިÄ~V 3ؠ7 S$)mb:K/:qg/=i>o?;H)UKEx,} goʨ^XwhP~fG;tLcҳ+E4*ef6zi哫+{W̭<ߪCo3W#<wco:ɛ_r3 {š*o-Vm ~k:4MY/ %G1ʘ3iڜp6~6AN%Y&i̗0qE ߢuȍ{S;ĒoqFX⑥ ?8VU)dU(1 >ͩkϡe!].\XFf ǴRE.5a, Ο`Μ`?zXv:dWT*C%"yn-@k@∣iL}#;_?(/ҊduC SsRv~>MYHLZ'/Wp]2W2gHx  xJt5D=Nh(LJЙ>l\0PG|i_?\$'EM6BAp` fuGcy 2 }%D:$ÒNPSvi}7<8I Pk/{nPt_m17Q>1~' J~Z 1hT3.qv~L⟹N*Lݲu% ѸH.]Un*kk3N:,%"E#QIPfol]~_Mc#,o8#K^x?kT R|_&Α/c{HC&|PΚ& teoQԑ%sa9aY?Ͻ[r>#iؿ?^&-e4$ LrwmOr3tz8#UL̙5&"e ,.RGbыBl|qP"38ÉA2α.wHיxO:IAC 2ktZTV 5>9qfvַ.x?KsUδ~>BR!h_oL<chڒJ92qkI,@4+1ͧxA߬!#ؚV$(̥*\%WOh]- xY#t]U0 uoXQs7*xA E e~efip_T 2Ws [2]Mh27ڰMsg,MxKf:ڢڪB}} ;M[Q Y6TvH@\ȁPD-s 4~&I+0Mh*Z&2-J8( g,m%Vv4ܛC 7O;@(ƅŵLI?w9MX:S}d`>kxBDQ|fI#/ T=bךs%8&%u[}$H D+p<[77S4%#.[JgWvmnVb0(7{<|ҡҸt SDs;!v1fSFH[pڧF/I ̇jI%-AŎ ҌT`  M4^҃Mթ'lkyKr~2QV5*GU:F%r3 %сBVdǛ<6V2VN.1 bx]z㭎 w{P:朼8o*1$D'8~gmX쩏 Ym!3BM}Xs IG[B" ώ̼uR<\k׷)U6,VNh”!z 9` sܼږ.2!ˏt&L\~ozFMzJ<6J臇gh#sd:8ƀp|4r/ÌϙTR$rreݷ/؇JkW +l~3`aAt JdgF h&C0]9Nܭ>fx'nOS67■j.=dk˞X+ay}H_J!bcLk"G=e.([7V-+qIIg}%:'ђW_/Ir0k饵<򪭄3'A=wYSD1s(~&7/oq#* ϩty\@ bv4i۶~fRtQG (w՞S'a}-9 Ajc. }%@yk2]B$YFYYx3\Pk@ضyXPAJ1scܟ kԣJgY[V8@RVI&tCǔhܯ?eLHKy!cwt1,7xsqⰓ8߉ Oc8a { 5Cm,^r @Lw|Ul!FN}@O_DJMXϯuvR@Vo;2.&xsp.A7ki{Q0#{ [|9(_ΈY0L;жi $nWpfCez^L`KSŸetjt ~]/!m$/Ә!&|^iP)#C &XSU8r v_Bm붥"&FAkxD7[hi%"QipxėӚf9i9ݔ8։:OO7ޒLrUX~řk gb)pUFcc}Wn8B`5u,6D? )L1*++,ܐHg$7{p`M,XfF ^`qUʋW4pNߦ"۟ذ&gM1^rꑼe3MڵPl78yÈ]$`%Nvf5xZ]R1TؠŧS5HrPC:ň?crgg3`ǝ$Vd s'$&JO۾vEQjՈdcM4D55}1qԛe<>'5iEO7nlU˨g}\恡!^9ʸdT.R߇}5OXBJƱ']K _N`9 ԇ&>KGSH5a4p9:W]FG={I!:bm>ݙ-x\ش n?*0 }_)"[tQ+`!uX 6(W7;u.9(CGޕښm? 4|!_tJOn mCuhYXWj>{T"Z43c*ݞEї8XNC DEI׋JfQ8QTOknlp*$3]y!-pƬᵫɊ3'h0s9|}%w9ρ'HBbr鴔D֏sF? r߰t8ka$37/F|F?sc8؞!9T\$jgș*smzն[zI{3)ƾAGhB>T't{QLWdBdWXXs?0tp_^S}7?W~ ľVG;D m|)\(<|BVu:E?rGBDž3^N>ڇ_匡SyrN\s8ՄUc%=MƷ[TZ8qP4jA(ƴ/jQ|ڏm>[.\gt~FolOL<'y,gTS2MgH\"U){>G7nB+fV[^~uKHxg'g ʆN$=q'2j琸[ 8k"=;,ӪDL[d0tNhi5|<38_d?Q)Uqe' JoUE^2:jZnG,Sn7`Ii=掫rxSUH8qz 7H5}ϴn0J4Lz ;;E< +ݡD@z2}]7^{F,XꆳubpQjvZHΩfW EYTDtE 0f>)10Xr@JHMD DQ)'z륗΄f7݁d2=.灛dr(v)^p{B2 ֛^-Ɗ?RApŸ I}s>5uN~ _-A7a G`frywQz s48G.Q)T }5(N= 8Ʌ=g#-<ҽ5#,Mh(UTSr25KKҳfGlɓ)jL]iO;]npOSF)dKf#&GJ<!s%kNkeϹp~He9b$I+ҟS.%X0:9[a|XŲ m]Z -fEU_Hd&_7`(yxCz׃(!bqiQ1/&㻖.h4862^i¢He{pmBAMS:Hv2N&uu~]fw5ݥUmv Tjv o9$^b`{U-{TQr3PUn҂-}b`\T.UBO= SbHJSfQv_P;ŊaDf1Yfd^(߇IZ#C79?i6Pм@P:@p,o B'W~$(ábJ|6VK}`dm9^Q3by,H$_`Q1ׯ+I" B,*Ͽ`T?[h+L͘6糚ŷ}Ti;})pѻ"o )?}q AyDb*uWBq(% "ܘJ2hf`{DxMC-Gg6"Z3e9D/@WR q$^n&DDє}r&s1َPogf9)DU&ݟf#OD VlsR#;^0.X\XeYoT`i E$m EהE ?E6bd$1vkm.}FC:\eF1Ad̖ 8`%-b+3 z&%,Ow]1ŹIVbʎ $caH@$V}00pC*-$G)?PpB7;g4Y._BJ)\Qy3O]yB.qéo8 X`Y{frX[ @؋A>1(x85\R7 ߒ,tLq 5]N3e{AǠ^/2ӍT踯뵍nr0S]CQf, v} @&wC4HCm%stBwJkxo 0>1]΍e#+E"" ܙTH܂Y5ӡI ǎV HF9e-kg=UMVQщ̅g:\SdlIML'ݕCd9Y>,{gI@ځ}.`HLnJg@җ硿:,}J_]`ˢ*g1Ť}J_Iª4_ ~֕_ **_@mۦ,ٞG.}ҟQ}U8K%<2ǥ!{3UIX$q~<+( |ઈFVu1Zvi\ѐlP폄HzewZ;\=^ǚ-%N6R7=V5W~-O˹@; > AF'C[r'c.f2ë)z)FT)C[y揊+rO\wiLX*ɱFDz[˘ UͿ뎽)|2"AVyӧX(^׳m3w"=Hg+ZQ@v2?2 (~;y&;HbK,~O ?41:Tt&Ģ}Z5Gl<+Lz' q٩f'WMկt8u(aIȑy-7RQ]e18gz֚j@d:G'jMex\(龼 E&{|~!/ˇ4n%nE*R*RWpP]_J~LǞ5%X`:Ͼd-}|VR:7( C❚ )/LDDk2Dduhu~e>'"'#xuGvFײq|YBLnWW *gg@%_A'j:G`bGK_V iwYS>D>$յU-[f?¼Mt3k-P7.`';ߑ6$)+A&v]zeߟ'QY66t>S4z9 Evw0ƻ x]Im3"Hy]M7cQ9ЀҘzS[`yhƖB_6莈?IWY5Ga)?+Fg8;✍qhaPɰjoJm^͎"XWsIK8:ciV9lX:67!Bʮv>;jժ[zxߌ0+ {zHK6NpjYFdK"z'4(+rj<|)Rv^-FWIvgFT3(vtDQ$AN*=3ή!+4%4+ U;a>o6Gkb$AWo,yL]4 aiY$;udk+[Gd]N~\{og1 zǕZfqvdrQʹV܍m(r3|̓p,Xk< vD9:n4u3+H96RpH9rzL1a"k*͈^49Km(/pۤru:I:Bwެ@gzGP 9}tmΔҗ9 ʥUw !yV[n~? ^~ڼkh`AӾd,ly;m/*\DQ_u5ɮD|c@F{/mGaҀ}IBw<ЮyX߀0u8Y/r+,:JRDZV"i!HI>.y㚕~ГT['ny+Q]>i|"CjzP>F8J+45$Dmg䰚; v'61RtMr ֲ8tq*XYػjqy} C \EU~+PdۆΎdʂ$^/Wk$)犴u< 5np(ʒtbÇe.KZmV?_;2ڞr.޴+t&O v@t ^'E[vŮEU5IO'- i!O&Vې9;'t-ܸYHpEq0d|0|lڡ%@oݬO^{'a+6H]]T3MQx z݃^ gY:A21&\\9rM+vT|T>.s}XI[ H$bExHH`\(ӷI)B41-BэLH(Txc%ooՁ &' 2p:slbuZl%Mu= OX s`)|`Pɧf悷P gdVDTD6U#qjFm]yoN{L%bhkj7Xu$I*qrx\zJDpZp\uO3f(:2BAYXuLyړ.י2RH,cC)84I;5Kk ,at4q!ty~v{/x%koɬnPVfSR%/LQufi8Z'M-{DB%s MX ]7p\}F\Q1:)Dbތ:醱x{˹,‚@Td+]}S݉/AMM=z\T޷)d #;u׬eܼ\US:}ՍqZw'!h m!o5l,٭OuL 9lS?-]:iJ*m3GgkU=Ӷ} ZozR}*$ݒT#c{:?tYI[TuK8Tq&2k+a#ڔ!H\I,Pt oIHnb0 C7aT:9G7+ g9 Ψ̵l|i F K6)w!ޖ%#u-HŅ ":xG oy;Z?(%X*˄]$TzYo97"<>987N0Vm#1lEݿH"oRU^^#|O@P#״-ϭ헷^H!K #&\#嚌L \FюPL'&Sxtu?D]el+;:ed;,M.0Te&1R}qΙۤo2Teoda]vN\u:;AS H$z}%_~@bQ;gO$hȪ I s*E>u@ۙ}+Cfld棨+UGD W^\VE%_>/4^r[c5W*G9S8 ko3_oX9Sb̳oILja 58[18"9U֣OVa"~FI {iu6_cD|ɢO~kBZwI8W][ԕ[8tK"S=UmK"C*Q!`+G:3&%-0O V덓 +«"~2egJZ90"*uZ=nsN~.:ꔅ5#c֐$h ecfd.J *3iIţ!<[-@v-1]a]'rZ}鱝LF*AƝFٍyORb{k$C1O&+>e^5RGYrh.(= ێ}{"f*Ñ`R'(yeiF6N@ȱ?0X3p)Z[4S! ʣNtw+=H_{~P-/qj6uIrb>y< .,eq!]SfD3/)P] j =Rf{ӝ qt /D:@ڈle&!Ιʋ4˕8/iA2Qh`z%x1gMW9L/ӿ]dKPR~D`;- L|M7Ԝc Sh n"e[+p fZtS'͏Y/> stream xڍwT6" "0t Jw0 ] "HJI H"tw#~{y}k֚y׮gae㕳C@p4HP $ʪC;CB(.$)@ PuwQI1I$""fh8ϪpF >?t@قqh v0%8hWI~~OOO> p0 AA;ʀ&g5>|V@+G{ Q)p;詨Z_`<UOB0d- =h)<n vF!`3{t0,7 sEP0_;*s}Jp; FO^7u#<[05] 07w̵ >( @ qq ^{B~~wuEk@a|_ `h] ˾$ 0]Oav`GxD$*p{ ״(G?ki" 8ssK)?'Rvwv .0g?k⺣EFwT a^;m/74g@~[^bu~I;V?[*mvd&(" H7>K"" ^i z=u/_G[w$Zkp=oaC ^[1TcEhi'R|SsH4l_[JzNj‡hO[Ӄfe1:wysZz; t@,)jN{eXJr&Ԋ2&Ңe6m`F0̣?ƒ!͒U ~`FbOcϼbS>)3IhZ{hIjrU̞ƥ֢0EvF1{> od$y܌y뽭M Úm\qI2}+PkVaD}lE^)qz&B2'1#']3ʦ@+qX\K"L$_pNrf{|H},6|^ZQMTsiyMϒtT2ThEmURTV<ȥ A&h8 ߺu/$LWf/@CM |w[t35>ODh-u?(xjA4b&xbC8dscQt)n <97cnn\+,`="EL k~S@s5کl&hiBAԇd{N;3F Y|swF)j7UN[o$QÙx-x?i=>O)N9tx5^N)CXS\uBĎEɫ'eoq?Tǽ s0&.ƬcjjL C=9U ¦4oL#-ҝƲh]Wūń뺒@­7j".Zn+yk.p虍O@ /LD6oۯC:}r j 0?pJRru߮4Hv|DÍ{Us[%׊"Lɱgv.G~۟ƱVlhtaJMM6>/5&X\\K륤l~5׆A$qamP4GD74>1_:.jRGd򝈱@frMNI" G{a3og1Tm)Iv^]xM\Uy['IAKh^y-;5l8s)3eMc.oLNj'[{qA YRjnɇ"2_іУwb^)H"Gk< O>՚C^zH 4M(C4@J@aM6UWjJδk.~[%ߣGn<|(`֛ϓuI~f^8%jP2T-ꨢWO"s={aN,iJ?S)sHܮ}۹J,'SNY`xsw8rjX 7Őh@ӌa/ƶhb2~5D&MRHhZ E4~oa|t:IIA8aIQ_ƕzLXMQWb#ˌX pqq s;let;Hϸ,TM { &[48N%[ %>^GdCIJžBz|٦,ʼwi+^ lRyȌ|6cw" ڶwHQ3 %IZbGLuaKerJ"̓56^VnVÀkt}I2I.{"uQvJ,֨Ѹ:bQpQ1MAJv̎*-j)1UeWRG'(<6nK:ybW_TCҝBx֊G-@;[ :?,* #%/>dͱ__ ߺS^1CLVmŒ-v3{wK4E^;9\a5L5Q䥡t5|*O=/u^R̰NwΪ}P.Wa6lae:KZ;q֗$og//6?k$juG?⩹Tʨ |OR"ik(zvrCt*91j-y60:,1u䐊O5:A jCbF %Fki Y[XU$#[7Bzc?gn̅<ʺt`3o?aZe`,e K nMQLPx-^2/1EbҞ͒D/}ayxQ=]y2;IϬ: REt}^ki 6LkK;lAW,wGdib *17t=.q=/60oT%5}U$Ή [Z7"2?Ik Wc>V̄?\INSI9YVE d?􊆶1ӏ:L+ c1Eˏ cpC a6w!$ ݗ" {!4l䜾zX7C ٘I[GUf% 5š,$~)ےMĐlsfM~Uq|AO|X5;AL{c̈'e3EX&Lܨ@FĦҥSD[9Nah\;@ӒTb*IKM0gʕ4[A4A~Zssf68K~2-;Oo0 jUR 毮ߑ0+E)[3_ -6}2_sa=τE;~!CL<~E`H&ay%" {ä #藨*pڝw}_AB/kt5Y;8/8]hLF, hsUՂÌfd Y^~'?4u2* 35YJVWސH QV&YŒ!w6|%EvPN~sC;.<=xSo;ZJ69aH\is+o!q5{ǾPId=$is9ޡ?@_ayc*r= t:@lDݗj*=˹zؚGs,̊IOA/{[5Sk.$6r(9iHQ67c뇀2G38V 8R]5onTI?]]UJ ߄"U02]|G|Qmd"jB[(ÇUQfU7;<%>8S|S\NTjz)I.Yyӥк'˷v4R^bd*GQ(a?;)^P#U-ynȳ]U{P מtΛ2:Xʯ# ۨvz֒4bg/ֲ]Ďѻ/'ڏ+mxE+uw~# tdV!HZepŒI^EEnk꼯@9`5mW\v+l!su>.c7J B{R ަ'a";KeJZ"6EZ<%* .QBRzHlM,,)m:vnM4ۋ8xU6qV*}(nz]Gs&fC5czE?&-ڳ^Wet>-t*g;gwη %H]m,/-RM'^>r164EJH0PҮ ތ{ok`];'zJĻ1{),<2 ~kӊxgCbeR}H MM~9+\tJv<݋=8(cN!;ZkS5 o&%)cr4v\<19Q9y; N.tvv}YixƅVƃLv[B?4XN#x/t􅛆[ N燼X7d]r|B㓪s&u{Md]|N8*_rm9No_tZmл(g:2zn٣FpJ t-ɩN< 3=T}ӄdŸ?v:ѥ70| `5f+>Q43DzAA9pO.h!pը0u5O'snl5\~MNޓk6Jnlz=A]R-H]>8ѪBXpn89pC.;`/y(pq{#bbxU˘alwI!Bհg`q [;Q-鉒c`1Z;5X4U/\fKԴ; 'TiſЛ(/]G& h1ZclVRD@qYZHrgIǠ2qcud{2IYt =,O n`\NbC}nc2DŽV`>Ok|7&˂ T 7w*>rHP<by8CdQY7ħKzoNXYlj/ ցs{$6[sW_0EoRSMV$D3h ;;(92)6b"g)N\4ή> stream xڍwP-HQ@t^zhB!A BI I^E:"U^) EP:JS rs̽}^={w&<F"PLĊH+ }SSy@\\JT\\ u5 4 !XNt )@BVQBNQ\WV!(/ 袐0 )F89cqe;  r¿UwA3W0?R+;cbb>>>w( " ΀ C{à;d<3nc} h3!aH . \qTG0!wHJ;_GG@:p 0b qàpo h܀8X(kD_ipP0$C?u戻v??uE|p 5C DxztBp&؜`X@F\\\^\y0_Gg_<`͸ 55/ "+HʈⲒ4F6?_{%_qe±62⎸/o1W!M/7n qGH @?ՇA^BpBPE:M/ j::a;H ZD$ˇ+ՁQ S?Kj Q_ h4ďdIi Mb@LBxA&Qyi@엉ih~/W_2|aPJ.uǵ>"o??HꋖN? pֻ5ff4)v*Ypxצ+/Cv!OoYmOh[ br|LlJioMh͗j1u)-^~G3<9`ƫk;deC@2_E$1-['d-, ˔Z|lk)ty<^5CPyRtEt,a4A00ngyqkNIW[ [G8wZZ|pnJ&U@%47:6v.F&Ky-KC6c%:ɏoERzkT,#;8ڃ]s1Ti?vjHr{&vZ?؟+wвu4sx`;98I.0 _{\XXR.mTq;j2J%~1]03V'9 iOKeU~zEی@kAr<mrm?rk㓅\@JFNE:D&W/ۂH- o[Joث0UT~m!:;u@(hlb Gf,`H-SŚT$QR^bL#b0v9H x3.bLq"u)^B$Oƣ IOm_񽇢 C.!ŴS es2%)zHƽL3?'Q_.© Et}$ïBfGCkdk< |'Bnm[Q9_8aTt̼uElYz1[(vϪ#H_&2/֔.~ʞ,́l7ʞb^VUt#R4yt6,A'pa&q:vhhJ<1vyv?OK[ s,o? 777S<A9d52?ً <> 35xft4Q0[3bJ==fYXKrQ&k03ʄzdqUYnr"XI4Vy1գƹ/\:/vgO[Yù)PcUZyhlȻR__Vbah#kߝpI cgY~puv͛1^cރ|Ǘusޛu +y9dU%Pyã-ŵCiPrXvl!y\zwfң8tQ=ʐӸ<97mT }k TŢި|S} ջgVK4D]z2 hg{,5d_Eڜˡ.J=%K {@m`9m|Ɯ!#Å3o%F79\F7mo\Ù~홳gODuiD8SF4!WT UT>936k2 _ >_L-瑤 ;fxxJg8M:XdlD~DhVLkQZ#<-R1{kF!Rj$bȘp[_j/s昜~zVt6c ⺔cBd\?_b[JV7„+Dy9# EO/~TWM%k% m,"W ͟t ˁ闕>:u qT7Ιh#FgA }#šHwұK?}w`"Ru["!oGFSk/ ip&za%?kl67iX_ԓ{K%5:ءKR\ԾHV^+3^pFmo=]dυ` hS* [pVr;-Z4"n剱{xݧv+ $AVEZ^3y|쾔Ӌ1@FyyݜCu;{[QHwcefUˑSۏ¸rMkβ+q8IGQ* %k/V  .d n,#Uؤ'A%%;owZ? B)P_?wlp;ձ䖺l3se'i'e8썇Ci\Jܪ&l󦫁" %)6:DZfF8snl3k,2P9нjzC͛Yǽ^E=+ {w$8ZށhNiԵ _hAsD a j|fue,#)˧ f$'nzE ؝Vho 6Ѫ'U_58MڈNKb]"<6("qFTf tFf砂T93 !Q,싘evdZ ^^$'5qi6{`Ѕ= ̾$I1zU҄@sM(s̺%K){"wd`f۶Z 6yfxɆLsR܎ _*.Vyn> #>[c79U\2>bC 2 pͫn[{ e3=^^|yy~.)]{3gtsyln}1Fj"X=R0f ݻ4MX>nQlUeѼ1?ut̥)#l>#?}?87$.0Vd^2\Eq~|/S寭H,vۼߌ\w5X5}Hi<|ބKZGo)ZDrLPWH;iyn"NAU:FKISUęNj^l!MVVVϑ]uC rvD;;7Vc˔8K&2,N{NIOZ?{6N^-IE 6%;TzANDsT_9fk+ȺF4cTkZZI[gL^G;4v4xi{S/E6CӠs"emflMvo!f—4Oi2[vz@;Cnh)K}CʙX7n=t0ɽEe8-F(}t}c\xN֤}ט I둒88+V@Sd?,LiQ%3lh UeӜQ">Q*V !=u8$ßsȕrەCWͶ?H? m4XmȷJ$N M1|XS*;'z)fjy~ߥdd`rc-P?wk}XB+ 4&dY r)L(`iMh2SБRZ"s?i^hl$ }W8-x.v43P+lW` Ocgvx#P۠mmDv[H̱-Gvz)p~)m[kTq bvR -l:;)kbO#AqFޛMz71/chbj7+jfN򟖧Q2?uKt\>~٥RϴlKy&x ѳ tu[p_I~shli>:G=VA\(/A ο %bhPUafyr&Q`d&㬚B0) +[9q=dabu ?uG[p.>x ?fj\<&z#ѻR Ŋ^Yԡcъfq?km'R}U:d $|vYyC+ /3=W.x3'x!n.6/~rW sQ?*9Wŝvf SgF"C7TB,Qԅ_eZ>tF7*jSCTU;ǖ+KI̓qd_ D.|oy^u\>_` ~^J8 yEt^މ*NJIR"gS}%Qz5> stream xڍxT[.E^H&%$!A:H&{]tA4E@@|uZɻyf̞gvfh"A:BՑPgb%bB@(') qC=Q0$B1T< 4S1D=$D$E$@((7) Py =!6Eq =?x))I%w' B@h;fG00AaP߿BȺ>>>B wYWC(7U2@S'`tB<  z0LtP_dݿ?O?޿A`0!N08`+E @/"BbA !NPW20yQB(W¿`Y QAChѯTaP04 Ar! Nʀxy!`Z8$$E/E~0 S4|@P  ^ 00u!N1l^y( Dn%cTVFER@@RR8 ؟< +]9 ^c#1ʅx}8yoE 3Ry"v; Q3zH, jkt[ 4(!1+C|Cj~"Q_7 /fn[o3CW FB~  #`-fƸ05D+;b~onRfKmpMHpI3dp̈Y8L2b&sN|$'sU7jZj(=#gKgD?Q~lƱO&Tl 1,\3ߚM|Ǐr3Ďtk%j")ǒ驓r[PX\g*i%\K8K?f:żUBo<|Հ[:f_1&LBך"PY :<Ұ_"ϭt5< aU)ӭW}QGHfDˮ݁-7|jz{ބ`|\În kE)s1BSX7)̒RT0?W-\X\ڽSG7Tn}óKt<%)vq(FM5&^n)[̈́I/(4 ,xɏMJ Ԟ5g2_Nwqmj6}?=tՐf(W5'|1vzvj>F,bs.sw=nIGeUm2GRbk5z!\R$_&M5#\ :hvm8R4|8:gH^$=>) SP'aKW~JȞU.DRY%̽.4T;ҽ]mUVL @\}ge6VK=.jK> gUKm"E=KidDPZ򾏇0i4ItW`-EWt\'+Щ4gӺbŏM?ѳ2Y=d{)ܩD.e47 pW ؆z9'/n5#A :YBfUOQpsdC{dTVzCkeU٫5eNy-ѓ* ӌuݦyTҺ0îlY̦,hh}$Ďj58LT[v y&LX`i4(T L-dl}wҜG#YiîJ|7[Z"5 bdq#Ӎ{N?Ҩ6ވFjNG7#4'?<9qPup*^63b>Jԉ[oi~sE[0˽zp7t/R7$ |4D=^&T;6- [avo9Z6Nm)[Pm\‰vl! ũ.BK/;,"%, e9EވYk5Y 쏦+(mF f3eHo\UAk*I+°]8Q*XmoWi7߭O *mOхLrkh>2| R&;}6#󛽉m睽2% [=C ,Rn~4M~2 #o)"SGs5T9K|ض%nq|niz;vga]ݿ(LJKq%>(j1n-أZK"]{/ON&Tձ9%ou>4f~%x=/mp +Ams+F IH1Dc%5.%OUs7}& [A n yMډ.p.#:&ȶW{w6کk" (Sy>X\2b'Yohp3.zΥ&4;rPq[`]C"t䀠 ߶IP6e\*fzܗXjdg ʻczRCz ͋3m17X }[{42X|o=Q^&nxBЪۅwOh^`&5>B+JJ|Eѱ\hJ'؟Lq~6V+znߎ?ټ74S"v3~d>9cAkgQÅ7:6LUۓ3#ʐ|RqCsZ f:gB7/E_|!ʁY㈅7 "]ܲSV]P= Ҹ8>5;/[Jy87٦!۱f\c/AK1r#OĎ4Lh>6:ooX< w*8hĖjO!Q )a`<(*[O2<if9LEXg"ױ@J+bZvAFۜt/,Z~gBwbmR3Q{QWU~)`2D*q eܳڽ)?ܙ-7=_* *@;N)ٹNo'Ry3k%w7gL;S)N,jo۩ʯlJQyZEؾP-E}JMq|lT_M?Q +[5Qf1?}q$VN*GVPWkO&.v^~{FglӠ_F'43*[y޸%]{R vJʻJ%pnJZQzd&EM aO♇/Xdt\-#, uw+S5!ͲPYfۡRleFᆴsh4eʓbtm8.WXTӿxtA$<=#n~b ͵>Uն .D]dђ>+YB+. 3777ۻԸG`*c'?2g:S {h:yd[}9%."w.ٹ|P5Ig_hX@e܎ *Dy&NjVV.:p d$/c4br}N6<-ڠ90=1zç ;E10/X%C:'^&S?CvI J&ވG}U:yO4}r?݃ g=k6EoO[zzDM $kGU7uQ >^I4ɺ y5f3տ]wLDFWuXuC%)Ur8' #x|ﮱ˯*z;%̄اtf#죳Ur_PKHmەl}.% > =ASU4WST׼dm0Ce?H!0-St^5 ͑XK0F½Z|=eWZtY2d~k G I BqkntNe"e]|&9)RC@R&}<<4^Qu]h(܊⾊M2JŸ\T7茝sH'H'Sѫc/ܔҠ{RBWe ``~h.ԩeB:u!`[IQEe-wR\2>YoEB\ߣޒGgad>LPKIfA ǹ GB6M ;*'҃t;-Km0OR]I79jH&z\Þ뜢71hx*lg`P"OXCeYkt k&e A)j#ၒ hHBL] =uRǣW;U;C{h:hzŸŜzIZaK$Ҧoȹ mŽkzԣ@ ~7 Q )y@:꺽е2?Aq"߶YȔļox25&&aں} Y 9\H{9 Ҟ#ŀD9Jv:&/L5hbkMh Gu&gDzoz,ՇB: c#6/iv֠3rzHJ^*PmbEV路Rz,ڟ\}Ng]z N\0I#+y;Պ.ю8bTkY=6M8Wul -%Ԩ/SeMJ87(EaB-p;JE3$ /[~]-NJI֗:3>IS43.b۞|L:>H.f5)qiGr{9({&!ڠiDl >qWe |hz71\tN;WϪYqOS:^fs9tl"1Pl#j^-CrM2J0G+C]A%ņWddxm|\NebPXcB7iQͨL;gXkXgLЦZ B|hjy1uY;MwB[2Ѷ-xj7ɯB"OwȴgaEr_Y\_9SJ*z- @88:AQ0fmojZt RW9 Ukz?֨$dtlh! 1usk$Ƨ2 ?mI,"ns G endstream endobj 149 0 obj << /Length1 1371 /Length2 5904 /Length3 0 /Length 6848 /Filter /FlateDecode >> stream xڍtT.(0HHw#C0t7R%R  !Hw7 8޵]7gw}EKG a U@Q< ^>1OMrH.H((4O:@HD_DR vYy*8ԅM䉄آ=y; E `8@:w G q[I tww;"60-@EAh&%b\k;  wAg­Hzs@ CVCx{6/f*NC G'0XM5^! E; `70l& P9\x]`F*>ey, GOB sp;5) UKACDl(#aaAQt~ |NkP_5GvPHWsE`j:ZY/  -/+? 2QTR3c227HH"\e5OcWn@U pG|B|-)77;;0Ͽh]Qh#67ǴP+GQ`6h1y0J /9P- ׷_1 ZCP}<3~!a{/$ id@S}$ѯkapW_(?*C\H~ ֿ z@!Dӓʐ ,X@A/bLu}&,e2 ʭB,UZZ3Kk?`p i~51Wѓ;3 q34;=uq qԱ.Oɘ<|&gl:+LX:[l"xGTB0&% d_gp.d%ݘD*Rj5Ft>$kyy1Dprd}r14+AJ|`݇@+2_`?IH~JrRлUZyqGл9P]D^b^j`7% ƻ|r: (eJ;PC ),?J!~73-gU`绘G8&WD<"2~=*AӠD}pt2ܭG oގm J: Л,qydpfJ_M]'bA[s1M_ M[WL顫~R8`Őw1xe=o 2C]̌קf"gt{,@gGf 8JOCHHC#L;[$ igneT+e'Ȕ_vVvONِAI7uҿ+4&[a1[xDW.g~54!A+/c]|x"Zugyco r >^j{Qv%ga?ݢحy&p5x[8u#vlTP`Q \:[';~u20#+K}=Ϸ;4’5~]P&ƛlRƀ5'_^K AR)3 50ȸåv}fc՘).;EEGgyVPJ޸^suvq8҄IW 4=<8JR>3dF u  .,Rcz*&#fH,0sNhmwtjd'R.vOȦ30Vll0.i i^W5f0p'vJ<^ZmҶ{5* ~HKphK3W/lc+>-2xҰ6q6mQț!H]=1h'(EY~'t[w >|P?[\/Y@8|!Zk7}PBL>SOK_XUIS׶}952#a4{^5S}gWWdʣNB7a2l_gc̲@e1U69Nyj #'.o8[ V$;-_2*<S9,u._8zD/;aߌ+2Ҽ3maW(?ORyfO^[cHgM'PhF iMkɭ=aK {;wG)BC][Dz=vsj~'P,WX[/Oa1k"C#JReGGKI-k}َI73hbއ+V-q ~ 3ëĿSȓvIn(/5'Uܖ۝5Ӳ~Rd?zmUY}5s.1oጁ(JXlP+nvs^سi/BR;@|8 }2VT&;#SdkiOZxz rq7p óFܽ_V7Gsh.bJmedfT6*;sBr(bWQN=HnSGpSSm[2!&f(5T FR 1^2svC8j%KzXSxsy yNu2`cPJ |Mvfig&ik'kQ6E6EpU(B i /;U8Rm+4T`a?bǀt7׬qNޔmğ=ȡYMGyG ৣNpF5}N$XvK @~Txr6 <0Ӱ%Dz^͟?NvǨP:&oer#M@qR#?_˸R;7.p~Y栖bz$J}$^:PE~L2]ZYd~oaG9fcUe98 hߞXTyJn[$I{|r~.E]Rvw>]!d}S!2>ta$K$8-,Kmsf҉9窏}-lKt*V~T<?z/!)9>>h֐}0e_=xji6j?fQ"v`>GO<0lNZh.4(u->;9Y&i{OHO8;E;-s3-J6[mދG?ԛIs]OFP<|wٲܟ&^a:h.260<`}c**m\IWrH߫ËiJ&TGB'2m mL}ʭ<_%zT,fJ{tHVg &P.~bjVSRuQR$μp53e&|*]ȪPm(^RTIYӱ 2]Q'BfKg;/'6y^`E)~՗?a3W~E>L:lߟpYpm{'*@]'Х'L÷[z2n hvZM2mjkFf̶GKv 4.`"oE22kIƳ II׶CՓM߀UUZvk胉[dO-(miONP%r>NQuOͰ#q 4I'qSJ<Ri"Zprt.XPii+hg| zy|kخ S̥ZbP/ap k5)5U ng,&BWX(y)je*=R/_Ոeڦ|%* 9{wF޺P6byy7KJh)${g`x̡D4F0Z|XkGhAq@љyd%Dn|R]]=n۲N/[qQgh7f1G~핳5 VQzKD0fQM^<̘x)=}ל +>z"rVkx b,c X83% pϳHҚ7,NJh1ǻvo }QsiVM|7{U<`#HeqW88*4%hδnpwZI9e[?NAQK9k]q!ƕ8N*ۂ|=V*b&:?3[37 qikh0Jb:'u@^DxcrbX+6Q'F'A7‡$ݪ)Gڶg$E_n L:oC|y]0-Of*JHW\  BOGpNvc^oZi+7^ zξGiNn< ĚssVXjY*{ۉ]z&m:[d9;9ER$諩^HL@Wop; |!+xR6na7j(nT)(MygxE&]N9>e}[uEpn2JNQw亪J%%BM43k!%_{ ~!kF=jYW=u^M0@240d߼W3_\ f\34ik?2I endstream endobj 151 0 obj << /Length1 1660 /Length2 10487 /Length3 0 /Length 11560 /Filter /FlateDecode >> stream xڍP[.k);]Cw  HעXRݽhR(Psw;gihqJ[, 0([ bdԆc1]\!0?,d] L2TA<|AQ!Qnn/7ȿ a.9; x]eaN^.X,Y<""B.Kۂ2ZZ0K_!Xmp'Q à sdx@M+le:wk\Xm[_ -5<  `듋 xRVvC2Vˀp<\< ?A0G' XC \pO8 {  '?K5wr8#0OcZP+A\Os}P_ +7'VI `OK[ *y?sX?X|\A` O#,@X$[ 0~߿Lf:x#)ii220O'Wzz8o@2ܧ9d9;:쉹`n-m.,#[ßz ?z#o'@ 5j`+jᠧm<1/9U z[Ś: ~sq| 7S2dOdn<ǿ ĚYՆ]UKSzpn?ېp>ˋyJ[dOmo)J6_߆jm;F$qKМjeCvج$+9t8Sse!:so.Hg|8H!25ғS '/G^(\ _(@R:J~|b>dv%--w-)z 危heMfUdtGY?M:?O.`..+S$PTR˕EZ38o횔1Z1FFggs(2%!b=@3!3nl9h^փHz>H7Wp໢$4-(Ps@1cu 94S|;YqWs!k$s=˵j `J*3<0P ]u%XO޷S <ԉ#{}WqBu{2hSKЗI>W޿-s?gH;1׾D;'pRV'XꖏX<4bGTWۆb=/Ys~XMݚ˂dkV\EIosTh(nJS Tc:#}6d^Eh$D܆, #;\ޠhTF9:G&8 ̙Mb1> ;>414V@2L޷ACƷ+ Q=`7eVyʘzm2kԎ]>^s$LT]묍^l܁ 15ƒ^t24=΀ㅐ3)?!4 Hi6# bưw}s'+Zٛ+aG.}dc-xrN(%┬EnnU\ ,6r+Tc|7qFAWx7D {%f܎u"ĕaAw7_sS:RҪ20WgJ~j*t;g˂"݂M{~?z,)3?h.}@j D:AZ;%#ޜ%wb.HuH-T'ܠR}r`"|6T^M[O8oF|=ligaI@aΧ֒]iʤ h0w]R"w[i`͘V", h`l*@tGԸ:? E6 R3ch]j.\Q~dxD;11\^NL]a9%E3rNy ׇiõ| )xTIWܹIP%lV\4;Fv^.bZ>[}۰;es ΍bB0.%RkRžZV`w uI!-a#U(4UiQg d7Qbq$赍;loхȚO7?ԽB5xg N$w%Մ]J :Fyi؛(<^:p5{Ʊ-a#bK(W@7 ٰk7>O `}/ F ܃n*G\[`{'dkB詗ٽ:N<*pzތvU2XE;Lx%{#k95Uf=IKBbFƣʞIǍW e.׼Q+jT }tcŌxV>%F=4@uM&񲲀KE$"?gP_ET ^Ts9'Kv',!E˔at{ǼM[%$sIu.9,9,3o<'; + x(/ն |9 ^Rxe $-ltm\0㷎`,]qxY Z>LWZU̡ZJJCyY})ug9fC!VP2%~`%xqg32Y]VϚ£QZ{[z KW T]oyle1_SWQ<֑ICDbI6_PgweX2uv-; TQRACa8?~~U|tQ25)!6 Lm+L;F` Sv'NF~UK&ٷZbS "_ ,-S(>ϤvX[p'uF~ag8{TLh 6X;O#& vPwrυ Τ2̕wL9RDsi*?KkKCwxS^bԠ*q%=?^ b KNU] óx\.ƾsee5%.^B\$L!;>Kkަw~DfUɱyd"lH6 oFcS*0jLIf^/u=M{Ylِ̓SViyZZ#Ɵе%g_h"/eRuoȋ.> a.qYdiV,cP}OC/|>oǸລx(0=M&;M)z @>4}NyNӋG~|z4Qn%,BY}[I.޲8dfFeHU_bXVљG=o&qj$t'F(d88~m8XS y+~^Jd@di,)<ͺYXJhô,n2 Ôx|1w^$Rάgj҉wV Ʈ: zoCDĒoSd]o|f30%|&W}zj80/?Ԅޠ\ø`U]-9ԃrS޽|SWpGZ]Fߚ\-(" w8>9QSӸg 1^?,4i?B-3rHHx^n:1q-~}`Uٵj\G~n5.H0xS 7k$.^+![/9&xע'kLښW lP@f#+1꒴9M^\5+LB1~/6fݖb+{M}(!(ci?%{ = z=EJ s=%I(ynLU3;z[𺺡p룀za*k}bY;P'̺C|5HףxEM&ɜDh:ZEj'h9bͪ[ڑ~~;ƚ36r5-jU(tbH#Q?%ᄀ"[b6 6툄rRMx.#@QXA~iMá|quM]c) E}*Hn؁U̡ޛz[ h%ƛ ~x$uhߑ򦨢󜀞S^ 9^HՌ~ YA7t>وRrub>H쥙]]=%QE_ȇlmEl`auaN>3:Iӥ,kIu `~W5V2A`#zd#WƸxCb{\Ie'ma^X(vCeH>n`96C{?b04:f!}&n^(u\<2'ÒZW )EXwrx(5fUNoE~QlH*Ǽ{Gg :*rW*eew,)57oH4@gH(@Mg_L/QA).>Z8yo)sA,3A1pZ8,oKQK*4?Z%۫IZ_6};05RL 2nt镗)/^?0͊hULH3Ser_YUԤ=|,'*Yc}6Frζw$:[3lY O'ˣn4ٳ׆DC^bn#Qvo0ȩ 6M K/-^zNаVͣxͳtO*vV}̖CS!pZJ[>U̗i-JD ށbE2omGPX*ef.Fg?;4 5STje*!-C|0jfc~S뭙cR}RQR5nki⬲,Deʔ}&w ]JG=J?6|wA{}掟M U1I,Βhd؎'zF{B#y֓C@D#D9͏9k 7z>Ϋ+jUMѳ\苆>/׻xhfsWtƂ=@x/wR13Ɠ+Rq/!y&W"6J#A QL@$ir@D\/Ru@R(ٹX6ă;~Hy\iTL(܉pFw. r/4+~fid:q=GkDg !pYeX{3'$cm/^#a쥙b˶EH:2%+vh ن_A:8>== Hoa89i͜~;WmlΞsT#oMu2tbmР!Ag ""ڸͬH9_ p С QsfG&YaT5%_f c'~Ie ؉iخy=ʽ&3A)>YTev/.yolDNH.cDUON+W{})3ŁSvwB4Eg!\Py] j;(ɥA%:rJx|_^]s;PJP42*`(C*9&`Ԃu%]?XZl6㪲|^^:QdC'3M)^#b]EY݂lFo9!;r1B)̞e~=ubfEOC@_jQT׶DY3R4x<;ʐ$.TD9 W3~` gJO$6GH p3v#y6-:JE{Q'#+ObV1TM~Qh>ZBF A1It UA)S'VsVx>Zlvyо̓/o/TE^S,\M ;(fUʛߕUޫk$#֮ҢUi4`r c'| DXIQIC ӴqN? `˾sLk%$tfv|^Y~m* ? ٜal^U ʃ}eH7z #ܦA?'8wN,jNNT* Nl@G3(₮V/{{tE*!N}FzfMsę837O}LӔʧ,E_-Nrݢ#xy\0BWX~RT'~*Uw i8%V>v]>ҲmWJ;"ksx4]wt1" q5d>H4=V\Vtz~\j^ܻlĦ#Vd>w>R 9%3VjhVsC"GU窳{quy+o^tɥ3PچE]I Da1ܖ/lq-"^XYβT](WAH"uT*~N庹%&)VTn^LzkUiDž52S4~{#zn.O\t~)tpoډ=I}^ ;DgH swH"ݾ5qmX{|$;CLߗoY(Uua]x7~]ۄب㼇aյ51%|3${_KrfCmGvB $km]/<^r/,T' ^"Μ $ޒ|!~f^iwFrmAk'Ip' %Y<.Itt+^~TkgvbEH[>B ^!(n(ѹӬz Vv}ssJ3SO0yBaj#3SpHoY~eCyfjuS,C^yz~T-;%Gwv$7ՔMjNT}@Jv|=L4 :ԗg܍W$}$6HR:MbF 8+] |*l=\?;HXH+J@k)&lzu~u.&0s s{M{UZ`͖ҎJ{^H[ϴjuFR`\:{@Ŝq?2qsZS̭#1&-B w9OC9P&yXả.\ܙfޱ?g< .E}^䰙8@3GQTdiZi> w{#4^i&$uK["8U!蕒xe-e~ąG h:)e AP (ŃFg +.xꞣe`}ziaiRO~GPaק~!yN)Z"5tPijGITgJꋎ[QPF}.}txmZ*i3V挶Qn[9PSoZOHҭ?mٶ_2kZ'X2GUɒE7dNKB%?b:#xzFdW0'Y쫚v/˙-*-9E:P~7^{bq` {j(N2ᖅ m ی_{ʏK)'_k- !;9̘53gKԋ:'mO|l}U] 6..({퍺SEI>& fq]=q`]'\[ ,M}!/n$4Ҵ'02bBX", z蝸{jo6%\1;)~҇وz٠N<tZ,c$?۾_`Qߥ˻2p|Boe"Q~YDt1u7H}{}1dUjjENU',lEAֳ3f 5,Pw9`'*}~_FcQIJ{J7Yh}5 endstream endobj 153 0 obj << /Length1 2498 /Length2 17941 /Length3 0 /Length 19394 /Filter /FlateDecode >> stream xڌP w 2[pwwgpwwA]@n9ܓ+`Vݽ@A l`pwe`adʫ0Y)(Ԭ\mSh]yudbƮ Cy{- `ef3/@ qS:8z9[YXx@mJ` lt25Z@ƶUS+tuueb`4satp@Cr]@3_%OPrB lL. 7{33P(:c,z?0Yllj`hleeo0%]=]fۺ8ݍlM@n V*>Sg+GWF+ۿjd+ fvv@{Wr;x[ٛU#PZ `fffc@OSKԼ+YjqtpYA}\݁Wg7ϟE,,3+SW wth :g+O.3hXI4af^>b&Y51JW)" a`08ظ<dlOxJۛ;x,KM g=hK4@1c`6b<Ho= vV^XM,bϰ ̂Xq4ԂNnq@kK&A-f6NPAQAdpźSqwb¤Z:ژD*VP`<]H Zdʖ7GM&+)֝ H_K13ߧ59R[Q7I)8M޴۾GCם30k|dh2:.Eܴngpt??:/2Oi׺]9d yKX/P~a.SM }0ԏZH_kk81>D-/v畄=W3G$dËո>'JYk}OgU[V|٭3pΒhUsy>rW;)T" v@Z֧\N]יѱϱ97ѭ&9[!͆JaaQA4}gχʏcq`*1Ě\QKdpL^wнo.:8zKAWcqW_8KhcIqkY/B- a\/a"Ɛ{_ kC Abq[T#TWh&q3:(F3X}#R4@޺ukf 1~-$OZ?"'ϫO$򵣘ݣ˒2sǂ'~KbE"j*qdW=U`6=?;@2S 3<ooT U>Q[ٚ#AO|9EJv #tccM#p Ԑ)kkw$ߩdWBpn   %RkRCF|@cpNP+O]ֶ B Ʌ,ۧD 'vXntm:j .A Ev{CZ=O*$ ^ަ ŢVU lF'ˌ;yWOe'Kny`~bX̙xl#Nt ͥUBj:X xt$CRmZ#KWKEm6uM&]}7B_ky@UFL-UҶ2*_gKӉ#< O(5W^FIYO  잆Dڟo>mrP;ѧIb(&p݂SPur$j[Ox:\0c`u8JCjFb:ޏ79ʂPϸ ?5_堃̭R?Ƀk=['h@]p QfkX}) wQzH@;4ٖU$|*,HY8Ո.}Qʻ*oL=׀*cI}u(XFWiKH"Zf| Xp_نG7Py]u|.8!V^Va7R53vu~Y;5L1Hy$)Ԓs EխC ,sE~;hcDGw\>5r?4h(0зlBBO2E?9t8W--HVo%~4rsd .?DNW 1!^"ثu6"i.i"@ S,"gc#cз}.1_Q=dkNOL&a+Z 0#[Pf2XbK4 U–}{XC,Ppy[EaBD@* B&FvP7LbJ-R"Ԣ(L)d虶D0aV*(voYNԡZH-Ʒ8#ARt]G~U1)ؕޤpudr 8ϼD1|շoZ)P+8&<;fY"SDK2* j$9q^`FTM/ԐUjN1*ɆH bIwZI*݃erG`P4ܔXL"ƨ!ҒIpڙ#.\Q[@j1{wlsc=ioXZmsqwkrSjnmW~Me;č=5Y~ =aDŽ]ILu*w6]a>KCҧf&1ɛy^].9_")kF' f> &Z[.*+& E]EhjP;+8 ۰I;Afx {:x~V dʳth;:s> z<^jwAH,Gf7`gaF4EU˼g=h*3j6&1RmW0@S9:T|ۓ~ iT9{ӡ%`Wd5їe@"ߌv>9WkH3Ryor*W?dNJGW3BlQpo掬ҧ`IɀO@k Y%:x􎾉7UpcEv\: "ǪdH,p2lVi: w\OR\ Ke<RGUo1bE'n*8lc닌[tW!n:z|ɗR}խhݓޅ_G _q)_HHۄָna>x'ΨfҤ柅fQx]4~b !\&feVCьܨ^罱P'͘p+*O.8D0D^< zCq( z?Lk,FG*Ip©_X;9cTx:C}/H LHߧx8NYgc%/Zj5Qݖ@78OS_b 4sJ#EcVccAΝɋBxf})5 G9@A1sS%+7Z܄Y 3vv1Yījs|Tk"Zd#==ㄍC(ȷ2w#weW{6w"jP00u~jjSyX y% Z%t),4K>e;!˵eJ*f 8+&֣]n_K!q 7pي { 6/oo / ;G1+.3i>g}j.F%q.(礔IYsrG|q~mA]i!i?_tc(coSQ;Ll<5Sм(}5k-IkA>s6ZЗ?G;i f,?qb G 0)'teLos&4,U2"a~{W8[bK&*XVC7LR4E˯|Xy*mUI?i-VKsAhAPE>ܸ( xjm~IJbsUAgPvH4%?~L?d}3 /ZPbB0%^hiL,#jǺ䶈'O}7<*1MZqƵ%@-2|q hi-^%TUpYJ8y V1Px%{N=˂Ci#)aɩ^pt3 ڨZK7AS1J-o E'جÎԣrdC~א `Kx `]F`Ub?$6pxMaTu-s{)U=91'݅~Zhh ^SX"rex(3!_->n4vӕUaIhڛMhe(AWg Zp8 :c$(k38t<I%cfTBE2#o8Rej uIwPhǗOdLؙsgQ)TS4& LWIQپH&e!7" (9/&=)%x>&{=-ؒ|U.*QU4a[-Yn4XT~M()R@u# l8/J6.Fh`xW75:?/'5qٴr@?c?F8PͶ .Zqx*<5}yɣܖ5`+ 6gWHjeMSDs'iY0N||nE'g[[=OCwb0䨌Wec|sJ~l 拏GI˴`<0?pHsL]32Ƚg* 4NiKs >0C~B V*IjѤ%ʎVtwph<Z1znaC_6-NhuH[ptƆ׆xΊԒ39w1; yv86L^ꉉAMD^"nvAELEJaG#9#ǕLS`+%(|:q21*B R#?+.;s=3g%YT>ޱ}ºAK(oAxY uWUMMplI~A{ /G$:zmfg'؜FR3>^5)K}2KU$?9qJ[L̐b?O/eZށ,X# @BmxM!@aNxtoֲƏ.yGB㽛9ύfҟQ1IV̶C\6XN7/ɕZ P dO{v*cbC hR }GFg 9`HWQLBLş)I( M<2n`3_Qa?zk gk8gE]'`%hT$ YVB]s='zpNV9S稱-B7)8ޯkQ|+N#Hvδъ? W&~視CfpV46kkr]Ix7r, %)n[ VK2&%Sdo GJW SR%`ׯFH5 ,>jYP*g0TqR *-d+_]xeb|ېGMy EaѷFO.j\N*0RpUMpjaQeFQ { ky6̝ggIX) M٥UKX%w"K%34 l\';Q_wz4畳X+e^K /KBn FSXh/ޢgGH>tt"ۆ .N< ({Yyi} )%dFq{|Iy;-)7̾S{fAШPzFg( KE2Fh-99U-mquLsb佳gZ)U}OKΒf; 9i&#+o1wZD%׳ JݢpDL2^$03t1s2;;؝>|0֩]x_:?}2]hu)rAءj䏎))fɠ p[QAp!>+Y?TSC|VБL,"p?@|BeQ*ӫֺfėjb3%ۗڸhX%:YCRveR0T7crHi >lgo )k`'v F130cpp9K,1,lB ǟ@{DX8}EV7Ox"~4?$<ď@M/.8OG5 Dr~Ke_ec\|dH@B7ۅAjMWt5+R&nd'kSHn/8 3QAX);{Sy1m boY U09Qsl k;m߿2fznɣOm#o%$e{dkZuC񉘅$k>imK9NwJb|GS~S>~,Y X\*Oî-d|c:gc 7XFStWxD2yP鱬;w7J UI|+K߷Z5 TO/ ]3!D19pO!?km[#b!p&o(=x9)^o0 sJӯkܺ ל X>JNT7}> b+} $͇HC(*E2F9Û xjFoTg2l xYZv m_X_)\[eA#lh:-,o\I>^M*t ]u@֭Z, Tj,ox.vqca*hYn֎rJAœB}r JM paneUչ_o%c[G|"x:_y'bJINY`go!C52"i$ttq>߃yQZ#ID0h;)4fNRt̬+E?ў_.pŖz+ZՅy!^>Hq5iij-3dP%wl.S|T2Qn-GA6RƢErJkD4t55,w !xŻ]Olth%8ka\rV}fdx/J,x,S)RT/w"&-§M-A'G=A/ X9®av$}B:D:oiހ!ԏ-o4F&#c!~|i+B37jd,*{+P—}ʅEK/bnt,1DxfbmZ쾲yxPj-8FE8G);br' yXޜ[^5즬dT>s>RUkR6~whRj. >Tr4ƜCogض3s{}*JYԽ.e?ʚ4ӝ[g-M,N0M<`tl2Sإ/=)]E ̳WC~YlХPW5$mQj|D[72vk_MOO%h6'dY(6t7 FkԆ2MJm~PՏMRqfOa!s.ucy0[}-0E5vġV:I_>Jј0k\AQd)PGȭsfR-ǚ ijL gk4$Ġ]F3?.-܍S=pu1(Yr4AY{ '&53؄L P#/V#}ij06c ̋cSE+덄X=HپPB2gW3DxN[e?_J r(.0Y{R!<"In^\% {o-OSJM( `y=H5MKǜᄚg ,}rH6#(|Ȉk'Tlb֨Qr9!˹A %n<@K_sV5!.rp}Ta^ AMk JoV5A-6'sFRXdh6b=@Q=#O 鈅 F+ieGr}'uME<ӄ/ڗd}XoAl<ԙ5U'3?)2Sf_9'M}&hO {Ua J-k;a-TvO-M6o6B3ӂq.\P-Ѳ;izԗuͫ}N ^:ߨ뻾!]äc滶9)+]TuFSg]ˈ<+cSѭw_q ؘnKyJRPEz` r'}@OQۆ[3\ЋQEQ |@1y2B ^ ¼7z㯸xbj|&P8z"# Y~d*@+"j={tD:Vw>tw`/i=oX 1?qs5A܉]ة*rK[ՂpbƨQЈT8E2`(F LHE+" n *mo? -AR;Ѭ=kET C:1>Ձ bU5-Mc8TZްT8}O-srVI6rI!XdƦ.o2oE=?w7r0kSMC3y=hQBV{`MPu/>X<^@ED8ܫ\'= ~*c{N 8ήaevyOD)ȆY\OMf>][yc ]}\\:ik'9 ?<\Z}La`f9:*3mC_9pqa6sь><QXE|0b{߾-ҳYRsjk+k@KԜE2O>,:Nf[AW5c@O+rr_*d(u@kK>5+`ֹqo_|{q2V8GOw.͟'˓fB@rg^W%oMYu.4 ɟPACgg#Q?c\  KŽF`Z nlg|<4EZ=TK·TPRbw/)ql3j?ώO] .ҴM6˛ PY?A̲=[TQ*Bw_QHi5.8c"|r7"Y­^D䀡x8z[3Vsޠ'=Ǯ8\w=Q۪YHIEc-2|~B(G':\BBx5LfQww5>Pţ鰊D#Ɓ]vf~6\7oSb#6m[9/|9zȻ&-%X6/7bBP;5zSpl ƻ!l^D"%~1) Rų=ӚRUotUrYQAu ͗ +&c][`װV$EcK}wRgP8.p-;SGe*oy5 i9˯mпL5_°yTE-?wtan~K3FP pbߚQ#H6 <.ZltF[6/R2@'Ҫ:lJDJߜ ZȸO91"4Q{B)5$W~F4k{-^rb+#{X=ߩ&]H3_;O~⩸]PJe ӆb8 }fi:T;a N촩Z{Hb$# fZ.m՟X;p5? 3 H*=!K'}i~3bwV/Ga+&;C k: H/wlv Хh(+$3$ٶjlAI`OoJkJxPMԜ~}N@ii69Y,RnJ`"rYΚ|KixDhy>-ce0rd-KK/)hcAMȥ^ۀ *A*oƢ*+xb}F>iPcleBYsTSδSJ>촅Y%C XCo4VhlUR&*h3ԕ4cx+ޞY^7`~G(ICvSUZs WHڔ9O"<\d>j<+d‡b͔e]eQjó>#{u`~: ^2KŲwG6x煞-rjxW'ǻ ]ՐR*]ӗ3"s۶჈51{~:Q܍5{ҝv RE?!H} 餝_ெ[Ve3)%Es{أ86ފH)O] v,\" !$7ajøPu.h?%jeLߢow|Č^F{Jȵ1FbQM49J^| fʞҙZwMF񋍞E='ZX'70 o+Ai\yZCcxR&`ϸD=#kS4dJFCjgٺ9  T Cߦ;egXvG^.--14QH)>*&b+@шLrD+:j v9DzٹV[9rI!q/,L1YL+q9-N1By.K% +1 ,tW~mQF噡WG< ON@htLqW4.4vL=ɦ8׷YT[(ez,)ee'܅E~.QVs0&ˀ8b~ 'u򞧁QYh(6w|!11]I4?iЛ*kmQL}{ži]QDu4Iι%ϱM"X.HmI{@J0ì$F Dx({3#9if-"<i^G/wly1}LDK\m1EWuz)L3‚M 'JzӅ&  /mըO1ojz@I^|O;^QkS 4P/mt& 5$5rLx}u^Rs&.S^n{!LOc:+OȒOM Jm8Ζ13+QFsNJ~5iB~dv^7m=\4>rd%%&Ͻ0Y#HӃqhbG;OۍIxáU~ɶrLbҞ# v./k[v/$GdkAtjK-@nfRZ4&~?$ #HdxE6bXQ/6܌[ԋgid{'>uS@#x9 lFofŝ#JXء >rkRP}$Bt;VCl Da)]+[,y][~k1A\AXktZO`HD=b-3Riؗb.Wv&0y*B8r03WݣL.ԲTcl78*89q)h}Z"lqͯ[ (Y{FTmʑކ||jmD <|[+\&} vM̨#o$@ )t>8ݸ. }n%C@!xg&t|8%aDUkk^pP vT TH2 t̅J]1&g$tҫB`.V>4cʂp#&% A{-ʻT/ B@MpEZO0y[״חc1'n^֟_;!O ϺY(ϗ+gb 5ܥo,mUa}/*D^V3:GT2²tNmsY\X(-Z)yB2>Jnk^G6u}]IƗȑ̊4(Irz*z_-b7ƃLz]]dl!~X~bfEwpm$ \6t-v6phR {+Ld!n̽wJ05ͯ)C5xIdqf:hxB"fIA9NW"NV*==o|| ^P/[vh[VRI2s'!wL\|| ˙(0Ei^e,ϵoQGpDzwgWإjtB D02{ |,pܖ{piG u\Y_W=gn;}Gc([y hZgFQdk퀀ԐHġuQRkeaV)oB48DǢ'2,;6Dw.uXc;9[@.Ii!`xf:@@}ԦAO}${ujd}ccxZ kK2aj*;6^e`!۾[e) ?"RlE\c5EI[$Z\z|cT ޹*N!nEirqTݔ(Nȫ;)Ԟ~ kw, c׶ ٟu^f+Ob:[,y j9}iPrYqİ}pN\/Xު l-BA"Φ7^.:ڤf`'D;U1d6Xܜaw@tMqfN~DeER2gPW@51C/vg|B \G!}y K|FL q]{7@5c^HOU Wcɯr6w/ u:/؏>[uw~}[/bX˻|)T|_4h֪~})JkӟN-Ǣb)1ܧ=YD nC 3zF9@hm!|")_)؁ ѭZ]x+UY9LK-QgפO[xu:3i`fܢ|S_#}N= װfX(K]_-Oޕ64 ̐ ٝY|rkw'mz\,`3jbEvŔ"x{$5e$%STѭ%Zt!L@RWlll`LmB&B&4Zn@!0>-̴鼨%. o-Tџ<a tfZ[E2 ]aާsulUdzV.#jӽP*f'ozh/ѕr Lv"&:{M^=d[bBJ,YȳvA5-4*`(=o,hN} bEQH:^e3z~`!G,3$FFN6;0܉9Q38 >rK㈨) [3nC`fD6bɄnr/ 7@İcO&j_d&**Ccn ,իU~joGW@}"* Ho8NVtD[]mBrѻ`rv|/%'jx;RbW" !Okm+X m}{ƀ|!̕e){}'%RN۷LH0Ž׬5.tX7;wnE Kg`0 G-*3^Ml3JicfՕt7Hg N_"~|MEZxw7r}a# (R^,QP:ߞ:.G:ΣJn"bb/G'}N&LxֹeOɯs`J@Nŷ?b.E &fB1y& ` {Zk:==q#'>;;Vw)כdGMTRSAb}h~{ -f$_ĵ~wK?M@awno;8+m:!RݬrN7jgz`;1ߘ$2HQUPhxm/O%Si%ɋ]0-g,mPǾUYn`_7|MJΫ&yE2*}菧6\~D#P@G$fh6Ud#α?yVy7.O ^b9IUƮt-0EJxeÊ]\D<\S+~Vw"m._de6b緕$k"xMQ?:S}q}xr\ u3v& 2@[kH,#*Ä܃q.4,gt *YZeZ kmF ܑ)Xmqo *6o /8;iDj~ endstream endobj 155 0 obj << /Length1 1627 /Length2 3771 /Length3 0 /Length 4794 /Filter /FlateDecode >> stream xڍvTm6 ƣ4% ))RRA#J(H Jt߂=gf{fk'LU'P'!09@ `0  `0Òq/;H$a xDI4d*рt)8.2r0d D9@E@I _"CFpYYp@$bQH<`$c@w($0% _)0d A %c@42`ta0X)$Հâ@<BA"@=0yd1p8;DXn0"{ X Ł9-}ه, "G"P^H,D%얎T$ßPD!aq;=BwPǬGA<İSs|nx7r;m)Ps<֓hPM l. `g$$}PfcAmXgOBzHv1"N '; :O0lɞ04C}P#S}m?[TS#p@!! H!$iY) Y؟UD bSUO\߹ T݂`(,ݐw2oEZn/XOU2u Mj X\׫CFRwA=H,I dfW?;{A# sp?>rܨ*]HݝG;KD"җFUBJ S B25v8 ;TZ~3T7:& EaJRS~#8UP/(@]~CI)Po? jAj?0P_ZǟtPAꉤ 56Fم,B$R]S e PšU Uy̍K+cG&C֖%ުLD}d^fs;­(9wUNb:?) ZG <څk¤{E[䰘im<> M,ҏ ^)ή@{2dv~ ,:6vbOK(lLj0xV<-=vL3-\"tѣaN݉qՆDJgrRE sjIZge$8B*~CCCBN զ6>;1PRg~S+$fZ^ޥb_|_Y=ULz_0,;"l1x{rQ`(Y=a \GCQ?xrUɸ{3蕋Ľ'W{Mn_\RpTvv`-ql EڼА(!%4ʛ iXgxZDhpWv|ɽ߭eJۦ+(Tخ55:wW.-}b:A:p';R֜9sR4159~rB?Qg˨¥̈́]L>?y˅{bQBtZmFA, E4Á AZmWGǍ=fxXCjVusX- K?WbR-qS!` wD錖ϱ0EEę?5VSn3A+5@{r2s.5^Tg G}H1sG QwV:Sc(HP[FmtǛ7_X00$.)cXk8]%sR/߮_&bHM\sN;[onܦ%D.2A N0I-*mdБ<ZSzc RGj}s**+J?MUd-ɨw!2^e}oҜ7*a+HԴBVUL > 3<]eṢkB򟿵zN#Xp\\g( HgoYYyt=͉tL!Yш+TuqLW  tXL|@Ou$ȥ wo .1vO*tTbgDHچ67h>11X=4Ĵ[ zg!Ekb ;yjTNkTL7,=jiޭBPYI0R|Yۺ#ʵKOG gcm:fĄ@ :$\PscHAj[dNk2swJFO]N>掻.mjk :DMlڲ>4 @s7[(vG}g^>,dXy`Ħ]q=AY"[r(|8!hUzN&WRrj)h}l҆2iٷgw.fV`ϬshՒm~M5۔% m:4&CG҆>#2׮(e*6{}ڀacqk$χѥ7Ila>r1oʻ7DSrj},SkWƚЧx=Ux>bQ|q@ϔk݆m͸6(ed=t({S#^IŀOcnRâtJQK5WðAGL~ʷB ͩSeJe*Zma2M-7GD{su֚#uV9f{֓'q]Ob?j="/Ll<1mx#KgV޸螺e4ZN>#4l@>W:9ɔ@H 51-ՕJuw|oqӒi8O;>N2P}E fɮ7mvzߛ" M-Y%5^a\)Btۧ^#):a[8J&4%$a]j98z5:rkg1lKoۍ _=R5jHǔ.mζkYlN`x3A[p W 9*!n`!]1B-1|dpD$¶pB d1UpW_i CdKn҃gһ2A> stream xڍt 8kؾ-~,F!1,EB%.KYٗd"|C뚙~y~^cS1u$bb0qa`f&@P @O QA y8g^h& d` P( TýQH@b@'_@! eEu7c8t#S,BHwW@|||n8q(;& QÀ! љ8`Mx'4 bp/ :;Ay7L+D(q01~(B8/ 1#G8%ý(4܁p\9R lDq8EQ-kbX77Qw "1YW 80Hǣ&^s 9Ӆ@Q@< B$gQz3?w; cGB`$P 4Q` C;;`=Q5==w /$~<_eK "?:eo/ & IHJRҀ<$p"#u0X@GK^sb JC/Y!?}e$߂cб1Phz 7_W H:x8a 1N_׈i|A1 p>h( hš@ F++xl k51,h$e'܏J4#,"=V0`]><<,hBrAFR7 AM/#2GË0HHR  :ye4ATXt0B@a? !w[jl CJϊw?RZ%鉉`% WO/L}`?nSg=[ky/SBz}(1j&se]o+}E%eYCϾodz[(t.8dK,*4E^3^% %7eGS'wXB<ƥv)=> Y5>G>-1ʌm$M.!B3%v˽^.*E1IiHM½y(ћV6"q{)[8˝[JKHF>ڨ^=*1=LGjJ) dJxLhYλ;#Lµ`wCFS^. '5̚]2ÆjtSC'CrR!I Zʯ-N]ڦ:pA#55e]R #Erx*gPGD̕7ۯ wM?(.=V~juヹ!L.l<55ɍu|yj3* CN.158 Bkj haYWۂ>oj+Dp6e<ȷ9=Ji4b]+N}M>L=|uY:`0\j4?I\:i)9ܑ;iW|^ cל:9@ҮjYuю0 d/צy>s(@/B7A:^V[Il&kz4k(ǝKKm&6 Sa&[p*R :La@YB@|twy-PqF{ YWJj?'-1XK􄰛ļGҕz}7Nq2qE~+&t/A whwr=[3*Ui" jpjK |Z0Mzc¨^.,0^ANW*PJu77Rz*kL>fy(ޮL)|Ɍ)WLja{Xp`#! qaո̈́NܭRPgb ,<ʅ#hJ] C"^sk7",}7_CyֻYYs+|!"fy B fϲVܱ(Muu>k{:gU@եI5|7f& HPyM .v}/(Uϔ-ָ~=Zn%=&!G.TuzZ<یuσ$.WہCyTR^dxG˝i;{LQ+lu'[<+G^ [t8$.q0ÃXPQ+d<%wMe%b$H Mg T٥]Z5>'ݔ-g;h'BeVyHF.~@t/=,1@wڲعd,\1j_n3a|6N!y#Rw(_IS%zS ms"'JО#_fT.=y_t/RCȖ+P=i(77"%*~;YrI$դLLBHZcgq BHΊ2m.)XNBẶ-anQeP2moQ'{M Y`_>sDEC l(R8|4Q!~k5tKrGnP7;}OB$6<'J)ViLp:3twm;PiPy|Ķ/%-3jݒay\U>>T̘@Z1N3UShZ}3~ yx&!JhZ̵u]͏Lڂ)ܢ!'S23mzpJT>ǥf5uJ0J6ã4ɕO,QY盍.,H/O d+ߟI : u;a݈X{562,\HD]yoWDĥ^F5C`YEPYRD-ىκ ֳuZ.aU՚ATu;2 QFy_%{GnaıRYYbB_ZM][-h`K²Fh6P \x"_Dh0ǡ6 wNwrob?yn3y6cl"MY s؂KdQ GYBϴ7#J˹CÉ}kSHYXsLx'k Ҷ%D3ƃpO4xf4''&_u| 溙W"olFJ[rҰyu۱;0Co`qؚװu@Ms|X^޹Kg)PT@Xݳ!dL/4l8c\.Հɹu:/Dʩ2e_kXb/sVF:'1e~߾{ )>Fڢay%e4̔z eze3=ы1 .,]Lb>2>(M6BYԣpQUHr0qx~CQ$dYlaa-g6G8_ 9Nw;tk^1`i+b,pS02"?U">n,B{쐼+޷fR8ȥ@2+3f+E,t ^Qً5F˒-N~*y.d͞ )e&'5}DNX'o=Jou/KgFON a'ں}=VwV*3iJdH/sj8 ^7Z UWZ}O0{!E>p֞I~Ja8 D+ע7d,<;퓸y ^~X!f)xCٱŦ1nEZ"m1XK/jkZa==Vm3UT:\/v \;A6$ ߭7{ w5xS.=K~|2`]@8\(D%ۥ)ܿ#wtr?mɀɜOoT)/mDb/pG,| 4r !.lTj9ȀA%H$3-'M|e4yP#b񺆨i/swmƺQs[[cZrGeutI 29_|[ܦNF,ts6)FYvl'= -Q&\s`ߪb|.91 9zF:Vr^5<;t7+sy߻|7$^ DK;f*}ѩ|z=b~3xRdBT>'UOFW0R}/Ȉgߵܪ2U&f7p錐E;].dݟsO뵽Ug5IrY,g;ݫ\5L?7uDUNN 5!n?+8iNPap۪iU{ޛe[ʏ^؆HhەT͈ߙ"4K9 at#'.}Vod1wÅrq.[wLo|aveJ%y%VtDn] oYw;J57@LRJs_}SOFڗʻr] endstream endobj 159 0 obj << /Length1 1434 /Length2 6832 /Length3 0 /Length 7809 /Filter /FlateDecode >> stream xڍtTTm6#J Pzh)%$a!f`ʡ ;Kn}}9}훝E[W i SD"м|` @NC__`A;> bCEC k<}@"UW@@A0X_D$J >@N(-zϟp@C!@9^8zH(lh' ~~www> epm] ~7 hBaubm.hw \P:aC׋z*ꀖ Y/|NwDpğ`tt <hM8 !nr(@=( vs;nw]V@X!a w}p z= +MX: ή0)&?63Nctyía(W7;+8 Xl?ٯ0 Z{?kyY!/ _'+0 ",?36w"UH@Z7_} N?si"5 #g`0%-?!7}}pC%늾zM} kd5`VpW!c q6]0+m8jG ~F)_빂_.z]"~ϗ(A ED Z<(C !uwހ5}bbo$~ F`Q  @+ u=t]AA3Hd]e`i ;ڠN^ 0,%` u"F1p,f0>F ΢>uPxY8rrMgLTe(og3-S'hY мD\T'cTCUA;Be .-tltƴT#ٯq4SKSi`N>iDk־ . A{@O+,H}!ڋa< [-|操^n-V+:To[,giK9ܗՆu霾D*EGw <=> y'0Pdh:S%׉}n*^ryk$r\iQYtH,f з \%J[V| cC'wLyC5.d>a~Dad 1´&>\{Wc/ٰtG,i&Fl:Hz\#<Ǟh i$}9:@&R|:,v/dBN^1wІQl-D+RQ'GNLb$dqTKGeUm ɊH=w;eu+BJ \}sհ׆宬MsqR7Ez6~4CP5͏%vG%I+SxmjZ$&+-cY g>6Lx`$l8*BB6 o; kp}O*\H*`F =5:Wbr'O9aǨbONM%\.w!Šٸ'0gCHb7ɇ. k侎"h.͡R;s< VtpySds7S"ŭkf:NUm#:(8m7}sZ d\ %\67K<ŶW#Su76 c}˝֮ǵiyծlg}'Qŵc%!ƽ~r*/mصq xIBO{ +&3p`pCwB;WGIF9@ִ͘½k 5nNskfd,&4\EP t{'V賐Pb(;IEtgtsh(GMЀ[bނO;ӴJ?u ^qlEL3 d$ѫOZgwXޓg .zђ?=$A/TKHK9Ec=49:8S!FY(=fAOHDlF=Ŏʺ8eףksG p5jgacMOI4v H@nDi}dQJD--fW>/#);#"+sNTUH;ߎ 0: {\2OX0;}3IT0Avҙt8a=MͳD }b/N> PwJ`n?rPjL\rVщ7,w*t X1( M,7H}1av䕍B)T*~,\"9EjRɸ /KY2^EELߦATj҉ʐ^^0[.E2P4v@NiS`AdErlRsgYI~1HHC]P~qpIǞYAj}K!n7D'޽R֮Y{a&l[ ;㒐 OKр7]+ù 7;m+0&e->ԆW[{%#cu%a]tM6: jgxepY쉗vݷ"$'e'm;p^irJ-@=qP믖IAPQ,3ԧΞOq}vGKj[UeWlno1yoWGt2Ҿ}&,G<;2!_Afi݇`$ymT_j?/4j Tg\hܢfv;{k;Q,?d]ReW/ G Az0Hz䷴7QHT`bFyee>-3%&")KAE/9~1iI74,)@o>*o. axΨㆍ”u2L"̂C[<^l(4:?M_?{ahtP"UpWE5K@XD:LM;/5_Wf}Y? ϸS>H%F_4ԧMԇG)ӥUC][CV8?:Tdv{W0= )y:"$Dt!e1l}_kʒW1ncĔ/NnR+ZɦmmxkY-dǭj]%9=/lt{U@_n#.k'L+1q8vԣkm^c"oLY{..F$`gE=qz*MgIpFw3%ίUW}WxO`7Dvns*_~CUgڟbExJGOɘ uh\}f^W(qHuu_Oz.VZ=@gF˷#cb}8B4q.atd]P{v¯釛^o`HɝM5i55 B2֋Uz</-2پأQBfmЁSo4 Yem)/nя31 E}$I7Zvĸ1XTs3'gd Fg)^ը$pR0iU^uˎ6;zv L /;1vRs9 *oV=|/"Na)e.ӕM<gK̏?}6^2Y]Y;:C 3lknW4K1i,AקOIBo1gj i-\>ɄKǞv}v5 $xβH5> .tHIK"-\}(A7'"=Ѷ.x'KV9:"}:Ek\cXi6l&)`1K鏬3}T۲7=mMz=WYl<{c'㫇5 O(׈ok!t٢S}/V;7GX{]1v%'E;"-Vdd(G@%1转8wsҒ MXnsSKw4gξUԞc%Oǒ3~6{7幏 xQ˲:9iI8UgQ"BHӏԗd |>SZ'9'nwYHGƇ!5'OlmWg?F%~ ,;\ om"GsKa<Q'e,[XInՑPs!puWI/B& ml?.qv+qZPץQPfcXg8MVaܶ7c|DŒSЛ~(nW\FcᦧDf+LaUa K҇!j[e>x53}te`=OjS 0*dF<EĞ֟i|3 XRƽfbh_km{PmT`2<ߝuHkDQ Wyzw9%;}hb9u:5# <ʴ9J~PpDif)aPDz< [{1 6Yf4W9}^*Xw7gׇ+uR^,.mbxf`U?!)}uȟ0@yQEQZKhRD *UsTM:wU'"N!5DDfi̐a6?@e5#r58`1ҍJ`B RU`acW~n>2.t 3}Yu>Mz5+œ4~WWr31~ > @&0pi]4.{I^Vŀw۞NQLvݯUE9㟘ߋlM%{>znl>eTrGڜ쐶?噌GƃPJ~uY Gd(lKvF-E>F'3 (}XRbS)l?Iɐ""{M0mĹ-"n!c~쮣7֢jz `ŞG i9ZYSz˥hq#oɃ )W+Χ$KLC'-Ϋ5[fs= 8X8ze9:4}^[WX4EGA'Q )o: $qK96SȑnԮ4W4tjz"f?pUtj6ͧ\=V+jdZqEꎃ MN/)bq#ڡ u[2Z̷|yf~7zn5"ާ9R4ɧ7T>JŜ#.^}|n߸RjO"V}@*m-֓اi¯6 2RHJ>aZHz(/{V_Mx1\6'3Si.Sħ. FuɄ"r4<+p0">9L~9l~_vH| {o ZOEӪ]G:KTU<pvg'<%PJpo^ W@6zH^4!۞ts9/̳>M*c_NmJjf0~B[BQ" Ÿc.8T]4K[BC-KN4D?Su)l&*ۓϖQ  )=C9 t%R<9g~mՂ1lxu?W jr5{GܡKq=km3란|! \Zp?'i3{0/w"^DXg&!asr{bI7ge%MheH=+m! ͧNGW:SzF3~Bp{xv=8geQ{^Fr56p"3}lȄ܂lgOpj>8la$>eɁXGS R`̿ϜnBm9.-՝M9ӳ:ЛS[%/t[bny/;]>n#J endstream endobj 161 0 obj << /Length1 721 /Length2 4672 /Length3 0 /Length 5264 /Filter /FlateDecode >> stream xmrg4ju :ѣ D%.E13 3ѣN"D'щ5DF^7]Zz>쳟˥A!0HDT`n `P<V2`pb 2^ `@D!c ȹ*➋`+\7"=`tBTʹ @F`N6NH@ CqA- p'0h8oM8?Ю,Z-A t4x5â>_//u'!p$ A!dM m<?wt-w p f?wrCQ t1p 0YP_z9 $N醀#VB- ]O?ڏcN;z?<50 ⯽bP? \""X7Oa#i|žc4׻9$ #d |r o Y {igKX /(lok} (V{"B-XOΞuZjuӘ'OM{$ަ,}'OίmE3;1|KyzI!TB3`eda0$3;6/3?=KqrytnEGu2rHtn%MbԈpsڧ BJ ;`e`FX(8WD"Q/]*\ұaRƨoV@~CM…bԙe3'3'>]}TJT!{QyŦr؞{ } 2%.Evpz#J, Jc9u}-*;\pf4ѫ&wϯ,3o;!@ LGl** 7$WWpYQ5Ϛ5# o9-ͰEq?sHf =R=]q'b."_{88  8ixxs=e26R>-MԜy$l$Hr*ReK\w:(_``M:ǦBԲmhR@NP >ѝU%' 13atLjgt4O ")<u@VoYA38IG 4_?)o~[u.ᅬpLw$,ttQ[ \6Qb})Ŏ72K@w>T8~5,N乁c-Tlv#$I2<-fJLZ摳lru^Pd<=.m1MMf+km(=[3/71,(m}!\.·ڔe=D{ωM^ E2 !w/3+H6= M4A'Z,Dƞi*s\F. ONޜՍ 6 ۹,W!#%Xfo߷90 )!Us*@>i}ޟ|Gv-z C-d9Du1N,tA po%ǞMݩvIeʾ&Ĵ6flVk;;v^-YlM.#&l^D3 KYOhlu9ZM:IQtf\jwwŶLaG|-;+qm@٧ N4 8$ZTcg3-KVn*?CmY;S^cyס8'"R\R.E(/^,j&Ny[뙧}x0Q;>vdJKo7f>!ʏs5hr\TesnX͈S)lY,W%!%?b:I9;D>b60*/꘤p&8y\/+5D 8ǒܚsϩRXKIHdݢxN m& V}ih6{͎Q z|yń'<3reh;Xy3E ="A`.jbZ_+2f%vI^ف7Ҥz3q|Po_-g畈 eWGߚ&PJ/$/32pDqDwu&:`O#4) =lp7X\~\m+r-]hQ"eG>xTh "#Ud5i\*!' xAE@}oU4gnş5Y,tl:/IZo8io'"v){gdXߟ;ٺE+u7{</&Uiѝ*v|0l (kN1S#k>w?{Y9Ay|'?8*Yf dW(jP ]~:e!=0iټ౱]PEf-|ѝ6%~R)'ryhz`v,z5bphѵ1[$1ʪ{Jb~Կ s;_<9|9t*ʝX|Jy~>M۩^L(ݡ ֣KHڪzԴDjt³ޘy&m=t9+r[lS3΄QDgy+3f^x_hiޠdd357hm Oڻ;=F!}7;\+9n"jqK5T灁?"(l ,A]Dn,,fhaP)Feɻ3o52i@{;H8dg%lo VUÜ{#gZ#K 2f}{UZIݴzEW1M;7I^_w󱛍^1cŐ=!m endstream endobj 2 0 obj << /Type /ObjStm /N 100 /First 837 /Length 4665 /Filter /FlateDecode >> stream x\[SF~W1-~qB8.? Cfί4-aPڭPO՗sYZpW!%^* cšP^^-U.|tE0ԫ0*"[̯\3UX/-\p AW=++ g@k(1p!V(t S(XBKt& _z<0F>ڂd}D?-Efck y - 65A=IV"hDƀ u焧44iĢI!I p$ᨏ F P!Bނ> F ޤ=P.P Pi w0 pg1?;.  ZY@z0%.&:4J\PJ5N` X5â Y^R #l$$9;52J' O~Q>LraVG~x=b\ gbpZ͊j<~g:j'iY/f񸨾 /7fx8=8HRZ|ϊ|:RYL(rk4H>yV|rwxZyu1JSǵrMX -ht z5L0nK­ZgUV>LO)O(?/ʗn`yA)9pMV LA8 W u4ǜ%t\W(Y~f%]?GB<Ϋ]N'cdz#(zWfQ4ƯEyo WMI <` ;\\\{j H ]־pxk_ A+3މk[0O _ږAu@"`#4ԢhYיpa:BE]5k5kAuC7kLM3?pԴY lj`ܝN+rs(/s];$L]WXLPhHa[rO%`E\ CZ1PhknoUK.i]A xklc"]ɬɐu7X$L6 𱱵r >bil(ȱ~6Gci1@ R@x%T/N+!} KjTK`NQ.ws#8 9HVr<ԝؔ5v/\c^gʡ>gC"d|/yuݗ>_r>Hv! 92Vydya =zhBՆlv"~/{q6#~-V7¢MNeP|F2x< t/+䀚mFj[ 9zE^}y$}/R >Y_48nuGxb٭:NZة݉Ah'Kݮ2CP#ѯ!,A93bsm?bOR!҂`iz<0wY7{ёa$pA0T`}SXzfSC-Ar c:p8J)@4 xF%0qM J t9K=h<^=X~ALRS\.$xvuaw[-Y=d]Uy[LJ{]2`V̈LHwֱvY{@DC-.C:&t`3SLL @&xbHKqV8PzC̰)/scVq(p62b2 VpvNs8OF'aCd&Zd)7;KylFev -)OŨU|laQs s8q&j=HW"o]*qb`,K[NH,2%TtpY N`R[r!;)U+ "lu buj!f;5Qd Y$ɥ 6]dhMމV"ʰ.9/[.N2oךۓ'sNeQ59a*/e6g^h`|8(y{TvR&RR]ddz;^52,K)$V8Ywx4k_) w]4el!mR_7 Gm$wi2tb|jCeW6d,#&.DE5w:ȑ!M)iO\؝v\b'S9ycٓc[Q F2d6z=nT-9*S͞kdO9J{اO\&*\KSqʅR#Yn*%N9M%-z)7wfOӖʴ RZ>mA@RDJ)IM ̓ƥSdqO7P&ǓbXwD/޸F0ӷ Պ;d-zF(~ fUO%W Ȓ/?mTs=^)Je1?%E<wIaDBu[XShApdRC&,бh.L k hf@#H7SOTtXI (iN=sZ6|kxwx8c4ҖU摪޵:nK#^M^!\{cldpi }T96BȥmL%p}Fd"yВ>uqE'T$0Q^&7mKsj #h7ag*#u-fPVr=oI3硦SW>iajͦlsrz=! S-ܬf|2Mo1w!ί;oT ¤O#Gyt`@FώE.z^Fg nU#I_·*0:KWzps r|Y.˽rGqYY9*yyQNEU^t49)(嬜iUϓ\~15R$ׯ g}"Q"ALE"2 LZ8?N/:W͏FfJq4^/8խMm$MíW^@pvaJUz{MfפqθRayT͇.Wz6^mO\5OD uٱ|ק"#>:f^>-7r|Tb).w7} IǓ<@%}7XFzM `g_/Ϫ .F{r\Mј;47ߥ*a:% g՟Xp6r $,UIW+A/U~RZY7tE۫Ť=QGZrX HZ'sYw푃]S\] :Oyʫz%x}ros5zbc2Qyн**մ.>{=JS GBeg%L}zl5ðzق#nxq- vy-k!j)Jn}k{)#6aaz NDrbwW.+ջwo!.yph숆n[(%nt;,3 lOtx\qZ wTTfӃ1d2 }ZN!fEOWYWo4u9e:EdJi;ѷC ?yCgw&)%]uyY ߼}ku޼AxO^Ƒv Sll:y~5._k%iu|%=|ko"stK'!jbMm&6%mZwDƞ#>w+ޫ_sd0)0X}ʶY1i[v۲6R uX1.tp7oVڶA ]Y dZݶM+!;I=4 t_m697J-!,ibWB/랸B_1ޛ[gIo'ts=.{eГڝ ep[ <Sp=+!?mkko>D0G+ gfh]ռËk& endstream endobj 163 0 obj << /Length1 725 /Length2 15948 /Length3 0 /Length 16495 /Filter /FlateDecode >> stream xmctn6vضm۶gNVl۶mZ콿~=zUWWWw9&=#7@E\UHCF&lfj`/jj 039̌L0dG/g+ KW տu[#S+;+g%]ōٍN*ffWK3@DAQKJ^@)!07s6(ZdL]̨4&VBofή3wvȉ +ȫDTEFYۻpmfh#d?X=#01LL\fV0 MMrfxٙ(E\͜rfql濮FvV^C2-?*+q+O3SE+vuv3Z?s#gfjffpϬ:z 1(ȫ+i O,fo`jeoPqO#gQ۬hd /f\<:J=73#' d_pMܜ]M?d2343Y_q0 Nm -+1TYa^A458¹Wß 4ۻܕo&63;& [y-&~W׿SǶ3sMXRb9v*C`6,Gډ_[|ң@3;F )6x_ wCm`YPx_e-8%s-J^;$tŲ!r0Y~ë p )SɫZq77K:C# F .{=jϝ!*)=9B_nu2`A\gvLX9 uTl47/i(i[t"\9;#!E>#}@ٌA4Wg A2ĘKFS젷ПUsU02 _5d xϳ${zf6yi^5U^A S!}w)!h %SF;rB90.3=ltf_<9Ka(:y,op#E}r#丂Y |/xISؙAXgbER^9 s-'p'w٫Y5(ӕ|3uVARb$!.D 1@0]I2 g#^pTNYh߽Y~tl2 W*TXQj*zl}t-f:nVMoPX"*Z_n[7*JSkU{uFs'Ldjig&kh֎ wA3tݽJnKn9筼6[o/[x ]V wAeDH~3 }Mg⺈w;k}b21%:woQPK"F\H1^g pHUcf Uovey1-غ aWڠxCL|JRzV>= ;JHA[;`ك;֣'-A!W^ aehīO1]eV O \ =V' }]^Qc(%OOznu<ĜQ؋TIʪ+eA%8d$ d>#gشgAnK}W;2(G5}3.}ysA4Ξ=pdZaQe͆փ$NLjJ)?ɅLo/IKcR!q1hHSEzsu3Mp[HR9"Wq;ED-ˉA0Qkrl(RDRT2;]b׷}7C輀썩$ s4|ɏE]Txp8TQ*}XWױZs۫ozMZǛst!G{~V7N]j[vjxa{L뽱dKc݉Z]`a2&+Wk Mv^a&nhkS/S#7R-nKv՝fŧϴLBCr=m8p cM7=۩ej H 6y'{H@$_MWӦ{_^gf2  B*|Xv-@!G9L5fI";1uCD(T>'p}ua$cc }bu~땺W"tFB@ ]ӶVc+U?0|7$:NW6U 0Oτ: T|w^)3)2ʿLXUܞ~c]'JP2^Yn9g%:N_1P8-vЍ'~{"瘲dzr~a7kTU(jߎyw\t}ƠD񪉸abR3|g$#A^!M{/pU#_§Em? 0i HGam4pqh@!#Eb. .lXp(#\u8"*57ҕ:S):e%eOÆfpgq| gy%CHNmݺm^˭Ƽ]IߕXx0J*_s~.%#]VBoKd-OSmf=mu\> :b( Xs'Jcr-t#wN%TAx @"t-'3<0zCVm*O_> 3Y%rqC{nf \a /E #!8&ѩE(g{`^ay 0"0ۯE&ymC#@;ܝ`(F[.gEq`Sn\^A=.#x腾*/\{9ؾ %:;vv_=}~ZA\7x- ؈#u))I*hof1ZOe43R"=)g*̱$D'Džs3c11զЂ$`LV@L$ 芋R? 9:X<O@WrqAcZդa,̮17yBt1f gtǵ'&"e mڮ 2y ]E&͊bc:xjt:F!3.\:8nty}\y?Z~*gG:{2 HBHU,-0I6v!rQ\WW0qaXx-ؕF(ngm( 9FbGzG YЬ /uV_l!Iar#?Ol\7"2 xϝdwP"/B`pϷ(-jК)j(rgydLlJ^l% ie9,b EU]#'s @{ܜ辧Mv%Rq A>tZ Zjj7?ݨMy+mI\3z'F`rACDiV-!vy}]!h^ UI!Qʉ`Nf?_ E'B_wZzl-ZB _O#R7|pX5J)(P~$hlOq֗߉UI};uA*8qp)/ sna5;]<7@ "{RL+.HlQn5q-&\<2htԹ2z.Ab·uTA??eSC[@0C6T3n&, bTU_!|Jy(9ExףV6e 4'>qR̭n$𨪼S4?ή0LzLQb]{& }qe&U2 ,N2J!F 7؎zotwq1hu{*nղ|Tk Z {hۜխ#4! 42>9N}p$X-o`kkc@&Ds6j,z}tƟ"*BflUbQktw3|$͹GŪ@U#dƀ6oZ9CPQΏG:j% (0knb>f7`*%FXō("یGJ84P~ e9Ϛf*NMW(s &Q ;H膿 *כ>p*,}KUhHJ{寜BZ=p"꫚(0#%)XI|C%[ݖ@45QJR$AU%>"|{e-A; <]brYZpl0C#bѨ cH-'{ -A e%WN" ih5ј*=(VA8;x_jD]|K~= H"ܞqV_Q6O0!ve~Rmܪ}:;3$qJ;*MR*N±):O'ah9 Zsپ|.nЬ#]Y=J{V_DeQ|x\/sr$7]5NFp(mLB7S.4f`=F|D, *l>ELa rC 1",/hR;Mr B4*Y9r)`ߍ!fD@MvHw>X=:rϿKܻ}&Ր;[&~Fiz)v$5BQac!788\.\kV*tXҷp,qX79bVziO('UU Bڎ ,keX*ck4 3ǫE6-3I"#~ϕ&y"`6(eGP{:kiEc [PP,=cVCM=jph6izoOxSvAb7`KidTi[EԛUSx^~Pk*<g>tT͗*υ "`ew9i-(pL~w5JY)l͟-Pe]R,ŝ%FL&F4=' qD?q )3q뽽ob5y%+ Ҳw_ᶟTl/nH9/@JD|#HCp-b3oDǗN3l$̾.yFH:D£Dv"]O@?OSyqd^D?E$d0P?|||Ղނ@7$" WPHԠ=_>qĦ6! _ˋ&s7'VD9!Kf+>U.Ө I.<ՙ@"g}#HkhmA,r3ϛUUUi>ěGgrz鼥 #,dx{kHn*xȧ1zWI=C0{_wmsHs2ء#Β-cwF5K/eI<*~߁_q*.),+w |(-b{2Q%xLaA,;reJ-JusȫxK8RdWS퍙} ^ `ŰFK$s,%ǔ"C%S;5 `AGE"q\UXx=6~^g9o_sd XW Tߴ:gسFlp9ҕyO}4 s~L;Nn Q-zquk#esmFҊ͔?U7drў"kwc)%;Ñw{=LnjҖIxL {޳lیUv`GH$5wtN$ J8f> Tԉ̿sb~^v7V߱Qb}+H1PǤYb1<:,4^4/#o@ъu524Qx13bˉN&%5%=Q$f5d" {^ lBc8I)ni+Hf= ZLtjl֪ĕ;Q P|LȰP~a90y3M8e U>F@?OYxm$G#̲F;i_3@8@HOeC%Pɕv]Y[}`5(qz;^yWmY1`ڨeO9;za0{VS͞V% WkC aBMݼ-VWҋClUZIY$(M IAbrm휹V1l_aAjKC]P \zb=& <&T WōG*nG]("50]QL%W䲋us 8 X #mdǢxgt%WR +t4 0:JV!sjZ,Tv> "[`X 2.6u0V~)ظdp.nRn"X%\A"8]e|X -~O'78vIQkN\G,^wbnQd" ER>-d 8҅AzyXnkfP3AP('NalҮ%Bj_5 F/"I;!(-'U # 懏rΑ8 ?5X:\tL} "o,CVo=Ymc4-r ƕx\oN;.H R@\/ |sN[fv)GF=9G׏~4KMpv]?m?B <SQonW/ʮy. 'Vv"3R0” g/1| ,MK<.j5_(7;=ANʯ`„q2Tu&"RMX1 >rY[P~rnsF'gB]! $i*21Hy .oJyܕ|}vhvax;yY4Ĥ tx #ݟu3籍Z_FgI}] BTllC1 KK߅@HTY>ٴ̺{n#IKɡ(AMդcqɾ)D]Owfen;E~clp 5 G}V7_%%,x%Op}zP+)5`7·9{5Q H2p!Qh߭1N9>^cDL>ezgIrNpՇ;p،V ̬Y}`C|vuES`qc:~X I7Յ79QH:ס\B/i/V&>DuɬLujŒiMwcEJ7=~A=q'QP*G-_ {5Iz]O+N>ӋKN3 %~0qzPieA G>3/3y]M' ˓pEd8щHT5N~ Av7 Z i '6yTt'T f2=4ynS׶61nwGu%m.\SHP K7Zkږ? EpW @x@W#3? d(bAg^r> (6ohpp.@=Sw>h@-Zw* G-:Ƚf3E^@:=ٹCt %A[vr1b wb /Ζj-p |=,aT\.qXĉ.s>mqN;z)k+㊸aT?/۾3tSl3VES46o<`Z*=Acppw=hWciJc8]֨}EM-ȋD詝%فoW-zm"<$7Ԑ @`"Li -3qVnn_DFc )QƲ3$ji@@IP['RފvtBJ.)U1diGRԛIךl[78uw%ϲjK2 pysv@$G™26dpMH*7Ҿ-de QL2;zxTsMv5tVE# KFmAI+hwN/0@M<'-cXH;@҄7J  9ʗG/{*[ӪR@A j(5,!R0H9]c5٪9"$;}O(:a"N)F;.YږKȟ94}NEb錖1 sOվVsУ=4g܆l"`E$1D1}tĔ*MÐr"&vޛq:v{$ ʓт!]c򙬷᭱ݍCs>嫦ByeDli>-eTa;F;far2лcS(ceX~ubO}tr\JE]Æ\KFiK-?R;Jk\fkyWsHFʧrg,3l0B}$(\ޒؿE4 Mg[7aҵ¹/IɁ1iWK fQ7"oF !B)u4f[nۃYK2@(ÿ!+7gn=VZ :kM9쭿bpbiR5Wܓ5-4gʿ"Y $3l ~Ja`m +^%+"G~G=e}QAR&2$Td+3mB&223 ojvς /});;aŧwKaD\mMU|.hըݾ,ߥ4~[_P)+ӻ ed 6.HY sj^?FuC"i?A/;&ăd&L|Nmm3\! J5{ KK6V3Y?sު{hRkG_A V0iC/mCZDA3CČALx"tj\[eJSX мƇӏ$+WU+=׳됰6%;U'R⍜ 4dmj#$i.}ʦz*6̋cA u=ZuNw9?ȣfWW!&NLOlh5FUn9c I'Q W^o!#n@c?%/4}ӈQ6]ݠm&M)Kokq ~#$DfR;ҩ]_ҪۿV]zv@=ǹ19{9fZ"qxlV% 6& dG3@bLzD vÊBmĚL8qՅzΦggh4O͗ [.*(KϢ̃$l~%n"15ܨBKsb_+g-}m\:$m[f݉'Rz&]hDF5T|s<~™`$(ܔ)3ix4 RBPl^ <D uMKEٌ9* U2Ē5KM`0 HlpR((pujh+v9FwGkz%s%}?}A$w^!:3Zj\@{Ed*UKl`vHf4$ PҚ#>a4+ Bd1rqA9_^qZn,њ~\*1oNHg3u <4_0*gL5NpH86]|Aou}Ai2GE"_a?NW֨ dMLxVO'(G5Skz㽷Y3}l8~x1e.v%z:c^|;PZܧdΜF #۵"~VGحnAŌ&9cm 5P&eHxʨ>-%Ps_ɒ5S)p3%A_zꌰ_ UIl7]@5~D p 9$R`7CVDnSC^=ܧ?bk&uY7 3,.cwHCq<`iq,* ['^P @o fx%r˧gmU8 0((˸R\c$ Gp3_p˧ (B`>ч |Ug{Hv$Y j =&M|ˮ5J8]eh1\}hN Zu_v|wغ)4 |8Z0Rʪ 5\B;U7_fi !R܋~=)[Qde]g v$ߨJ-ݖEjiZq2)0;N0z1R*GI{['gM0皈$ 3 Jb_[@XCw]L'Ӂ['qSpL..IS !U]h9 ^^EE<2XRdljog< VE#SQ x{{w5`(,:x,ْ}^᳢/xk 86y00B6ZVb@p$gƅ\x;~(o[_'a,S-w_$Gi)aԟ ~L(O~Jzc}]~ґ»{cE-Yч8~8hmVЋ>5KNs K讁sRnpR4Ò;zkxРjP *L ڇ4\a].܅TW$/ &1ųf GRil4X$0@kN͇ +{咀1j5~ nTmkr!#<`*O#e]IX^\ch ' 7~x$W7>DpHz0զoc@?1NtJMS_\Fd[Ӛ>,䄤=^,]ƹb"F݁_{3ưJf-ceU܄ϯ냚 d\ "ՏT*$ !JAb+%(Jh1 3}L{4P\/D~+I{ubA-FQ >%)q6 0kp(;@PP_;2sb*ˊ_.|.#]<KIVthK+q)OF |?qIFpܖA0:_PCXX\̹4IrOlefB<2YR,cVp9ώn1^|.o>K&Rf}bF]ЛVΜVbֻD$M&)0)l`("̣c H O{'dA&ΊA?W`d gCm)5NƁ r<@Bl4dW+[gBtiּ;LF(TEpl \,jm$ uM/~[6w],}WiB2[#Ni'ȶ[?%FJ`I"Bl,j۝W(cx;V*TRЏ@9[+M10jJ}'fDPP@Y75B6 rbQ1EOQ0N_9h6k,=ƚY^hlCC  7 ?:7$xa] ֺm|O*&ȪľC}_;ɧJZ0D@)m_3Z9F007YA"dZθi| lN0\lsL8= S]s&"AHT\Eq2D 1!菨 fA6& YrOx;AH/=f_GV_00x_C&uò)GgNjyy-{5 2.SPJqݶR8zwu7r|T+Kz6nAYt*QՊU?:>GsO,\1TeyhRSsQf k? nQm%\5lk~U};lSQ69wםqZd>u-vr+ oP$FM]ySA&Ŝ Y؈ ZʭDcb1;KJ2C!࡟p_Lv^)pIN:|hݝ)1z. endstream endobj 175 0 obj << /Producer (pdfTeX-1.40.21) /Author()/Title()/Subject()/Creator(LaTeX with hyperref)/Keywords() /CreationDate (D:20211208182941+01'00') /ModDate (D:20211208182941+01'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.21 (TeX Live 2020/Debian) kpathsea version 6.3.2) >> endobj 165 0 obj << /Type /ObjStm /N 41 /First 326 /Length 1381 /Filter /FlateDecode >> stream xڝ[S:+34Z2錹h.8!焘&ΙVbhCF4rrwf@E-~C/224 n@4h0mȷ2|'BUrj?(?u= e!If:&4+ N')qJҩCN$|N7mܠlqi2XtOq ~_YR;v,3{)6LhZ|?2-ڟ~wcC^;{f)ٟ\)URvByܟ޹ uJI<֝ڡ+O ݭWNx r~~64fT.ZZ4Hd [װo܊INWe ۛ4@x3'_;3ief;\SAP5 ?9ORx{vfy-LN~W~xöjTpz|~K5M{ڛI]קhYaoQw9Y]>h ל.w()eӑ7נ^ e iunzsA?G@ر=0"LpsI?KG٣j1ڧv gpWxte8[;/4525YR@'wӷk#UUfWdReRS<zQbBهIۇ|nu/L(73F†[g"Sa􎚹=GOSžbfNaI oi.~qK'ڂ<!\o(a[l8mgI>Qc,kȫ݋֮}9kP k$iy{]`@KgBV:#2ps΍Q̥g/fZ=,eɊ;ziI./6YVyA͢6I{/-QNfl/Kn, Tb'-~'\=+?W{m endstream endobj 176 0 obj << /Type /XRef /Index [0 177] /Size 177 /W [1 3 1] /Root 174 0 R /Info 175 0 R /ID [<5E4DA3262DCC52E6206E343B62898B95> <5E4DA3262DCC52E6206E343B62898B95>] /Length 461 /Filter /FlateDecode >> stream x%IsLQ9Ц$D <S#hӂl,,,,**ua*[TUEQBl~sν{97"_HbO*I`cR|X]1B bX-hv;XYW%'j&Q;q|2G l|f@Qe)kV endstream endobj startxref 261792 %%EOF Matrix/inst/doc/sparseModels.R0000644000176200001440000001214014154165627016035 0ustar liggesusers### R code from vignette source 'sparseModels.Rnw' ################################################### ### code chunk number 1: preliminaries ################################################### options(width=75) ################################################### ### code chunk number 2: ex1 ################################################### (ff <- factor(strsplit("statistics_is_a_task", "")[[1]], levels=c("_",letters))) factor(ff) # drops the levels that do not occur f1 <- ff[, drop=TRUE] # the same, more transparently ################################################### ### code chunk number 3: ex1.2 ################################################### levels(f1)[match(c("c","k"), levels(f1))] <- "ck" library(Matrix) Matrix(contrasts(f1)) # "treatment" contrasts by default -- level "_" = baseline Matrix(contrasts(C(f1, sum))) Matrix(contrasts(C(f1, helmert)), sparse=TRUE) # S-plus default; much less sparse ################################################### ### code chunk number 4: as_factor_sparse ################################################### as(f1, "sparseMatrix") ################################################### ### code chunk number 5: contrasts_sub ################################################### printSpMatrix( t( Matrix(contrasts(f1))[as.character(f1) ,] ), col.names=TRUE) ################################################### ### code chunk number 6: ex1-model.matrix ################################################### t( Matrix(model.matrix(~ 0+ f1))) # model with*OUT* intercept ################################################### ### code chunk number 7: chickwts-ex ################################################### str(chickwts)# a standard R data set, 71 x 2 x.feed <- as(chickwts$feed, "sparseMatrix") x.feed[ , (1:72)[c(TRUE,FALSE,FALSE)]] ## every 3rd column: ################################################### ### code chunk number 8: warpbreaks-data ################################################### data(warpbreaks)# a standard R data set str(warpbreaks) # 2 x 3 (x 9) balanced two-way with 9 replicates: xtabs(~ wool + tension, data = warpbreaks) ################################################### ### code chunk number 9: modMat-warpbreaks ################################################### tmm <- with(warpbreaks, rbind(as(tension, "sparseMatrix"), as(wool, "sparseMatrix")[-1,,drop=FALSE])) print( image(tmm) ) # print(.) the lattice object ################################################### ### code chunk number 10: morley-data ################################################### data(morley) # a standard R data set morley$Expt <- factor(morley$Expt) morley$Run <- factor(morley$Run) str(morley) t.mm <- with(morley, rbind(as(Expt, "sparseMatrix"), as(Run, "sparseMatrix")[-1,])) print( image(t.mm) ) # print(.) the lattice object ################################################### ### code chunk number 11: npk_ex ################################################### data(npk, package="MASS") npk.mf <- model.frame(yield ~ block + N*P*K, data = npk) ## str(npk.mf) # the data frame + "terms" attribute m.npk <- model.matrix(attr(npk.mf, "terms"), data = npk) class(M.npk <- Matrix(m.npk)) dim(M.npk)# 24 x 13 sparse Matrix t(M.npk) # easier to display, column names readably displayed as row.names(t(.)) ################################################### ### code chunk number 12: aov-large-ex ################################################### id <- factor(1:20) a <- factor(1:2) b <- factor(1:2) d <- factor(1:1500) aDat <- expand.grid(id=id, a=a, b=b, d=d) aDat$y <- rnorm(length(aDat[, 1])) # generate some random DV data dim(aDat) # 120'000 x 5 (120'000 = 2*2*1500 * 20 = 6000 * 20) ################################################### ### code chunk number 13: aov-ex-X-sparse ################################################### d2 <- factor(1:150) # 10 times smaller tmp2 <- expand.grid(id=id, a=a, b=b, d=d2) dim(tmp2) dim(mm <- model.matrix( ~ a*b*d, data=tmp2)) ## is 100 times smaller than original example class(smm <- Matrix(mm)) # automatically coerced to sparse round(object.size(mm) / object.size(smm), 1) ################################################### ### code chunk number 14: X-sparse-image (eval = FALSE) ################################################### ## image(t(smm), aspect = 1/3, lwd=0, col.regions = "red") ################################################### ### code chunk number 15: X-sparse-image-fake ################################################### png("sparseModels-X-sparse-image.png", width=6, height=3, units='in', res=150) print( image(t(smm), aspect = 1/3, lwd=0, col.regions = "red") ) dev.off() ################################################### ### code chunk number 16: X-sparse-mult ################################################### x <- 1:600 system.time(y <- smm %*% x) ## sparse is much faster system.time(y. <- mm %*% x) ## than dense identical(as.matrix(y), y.) ## TRUE ################################################### ### code chunk number 17: sessionInfo ################################################### toLatex(sessionInfo()) Matrix/inst/doc/Intro2Matrix.pdf0000644000176200001440000116745114154165615016324 0ustar liggesusers%PDF-1.5 % 51 0 obj << /Length 2429 /Filter /FlateDecode >> stream xY[o~_1@n2HJUEI6ygd{ҹx_s#Eidgi<:!իosn+etY,n*9t C̜l볥u*;v)a\g:nG<;y-Oh>v#@̸g|5 U]+ e],W֬IPZZP gS  j+nE[|=UYtkk?ׇN,y(+[&pxGtuaOdjeSSQVz;2 Xh~Wj'|3e*9NҶ ׉@ m_Hϣ,J[xuUv,ߋv b1%~9բPZ9u>2{B0SL:_=gw*/j0U«ڹ ΍YxsyMqDO58 ~IgV^\ `ev#r%,-RS?l9RC$z#}dH+H:{P5 .!QAzCbE1wXmw/EHL{J2x[,9e,` 02ZzHe` =!53݊Ef_- Ar.kۀG8 ,| MQTmΚ{ ͥcr$>PPzӵ<ҡCms6jjhh^f+yzp,/׳B n/=ڤ${<>1E.nHQУymƖ]%h`$\4sC|Z6W$ en/^',aŲ*o̱ .dz*'VV@2cCt`%4C%aV\Aʼ(s,QDtM^BVA ©׸Eieq?F3|;'V4\dd8 ŸL5 /Qvū9l, Coʺҥ M|aOCb|H7אL>ޅDιSmY3HIg#tl'5uvalJ"Sx8J\i+bcߔ=Ih^V6pzme: +hls8n"G|zBWٵ+b|0_68g@7Pu^-Є:-P:n+FðK岣#G|YZEwő҄ ;x,OZ'2lg^97jԩ`oT"E05Ռ+J8OEHCƫNt]t#~7:r k }:Br. 'xYc内B/ Y}ϕr]0cIPUr#1 ! F<|/V)H,4 !{:TCt!QL +e:˄6@WBd3|/fO5 yB 퓅LBѢnX,jJ.N ]=gi1h>n%.!Ĥr*>XH}$weR^֚lE_{>casqC8_{\QׇIoUȵz-a~0&٣Gv~Me)#U›ќD,#D`磭ߢ@ѐS;\>Sp*촢ժ̡3EއC0իjY endstream endobj 70 0 obj << /Length 1876 /Filter /FlateDecode >> stream xڭnF_AJ%'^@R$@@}p@SV]QHν32Ȣ,Vqpq$*HNYp8Z^GQϓ˲L2kbf]};vV!vLӂ)4iA hAӂ@Wk2ՙ 7-07naab,2~Wk*D> †D2GL$> #+g[X݀GȈ-[ܶjycj-kmeJW{T )H5c˼ΕiGYStE$&Q,]Md8v" &2T6U5Jk͊1H?j2 .5Ռ5v' `k O† 1l #$ʤL#~#n# <=U\? +(AD/- bZ/qqFOl d퍠$OڜEiQ Cţ ~jIMe ĥߪp,+dUqVdQF<tP$Nm\q H6Z% <(W /0R(Ha`-,`#7 ;hW/:WsET']&uYȇ5(1kѯ/E骔>!:rR\~hT@6UY3y V =3Y4ruqV%i2Sc*3ϰ(m\)8QE}Kpdpʠ `D63ݱ'OS_ oHWZWeP;;5я t1+{κhSf')\9Al Y[%ՕwI$W?.vU+ևIs*l瘗]垜vP&Ci=J Gů1~jO v*Mݰ7qFI`S$_$:;N:'ɻ~!76܇Gi5QQ! ѲӣdiNU֎ 4+FdzIX')fkx~WKiǓ4Y]Oqko3㥋z#(;#04Oq}u<8,ǦL6c ة~xLN~/_,˕iOӔwE*Ta+gSd=$Ro#1! 1mckT@=b4}>de S&Z*qu 4K@jѢv,e".TEZc#!V b*xJ(TLtZUp0q4s=ME8x ~ OžPoyE@?TvkVKJa7<l }fIг%ݎKNj ~;EOZph h+x?ǵB5}^]Q 5t~㪗Z3&U A罖=sm"j=|RG˽ON3><33X1d酜+mIG0ڧS4Kܕ= dG>.AvTei o#jѝ ,@xuC'(b.'TG'$1 dXS)ZBmTW gl cVwA_Ubk ![*;l!aa£hl`⤗ |:Ow(!]K^rEu,,$AXC&~_oW :n446Df0bViCgSwGӬ0:5]=Q1maݵK̎m3ȼ酼RSPZGe 0ºPnUUcq ]Ab6d5% e^g(,X|)n ?]f;C-=4NtKZ9\gj(skzHC5G b퟈S(1Rk 5g i: 7}-GpveZKW抋=uP&p&jZIhL6Uyv_VeE7z!h43"w |o 'nV >e,$"9釙e?1P"f߲l .Ԑʸ 4k1JNW~"gP|@i+3,*?H) OxP/yeoh!RklK'\nu[\}&o,$lZJY[۽:,ZC [Sr+vi T,Ku'y endstream endobj 96 0 obj << /Length 2224 /Filter /FlateDecode >> stream xڽY[~_a@!7kHBMڦ )z*zLFЈ)dAlCƑoײ=q,'}(x:> 7hr j`Ʃ(X$)c5I2H()si"A NEίHC|hc2Bw]dѨ2,!BTe~ӽ9hEbXd.TQqNI?%O!J#{/68>4'߫ .V!9垃 =Sʬz3mԝ9xHS[:HgV-&Lv 79DQvJWc^$.d زWW)Ne \!TQ QM)a3Gu[ֳ<9UV <'rE?j},=ة?T9<pTL!T[Y34>o G1(rs])G*{>|"+ f,FۨPiaB| yj-bār4vܽx > &XC62|GU0d&[iv\J *`)4^>0WRC (lcEna볖8}п"2/Ju(r]Tj)lZ v `om)Sc+HBw|9}ͫ?^.Vȵ?k . ?UeXbTfE͔NIwYh>ZQ> /ExtGState << >>/ColorSpace << /sRGB 101 0 R >>>> /Length 2379 /Filter /FlateDecode >> stream x[M5ϯqnp#Cd%%n+?r{ƻjp=g=~]Uxxq~yn~?83c{ᳯ#]i\15rm3W_gOW/xC꟟67/_&ྯޤ?M7w>nr0Psmn/\/oc6!x?u{?.lj[~ 6dŁ?pGhC1i ]=g_|c~4w+Ջݼ6v%?xf!8r@2ܚcVgSFlӈZm-È$TGZD%~fv]Fdr fߓPQBI-4ljC/l{ܘO+TYk rKwK^=?uř%v>Px?>PM'wJ]ۈ-m#Ni;i .n9w(>~rkt޶ %[ Yb n+D,\8˂1PF;B!XY XY0b˹6+&)ͲHWGʤ'c XDK1ZWY0V9 RՒ#B"8~dO"ҭY48fY0TRV#'D`|Jv=fuPpEY0'WAD:Fe]Y5l+9B'Y0 QDY!☱_[1IB0~M8#!֚^Iv0m`X!V*VItt`񫧷 RqwbL"v$V7bH [[I:IB0ʡ !֒>I]t8㗅% RPt8(|ס-`L+ X)=.IvZ qb"y1o RpT6C}v Cm=RFwfL"Rh φTϦxNkZ+DhK+ڀV~~Dȧ+[{l␚HRlF'`Bm/֎ZۭBbgvm;t@ܲ^0kU@tQ4 pj轎є -*w*Q Eh̍ rA@nQM0 *ᆰ  `4mRch#[h s[V`Ťq0>ucq0 7(J&MsAn1pj.M0Ru0Ŧ(1`4}eY>3c4Ն /6L6c4-1RFrkQ%[0`4.(ݷK LsBob5]Y0/k6[#[>T. e1E tC koG-φ6ڶ$g<5bKAW/dX qTZ\z; :6$bj_'t :w(z.IVwk)~vd!<9WE ۟}s'\$d\[9L{wS4tVv98jG0BiGgѝ4v9O~?iۣ IWhw0I@e*?é Uc}YGOKJ^éY$rޞ/&{ endstream endobj 103 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 112 0 obj << /Length 4297 /Filter /FlateDecode >> stream xڭ˒RDCъE%rɊ uԸkdvSb;㺩xSl&xt ʰc힭 |얍7ܢ:[0%DSi%ADPgvPjȥ &&( x,xۘᣜƙZ"#o;}1}բiɊ GA0s.tk ~E̛E7 s>AS6.;vxPq); O6 حKm:2]4gm-/Lj8f88f`rݠڲvXoȍt$)oECQYnA܊cgʘZXPR_2#ǽ!ge E#EqW(1P'<; lFtqbBc 7d=^RŁ?[Ax-7枡ڽ.YGSR&Ƕb2&=k)_)N\4X6tvbkoNJ[@#vV~6'gz:|!fm婟~fW>RgdOI:q)DN(3Av^R}z>;9d<*Pa R gy_ #n)VCY'ҭXo|^YAB:?lɤb~p.(c+iȿPʁS,<`&(9@ Or%rHmzթv4.AyҝᇋepYR;rwkS>%$`w)j+A G3&T)!"L=Ȇn\AvFrF;D T1ɬ=BLlIGfC8Ϙi+~Xǚp8u?yZ|۫?Rŏ_U,ZRO)fLCAV7V2L2gIهEo%!ge9;Enrʖ]bj!>u/.FtH0;ͺgvt޲M(FXijcd#F⾳7@.?RA bŇ922IRy֤rKR᳡%(bRt\άW+ #{q?r;V荩1ciP ~4u>R<}Wb~rWE玒\Al] "^f@LB?)Qq%W6󉝴EE9Kvr5Pu5dEuYgn{w-/KgmK;/ص4̋G4M0iL &j$ m5U]y.\$]H>Hآ4_5)uNet&Y2.?!HV@ڦFA(:~҃7Bat+\}K6Ca]p6ҟk*TTE5!,1n\*TcIp>cUux?y<tk%WGF$JcX74Rѡ[ :ה9PHuR476ϺL|V|Rws0*,S[*HgΕ>+|c?*n)zD\7m%}\\嶞POA#2~kI$Ɂ<Ϯ _"zJzmz"x)N8ѡց' 3> e~JGf|w6%[QӼVqD'* fU Yys[[uVjJe9q DK~?} Zjζ>mFʅ:{GrdʕJe0)NʨEY4F2ɂ`o?]+52J]hCo/putQ=e.:$]D f&: 036r'^i+ݻ,`ᴢ9nάH _<ln/-F\xȱ(BRxHNj|=ϲY,Ra{pe68s ,BNfʔ_6QVlI>jUXJ-z*|*oŨ,tP^<6}<={%/qG It 6m9&T[) Gʸsll0r\$7GlLdAJ/OA0..Xb\v$2oqO98>^K&Q:D_k0qŷ7$>7xB?ԸVM6ăL6x *L3, 6 %0wjoL)J4c1ۋqlV.?xA?98>FoqHTU۩w4iĄT*N &c' t.;.5PX'k\:lBgF?} ;_F_G{L%W|}S鏶J\srԪCHq|ĭ)q?] uwYtGNNGHhkCx׽Lmϝ:+M u?) ؄.=!W`==$ruqOyh7bᓪBth>> stream xڵ[[~غ-,3(8 "Fz>$ZZMv.kùۜ7/|u]_4YSʳ/VVjv תƙ&SyyK[\E->O-o}gK4|QϺ./u={}]8b2 cspMwǹ+󬰿+s{d"K5 9&\T[Z:)Q0;'_ae vR*?~Ey`q\dG{Zgo$H,M-=~SO!blxp i:i$Ix(w˓$+19gףYض$Gn&&K'go%vҷkhdëvi[g\0JɌ ~ 1Qس XS9HSeM) &r= .J<^"Hd/0+*a 5 ZԎbc 0L(F8$90Й)[ʖYUUO`ȟ VT'y 56qX!(!LUڋJ8GmRe-(DC-D|w^& OS'k,uYO$D[T*+2"Ud5ڒWހ⚫aBSOf [ko甭mVe^ 4/T=;PK&79r9,W>>30<3&5={ M/̿o/_~f6&BBXX~NvolTj{h,I.rg d V 56);o#h]B\Fi=g76 w:5L"ތ-5I_ZM,)m0.O%ƎtLsZޛqμx>4?-!U$%S(Щ ;-bjahMVBw7>a }M2S֢\F$ S:keDbif?! ܽUH7,gdU;N'zNIG vGIܭL,+\rFql:°>L}.,0DvUsUwoqk'O4p)xj&Xhhpj3[2S(Rx{jG3ocWIOc,1e%!uftԗsziqS$kL;u(t 5Fÿ*jyTK"]U~ʰ^{^캍++,25' Sxs!lvCM&#ut r\T.>@""Cf'ﶨ>Zf6?N.]+N>c-r,ィ=v&NX9 Z`;ODw`11Z`)3$y^ܐ*ABt(2eC)e^h49n{ h76/|ejV7!3b8wXvy+ILg'Q_+,H#YX}q! s )\@cRe#"Ղpj&+UQ$y->g2HgEޯ2J8-/K\wY7J dmtWI~!rO,Gmk-D;,T:M:lEow;NNQwT%.MRY8#Y^%Dif[3f|OS, NUk(k(аOȆlE]`z"UmM81B-فkS7KXÈup$ }&ҀvdIukZ 1IUQw!MxnOk~3@?2?{)FG8  BxHpiUiAvpg7@$]z.o})Tx;eQY끿5= 5#JX$+ՉѲl^8JVL _;"r kڒ{Zvr#7]vqRÁ4 $p텥#QM@[}Iҟ@(dIR#& -7T͗AKgݽ`q lx$&1RH]dSJgiCH }wqQd{[T%Շ*jha9^uɭk_͓w#k>dk$krƕC0ig "ndN{2P1""W1){@ F Fhsī3[phZہS ~ O7BY}C& F:Hrb0m{Qڦ`1okZwfs1eTÍ&k\:Aa%T /,39ecL<(]R&$-xK1Z0Q.̛Kt$P]Phhb|=l"6Dr_!zr_ {Gyf\Mq RpҹhR1|cwB}@khpA|Rg)0)Sdc$FWwXN}t‡ݧkK"ʣLOC54 '_G\mL$וyGiW!a7Wဿpwb}A ğ;w/0"Lp*i5z;dm? '!nktUqt MV4\V9x(>>o鎚5sv֡m$Cgtb掐p_yDEډ{ZGNDґi[#gj2Sp'".V4QUd=Erpt:;~(8k(>bppgĬѩNHH8%t/؆MHRtUŷ5DxCo3WUA宪:Wi}ʪ0 Q{ GܐK$=/&:Ye+xQ@l^#||uv7(n6\r: ;QR;:)t*TjG<&ӆާݥT8 ME(u=@~2C=b0YV4z.3yՓ>WPsUd-a. N253FT5pfvJeX|mP*x]BvI|jvR%Bp;ί+X=Oʡo=8cP42gϧ [P!۳.חU7ÅMfȐ,98"95o~mUT^gus\v%Q޻/YS`3q3ܘsq%"N Lє&+0CA{:~e5m+ 5֦8*Z@&`z+氒o:" ,+HTΙorcLG4nSFEHs ` m2W2Js\Z:͈nGʗ0AQgv0ʋ0AWoaC.,:O*Y1]O-! w֓[OiI%)2YixSv&.A0u /B2EjNM~'^s/ޞ%rIdS+Ueugh.OYEU. endstream endobj 136 0 obj << /Length 2434 /Filter /FlateDecode >> stream xr]_5SNfb%LX II@K.4H\} ={/K>=?yr//YU,׋_N> |9M\ק. %_r?}uEHVU9g^>pN]A }uEng4F:3_,u8 9e-+ǓM;wAhiVhW@==$kÂ' ^o_レR#? X  B0x3q-z~7z[mޟ "=ߟ巿aՓg:QA&uL~(}HFs4KlL$?ĻD/(fFW8x MyҼVe $u?󞽄]eWO~<\Ei+H>UWvBՃ@V{gV^aŵx{ף8=?Qr:Olf5M#*kiS_x);6SS K+\Q4)jT.H!aIQ0q491]PF*ZCw8i=??4k>;Rii#}-cZQ%P)?S-*8iQW8UO|THzb-2-p@;0ߵu+g9d1L.(vW@8U5"\$FEt''Y.l<" Jeơ Nւ8& S[ީ6uܬPfQ-d3Δ Z%{ݾ3$$ęLY3UGrq$$JgI3"lϻ5)vk>. E6%;ضW-b = ;L8gG3~DQCw\Dw>޻8P|y?RW`F N yT*禭Ë)pb@R#oN|Y_5hrDxH6H;Б|dZK'mJJ!S$WV.成 X=nT{fmd3ބ`CGtCZ=-|p5J%:Dn!O,͔1JnEݏX8jDaΈ\|R8~:ԽxOj/G}. p!q'!Biotc7 ]R!e#n|Qv[_{m6"`!DORPMc'8A",2f@jJ ubl'1+qkgv؍a.ayzt'JP"fmh,VAz>"tv8jnyFN|ߣ!yP q3hI{]:F!BNb}>`)68xȲ| @5c؟\bڔXL$RjʇH=SsBovb߰嗠4nZ<=R9G}?v#X/{C"'ɛc9}F~s<=66Q9ek0o̱&;p,Rֵ' 3qGe8l񠞧qwhLLT5OǙm7C-b QjY8s<[gS O8A 5ѶkWb V↠v ]B*c.^zbd(nJ pIm-䉪H56JgHoKuHT)-%Ag`@Lj ;=7oj0Xx3hY8f‹/8mHaR%No~^ s-_TOAQ1>kz,w rR_ͱhL [*F dS],^I|r[m}è%(\)SN@| Q }Py=+,\?M\!irWG'c OuXfnڜX=ߐe󕦅~ N g281b :6le1 ן@Jqwߪ5!TY\\ws9ւ8d'p endstream endobj 146 0 obj << /Length 3059 /Filter /FlateDecode >> stream xZ[o~ϯ0Πqm bhYDKB$+RvͅI9߹K^( R{~MG$ rF+A:Z`8lO ӿv)$q-ϴ0jxh[}\P̫oӿ]T{~L)F7|wVϼeeywK]Q͙OܭyQܖ] 4mhnҴyvxk <h1[~d@Cpw J+\8=ϼ$5E%KS=Ai'b&J(κTO5$@ H3/u5N"isãakZ#Lf ׸vO %sS3TrMܻ<%8T`%E#{x:OѦb$=qTq iϤT"R"E QU+T9݈-<ȨC}]ā~p^ }(ŋ/K>iQ"͈\Fݦ2٩aY T(G?ɇ Y~M"O*u+qYAQIxxN$ C=ZV }O2YM|ߒdZ!)6ʘܰIx1Zltȷ>x"O< \8}H)BOE_ 2aв~4Rj2Ɠ&| " IcYve/??t<[iFjAd ,0)?35b뛲B( U>lsc)8[r9 /1l8[* /DEJTvwa(-!,"D rkQAk#L@1N2Ųs&~ĭWud_kمԬ4bjPJ}7AaPq3 R%;^Ҝ88Li"cFef[K:Fp3~.6>o OݘLt9~=Je }f8eHĀߒ@R јQ2 Swv)7? I8Vęe6|Mޕd'<'2cФ|˩ymE-. N7}|=)PWrVXk*h]ωL0C3Q&'J?5T*kqr ]Fn1ʃH!8,S;nAa]%0Cf:hkm$8d99.v]``3~t$eԔ꼹;ܪ]pbmJ[-vR K[Ԡ2VCk׍Yi>7fxY+QHH [S}0–9jO&@VX x+4wFċ6nŌh+_Y}Yd r>i(+RGZϯAS8*Bʭ juH/וؘ`9j+e}?LM0$XP8(BvY$-u:4l{[v6 >\gd Gs qit)"n@rf-V6B,7rXk{8oI{cwf, RBצ@/`h7 ݖ),(yN$;:z{XzN3ld VD[^jo7deigؚP^֩zqk ]I* ;|Kf-ΞM/ F!kaa^p?-YSdB4k^NARQ5Aڒy;lY_% `gqƕ>*t@G4Šk3F8e2[^>=*+tiiםWjG'qJB8uuvi5sr17=d ;)F)~LJ(зÝuJػoSE͋m (j1 X:e.AR>k$F4x"_W̛EB@ \{58zmPPd*T+Jp_k>|_ W}ʇlfOP =o (ީu:p^xIqSʾs"։98YI{VΚE+[0b!D;!督k9iD*edi4]LL CǦg}INzݒm(tE.9r'θFE%q}!U1IblSxq]^W*3WN8ZZ]+Y{^&=c+#^]x25 zKL e)cM7'1cg+±N |~^wcY8B@=Hs=gut5ېȾwъo@;%9?ܢ˒4dJqS/J3JB8 endstream endobj 151 0 obj << /Length 1831 /Filter /FlateDecode >> stream xڭXKs6Wh3 +7YI]qdҦZeՒ(N|z/>:8Uؤ7e]KV:J{i5:{t*zuΊmh2GQaZLBaŬa߹(cTء2plAW5Ir~k^apJy Ͼ?{s UmОolQ0w}Z*Ӕl +,86YEuٽvJӞq*rjuGMr N5bTsؑ#ao 6TӼpNW^TFtZRhp6kT`7+6To*Oq7' DBVh׾bG0 2ۨ<^Ib5݉["%ɥgVaQ+VJqL˖C[P%4Y+&sĊ~xI0-;~ 'Ypm%e9D\vVY0,6WM1-eV3 &>Nh#%s1jZ}$muˌe7:g.0[f`;{ N޼ZH0*-fĚ*-6'b~?ˉZEhܔ涩gtJd=TLJftnMf~BR|mb%1E)ݶ$ &x)X{X@)ttx!:.:iĹ`8"$ 2BCmB?KPt`$Igo,|{~ 繗ME#3ǎ5cqD|wf/t#ȇ nX y0t }X"j^Ԉ$L#J=(6c4e]4E<cސ[/(?7H[uLQت䩧YƛjVBȘe&~dM7_ `+/p}ö|ewՙ$6<:ҹҺFR<jP1pVro0}c')bQRׄ :|i * 4m%w +e}u~s2m9/o@K]Oű{`Z>iIm'9Mp) ڣFI5cC8 ?zO[#LD7@M+K#ӠOU2U j5A#Igl 61ZoIwŝ&xe{\YqE$Ŕ^Zknѐ%'xzwPq/ƥR>N}[ L66rJ1ft|t'k&R}ӏ?9FO*w|> stream xY[SF~ô)62v%TE hǖ,|Gl0T V9_{Ka*ei)'- faL=I`ɁX)L9d`R[I8<5dz1В9AxXg1 ڳ *Hf$a2v`Aff1a 2g\B6mlFjHNbWaR>.&iA&^ZmMmȕP$AZB |HV 5%@)TZ 4tb@-dA5A Lcl%a>E#wךXҐ h Jb%Y!UB$Z7A$`@,1jg@xW;Ah ))RXPWH?u 44TVxVcg]m]ܜxP[`\ص #JxВOm:88`K~+I̛*g~;;)N۹ӫ|笩{v_Ȯq<QQƬf&^Zr(LYr.F r٘'wY=18wuIJh~ª,.FaS? v6l盬o+'q>sfY9lgO7窎@#;iooa];ߏUU5mؙfNnj8a8A͓zD|L)K>% E $GU@iT|"Pݳ Xёe>TH$ =.KR[A򡪇nSrY @9ϦSRR@K"HE%9<8h%$r_'78(MW'<0*/ jCϫg__*)FH`) $ZHV}W0r3B@ff_ƨ&j6RyQQQ]gV/^P:\W#K}g+U~7ٛڃhƒz)+g9uoV![OU@\ڰ?$Ar=lz_1QtTczyҎ2,( BOK}}6谧~1̫Ǟ~Pc`Wu8c[{ѦmhFPgwE>a?MiXWKdU45v/hR 1&a$I>A6H/jX7-X'YPOHNh.{+:ɿ?F kd\S2e> k +>?b&&yQ('M1d5 UA%YþɰI1I80^'5d'9b4&Q6m*$ψ> stream xڍP[- w {pwg`5&܃Cp ;\|9UUózu뙡T`el@rW;fTZm  /IgMO wpp8x8x@'?Pg;:]Pi%^+kחcbp;C@f%3Wkˉ 3;zW !kWWGvv63{6# j P?(ك i qˮt0s^ v% x9!Pq; 88?A 6f^+% PQdste9Xhf}7s7ؙ8Y@F\ `!.l.?Zd#˔,$`W?꓂8A/cbfm>KMX9k9@rRPY]@ v=ArIi~|iCq1s\~>&rp, W9 O3/rOe8?d^P;_vu}i =:'!pX9/~F wseLS 8K`?Kn^>8Wϐ #mwA2nvv bҺ@ "KP;ɹ@?C@<W_]AP/+al_^./ '~)Z!0Nn nNj-0xi` uF>yBv ^.?Sؕ8_vz `bzb_8e0cc>vKa q9+_P@_ |_tUءo_|_ ETFv[ccy1hX_9A]v?gx5]_EMbW^f|=_x kAn/yY~o`,$bSzS%N=&9%$^QS t*XO}!c)@Y !ǖ*'NdD`AQmyjD7KYH*M (i'3ڼ7Z-Ya)aݳNL00q cd)"b3f2k*w!#ԦwDeehTX'UoOUok^G٭ ;iڝH-t  sa{Wzv;!no u.}3W(wkLDG`[j(Ne-`B{Z~vOx4[a;djXsZԴd(Mrg&E_=7rulNvxllVJw1aGgwQ%$/i7FuxQܜ'XF=J9?m\0_SGbٗ{ n)XBm9ͳ-iOI 2 ''ŮWXzOrJ1W&(;ʓ؆!Qw c[n+ /qGQ ma=z*|#'PseNnZ\AxЩpW:Zë=;HEjUSMI ,uc ;1RZXF[OKKU팵YyZIC <wRK;tQ=a)%.2ן6/)ֈ~[8hAb ͍8e*x@1B?eD$ gdM7O{oD$E!>M8DR U(m51h!3G1.o AwA4Z"/SW R"?g ҉V+\r3YO1 7!UY4gʋ|j V&>_\ Ⱥ"c[C NU,砡3myʫIpyQ.*)_7&. VѝՖg"j8{KأZ?!+ӚR\Zǚ+œC@?Q1U2=06AR`m3/JP;EoeL*+s >$˝4]o :󬹤 %rhBW엾5瀜 (rH 3T߁n"pOQ㩿6О? I |N6cH*L 5 ol#vShg#_7j~]C7 iq|DаX=`wPk.3P$Ot1dXr75 H29\f%qtW0s+R*K #ut&q^;N ?U0l>5F٥95}I1<]J(B ~je.%mkUhMy|Hȶ*DxOFAIE{C1VH׀!>$B[]$%3|87M=F*̺}]–,[E`o_IB>%O8//͊49?~am 5Ӻ>S|-}oHoćU< iǕ1/gƵ&yГ]\a2K0˫j#Ƈ=l5| }p7b8s\%5=EṭltpӮk)}Q'ҩf-?SFf&qpuU]Yg8,% ^ZFr Sw2H4zM=bx6t|k2M#JjSknU7j6J}YnGPi&E~Dk}QgW| cH8_ZP3ؒnEs~齬(jyϯj5All7!\= #[fd.pccEQ1^-iqtHvP؂hU\ t)+6KxeL(RK^@8f'tNHn_V;+ez`{ֽ8mA4'cZ%Q&VLQ_?wp(HJvpG`nj֔g4A+ [pJ{GkϢs]45FES"!e]Pl}oٓkF[_NOcwHv\)Uh9d8&@9; ›m`ٗDŏ<'LݥvH)r*jFlNN); $`c%SI$S5+FOk˪NI.q6y~z|yh{9h1hTUNu$i+ZwsS N{gR[znzsA؀<.&7bwҬQjٍm|1̩ g5}GʢZ;I56ʼnWk 'FduQx8"R5}eݔ!\]׀p1^f:ۉOb"L۩[CJ\:“O4.p򘾊!lA]w %yd8lGƧc'=x:Ϣ# x+G1)mDGȚMHm1'^{..7^c%O:c[.XaD%^ E&wiuX Q-lSӆc{Էf#=ֵ1nԟ KFl!U޴Vߩal:$>fx{y*eޙGH!#rwnr<-,]6-=]F7p-RQUY~ضz1Ht_z.c%A*̸%x3. s~AQ?پ]S@8E&K"mpJG>#IM9]FYE Z.,b'ftfCM'O?+5 ט]_yS!c% ]Ç*|6B9z*䐟fۭO=1 LKp WW=yW"%Q \hy~O*T7GDnŤDC#I޵o:걎U_XO\j L{#rTZ ¾Z~HI%JcXcJA^ I.װM&CyB70nm_@sY֮98N*{ij%C?my[{C^O1NԱ)VƗERvD%1{{'$_ `, TЭǂ|m:w/Bt3 7K+p$)*&'V1=[2SU/}ᢨ=]?(5ʩa=tj-`1;(OD m:Ls"rsum.^7~B hڤB#S!{؉iΘ [ (y/Qolᶣ$9NMi;"$se>d)HN//vt(ۂ/ʌITڨĤB/%$)}x´PQib ,o]RM=?~W7% ?1?`QP-.Qg"&]3Δ~aת[muhIp}>k= I,2ɲCC[tu/e!v7GOlP"q4'\iW3]{ˆqM]Xqq)y@פ_q[?G#W`V;h&%c^BazզI8/)ghao9XdC%mZ]#7?gX$B_Q0hqw'eغ~WG f󗨉~ ˪&4:TY -i ԎD_||q^JJdJP1,js4JL ׌GaMřy2m=z:|0Fwk+1ﺬ;*۪~pᾒN&2y!}}^?[uˆ~҂?k/aRO+o 8{'^/5K-[`{γ| WeRK5#f9u'-ԣWR:x|=r)LRn%SˢL|^a+Q={t"ne̅ ~&1:gwXL#   *Oc؊~[n叭`f*=AyEvl肆O1$5k2dPQs0]7Sbh -o4|JvK-Sn3}&A.A,'4JQF8J2zX,{J 8<:J YG)?IOj Ӱ,+#[1ML;04ٺT><*w 3^HA="^8yGoҿdDSbƟcE9_:bz8hZpA=c1MϗM :뜞7 YЇLx]s_%~:S~[yFZ^|Ñ.4D{MyXKstݍv]4+Ӽ2,{},qroNa:ŵgؙpvgiԜ?v%fziP el{uRXo89ermۧ&%F i=MIe4 .mXMcsUP45rk@uG)^< s&e<ƒCѳo7b~6<vNj@urޘS 拻7X 7~Ľ_&DqA,.o9U{vv4z{hk72Jntng&~&sqサo2΋ePFtװ̓jcbEP "~/~N0HyK>n,?X].~l%"*g5օYt:0* pohMcv۵L2GnWd'gӬM]K 9Z?Ox㰈Uk":k^0Ejc-vl]x>Nv@R )#w0uIѲ WN <(yU ArI_CBay%Fjh۶#+yM JMy)C1n)UQЍ\:=1xU&~q;Ǫo[#9> G&zӖMOIJ0\@.VLb(M-N#Ew],SW,Sg=(HO~,ݕH,Zx&ibON1bԙMމ-HfuچFKt;TI]%0|j!r&W<0_ *_&E=(v~/=꼔acQQ5n?̆JΧg(Tir$ g'˷8'm}$|]øHEf:wn #3 WkL\5^ˠ5dkLOyO|}y;Ȇ\B>ݭ$Zۄ yA_v>byݙS1KUJxPjC\iR}irKW1`o-m&}XQO}5.Cu),|YU)ϓ91t?gbEQ-$3,$98D.qeAϟ_CpTrGfK4Ư0"uJJO ]$]nN$[26UskTM6LS;Fp|4nvS{~&A("P)tuGKBU p:;H9>y4 ~eN݇nDsL÷=<5d`!N{&k߫!U.h&ZI_3=ZR2t!I6}9 SM5iR:X.2tؙY(g-$k!% b|sx2NŘxx-o~1t;#٤ud'eկ|= > /lgo i;MF8T=!GMyӋ @PˈInyZҞIpd_g}!h[tLqwΩŞ/YR,c7j,s4H"b>VL\Hz&MBܑ8+*-2Oز|73#Aftet)jd-aW5FNh}Ae4b_1)*|JuqF.?6S>zB*S5÷fciKKɝnu,7CME{6b (h nuzɈ^]JA B|;a^QucGB mć /Wڷ(:D#gs\q7LCB*ؒU>B)Ly9}IPc[ ןlψ8z%H6!W 1Q:tHԪa[r:HXpiY+q@:Lkqy!F-2 bo p\Z d1b~.9 }Zg 퍡1^o8%qҾy\hp5舒WQͤsTQO&"U-OcJ]|UaیYE9+a>=~a_L~<7M-դzF5 I52!ll9^l,B peV^؂V;r/Cq3}Tr| aq'*\77; VJל2$_=l&qҒ֣ -ĝ(&oh:f4UզVk d6XT|%F ZJs89rJ|U3CI-lzC;uF7]~:mX\Q9B @\.B:I>0nC Vg~ƞhBvoß@j-V G tEUt򩾯 r;`_Ph%Œ U4e ̫sSn뫕)h3;_@ ]L{ܡ|%Ro2`46¥R aW,s}=ap}Yri+J-J;6Bv{)9Tt&5WRʢsMa)}Ws ;E` [D.ܜzV7<">7q39f}_0P U(^$$=M#ۋ Ɉ Uvu)F(=(!o6r0DVgq<7%(a?ᵳq%C棨j};5޷T9Xx|#=Б 1c Oe&%3^;z$\~qo޶΅Nh;龗!)Pѥ7&NݕW>.c2)1&ݷ6:>> G[Z x 3;?TW~A8lگVg G hT;s~o[[DJ{hMb3̺ \mJz5cL,I%KlcXrn޹&%Y<.]8)`h,Džq7g |R{d`<8HJh(i+70rT7[x=K\#<\$"ުRK-7-2I!<|odTyTibl! ={Q:lbLj6u MV ˀk[|4eF [wcҖ Hn!yiLb' z9?!s x^Sc9&_bMTʪxN# R(2~+?Z΢3ahS9B?2\ޜ6oQ^'HmSuz޶ W{ٹ:T-H w5f6KJo$|lVSxvwѥt.6/WSRq[3zsgU endstream endobj 184 0 obj << /Length1 1443 /Length2 6441 /Length3 0 /Length 7411 /Filter /FlateDecode >> stream xڍw4\ޣ b.a F袋-ZѣD%hAN{׬5s<5l̺ 5TG %JJJ@( пDl.0\? J.PS!HmJ IA P/ E B m>&u%bSB8{lZ8 1' AH;zG0`àHC"%@N|[YN; iЇB]PPWv0?"; @;a`(@]ZGP`?C~At>9рAU= ]`HW>W&A pr‘D)\`{up;ojo=sj( BB0P}zma Fwpؠl"oW @A}3oH@k- NOuj󇍖 `D+P{ew44Ե諸"- bb1utA?yGU_A 8N 89PF %;_Uw7%U7G?s= @j cG5 H(m>K* х!vhѯysWد'+W =d`3!+z␿o EԿ)ȯ\\@DG["h!-m?Dl.DnY\ohry~qc͏mx?PL4 n:P`p]K93}JR\7H3HuS@}ⳳCL5'LLֱ`N$xeLVexO C1PbeFc:fHNskŻ7Z4w%#?Xyet9Q{9ROE'c[d&*pm5I"{WY\6Ufj56jzRҼS3D%u7_]cWŖD߿ac5O=qLI$]ݚIm0f?M N$^6:N MZ1pv2.n[?5E*ߑ6mcS%ESJ62lI@f%zBDZ,NO.?2ի(^ "g1pFXru8|}ܲɝ%~޸'ix^\ M\R$HP O[VK_^YLP6a[lR;-C%_a' }|]ϝ0V(Ri+Q݀ԻtIrYtS5_'_| +$ Q33Inv&L!0j9^L'-#<-ڠw \z hpDJE|T{P˰@SYMKVi%aТ\S[X[ΥU\*P~>Zh?pVIK{{5fǨ[1z8uїrJ?9יбE gI~ tR3,B~hRVWF/\lQ1ElE^U >{vyVXЦ5>}ErG' @Ӧw}u2 g2ȒCƤW :~t ~g2[V#5sΔV,lj\2f#$yl:~ޔ?9HvX} ]ѝv3|XFφP~SxIPˀA6(VY1X4c/|Հ110J%h'Yh(v"I JGbFL=Eɡoh$1:&\D)jnHJ捂 Jyť*MX0u}fpV̻JwRaV)|Q#Y\I,[AuPPFᖙ@ЧC )HF:)қ7 |a-rImOfqI}h-RIL5&z*L'LvGhݲSr(UֽZ1R35n&HsNT#0ɦM43{\ۯNW1HJ-)]?fvN=eyz-VtCMP0O$Qn`siSnj \Mq` ɵ2o߫  2>2m1\"hyifmo@&zL6NKg]7 .sJk^Xp-ؓ69JTRK,W/m㶄?thcd ]#>/_T0P*hxb\iDˬ #r{)DϽ'ǧ ?ܛ +*ĝ1]XdPa<:aI!(,UqE$t9]eD<|UᗍG8I2kuĊzl Є<2kEDlFK`'"l4˲8Ӌj4ϐ9dÔb#$;C^^WK_+Nxe!AHíZ En$5na gMUvT@2gԈ *Kez~!(O3W7ck]-١sKˌ]|2[8 !eX}J|-d:!&EV2:}ʅ#Ci|ĩR'PWF NruܖZ\p=֮+[oVC~$eU:n?cYSՙ0Oٵ-J[M9? =u_,YyQiNE(|c |aƪv$͸PzV/_R>8R5&2QJj{t 924zk\.SS%y~c F-Cup(8d$u9>US4TaZη'K 3(XKͽz_Ir`'emXZIs'2v_ ?V=8(V,hKƊ`4x|txh"abrB}(qՁ}F䄈0nJ>\שDmƒeAN1[wXbbNE2mކZY^;o}}Ar]Qg@1C)J:I^]RjPuuS/Y3Tx693pc|Z+H(Bj46+C}DAiyU,eVѠeAչ51AtحcKl~I/簡s 3Q5~VAթI۶vY}Vh&eBXWǥBAQTo.9#OFs]"?RHG ԻUi"qF/\ExHxa~:}HFn͚ VQh7x@6{uOR?{zIl톗.Ae6uT2 M|(j63).(& u"(Cf~R{\GrAk4?mm;[6;B^cŖ z=OC9PdZ,}/B䝍r{LQ#ײbF1mÿɬԓ`[77HScxG:}ּ NҸ2[)ȲB9B>ܺP%K1wKCtT/[^'n{54zƑQ#Bm.d<fYO3'1 X-|y6JsN#A~-({6<: tRc%~dbw {l嫴\3]tvi(Ctd3G:j8C[t~W!ya~lxJIO_t0; Ts# Xk2ں^xj6)>v9I|auɂ9>`z>!(U ' lJW>4u2$hZ=ع3v~ _hO&x#n5mloq- VI*k'wmxwK2'uJ?s~ nʦY:H9uw`Y K >~<(4iKUK[b1ŌV K9?Kp@& ऎC-y!Zi@S?0$*'LTu kogNZ[OV 8"x46$RpHyag"'9ZU&k=xL9~"qAq/x>:K~#1*"!!ɸ}H IZ8Tk)p:vr1밼g;=,,V0:"qcT;JzBL[vwQP>T!_?, ec{ۯ!M nLO{U}h3dp.)-ݭ\pjץ<퉩TYtX`2iU$eM1&>D$/ac $ȋd?f4[Nj9u=VCK_ŠF1o(mZ[EgytƖ49E**JuPƛޔTt5> ;ņ!T6P4]T|idgx ~s" 2o';lkwSߏӛDH__]c{8ړwnz7ez;o1QW0u6:9# f Klں W8U^jiWy#yvEMZBc8N2762t&,?r%J *b&套v_+}ؼ'~5C0;}kg9_%{]30.~a L_vk+(^:WD "iJ'}Ngbw}uej ۞~vU~ix3soR^> stream xڍwT6Ҥ(MD:QCФwt$AzGIWE@"T)"H|A=s[Y+ygf^ox5RECh^, jAHT1Fq*S8@CL'u(C$, KHoK@Ho"+ P"l-4 QAc<{^4`Gh~pW8}O?-*0`P=En&?0?z$(Bz눁Jj/2%$* 1Imƒ?܅ (;4pH ~C_1(|)9A]a܆u`h@X 8 LS[/u(4 CcZB?@p@ `~!X%K8]p;Fe r jޯPbsZ%[Oٿ'"ԟoET3~nت첟5ikClWK}ɞ 3z{a8k(mS$eN"l']H6J[N#Z↑?ǻ2 nki(ab21^f+(dڲ-Tqnt3ݽ=#\6Cj2=bM'ri\Ww(vL'Wm:oZ^Kh``yA`TN-F؎grwLSo^|p n9~i+niwZWѮv!MU$ϫ 2evq#3'vD%S 'ы^vEku_,)vҢ;Rf򜩞NzVFx9zZt; |^x6;|pe=[ifn b|#l8ƖX/p۟}Hʵ?pd8 G${~`Dwn'5[g?囒Ĝ@}'u=^-LM R ti|=h$Yif1;mxRs?Գoۢl[r4\-\g3 evîw6npel.cymE6ݢ^ҐQ٠όHӼVS v|Ph_LC 4fh=x۴8DAv39&lT#oOu%ŁŨ>8Thpn 9dCy.o- fZ9ĞIfz>ݩ!Fqra⨫.80F?tYmH/zQN.kIМXmcaO/Pz~iB77NԸn7o[wOV,7ϸCWƛ0'2^Uy p-`hڭSXGk6k+?ʅ5n8j?vj@NXo;s[ҥJ u,\s{:qb.VFTN,1/f;k9/uWyڨzeJW26_c-mhV*3޸Nܤ oZ`q@_tߦ >hЧaq "Dp^5 \cUl`Oۥ'&M3^g*P?OS5o^Lb T 7۶4$+Z % {rg舳{{ڰEk*m|+ oz}BΝj)7y *͜Y#{΀x fRA"gս |"b C@fwŶ9cS_z;X Rm~ەZV<[> Udߐ4/ĐH<6`uqX$.u!7uoE.RwWWW|ՅoCz:B24ˎ Nz,b/R'mC WVQ~y_apل+H]z(߮B$_U7狤=>9(TgE47Yo_ӧ0HJ?Ovv,rĺ LCHө/ĿWU @wu먾oUJ{tҩWѐa(ʗЇʩGLD?0, wKstCaE 疚3!ғ;4K`hWf S#bI7(3F>a?YlӚ*IJ7N蝚_6fu%9n,sTWkSۃ6[܆pJaUsmwe&N$<| mѓ1L>W܂nMr/^cviotmJ{66-@jkDJY|ުS^]Yō!q|ֵ֎DO!g^t-ot ɥxPY{ R]B;.>-gkYpF+V= +b{B"={ nO:Hm 8uhg"kSdiD:tD%UOjuK'_oko.#aUyߩ<A) WY]ws&BAʬ c:D˷!끬8~0'0RpEh4kPz-2vސ{WV5һSH,=zdG۸6ama.+ϰQJ^lьl2DߣERw=-%DJ䇏rVjQ,ܧ`kSwNF'68Wa6dZO"9 .)\ ])cI̜SPԉ'[⩿z*zD&DHmu!8uU|HB|wmw"1>b˛Ef|𥱻}2{?= q6XY;A}bq@9 Z87%Swlv!i|S=V&W]jwTnF68E+dNS_.IXvhR@TOm_S䍯?YݱPِ#4@:?JГ]$s $Їc߮vJR^Ϩ;%2| 29w{D展rlR$6f&i1Or5UΖP4'N٤aJosKN{LA`Q-=Zp+<k-Bm) >m!ZziK YMlOEdWw':F~pY`TUDnFE<>3}|Y8f$lTV"FMŭ73kI @^.^m6Tr I;CM&U /bXF&Ks! .L]=ړ52ϲ?{oOS_6b[O ו:+y5GR6( zWEOLۢnrsQAOC^⍕YqF9Zgl>]MTe%[槟H|WujndDiKDiLb@]֛r6]ddW%z9KЃČ Tsa2rI?z)Iw wڙ8GQ[ {tfo(eZ3^'TrahEz"2I?8Oν,rBNxA}%>ԳVܭ^|6TB"QylNR!X!ۂ*hXv _Z/:ZߌFBΒ5mfh_# oHV1h"5C@r`$4p ~ڝ:qkGIvݺ}mf+N߯1Bӈx=a@['3AnYwjm 0;}*7oGt6+IK3|v/mYl}:]dΫw_%?z0P-HvU;jEle< *K.vkjiWk9ǑLǬلGS*`:tA5Ƥ?<}{3tYCn#]rTtD\oIG17SgZo$qUujp:/|Þ}]`G݂ ƃ:A8Y&7n`S.',B<=%ն$tjzy>w?iVL ̍٨\" 7Ng*Pc0 M;{75䔾ԾhT}Yh!Mn,I]z*K60[;'/ΜXmU8;]#`P]LHL41䔨E Lk[ݱ`CBYVݮKXuCu]4_sF{ A# h\<39dY2#yǧOJ7_Aq]U(("#y.]=N[CQкmwMb겻¤YwPٝՖ:!u:Opa1'K*,e,IOt],W]Ic!+9KKTP%2Ϝ2/mg.e Buv#LEw3_сzC> stream xڍtT.t3H͐ ) 0 0 CR-4H#RR]5kݽbP`#J@ (Lť8I h )pS`~Z($@ĥ@R@ @# -P!`-A: w!RB9y6l0b}z t kh6EE@X  ؃?@'T i^ӿ:v 36 Z8? 7Con!ϿXкbBaioW#jaWa X"( m` E.`@m@HmFe j}?\c`Ɇ_2K`x',&O걒 X D0vf_5 Mk @KWQFclsCIfPP *&wQk)/͉0*+qzܮC[4ޟk v o"ѳ!Ct'sז>;o-/>xVA/.j" h4ewMţt7SLAOnŰR* ´JqRH<'{5^MAM 0}'ikہ ;B$ _)Z=y*-70R#m5g#ȃpߟnWHx~cM,:E[ȼ*h^'{E HQIIZo8i py͌]2n7iaG6_*RН3؜ yW(/ _s~4hG5#]yD&U\yyy+.חBw m^KZ##;rσx#[M.H?ia@U(Gm6#;~\ Im|K"F*E$(s0Mߏ!$ fPg=~v5ʰ7,;J~m!m1D:vSJSZgǩڵt N^/qӛ| .ҷJ-~V:|_rs@3z25ѕqu|.5MʅdaOukuHc>VR8;݄X #,N:Ӥsoga& Vh^ )l qڌxyÙ2 y,Ua!8=hd//W~/az}Bqhc 2SOܭ,^3._= '5|6cB椱SXV/rFc@ߨđ㸢_1V#6c@ڋ2(d4MT*(jM>#}d#_ME32w 3kip +Zҟ4uoѭ> \63d*VxYhFn3{dOYbd=i4[⹥6:?Zuӕ4:INykNj w. {l vJUJ9G/0ԏ-\q!bdGT(s2Rq"6oqɔ4 .3rpڤphv_ t 'qTď LPҢklMLO뮔W "Ф-K^dy@i1unC"X:.cLQ9W|^`SXX㑶+1 Op"y[$d-<#$ϾYkyO&Naw8`oZ Oyµwg;w`9S)w~Pg=ONrYrwt$o`rXS釭Jh2G Kn` SqmpVM-rY㒩Mq ̷er~lxLg;tw"헝]$_N+i{N ;9b*Ѕ7mnysdZX5`xWgU.e܅U[ǿz0TCqBm FxpTKʯ ="?"W8Q4J6?00<Εpp Sua;uM@Tm/,pg&(7^ V3q!cq 9ՠR12NDCǻ=)m1S}R\db =ݢT0UhsQOVRteƷ:hU.-%ip*.⽝G Y4])$J֍47 c^F(cڻj'C{ k4/V63%*]w*p(NR5*4%t Lᘯ|{&7Of:f6vAb$ʼnZ؟EtlnqnkgB`G ^Y5êdb fR} yH~vpƖsݨny^SL{9<>x`ͰJ̡K,iy\N8Ic?x8>DLxO4@]mqe r0~l4XulF͊plƉ:ȢRQPVB"{rzcwt'Q|[ Z6?i%&PZo;gqW`XEW,{d57Ǽ9^Nw:Owox5/qfq>V؜*L7滎Hڻd i&9*ZG?Ņޱ*`4K-0`;1pz^Nfu .DKMY7GB< l԰ b/nbac*VgueDɵܩxgqKݏK1:N=/.l\g@|pX?dE7XdjC?lvH `_-R)f9%R'3eaj?4YҦW$/n>f]]89Ícc1yJRP`P*ë ܢDtƚGWW jTԏ,n ͨ 閟"[mK~rB_κVNݛ&|4qFt<*Q FqpkB/t!UK[i>^*!f6'G6v |AXi cYa µNvђYAGki.b9"4Tq"Raz)K7hI[hr~9YkY`KH)gtXh>< znX`YUԏHHwj-yNKRjw띐DmWC <܄uc?_:72+mDT|W 1~ZrpeRڧ%NV -. "5YfGp)"%vp.{iUgޡ7i_'Y њE] tj"?>Nf2xƙq¡yj;BPTG,qm5=/;^XwAֆSI)ST_HF_~Ԃ* e \P$ R!S] ƈ4 mVU ڿ};cԄrD̾Q"(Ho2oY |r. =ٛ3*w;EdY{ų;gBh(=BX\DіW:; ƅi^NTd)$~ _e]^yXx44٨]WuLn>k츙m ״ladHteNp<ʻP?sg烥IHĿ|Yqn^P?FRI$y9.$2ͽoe>lJtL}RI|lAyxXBCa)nzR5GsU|fi 7@V n W9EUE6֬Ǎ=g%H;_hbǭ,&D-+a#3 ަCGs8fRrZ&$n])/F[ߒH"\1ޘdڞN9K/PO[o=*`xgп]jLJ&>΢-9}T ;j/bEhn7U, Bկ/`óS 6TM>~4b)@`| ՎxeuZ:>-ly]- k^+뙺du~_-lWK2l϶f\K!ٷG#^ML647GMMDtB;O`'~x|b FܲIDy%7#-J&aU 7b/2N}W?Dd$Js~fe :/SƜgL.tʦ^v9xq7!h#8vyaR"~oue`4x74냜T[5k>+=ǝW͙.dvN\'F~Pg\MPU= &}4{i Oo8&vZ":"< % W{$-E'NIF/?'/(sPRX0:"9ozy0_eeWm+[^c(HLȅe9*Z'4q~N0 W҉+4g2V?gP, mt2Ej7D**'4#0oǭӇ|>Ґ̭-GYl 'eWy>|/fͫ.>4W\-u(X MAksX}VvR^Ԁ4G{!y롋odKm*./4nF#~xM o?3*l$U_4zUV}靧HBv[g!d֒%BP'~ endstream endobj 190 0 obj << /Length1 1386 /Length2 6160 /Length3 0 /Length 7114 /Filter /FlateDecode >> stream xڍtT.J)!9CIIww0 0 0CwtH7 )( !" {׺wZ|{gww?̠-m) hn0H , y@ >Bff=8 MlsCuA#w'?| ȿH7QnP 0!, ngWy; sC!:msƜ8tP8 lh(/'Ńt`x qgG"mў7pCa&as`*4]`?`?.߻y.7W!8w2 E:@ph*\Bb!9 `; wAxPp_#*ey,@'wA1g'a G݅Wwu)`\A#~a~*rc&uAl1C0/ a;O h5 Ouf, 0a~f k)hp1O'`e mE0b_-{e_uYL- AP)7b7;;!p' k#1:@7G0Gv6sx@p fGCp_֜qd@ 00jC^/?G@6'(A 1X_0F60 hL 3?Fk`rxQ970n %AB^Ixr<5~_bq #?aZ0 VphӐq=8{V[¦CęS)'3į eEzbI $mztX_vͥxܫPxޢ^WFA+buUƺ_o]ksB8 ,FU3dZEn`LhRy~Z9ZŢ;Yd֊ :TEo.F9);T#2;C3#b|mėtZFNP.95W I:d@My `3dPEpW^OAfk=DZƁ'm^17G~G{nSϲHG /Tj$ܞ?'uR dAX@7rӇL>i]sn$`lxf4*[0 a3)Տu/ffmkz!K臁`V5n4LNJ&,g/,RsqTT Km/[!7|z-ٔpl+pxcy`o`5 U9^,vwJeфu |oWBK4Z*zJpv!v$~"O"ߓ#y]Td~%A?_=dIX%H\[ u-+4lzH h&w (i/;-}_EժjسІc%C"ux &G=dHo-z+vvf`;9ncl&;L<-CH8T󽬴2뢷&uK״*X0͹,P'=mS8p޲ezAӛSXF$/HbR5y - ،^5j~Z|۝4  v~k[2Ҕ+Wq/jG1i[C'Th|!pbW}^]oU=sN=eSVR7xE04Z)Ydu>.1|'R+汧 l{Ä.o<| ^(XRRcybQ>RzbI+4 9ur3>MRq@(DaPv~Ub I ðlIЇO$ $$|cEBd ?_<4(qPOa˗+ͫJ83S4Ej݁~Z?v' <Kgj (I)='& .K vbd9'P~x%Zn{=K:eSEkLrZ%~Ø4BDD\DցM3Veٛk!u~q+ٓ%:R/xd+n  iV nڿcl'Ƣ<5̧>#_Xhɧf*lCiW.gld\gwY@7Rjid1y/TÚnq tn0<ȑv};Ͳw//671-dz)G/G;sӯ,@&!K U3 r6^f컄⣋_744^Hߧ,йưEznUTtנb AB<,ba5S1q_C·U"a t{d9Ɠ 'ܒ썌xM"}xewȇNҨ9j&CW;y o7~i~?yWw/oAu) U@om%5QWǙXYG E]bk?t4 "Ȍ](2 n)B1J]tZŖrj_[-Leל&5a0mwS4<ܡSIǑ+51lĉs6T\R!ոb8M94wS # 3 9|)e] EBfacw;wu;!+&[iN윽DC}ȭ.tOXǜQOw.uuJB}C}/6ZaK.N᤟SֵBT=WwZU9V EFxq}2lU?wuBNzXn]Չj}>t]Q87H2_󳶗5Uwo) 8(ƶ:fjoV4l$0R?k/"q4ibyRE\q%Λ~*օ^j$ROWbX=Co}7hzokP8nBWg*-Od({滄Uj Gs,|}D^ 5~q0?Yx1JUOIw˫H&nŃ; 6{bb^?u;dO~en[pk)\ Z+݋%@}ϞMFEpEHV`!g3q]3׷>6ȍͤ6kO;mry~s,gsCi¡gk;Q0<[X7֭@hmLw,Y7 (z_?8VD֝3@#M{чvx )*P]z"|WKZ9?8iR%|s5P$޵>x =3VZV-PSH0w)QaXSi?߸]rrȝ{ʋv <[N?_hera FO17IB>9LrϬ`ڧ>:7 }q0EMcLLl;>vd! ӗuc,s0, }p` aFyhDP7 бmbGo\,ɢr- ݛ 5[S,AfcA! F ݑŞURk*n/Fnsbp"Fy5H{zl;(TxS5,8~ET3JJZ9 4VWvA }o-\G{CPټ4 m[xqtM\XPqYNx \d^mwޟ E6v'DaŌؓJ4嶄MLdڠsl|&V%:?ٺ;jC! Ac!S )-ItTc89J;g1`|,}o&I'vncv] 9+jVɣŋ@~e=K͉ÜL=t[& 2o*f{U!F_F~h HgjgNH3QLdSMr'XmX?a >7@Imv9nsb/4{2uZSFdl #Ċ3Ox 7x;M}\,m2Wu?9Bi=A@#$e:*e N!%̥[-'Su-T) A~94AmwV1zS3ܓ爅8D{_]%zF݆~7p)"җh4z"jW⬃ '!.M. 3ALqi$tsCmnj̚ J"㋰=wKI"DIٻ3dLdy@uNj8 Y*Ƽ&jTP' lctiS v(tVbdxSX_/%; MIW9=6R'HفžƓgIƐ!tdzq0|u!M:;VV!F@V(cn<;ex'6 } ,(͸Cc%)(Eӓ=,35{.mKy;H5SƣC>d_kY:To׃I8" ڔid}b+wX0_)nu١&PΈ("~OJG_ytO1+Eb4k7ݣKIҴO(ߝ;BM󛦅8Yn"%,-tqǹW\DQ&Q{BdL {9uH4vt_$%%,AIq:(vpMs&u{UW|goRT]J}oRsxEcΌ=>f >x0t(Ȭ{Y}J+h] @&iFm1EO>I[ĞG֛ ~%Sb i>by{CfÚqR4Q)mɬWZTrAf϶KskuaT)^O<̷ fk&ʪVT*9'?Є -=UT>8dFbENdu;qpMAu`q W^6Fg|zܘ |;lV +N^#z,Wl8(d%NbXN)V~ikCyA W^(qo:ﲤ=>_C2+|q6^zgRYJdQYnʈ=pu?Uc:x\a8,JOWj(m&QsNRA{ D@{5V/] H.GԵ}ܕ'4]."3cKۢ[bdQY#D>b67܌dz֟-3gޖd%Vqo4&9PaD {g}n/1RXH~[aϧ+2r"kU1\ /Xg%5@;,dT9<2HKT*<{w$Hҝ3Źfj*$p]Ö=C hr~\iVyn1iRv(U "v˻Gol~hTᬌcSS- ukmee6#_'>UYT]w]>hMzNsچZ9sxCtR2,OC‚}Pd52 wEqDƨ2ɅxS]wS#қG'aa~_l):sd6zkqd%VU;/7fo玛V3fZtՖB<5Do)>C}TvSa `wBG >DX{{y?A[ endstream endobj 192 0 obj << /Length1 2651 /Length2 23228 /Length3 0 /Length 24718 /Filter /FlateDecode >> stream xڌTU .Lwwsn%p蔒 i$AǙF]yykoh(ԵX$A@Y + @JEΉDCmGD ts9 a ˤ-Cè[C_g@o6c`7*@%7fa^\6WےoBN|* 8oS=GtZ !H8:F{wY{\ו9;A^+h|ZVwJ/)e@ֿN`f29h kl  \^k<6_/M7IF6H&/cF6߈&q~#no(F`.*o/sQ\4~#0E7s\t~#0E7s\ E`.7YF`?Xgr/HI~6? R`rcn!6!8wH_w__ O? l~wXf$? N<`WgA+grt&~s%..ϧ#w9b\/׿3@ i~d%PR؛e{Ddf[[=| Cŧ7n7)K2 O?j6$i4>~4KnD?MH¢-n+49h꟱zw|.YةUB~,`Չ1)ɵ̜&`!E`:A}!WL`B 8*7\|7UӽАkh_r/Uֿ`gpy6*s gFfs]g| VN {+KnEY4G+ ^rӍnCɂķap}Cr@mDZ"n1[oF;E 4a6=W #Es{"|vvC~N!jT[֦0gLB_ByU_,[ d?Efȴ]NJ%WN;.Vܞ-2~p'z[ϓAu2W'%pcqSZ*iҽ;+E38]-]N"vsђX[ҋ©.]O[~sћDA`^[i_y9N`qwuj?!P>a,Me_{L$I3D&&cqwW=@'&1bv3}LԳMTDIUTpoF GtHӊrLRÆ_=y\Hq εpxq$X#oJ\so)(- ,q$eN*WA 16o0 6pR5չdr)X00מ$+Xa绪G =J h;yBt:g䧉.پ zS$ykERx i쎤!#~$`!Eq鴦nJJNj~0BmmeeX?%_!PQJ%074饈OytT!nJ\u `?{UO<Z74pq{Qe*4|^B`+")he3nOPڶ!JgB܏lYDRH]~\HF9>?6=8$XrH<2K{IX$fK?Rjo$PO8̗=Y/=N6)/EΘki@9>}`bqLlbk}t}k03)M Ҋ\.Q3I#o溋Y$Q:HIqwyXSCR};T 3)v0"{O<zU)^`2 q)J07e; ڽP@V.UJ<\wZs F҈lHkc34$rV]`V0]-$fۂޝjrQuor8M('SRpZNno/~;Sz=Gj/y۔jzX&l%1U)IJ%Kx{k<-o J|qL3GFn}99WH#:2.c&BۦckE! 5G<cТ 6%uycR##V"`ɄeEsrTy:Mjj`a&ܗT̲]:q)r}=ǛںzXSY^ h5fwߣV\%l({U,Q!Q×/Iى i<6V'd"~Ẑ.d҃Qs+Z4s6wX4zEZn@VE]{=1pNéȈŞ)rȜݡ+h̺M(eKn˗)H6VL<O&ә?ێt [GDͪ6YuhGwA,SWCݮOA6^HsϟPDa,E|1]%>a08*C20h&j= #F۱P pȋA9 vgF4 G1/~)XѢ.,}yЧJb'˭%b ^=Əqg4֋U-m™ZV²@E:M~㗶[=kdsӅ;}KA36A޼psts1{Ѵ}UA2 1qO'2]9> Lr_:BSI}0ᕀUMޗO/OL2GE}mcZ|hm d${{(L;?DSUsy 0Q-+pe@v[)03~{_3eZ iӍΐ_q[ nj=9qQa=;-Hї/c]ii ERnQ}=}}{6OP`('n&FsdownMI^hޠ{Nht?}OuI5$X`yHS&:rMw%Ǥ\(iv{Ic4h7wLVYKqF…y) 2~2{WF5fnuvqsߴL`Y# UepǤ *n c5a~S7g\MH< ye2|cCu^G' GיU@6&O]}5{.`T`5E8Y9ܒd=4~Z< ɏQӽ7C-v U%H;x^OM THJr|qe5Bo /_ RŽ* )vj*:9B!L1f]7xYAkA ](g!Ef%א5)+>%pc57K4Uy:YEFɌd'Ƥ=jyg'C7 pڛ,1zp^1u k?J, nsTv2p_S|$x!nQ8l 3< HҼ*Ǿ%Ct}3S}S`apF=عI"nvCп3d pgCm U 'zi!1Ms ~wku&r"uf捑:JꝨL UTGH3 Uo'('ϭYT)g WΓS v"FG֛^A<6"( 1^%CIH4vc?o2=t7LЖ =\ҙ?s~(>TqӠTə&]?*?=*ܻ ؖeXnϼ,4*Fq>LBj[MRg'/ˬA@"(GYGFYd*~^"FNrCbBhRN3xu7Kjj3Fvm).ZV1H찁I:z8Ǝ1<3'*}z##C HD 9{7+ٛdu#Lr9f؂lOЭh9kYɵT%aP3;ޡ= cL1՟UMGny1u:fn# ҆uyhm.[hs96Ny]FU#Wxj+V*\nSY S|}Mn;LDl=z['zm=TQFެTw$I)!mP Z)[)MV| #4.GW,k#>V9AQG\R$dpOɟC2Z{M a+ԞAoMm:bM\r!`wT+_+H*wUeTMtn[LD;m⸧ i(G4 M%1kzs03ZT!|#aJ!t|{h0Ya9)93'^Oz꿔B2{6uxqa^1c7RujI)]'40 *?C[l]Tۃ/2ҰWj36yD O_ Lɸ 2B-MvF]fҚrݡ6ڪ2㎰9?di''1}0MɄfX= d]c|dMe;8&LM`7&klr^C -ķ5 5;H$Nfoo 5i-A&.pV u-~WEbq䮸)h2 3ں]$>ʌc$6x&aksUAb[dWXeƇ*K4.RyLdCbIU;}Cy|NǚE:&h T皊U*5 M5ō+ؒL.*ZMԥ1tڳ2o9OK-qm82>|1,e OnՈ+0qmtݔLmOw5ø D)Jc F-ڥ: y7|$8<]_ELj)9RDrL"5ю2E]C(P8!]O׉jY֮'px2bޜ,[>1QbgIYfBk|ZCw|E8;m!1Hu͛ `iub.@#c) |/]d'*}|1_~oV* ?Q1u{ʃ}j4C,x+G0P,/pƛ#(PWbs ] F 0 _ᕃ&Q\ӂ!'&D.ߏ{}ۯ*G5"6h\'::X%w[3.0Y)Ekl&iWZ݅c ,  Pާ$\b7B/pUb3uʠvFg =w *ryߥCjm@x>Vԡ^53#5<фx["QA[ܥ;wi :`݇bo:GƔ}wq#ԷrkWXGo7!f@ˏP@PSaHr5-l]1')= ˻D0g'Ri>^Z)UXh4t vb<2QDrpաַ'GW:Kf|}Dq^<Y پO~833Z {c(A?8Mc&)_yYAmwMnX=gKnSe fze9|*,ҢQ}rN J/ǝ"8.Wwm <8KEkIY b:ZՖ0#doj\ 6FL3n]2 8q5|s{/s^x%7$ttz_F4Hܼb 6RCyy].DJe>ll"GKQ>Ȟ"\1h>+2]4@iɘ4!-QM[pF~sc)="Mw/QJLU#Cqy1&Tńo/)ߜ«3Lost:6(3q936'ߑE bS~\YBx  QviD 0l3XwRW +G1BO.Ba;$+ V.E{+X-+wڞ9};{dBjl>t=f MR(WwP)7aSr DX+iEIVd{2> l>3)YQyfJQ\a)J4s)Y=^ )L;r/_$IqMZ-wxp2lJ$CYY(JuC(Pu^LţqUpgP\q}+* pP7jwsHx~IPI(nUVV\O*\+7{{+}藹;[xCX8Ȳ xx\1/~(ͣؐ c<2dh(o 7w`-{Z]%#< =$7,Ơ5e~D9T!E+; eHic$UX HE/nGCc§ /ȽePOӜF5oQ*?`fb\(cJpyO2ׁe`Bbd)q$yr3h $WkN^gtNcҾ.Y9/Y&V񮁁Xo' w>)\eYu_g|%C #vq4eԓM"k^"])-:KM?)Vs!5:O*5#79A``҈Fhfb9@KVJ0l0p"zKäXNj%A²!VB'Oggu=ıw˸g]mԛ7dRaO0}ȋI2 a;hFd"beVtkUf$::uURoOOE|Ezލ发Xi+}k?ޱך)M[M Qݖ34y&Iǂ5xe\X$dM-SϩIH7w"툸[L]I*JLVi=NZFu0 ]QVtCj+xZR祯q[2S=O e^]2Uedd,?~_- 7IuA1b͏P_AYwM WG2B% T Ue0DrQ'[:l=lq۔LKA^zN:o^ V\*ySwF ,Wzf[]SَH ޓT $`E*+&Z-^qCoo3^ T3=/{R2gMVD_7&^<1]vxnؖYSœAZxBܽ:8ӳ}n;HԪ +|bws:PGW CkrLhk3C}/fŖkŗq׶`gZ,kպ:"2>L][`X *Ջ4>i:}Ct+N88ԇ tO!:?z׸GQjb"Ck/yp 3]᷇4|tACB]zcY]q{2D1QH0JE$1p>|[wvz~5[n,ʏFç=MW7Cpg<C&m$@ ym41ͣy,R{h@I5&S*ۺ[b)E(ʐ_Uqe1F9n6I>(g7k"8{#׊0Ut-o FߦU'W=ǣsb[x|+PPn;sn)#_6}z;J𐘅CTB:q ȋ: )~{qe u< jtv.߸yE=gBic 0.Z/:Jbڞ2ItS:E[w,!a-rUA\c'a9CR/vT#qiԂSql62ş\77 TCH015W]+z 1{M6X5vj ?1[(gĵ]M4GZFooAmdTGkA=9 e \Kws{ǻL?а~.W3=g|ңQ3Wk *c؀X'fRY3\Oί [RԔ¯ uw6.i<D] U-pUDݒe@re#W`q\[uggs}7=?]7QF5znP7"ZI^Endh+CWnBGE1[ CL(;(!lD#\3NEī%$!KʱlY?o!W)aV‡XΆt/ψ-F3u0a&_= ZJxq E-Y_ݽԠo\OWBPߛs%$-R#Pn8~ CTTn'_haV9 e",A,~5,+hgUY[Шj"oܟvo\$qO̿4%:䐇yc3ב: 'z`rؾXڅ@ح J^ 6/zw2ӘdfK(w*խkpR`2œNwBG1e QȸL}՚ cQ3mDe~.8rsߧhsN ;=zp?Bu|0S3vݓ˾ Zȗ"7~xuѼP6 wlcjnWp\vQZvk+[6k^ 1W\)ϬV7!Ύ]U̔e>f,U2uԾnMiK6<%öԦHNWfz<219jHiW>zƍ \D_u8QT .?Ї).9\Dc "0Zli`7$0H['SrqH%8%o`9$+?$2pu:)f?Zy"rkujY(v>#c@B%J}>- 4« y?W:,u.{U'gRMӚ|A=8i.Z_r>"sY+uXׁa5]"m|0Li\P,kk;WmD/„Zc[|$@|V.nBrK -He ymt=Kœ/AI%Q+;Xo`s$_E7>W2qE|uşs9A#$[B]U F)YW% $!Q́U7'R83$+Qty] |sv+C:njm5u*amٔъ>%MEa' ١h*"G_A M-`?RM?ض!yHKĕMܑ|lo9UtbFYj7.ԹS6֝$sC羂jb@AX6 $lL;Gw,_!U9*3|':DxghP~vض[:md16>3H2NU=ċ[/W} BDHODB;xȯswKTzX+/XY´Io9 ]Q{횗WUXQrJ6LOI#!y{frApSOL>t|$W0FOP E4~v)*U aa#')>"m?IWy S\1bX=KUYl w h .]#`8_"!Pb!ϭ~ ji4((`5(=LJ.}*׾*~ӱ̞ n(JɢCV 9q: 2ARTbWTiˡfi`KҢ߂Y7v> mYJfL7X;O'gls,r^6#.~50E:aa_?ItF&}Gy^`لF*6)F z曟 +ԩ9yN,^ݪ6Ҫ|NwWnR@j3[).W{bJ'I(іQܕW'|Q3AQ#`6NAG3PZ)}7Y= ^7⟞spCn5ȿ7؝4-FHJV 3C.ґӾX6`1]bo'NPh_ u֨ kp4,+=K|>~ūD,I: :Q}[x~W_F-`х4EY.$噔`.Y=ٹAg7Nsjcz|) yYQS1[ӆ[go1y1RSd`O6^w~S:{ZP-U]^ TJtŎ^*#"x"Q[HOTĿiWVϡz/p׵f稹J[q!BNq'4bnMEݥ؉"Dޠlu8S5>|"lByIн!Axu 5Y0fs:I(eë 7)A `GĎݧ/,d9 N h}Z$.g/"W}z bH``ݜr  :&oO>ρ{hav:)mt[Z.܏o3Gz~\J j3Aѱ,Gmd.= fğ/;G~R%SֈniWDpaCrU|B=m %]rU05*دOKd@5|WZ *)l#B_P@>,h" x.G ~?iEc  ktZ6 l9;Ldͯ3F>A ,۩@VVϚij!L]8%;5`vP  7N*$6o&(h ˍ+cT5ِe0X%Y n2@cFv k_2gcnƈ^ᓢhql hÌN+Bgm]A`X.Z`qRYp1D6zX`sciaBjeky=8 K6B3{pݍȶީ2MF(_ϗtz~?H`9Ͻ*$ֿUX=ZpirK1I>D辝QӧBpp ÎeH1hRt ]ؙ?xTdvv|= ;m$-Dr'DQ |詹 dk#m &زm?ByFZWf}#W}"+_6ke vx2Oq#" Dc,oEƺ(_\`ȮӺߎ;]*ÏHԒt7y .Zo |ݮq|+@GjȔ է*qANh8Cz`qKWsgl-ѯ?} À<*bZ7991]z2&YJ&Yׁ ad bd,~W] >Dد/Q "~mSl-!.Uk^ 1%7w%8I$k f>OڤVRтCo)-WTÀ=xˑ77:ѲeI+}8##֓=/F*ZZ'O' A2Dm-;$ K0E6t×W,<ӻZGP p[ rsը*2p&k+Y}=Yi1ZtRO$Ehr䪁8ɑqg/j-zy!PޱJ$A1$L')#W tqlU@D'g;m]q||AOG)RjJ<{`B^ōA6P2c*P*Ap 68b]FX_/!.1'uFW]3PO^uXT.6"~ g\L~-e|crPv*n oc7lkD˟7UuY c"yODžr'@Ҙ|QD"_9Ε Kymx zMSNjBw˦sqH+_: xFwdHғ]L¹kis{9n!s % -k>@ 4eQl05uw=O;LGq WM6ޭ%xbFr盅gl"C%+ [%9H6=|m|X~ m1zX!:ndXy;Zp, ԤZd'eLPuks);-O[?TxtIYx¿Px6Y/ +;ph9ۛ1DEwNblvn'e '.0$ondtKdeJ1;<=H`U` W vZP"z񃰷 sd\ϯ_>\kB+jX$Ɂ*5]{?՟lQEgiܖlyGX״[nnbm:#Vٞ"pl>̓yW=-&~13V (jytQ {qQmm9;/`]Fm0wޙܖ~w |Q!yR+k,` \qgu8yu}@\򛚿?>sp^]0@@GUO څc,m=(36 hgn]x@;jƒ;|N;[fPܑ,HB7~+%<%ÞuK}L'DP$3MPD;NzN&/B ZKl[݂CLzlš~hڢ(8>2>j.p{mqa Ux^!#vNt46`@ +`sb "C74C>Z%zPHAk|u< I-oa :h@ @#S`SWF< [.}'D?s*app8Ҥ~kVf.KXY7G,`dUli3;ȆG՟yWEA5!t6"VURX'FICV3kZUl.N=mEC8ځh[U3fR-#rƮy ,{ % òR |(朞=%B x(:GYM!}l_yܴ 7-GpIJ} hclFKғfirlKvêC%9P)!JGZD[9Ƙp]VBr~YމS2Q1ө'ޝZ?lH'*]eVBo_Pӌ:s.m2{k̯s)B !~ :{s HuNfЦ0 #3}ci^ T};xnYp451ky"T_IFUj=AU }ͮ{jBE#ܖ_Nev3:@#YP##95kշ {pˌ|:+āʛVr]b nX@r5M|St{N1ѿg ͮ|  ޺)3]ƒ%]g4'6]yQV߅I[F4Q\azru-V.nJ㩒1`Iq!UwÙZp bx4}ehvpm ST/N3*U)zD+8eAj7O++ҵr/_s IY>Q?@;,#ԯnGئGg1<}7eO;>">j5K찭p؞DnD^Rᨏc+e@H#;g5Ia](j%q FP)Doxbg_.zOr@fdE&яLH:0扇r$':͖~_21}4 wڐch!aQw  v[) .HjvZCܩ6.%6rޞL @{$7Gk*Q1-*9 oEQi qnB8'4B~,Ū__ׄc0D2jM⢤^(qr C `B8'~zqm#Mu-8~Pς/")oR6H-JD!m[THm7sXqфWYݙgy}@V1Z1cK3zg@_] f9#~Y͸V#ron{%3;X'rלm3^Nt ΦU"F#EQi1FT u=< kob>ݓ20p%qy':m [#<*WKG_vM P*_]ptMQ Nxq4SR2 <=!)Gvpy .d܄iK!5מ{^QWp2GPU@ѿ\(Qv~^V.1uN*E)(M $eM^ +P R l"bU FScW<ۃj;3Uj 1)1[3L-iP3u˕)lF5+09k>u7( [K)x0 3e(ҎPuq @yPkʍ V^&iZ-;$ b|T?Om^ˠAyJ9k"Yah+v.{U_mmg|(juhb%:H~~LZ5ɆUEbpc.w8gC#,|%z< ׅ4"<*Պ^v9H\p`.ӝ)!MTT3g_FqoTh8O}Y#4aN}0FcgC-3/LɃ v"Ƌ8tVɼէBd) {!nZhЄ0g{ ̿pņlpT"['MvD 9]#c !r3qC:n&֊Iy kwt`SІ{;dhi\I-- yUO~&OsiU3eF.P/’I{"i {6-G}a}ou(Ф9p KYX/b0|rduTϬwzc Ky+Co՞#r(L8dexS x<w]JhޝMa4Z0C'|qWNo}TPEm ʔE{2qy,&Zd۲τ< endstream endobj 194 0 obj << /Length1 1825 /Length2 11103 /Length3 0 /Length 12246 /Filter /FlateDecode >> stream xڍP.-Npw8݊K w(^Z(ŵe̽{>&4,fA`gVvA:'Fde$t~:)ك..  ;;]?A[@ o9!H;x@,,_@oc nX%%%)aojrBllnnn@;'V{3rA\Af?(@uƊLдrKao/[+Sl^4* _Ɗ0 p{ 3[̭lAiEVgwgfl! 1r @Z\ |iL!VNNVG)K$@`g'?{k݃ۻV`3?0sq`[9m"B-9x GԒ?_:rw42 {9]Ag ߊF3+Sg{w1/r+w> 8|y2|=˦,W$$^,\N??QTVWUlnؗ)`׿ϟ`w,e҂9nn?]G i[??j/uq~ῒT*̬\W+ |q?crrZ9ZEZ,jdǭ``gfڼN/SzYN)67c8yx@B$N*0lxi`nADyylB|6߈Ss#.o ` #?ʰmD9l/<6̶/~CDD/:ۂ̝K9߾/UA_r(^<~;:ۿ y˿KO+xA _SKa A w)✽`Zqb7o4i ,^N{4duȵxH/ʶak#BX[Z/v CR$M=GGw6]4y.hطn2 ˣsj{5 ʧXb JfhgP;"2b\]Oc?'0!p{mpzVjr:uR^aNzI{CFSg:6>p{*B΍hi `q䢢dJ(ṳOWZ;1$Z=5mGǭa SMn B6ТZ = ~Yij@3"m߲Ȫw 8XդYq9 w=f94ʹs2#4Nij ޯmK}8 !Z(*9+#Iak̚78Z5UyYEHqw0ac.x2oװ6cC .z/>_ [hH(~QW<Ώ!6hy,Qhc)X /b^'/in~R6DwpwaE2CoDʹv sŠw2w>qCʁf^~~Bvnǣ)!<)'PwA$2Ѿ3 B\!f]0}PsdQW]4!BntyNFo] ?E`d7j;N~%yNgbֈJR$g]i:mO%!GbZ?,}cR۷}~z>9)1jj;v-'%zBիG3Rqve 3:wSS:V(􊪥er0>1Eةa n.wfLR}iɸc1nj(q3*:hQt"~h>J/*)(<{ `Oq]ߚ[{\OrC0/QFs[IK.1vLM>x)rPZom[>'AW/KUSp9  ~=K95*OF5N.߉OguѶ WzкCm$KkYx#X-m dqD9=h)܄OЎkۥYѼ6d'Vc*cOܮͣ>/x-,(ҺUs'5U>mfLg@}@ ~՝:F{g7)yϑf+nnbGtDװ ˽\gu*C "F%Xtrv-ՂfT'y}!fꯡ?dg41tkT5öY#J|O]{l(9ǒ&闭+fViF(&Ǵ-h D~UVADBnBYﳇ:Rg)a<';\q<ƐE݃*G62@}U(w@ُnGÁ/mf91f&JCYE a5ί #m-hGAU)y̰'UxQ4- Wm]ډfG$33I1F[bf;TJTq2l*i6Ş__S+N?@w!ôCl& ҠWcE> 5LMfs"Fkxإq *aA~\0Gb+~ 'ƽT py/"my j#b7nm~ FhCfXRsS6r71c RU`͜4%vnȴ)3Rrݳ ]HK,v6`逘րh*~egCQbJ~ſtw M'D 3AOO-%0|ODtڹn_>Z.G&?w Ko+°4T 256=g:px_M@׮ggW?A0A2]:)ZNX$@Ű( ~aí\u. nOp }81Iם|F+% mEr9u(dhUM:x !NPyu(-faIn;``T{㐣hBH0u$C=0daJr]FȝUfo5aܡLY7o&Yy~p{4 91Hєiq S4[<FzMā'N)=hn'(H)m [kù4?/H,9c(^ž!1-"" `f Ο4N@w¢&6簝^}p|+qh=R#VT53j9FI[j)r.GOG1J횒Œ־l F#i"r*QU">_YҮ$ t׃z1s{XYhk>Ojf"O1~$L' ~R AdWu'}fkԗ]QolC#3r)VN  D1VH&.]_{naOÊ1Ќ6 7:DbNv5k_'9 -o$71s`\.+_E%:euIu%#{P3E zZ<#gvo}IAb+h1eCջ εڢ^9H>$\( I{w1_1`Ynoj_W!}3P7 uMyQ.fwEꀞm\&O~9B/i.R 7Y:cKyQi8u,:F:n@*鸖y)S)u#dRx1,"d4ycmGH)Z򼌞BPMVEjW1p:FbOLwrJ5߫Ry\Yܪw.R8|D )0#>$U`#Km>:b3\1[zL=<,xJYUu&'3&^OtY('L_~ 9' (g,ɒ:e 8kGF__q+/c*SOoqb4[1w-_2*'g4:[g\)9PMȡL;aϳ蒾](Ց{a*;+=Q{φD-e Yt#Xw:3 6?[ceNŴ~KNC2EPy vJ4įF2 ^wL9HV*`K_]c^e= BrUbyU%A77Sqk&5A l"$n<\ WvCۼmF/||x=+2lOW'&$CLmpA_w[;Bo Ɔɗ/b/!1kw\.O K 387M1UeX(Ɂ0Ncnrk8S&"eT:(A|ȍ%r\K/@z;nGm~: kv=~bMQRwO{ FR_g{No߱ ?`An+~3piԠcVDž Gu+{N%Pn#h~vJ}YǝU|?U l*5 Dl=)ApTxi?ž]6> L J4eyaޏ韽%/^id{op_*z76_ k "m̏_6N)"2LBr1e4ա-#"M2ڶɊ0a;Mw_&DZ\AvCRcD PS l=^5nt$Oa@y"MeL'nYj *%xD!{#qY?6U1 _#P(+ 27T򔬃 kPiӘccФ2y0\ $dpgҒկ{N cF0ZX&ѹP5.6e@wݵ[x-OP(T]ǦQ3 #4*Cεy/ɤdvH %͋$uŠmZOY9-1vwrKBorS"\!U<`F'G|H8K(.a.RE2ƴpUӰ^:w'! _7Ɓ9v-`ez?ngMi1MŅQy42;]L@l#-H8&Yy˂ xa|1ZIkqqid1( Rݙ#5W…;P 8[Mİx^d vZ o՜#˱03uaոɇ$p@ ?wvQ3e&f7Jwu!^@B9xg.j*mB' l8δ P4[VHBL&eݜ;ayH::Sx#6Jق[}4˸OJD}K| ҩi;DuО4/OXA3HlZ/,|b}p*91nH A yL>)+G5="PL㴐fZ()E7(1h0հ# ] ǎBSD*nǧ˶ mC9.={ڗb %33>?1oAlk+@4FX$4ޕpbV!lA'z$͍MFM 4R?&yº~3ӚK@Uu[ \J2%b">UfE6@1N d;Y"ԮjȏJ|yHUM-6:!Ƨ|&!m<Д/%#qMG^ץCk ruazw1*;ɚ/*epegӜ[(-[Q^!#%zֲK[]?)A'b1%.\O겮G&,1pWaPN6ٔqJe+5+԰u]Mfy-IM>Ldun|ptg 1З mg~~s0h۸VJj/"%RD/fɢ$告M ϒ|Ӌw(&dJ8 <ɛPqQY%ht ~⛕x K{Xh3[6[>ԘkQX,~B@nE{>>)q|2:u?y3Fn|}q*4x`Kow銲kl)`@ և?WR@jYxV53<mu Esپc`ک`9ޤmMV h@VAUZҰeJOg2bd7#JUۨ#+~eI4Gׁ6+^ٖYD~)E9>ͳ"pⓙK?cIrIgqfI[aG% Hp4L, l뻂A22sj5qu?o ={:]?yShۏg~k2n%i>|Q $%܃ ME](m)i+`fv4ZrKeui3xR6ƛ~E a;f?[8{J6%ND&.Uldh3(_89κ<" @Pjr5FX{xj!ITA8KnЊ(Q"r˅1@ Rm_>KA3lTq1?=Nͣ6U fb&BYv/7_b ND $3ҝX6Z+O b>a{s{ pq5Gl'YeTRN-ݤcA B Ƿw]w:Ƚ]SYr*{S?Wq\jJ7 9d=OBS)R(䌤5Hx5P{Z-rްF`AޕJeP7YJ!lA8{._._^.5x5]- 7ʏRCy{3 H óɫqpD-m)>F'~Č{*rFЯh?Ztlk)@|mb3_|$&k.B ~ V'\:e zY6¹b>/HOkRdMRyL2#=iQq3f1zZӼ`IOF4XPFp>e<=lG% OB'JnWuUW%Z4`GbKSrM?6? K""xZ=7\ VE|nF2IsޮdG?Fߝ~3 J#Te2b_&XMG 0t H<= \pbI`l w7o&Eō]ȶƥeO=1)cmX7/N\Nqca#2T׾J܌k7V6!EH&GDStrrRX]#rTnUP6vmfLFs}J6â a`.Ɯ zu2'Dos @..>hp&=e@>я30cEڸbۨ eF[_ V7}S ? ݕkJ ~/Lb݊^>rov1w1)UFg'D#p/f-OsFrrTbǨ4M"3 )AѦL}RY(,螮ƒΈx#3V)L vOQ>̥pKLPCzN`߈.n GV7(7<31ƚml 3 J2];)uXԟw 'pI4 U Bt>`c ~)gxo1 gXOpӡ 3U,Rq!Vhi hXbqx37SQe.Ұu }t#ؽ铐:_2!NUW1zy@^G 3o81yK ZՊ򓉾!eKlkA մvCnI!6"e7J-w5[k2}_˹J^Pa?\"t5hP]~ONw̦'=tebqWfcNK ~.(i5$LF={"%T [q/QCH R^)at,9qWݗ|mi'*g<nmC9&MZQY|1oCv:Ä 7&x_Syxv*m !ԃ(o;HS,;>;jNmUwĢHmG$ԝ>MFRΖ9BB#GW&x Bs@&.mcqsHگʤ-'m=ǝة$=cj 8O¡=N IJأv'x }u)O>TQ"~ELi$іktJ[Uf:#YY [w`m7i{mw1;;e endstream endobj 196 0 obj << /Length1 1615 /Length2 9188 /Length3 0 /Length 10233 /Filter /FlateDecode >> stream xڍP-JK݂Kt'Gf̽WW]Eڲ} *2u&Qs)P vfbcf+qXY9YYّ4@ζHTZ@G'qGM%Nȹ8lظXY쬬 8$L\AEf tB{8,_Otdf(8[^N43C@@grvcaqssc6sb8Z 1@V5h0@ggHT +ӟvu#bN/.`s#p@3XF_1MWo"d33 Xle)fgwgF w%dkbG&)QUKdwvbvn7˔%;; w} G=XY0 -~7abϢ 9e% y1!c:XYYy@̊7='oK>^{K@ pvtx `2s-A`_@?;z/cE^?/{y5u?;'&qx1qpعX\nN^TYg/SO?_Ao.%ȋh4jY 7M[n?㯀ͺ8_ @szeM^@liANR w Oid 0PXYYf6//Ӌ"p_翏Ao;;닐ع^l/htCf0%ҞF9,M"n߈x,fߵ X/A. _ 3_/`|av|`q /'_˫_͐ fnL;T;tL^ .)t5ES/oI^,>y6%?x?%M#}30Qt ICd[+g9<T[>iOKs;5˧b4JfMg᜙1Of1s'I|c8>z_g\`wƧG s9:I%*;UZ<^$mp]p|z$;0sdSC!jW;DWڽGN gY#ɒLQ֮طiH|Zs}]տtZHG8~iE_SN^,C݅ճ&depюÏj(p='0TQzb{~tgY4FFڍo &+'Q[P;^-+΀kzM5ΰFbYT7É9͒"2kXǠ5'U+{,Lԭtki2vL$pj'MG4 H ߽FD,iyx>p#k8B?e]MLJEwInJxV%wԬMb<@+nvHmUa8OPf5 vtNCjDToygiʬEǤH顛;4A&ox11}EZ3 Fb;9ξNIdޔ\e(\I[EE8eJ"`O0yya'oKJue#yu.4un/WH%]#i*[;qOxc2jɍl"YSWqx.U +C΢$lc>!ˑ<%c͟B$v;įϰU;O D|(B [1}B6/!Fq+.'d;Q7sr:G㍉1؋U%9DeB^L}s6W8F@${ D+cz?nw .&B(,|AcP|<Ś:ȫ6i40+-y}Pk{J[F@Ж3ٹ̸<=w^4+ ?3VG֌aW.-]_TUS|h.td5?B▾OK){j_/O*&?˗f;p^3DW.nxfU$ 3DJܨs-T{A`oɿ  i`Ȩ@,mbYc6$m{ S~n_Ybtu0<̟jznJ$!6bDaSXaޔ7Z xy)Q1E?vD߿p3nוSHv#gEgX-wZ 6ۭ{VT-JTTodvKTK#*Yji Hmqo6L43 !~IsY"~eWE-' w|LU8m@bC3S:>>ZO{gqۏaCl c <΋o!.iJ-GEdڌ2_Lnv1/NщhW(iVlPG^,&0 Jҕө-Z 6ϩ@] u|MIU՞AlY 0g r_qkyߌSvR*J  lO(AP,i- <C,6iE $YsaQq'm{γxfnqyPYJ> ht ^эHw2С( 9ڴMm}8/|/#18ҽ[f#t:Ⱦa\D}jDN|ʹBw\^Wս|^R)'Bq~UTV.sI%9.7kmDxT=P}G˒VO!%:k hxS[c@ wt>_͆~k/cR#oCs] vodHÕnPBղq-?d- q(0- A}P8` Ȭ_3l7fm"P=@{&EW^!vk4]NZd YWդ LtI**<qQ…,?S}KZ"8,Dڎ/Uy*`=8uH { yCVgXݦdQ.Zmc漼?` t'5z׌ Ƽ904]њމl3o86v|O7sp"WϼcexKa*G˸iw=wzg, g ZJ` 6Hr1Xg)E2cXK{{U m+Curmۮu=KG] kdaӄPbl+ȳ)Kʝ_6N}DJj ]ը趘k4mC.cOT$˂`5t:x1Zɱ-DÑCF]`>v?+2ZK zM\&{S"OYW^!WԟS}+ǧu͗d]ߤ NTibSc2%ቒgkI7* EN I-?) ~1&6iқu}sg?i=!=zۼj uTi6o %%ط777.Wfg%,TNoma^$Vxw3?#3<4ԖzQ|x5gGX_))4/|e[^ŀdIuvztR3v7@'uD!5Gd!ݽ68*kzek%afUMp0 B}iHjo 2}x;Bڮ~/~-'=4)@ im^ɜюc/M)mH);ݲJ!*$Xxvf~f 2A u.{z77dF9=f:c<ҏsX#gBbUAGAnkK)W5iX=~oKogmo@ф4~cgVIv/hKb P/~B!  u21 Q^ĺ6!(~ i_wEcsEF\ݟ(f[c=Y)$c#u7Pmn 2|7bȣ~$֪қ*WydžZc}3˞ElD2-0>'/غN$S()?6fgjer,ӧmj,/*ǭ Utӗ DE.Dp*jɊT?O ʾ'h4C6^-&\CN#H4HJ($QsLMiy#vQQm_nS ٭\-[%6}l~) "nhTdJ.] XoǨ7yZnG:zE"[<Ҵ:h'7.'+tRYxc ўSYQr].ux%Ƈ*N6 \2!~!Wp.5<7۪M$ /3YhFǺΐ/v b??zMƹ@h뎻qE}jTR]9\ Ϸ^c123.e]kuDC=gi&h#qT(au fDu]B_AVL?I>m}T)C wfKrOn 4ص1}xVF }`$'P -OR(*w5)zMJ45p(E.Y䲘 \寁ܧ0< GBC9SjCF/߀W%4l ,dz鈱ā2]z"銚hsTdK?5|2y`H7~ ӟt-8qh]~A˝wCX2Y-潹~AǠK+- N8h؊SoE(麰NqOKhuOV]N7X.7S,a!æh>7ƁL퉳OJ{܊~M1p*d|Z42B` Cvl>GU5랱34JVm.IǠkĠt[ř0xVڭdqxl`F;wc1xwEi6j-T)27=n{+W鏧o ړ70yD/ID+(ǃL > Z>OΓNbH~.wn]Ab{¯!*آ;M ^*>W1vE$܍T|oJq-1k-]a~w"ƛhߟ.gzj}p8΂eۣI}|~Lј?{vWd"Û %UBcz܃:]Nv>*vF)o*+ SD5 Bύ.z h55c)yaMfA^( )t )T4;(_$a|B0ӅibѤc/i~ʠBFhf4S3q7l'uk^yi s\(@C]bPטKJR$ $Q~${L nqZ%P=&7tҷ}gKy/mxTV17˫ \L6X*1.whWȨzI8B㶈sR2j.?.ÜmGё0c1#'VqN !fLpRZ0_!RHoe#$܊\~ޗ"|jjm7ǕcwsR,b':G@2ᑋK;Y0xӯ NGr:(Yt_%'V)(OB-̸V6躑x^PLJgj>㖿^ji(RGAVXį*xr?k64;D)HY`}Xa8Zs~.)&0'yo}Pt\{(6NPUぃFwk9oq Nfϗ+QR"0|fӽN}HnPKFB۰:շ*7럩d7u+ v^{I_uvw4c02Έ/(vxR?6rӧ8B#˗ _ zlDFiٰi xxe¡NfLVcVm[뎬򌼪9SY*9+,nkt$VyTf:Pa&TeXG%њw6鉘]9Uk6J A fEI4{lxL<^jGKbPA[wpc,ƅRߩYy]LA$H'Ņ ( m;N>YYfi~1g!&I6Q4n6J:2LzI^ŵ(%0 zܚn(27&uJZwt aDnCUBOXTWT5xW%EWJvm*k'">fq/>?9.T`a v ]ܳte/%ӮVm;]6u,K%ສPkpScjfd~N4+~PY&=Ҵ2Wv|W.ORHm ^B'o.bqNI(sp;utV1xWɜ̲H?7D_/H bBAa@ GqF"`]-D V#/9˜Joz_Uy}^K49'c6ùX8Z|>e[Qyc 2 6:a fMk>ԑ1* ULhO=+lO›d.)~K :9=<:7d?=etoͯ7+>"A֦B,q^<$Quy)ooe.W;|yuʷ>u[ S֚-? i اXD>խ{zD:Z 2t/gk丵zuzB0S'aHf5ʤc ࠴t{@0guNGB?"jkp%>:r[RZH{?nG>TujS6;FMChy죘dpB,G5rpl>ߎWQϩ|]q! o',xoC^C *Rۯ%xiHrmQ 9 w>@v-31u%Nx]"vᰮr#=ĚpTЂ&V\neU5~;p[S(^y޶K~> T$݃?\3ź[[iVK#QӰ72A&#d~,w! ayfe ÊGp.vkQR s+Jr~8A']&(DeAk`ٓ!<đI|u$}sV0͹9)0ɡp '-#>T|;qzSwWX9=vRNsS5T?R*aӀlarzCs8LEç;ty u<`[jU*LN2%Q=wG^rWj\u1fot-O#&/2|C&C*L_6}X L5ZJ[xqydmh&LFsd3`|w@"s.ƱDc"n?𜹃n*n< |kfźHrX "7٪:SE h^*LJӼһ%OY[Q_{8 endstream endobj 198 0 obj << /Length1 1603 /Length2 8582 /Length3 0 /Length 9633 /Filter /FlateDecode >> stream xڍP.Cqhpww).%@ Rkq(E;ŭ] oq{Ͻgޛ$[֞0hpB 0[B][͋ :b0=@_0fT<<|AQ!Qnn/7ȿ !9+/-@=0^@\}APX6,!?; P:]`m:_!PWQ..oooN+N$ ;uh=^@[v/\`:<@V@L =``[;p2Vˀh<<@ g+؁ 5N`mh[yYa (h`ݝ;r!0!˃m_@\\`@@}\ lnӕK r*ma#BBc;+V+`k~0='0?0xx (hc&a7pÈ -[?˥mcde!>n7!!hZ_e W)`o`wcn-m?v!֣G[Z} q_ZWu-P+Ȁ=Dh 8EzjB<@삸G*'أ4Rl]+ww+_ Ð@? pq!P ^ >\rE YD\6F05Kx`ls5 `\0r!ćP\py%'1lZ\PbR ֦/;l^. h0 {XZ›c{\ba 5*+tR&yo<Ϩ-Zwۭ߈QSrJ<8!6w0y h^{*/کTż/ы6 )f`=CJBc%;}q9EJ<Fa _: ]^.2z2cR* F9ҢyfxU (pхdk&~­ĚF" wZgUQ>' n", gENǡBD8h?\,ޗ,TdeӞL\ջa?j yn EU_^@F⺗isn8䖈8 RrΪyBDe-+|~ AX`J y/]mkj9B8tIFc$H#aL.M̊H䅪ၔ OC9=K>JQ ~7N/p(# ػ-s.P=(bpx0~6h_ōư_O/wvV)]ob 4M -ude"}B=8(eߙGdpS<o;I"GBLtdiD7|uIB3+V\ǯkϊ%^̀TWp{ڧ'3ⱙbo%; ,#k-C-_r$T Rksxx1Տa1$N{?W0xo)=Y6?/͵BLE"t.o"Wmmu q]y&Gclyg[p ۂvej;YANX*d՚aw6y }Sc#=@MvKխ6=Jid-,6٦f2<T9&<`/qii3j[Z#yZ 1Q*?xVDb0F&Eqsy$蚠/TE6Op;d.fo"+åUWt``\\.L .L@3u-Y/3 y*6owrY`+n=w\̙Sp F+TQcm4eR_ъ%s$x2cʼ{M'PZ=hhȭx Ź]nRyĴ5}VD,DXP2{Aw$I8k?gϮ2EɞT58V}W ]9ЬѣSU~Uv~;>ӯ%xA&4P,wcыѳBٚ{iݓ/2>5d\D4v`h 'j6wSiu@N"}EBpCu3`wZ֤x<[5Iˑƫ!k5X|z0Vm"N\_aI2X]vͣwg oqL"MK\N,nNۄh+4)!mwdxk|8b\Gp_鼗 oLqx\~bbIꢪ20/ظ7PA~_>Xg@ZVs˅Ġe)+QτƻК"!)uY?lhƽ8rؗwl<*,jgԕM)bLz )SDcNyF]}TU]CYhMPO Q8\&r'HH;a?*yB؝>4 ˇ|, / AZJˡCgd)zxd}B-p82gJTۍNK|dX%w mpJ}+n5s<|hNMRX=!/\/'چkHpc7 2(4݃XC;i%дaD@b:Z`=<-^oL76^?&WH /#;WVNF( g$V/JBir䓍D[K3yn3$)_6j̇7UZx2/hlv|tEB#vy o*q+]Eo;5[1t̸͚Ԙ|QUll%J-`m} x"wGf6/&>e0U #˸&Ni.8tIua B<*G >;l!Vd;JK!!ݻu!j_Kh5#jN >R>篹k%;B_mjAފ7O_A$\(=źn 7[`bgXZлJs%1)UhdOn=rK݈?q`iVV}kukMcػN^mcwRO>bnjؼ_lCa&*Nozlnk|&!/sї1AʱO!pFX{ɋ7uG I6m:i%14k. 2^E%89% na Q4J-==+iyNeK 9~AA퀤LDD*GXxKQ|P-`r?0Bـ$gKъ6L4B`vW3Tx{Ř)R4|0fh $ih-(VRŀ BxdoqDvG.OI+;R fnt:Rdfp^OZ V]b'u׆:EWB]N.uxXO|Al4>`2`|ř_s<~'< dzڱQăvm;ۺ|!mk(sP)=#Wj[p%њN͋=T3h,PkH_<(NUŁ(!'`ia7 'U2ņ v .:%IA!UhMc5jD$U:{Uå+ԐM1^zXhvߎer/S{1žnʌABvyndD626,6C{*%׺ I1Qh}f1m޻;{k$vDaZ,7|NLyam"Neyĩɚ\`oɩmӸ>ٲu'1pFiˁ~I%0kABKx:]W[=;9{!"jТH3*-L(WQ/v~gӂ1okCYl!aZMjm/X+߽!<운_ 1Ƚ'*3AG=~Fu{R18 \ ^I\lJ鱵Hvs1Z䏖-~Zjc#'^9L8a(JhZBPg_-m ohj6'u>PtSl"3hludA9m&`-UVΗ+"ā^8232lX?޾|e7VyQY}7#B]8ɴV,ފ{#?"9mdp^'f\ SOv0zrg+@qjJ0mF۠>s?6ck8JupfhōypOݬ/oP:]m:ïBo2W-(YK(l9zH>;B -h7:@{Ks~%>O'J9~psE;~Aemv^%V-iz G>dQR&yԦ͖UEvKԼo'^٥0QIILN~w=yBRЊ9pBz${~@)$J|S~MBk٘Ƌd(\z!fNORbBSpBy2z Fyz$ߪh7˻28 $sQ'I:T-#d*o i {*/h.oy{==ԥY:.JӐㅎ.֫ 'r8Dic OӪ/UTǟjuVG^|,>a71׵.<B8r6Qwz*b$:E|~X5n6V<Ētpt*5?ިc}1  d!kpgd88_h.gi͔7fdP3YUI1¼YwQvhO |r҅ AX^?nY _nRItYffW+zzwOߠ-ZGQ]wp3t-HҞ/XEUI$-0]HŤP^$kH.yZ՟ q7(FeP*K젘Z&G @\bW(ʚ;O103T` OLs*X=6-Y6[Y/w*գxf6Old<:FwO!" ք[{*[OۓHJ{/᛻$l „;*X*ogᑐ&hom5ћ\tHLzPr~uixP? R,;YZ  M!<jCM=-u.1}nf> ¹2΁tB9Į Rj^vƛ\^rOkS)*_ZPf^Cc؛ƚ$V!@*r8f[TVaeTS][/%[t%9iƎ6 ^8{JF7ó2/|+mHSKx_@Çf;#V;4J&R3d7"/E4h~Jco_^ĵ9|\:ԒpAjRD9'dXBia:jɞ=i=ɯc?΀tZweۖyl-,ڏ1KZR? վԲ[ؠˢ^|zk).zmz:P܆P5̀"«֫zՌ)l\^t<0Gw)B *[ʀEn mӁ{9A :́ud%J$#թгܚغ'K_%QBFj10pn f|zn a Ztq/B"fvۦO3ÏfDK"IJHbZEܒZZ qWp] ݇_%8S,TZ[:}Z 1l5I3-fSiО_ϾU)@y\F׀bi#+:g]w(ȓйݠ,ԕyMG$*+0;S.vS1'WΞT EPŗot?j;\EezP&"*wEo\xA\UGҡ mFLjAym< 7p]8o7mƆJ+B5,~a|Ucl0dNƶ MLQx3 QYaBw% JkCO?T3Vа_!VGD-C3sb"ЫBOu˟!5 |`yAgk4 O'B>[OdnIʻ;=u!x.T&.&)&Cbۭ;%vuw1e{he:U[׋'7q>uoRĵZF*m=ѝn~Ii e+ƙ. N ЎFJ#b{-(\oѓJ Dk%-7MV܎f??3rRL'XEFͮ6 =O12iyOg}KfLYR[HQ芓f0h4K 0/6 CU}AsA'PNRNd<|"v[4lyc˰{ :%ՉT( 7VDx^p@H_ܖ;*OwPnR^LUbs19a# \̏DXgF2/~ZG.Bgܕݢ~qYýCi!|F$*7157 fs5R[5O:#i#o \>ER8%p 5M| ~8,:&QAړiDqzKeBۙ|FGM+2e/Qp7˽!CO$ endstream endobj 200 0 obj << /Length1 1425 /Length2 6648 /Length3 0 /Length 7625 /Filter /FlateDecode >> stream xڍwT6 C 9 HK7H 00Ѝ HIHIHHH("ݍA#!7{{k}zz;׽zƂJ({: e*F0XT !MWhG{ PHP Sbpj($@@$d 2`0@ " -Pz!B-ATAN)Zxa|$9@ FH. wÝQ0rCvRg;~ Ѓ'&D8#<(G7 W x"hl@G4m PnPpD:B,"~)B]=P8{ ) PW2@q pxy \e( jH * #.H7tp)"sc`0XRJca¿ !`\~(w#.xy@ !ÝH`=h`zqt[wsM 5~'o2 EDZ [ӋWm5(`qUW^uӗ X8o[0 oy_{?R/9uQ @9ϸn-@q3trw,9׀"pׅ%Mwix[ ?TCPKD\E>v?n   !Q ^&OqQ#GY(O1i0[8q7^ۧs޷l?V_N4 %J8>dFW"8 6+U/[.684M.|SF{X:z`Q( /3o9ogއ@)5an*=vfGZY!jVK mzA~6u{F ZaVr9&?Gކx2.6I$*A$:3+񳱰޷MyŏM,BmE6,v/Ku؇I0u~!Zg$Șfz"`XIg9NqAy.}nh—(S }IKNh-L ^HzL.|P1&F#ڭLQ"m*Ϧ` 7bh hT٧UntMתrjs: H:s;F_"csU9bߪ}'I {o~ |vA} M#zĐ woE?LV] H%}MT~Nڼ Ƽay@Xe'̦YUlK]7;Un-0G|/fugҔO^0A \*V߬ zg ۝gjHHG9H|ҝ+tA~2i}KJoTJw`ƳÌ_Uz}u1架'$X16$7Ǚܴ(kQW{$mߙ .%̋Ƿ lOoy! nwî*^xZ}JPzst.QI7F db1$|$ _.qYǼ4݊}2 *kx5&E݀+(:9 {IU4{Sn;t7)A B!v5 sEg4B=ݒ_z<9^o^1IOOFiu2'6}%tW?]p4믧^tO'"E3vP-7*{s'o <{ Y璷\gTղBOm "o~prdX=bàPY%68Vdq,H:vHWD^7bF"co$ 8T:r6JZo^J̵'0/.*R<͗vqK3+dYRϴ`ևYlgőc &?~IgTI=O1Gd{5z(%^;XJHjf$_ T+0`;ܻsשwS8(uYܜ}xT8G(,yAI3|㈬25>W2azpj]4,4ۙXVfPb)s9U9+Uz[0>B=ϊh=5i=kt*sPш3^ɶl֬s%?[jl^7CZ/q3m^.&L$vήγG29׫S4 :bDt izܘn&5ZZZėIqOJ7.2O|x4Z97͑f{jp&Ne )e>/ʦ͑= swhKEmUP)e7P^ul4g\!iF r+}3 Rcd'0fw?PXz(z`ʫMxg>2O5 z:rH ɪKW6&61~RXd3mgt8r1wI/qzΗɨX2|g\ EҦ" ūUϋX&P|DǡyNfԍ(M_s7 1S4;ΐ k ʰT{M_W07dF X89{RO)LĵYV_]*)=-XT|<\<Qꄌ串w*bo4!M*>]_%7əxFzwkTڎU8Lb7lnDQ 8^ZvK\2e!d!oCd"& 7in iȔXYYgɧfݳ=cҟi0'LhOsz1N1옌ǭ5 5ʯxc Wx"3e f =+RUt&xsghiǛȖH[FGxmKΛe 2Z(_` w̸uZT0-{nb=eݺCFDtCO_ZuN j'߲21 S|.="sFVZECL"س P|nFdJTiVa<b)%K+7;(^ت1:uVLre-48]*Ft6ӻCi7q;%[ڒk"U* ?kD(UW%ru[i8D[GKKO>N N bO~qRkcYOfj܎Z턞ݏQFp'U 4lW%S"auU*qIx fc1`A}Py5pe1^X317a6$@O KnXǐ7Z?pSˡumTﻪdQ3LQs$ՉQ%+xt!kѶ+{ MNmxUok.*U{B/YӋ<2|6bl{-XؚΌR 4l{ɡ^mtG'3O}YC*âVm!9}͓SiCJrðKg>j ?y.GQ:S-؁֏Т&L._2͝f6< S +_tfXde{J'q!}Ezl*oHy|YN6<ۅ+Zq;l:7 =KџuLb}і}88aG2z+ЕդX1n/ykHo/4쐫%OQ*ow@`CL+6`2ßéK?S\\zA)?s V`,=Û/-45?sk%j >6!V|=bί쏡0jj<%PUeh }ψJh/ge.֥F6uyߟ>sMPn|DcSFᵣr6 זF1#"|m8/ssE3 ֡ӕyʱ-EYuB<Ј+']IP}GKУbtDqXnR"y<w˖}~9B~k zW$ y֖lMOv>' v؟J+^ٳDܗz'RmTkZ]4ge '_FbA/>E Ͽ07Ԛlĕijk$Y-"F\Y`r endstream endobj 202 0 obj << /Length1 1425 /Length2 6643 /Length3 0 /Length 7613 /Filter /FlateDecode >> stream xڍvTڲ6MJ@:%RNBUzBJB(M&T({iRTHE={Z73{f7{熡D` YD<';h 4@u Xpy Gv@HOG00# ~B<8/qNP6BpU7 Ga*w'U' O Aq g G89*%b{A1(d@@u4M($ + w~Xo/ AIsNp(s#G0?{\p]Nx` +[7WR_\MwTT@PHTEERE?BeW IwKJ5|G -pe_Qw>>Y_B<8`pC&ߦ?sx7f@K{kaNp Tf"/7UPwܣo "~M$FCv@,7N0 # W^0꧄P,߀ Ppm`\Ѱ@@8{>h4n4L!﻽pT'/?̳bO;n9$I{<|}F={4qݨ}OUdTtfh> )5naffb'<4t[j6o'?FlV3dlLJ.(Vƪf^ftds{e(յ3AV=m{1m;泗RG%cBnJE?PgN-)rNg97EYP :μ32$AmDv5FFd?*] 6 vo &+艆^LB(ZD'e&>kag''{ޞuur~ UT>ŔJ{ NdSv(DzwpiWQS~O8FN1og+ZPpeV3>$J]r7}燭S-5=qu!;___Qs{lDzlm#NY6_07,wgc"8Qz<|0~kj4([kWm{?els:9mIН׋ʓsecu X9>U~[N';(gJ %O~ mF-l;KSZH%)E:PGx aZ~#ǮQDԼŷϝ]˼s[;uu$WhٌfcMu=E>~5Pg\-G߫ }Uh {/49}6, z,g$>UTm+nސ"H߹3l5~ոo2/P^8{p}qfc /Wkj͋G%lB9م[@駏%!ʞ['畡 ѷêOζT9Qlp0VD^lҭl@`Z(́N_X\#dYn)_{f@I.gKNWTG9M*nk &OlX. tZ2TuK$Q dO<ݡvgU|1Mefs$f83y2UQ}ΏI:N2{!X 64>zʹž71_fz)mʑr MRNE+ ɌBn]>_[>StSJtm*3[A/ #mRYևYp=wP:ɔ[0KN֋s:&WxݮИEzɂ"1d9fu'GyUJt<<~iDcdvS$luOf;MWnqbӍy^D' IloOn#EX)hVή>,OOGc37nj=řVy2j=@zńYS 6xh:9Vf+`eEp \@Tnch27n؆=ri:Y+\z$KPlsRnHHlܕT !O feԓ9Md2y89% _^lAw"pp^G)A63YIjKs]s̝|LMѪZLΓ< G4BF x-Ҙ>)F/dܒ.ɎK2c{m$de,͆ns.\;^wk C"U _pfƐnsZI&% HY+Nl28gS=AiZ;=UV"V̵ʂv^od#VҔ{휚B'jƏQJP/QF=rjFC ;8 a@U{^yqhiU٭<+r+BujVqOW!UlFp(ʷ+n5rGӔZ]{CNz Oiኖ#f1?a-L#պIN}{4#x_ W\UڱVغ/ux5U59%pqb\*ۺ}H=Rw \g9Ph8N#I{NPjBk\ 1KAj0A5K5 2P>c+~s H$^utBEnQeCǀ,riu#j$Af.0IwDnOkLB}cߺ 0evu,t/y+?7YFwcTElO :`v`gW|RɪN͝%ܑ!Z]kՍ0o L|\>yu~\jO`V1YSJU-!6SSKn@Cs9&B9h/?Tevk=2nuOR\L @bCªjM8ٛyF5/uO b⢦hu{-SUZ}%h1MNdIV/bGCB=\VцV^Utmά YbfL#I'$>17*&cX r;V RJsX~b[pvcԨ(뻞CӄD! 0Ŕmd)1n.qwҦ{}$*3ms\DW9?)4BLV.N:vQFĐnlmE$ n*,TgzLjZݙNNО8IJ3T&1'LΣ3{br묅(uc5ӗʗzaFVlmco7˾,sbؼf5j8+YcFyQQrf Ģ;t u\fKR &!O|N$C:rkLZD&"q۽L7=h-)ro: 2zfcе v/MO8ÀJFc=D>B49xMB {2uJuPx0λxA(=:2X>;,'[Tȑ0ܪA7{wka0/6rw;™9cHU# S63v=oZꇑ&z)X%B{ A3l_ ƾhs rBN~=@ u)e($#j :U@2$u4wo pv]tObf!׳orӣwǬmU&gL _aE6c1GK(2 ,@(݄;ʻ dOBetrx@ 5Fg2,ZL|W/ ϿE\~g>B}dO +9Ѫ*oQ\'@'Yh\OJXߎ,E-,eqry>)jdyG\@o!o 8p7#tcwnMC` OR@ Zte%kԴdfCndv'k=q[_8umXGTɷ_`P@*+@l)81hZެ\sW>7Rfj5jCV?ɁAD:`:DWQ $?ÄJ+:"4CLx3gTtd Y7 7kNC9XxC =E{-*݊ ڛ9bWL'SJWO_P'L*GZS[৩;?,06q?? lюp`\iPNPS.]pIh:O{ʶĭ7ZMRTM #yHA geWyYĢmXf.)w7gpdf+5(7r)bROy ˩QHXJ]uUd<-ᔱ{6%+,6c7ܔue.Sk`=HɦI$L~S@3U";kh2xDV~qcxD%tFq_ Q lL{"9~(p; )]r|^@f/U#jh-$H_ :͔TҚ2(Y'ƭGXI 2u핌1݌b"Яc[x:go*/9(q9UmrKnx'=4hͷܕMҿËoZAwʷÝ*ZF`8&\@1HgYa{He ;e;wx|C, )uk<{.3O IY_,=Nxڋ`_sy"aØHG-dJ3 -0TR>Հ^ùMZ]`Y6U4w< s.jM+q('|e6bjNє@ J;0դ,YcM1FTobd[bh7 m*a-]OS"D%@o6F!##x׊`/ʮI)oPN|ɑZ'p1uDl~zh~ e0gge-Sa)|qf]'.g"nFCh`Js/^l7? NT>Cyjr٣P9>1I(:Eư݉GnFjMm aow=ɑ,[\?>Og';)B ]6{E(b+Kh;6:'}2ջ <2y =<?=T%=E1 GurQsk9BDxH`>0A/ftnXu6$8HNT˻54ʹ>`QjbUdӸVw2=nw*b|Eљ,uUVjl}q]uWSpdd3;qd;+kѸvV o"&ݙf;4iÔeyW͐50e0= s˲*>T?5 I+ ʲ5=e9X縺u}$u5 &47<>fJ8}wW]c(7FMqZɔZn&])Kv@;B?MzLԶ8\>ЧzCvg.pKhtp$Kd`*1|Fp!6׎I-!5y %8Wj>fHyo򓷼)"an}f(5߉zooF#tolFKIsEAhۗ9$zXrwJix`8i`wϘ~7ri/ӧECM?3I(ܗ9V Z ⷎPg3E,Z)? "JF*/s*7-?]-~Y)5Yג\,l_MRHZq|g6:[6Y\Df/㊅;4kݜc>*Te#I?؇*E G/]<h`av5t8IG`G2ZfyRu V:b J6dă1r^RAC$Ǎ\{5Gik*KoY2 ɋDx8U@$ՏhIAo*rڰ#KW T-rIC|/wWIrO1T[pŮJM譔CC^Kz]EI2Z2\1wp[s endstream endobj 204 0 obj << /Length1 1991 /Length2 12962 /Length3 0 /Length 14178 /Filter /FlateDecode >> stream xڍPk.;ł;www Jq-R[ws&3sk֝TYQ(`SP3!PR[I(5.|Ŝ&2qw5{`cca3@u P98z9[[ZGG-Os`j{hf9Y]G+WWG>ff&;&gKAZ@tv(hb0&J_b5 Wg ]6ڻٛj2%G_)0n ?Ñ&ffv&^ k$)07Cnonb 21}W3q 佾s1svtuarQ!nޛ,ao.`gwuA#?qkg{׽Dz^jwuv6QV`DZKktu.O~kYd2ԡO[%w"u,B5ٓqPc/3~*J9RdCpjI/ޕ2N3Ɩ@#K<~:'Tzxuc˻ְu *Z<8i0!{K$۾":'u%py,̟U0s I !$=QsnFkX3LQ?rd( 6tC#1{e2Vh^:kp7 {GyFs}- K ~Ԍ &)`#iWي_{2pq&,%x(j4g 9*Ĭl(fz= Ҭ8.\40ˈ^@hs.bܣbzn`AzՑvlwu_ej̅B Bl^j Jr[5a^ q:ˇ9_و-V* `Y^=h*cYO'UWz=2rL22B|zBnqti&rbJ}?M:x6#7N7*'jmWؾRh.L\_I*nNhEiLt *,W WUD.Cu}WŞfV<2cka͝L-ԖȊSE(6(2ْJ6⊤ =paagxFjBifnn}T;.6κvf3IRxx=Ln@m0~u]]'7Mۏ 3K1P\,bA7 V.ҧAį8Cvy_u+_۷*@Ʉؓ .LS@-ZI %gU/HI ?p5C2A^,?nng签H4)h#D8`6m%~@ #ɫhLi`Shsv 35y1B㊅ I[\D ~}BdK^3 H  f%K}PQZ&=M^ "  4D4kh2~` @,34Z+NrPWX%L"8?,ng i8Mݍ#_r.<ܺ7~YM9f)%K61B~TXhEimNQ츐 vSquK$ "wmKC)ZVIMuQ>@&M.}iX:\fk: A_UTL8JXB vF%'?֕yLvH3NbA(A5JVOd!1oHDq݊ hb 5܅3\pۖKȇ+oFh/Ϳ e_V}hz {<0#T6F=RU[L:/zGT!ҿڡ2ngH5nRaGcUy/$Df(x=>Z/\&TQ8$qyb%Cz+ D(?zX> r>"ڮ Yːa5PX#Vi#$17gN_A$fTq;2Ute7Y=c֯'j3և.>Vpk{ha@fKg`6?. N b<~lͭ |*[X^0OJgtER8xbN+,|/wE)h 0NV5Vwp ׇFlq}$/ڒ˪=+'@,4cbHnIx[#/*\ ylꭚK[l MeIal]vOu}A(c5A0j&ؤzKTLr>_pA%ۛDy,EګR]NHgr:idw OKn)+IpPOBxE`2Y'@rUc0E*d [UQءsG^,86L$g4x6^IKť0D ;9d+ x3VU,/6ؗQ}Nj}0yKX2p%U#cMNa""E9:x 8pޯ)dYh3=oM0u}W01c)S$\o|*&EW? W gEJx0z2fjB4EĊyzjGkr/t>8wc{CϽ`"P!LUT͉3bb4\OS'd2zmnZK5ҋw]SAuz'tրȄ4!ZW,W|3x}o H' #ƍw^2׭w\7=2oC5O{etFlHw,:L: B;V-vomb#VZ4^^jʳ}prf1.r3"(|bKEa0F`_+j\N\"$ e(+龑wfbƾTƛZf0oyud4f]w3/"kiƘv]W0"ݘ#F/$bJӲ{|lQ~.8ΧWClrp|#GI])gj;$Q؟Qwpׁw3;fAͱѽm쬚0+՜z!Kv&5.l{,b ")^ThE2:/{O / I-<ŤoJKٶF؈`v߿-}W֥}Ld,TƑkDͨ\$>KLa̍tM#C'E]"5ٰWnEZ:p;|qJd3yF^ouط ZZuV "a"© "!!]coybe$N*yMX]{<(K:Ti3MP}N9S^MzS_ttC$Ju0E<@L Vrc z#kl4o@/aMJ&%;C%ElW.~ :t۾t-Qm|HoccIz ~><<*HQAQ,z57$ :|8}[Ja{aM ZrŴ),vЎNfEtLX" Ȥ0x4s2jj!&vWжL}>} VQ])si~Mi\6*Ϩݶ#di߃It0 a^r MVADhAuYVY3g)KMvbA0|=_ТU6F"Э3L7v3*ٹ;R P~-߯.PnN#Ъ(fpٌxx +4zRA6 eA;j8.%N1]jᳫV!,A5Kw3YꫵyY8D)4H:u}P]3!  ݆J#BA7ž[ ;Co/[m0 U)~Cuuu‰ӊT4|'c781\}[aiVNfw5E kmd`k )![sV(rk"Zf@I2Goc%+#MLR)IY.UFi!rOdFR&d߯\hdhJ;x6K=c Ӊ2+k*Or< A!?Ֆ34~ؚԶai$k']0z0( z!fbN_FwjMsAg)ax-Ϻص;:8L(y|{Ԗ[iUS/ӧ.pk]֗c6xΣ c>sFYjFڮ5z nYBDF}˜y`~Kq|WجF?NBZqDɖUԫ[AKRf9PW (?`|W,^UIqz&?)D4G9ϗ"# 9#D9 퇼I"ּK%0 +eod 2FaDk!qEw#eItj3'{ۀx}QtsѶ%_|pV A~#S}Ċ*s_~? ]) w3Uә U ': Ho  rw@cCK }"rnl|@(O]z<*TeN5CšU9_M]LtžgZ?p#HFg,hI4̦'te hj0M%|a)R=s,U&'ތ'5w Mخ C11;rP0>djN.Fx9\(Ås*zܨw0PSJ]k5)kO1R9<ߠVJBfߍ?=e#\1WPE[J0Pzn " 11fj{`Z`)zo+֋ޡl$< sZa bSORn}n)Qy(AHBm(?Ӓ_7yNO-nR ZK{9OfH?8 ^XJj|ҎߎفOV/|j@'K`a+:;~H2 jI楢zD[(V"bb*+L(zlHcIi즸 =dzZ& )DЇgDF,lNX=a^dp^줥ɩT?>N4 Lrȋ_!N"Sâ]uj"4hvwlik崵)'(QՍNt1;2MRI؜S=HpqDbGuB̓ a=̿|T V63v}f!e{LaFPʤn"|,.}y{ i U!xČ4@ZnD05+>Zwy'jZj T8\721@%=S=-m.3Ӥ$N5I BECd{nߙ2o!hs4vu]HjNԲG/0r";mQ ;>VHB\=Ϗ?/f[Յ:[; #b\5Mpi\izX+w9)F3?@?+}6[L _!']<,x278:!.x1]r7ZbɏuS+ f2 O$Pl@e5.Iy;wm$%>dH ll\Ny;Y Ć:%m^ 26dN|Ol ~,w:ͅ@B#&j&x@"6b"#X/z _ 6z '%tg0>OTԝ HGdt[] fp~+&R ;0멋-~'LPI O''ӨYP<ֱU r(Ϯ9D@y=}DߛS.bggIϸ&;&w'3;;s~z}0ZT67L r'9,j#Qs *=hK"]I]Yp64F͉6dy e^(6fS],jyf&lQ(IIpuogMot "u~Z-Ʃ>y!H= S6יi:|RN"y"X׸ނL[nlVkZC>"K|A[$hǔ1?Z"ױn~Ŭ&j|(SRF2osGcmJBw"`lݣje3tsHw G@ӐZ3mk]SQ=-@|@lO qظ;雂`5f_ `cGe} XВ+%"e E6fv.ߡFR ;Y}n(6EwG5jgIZXT*0n̛Íkے1sp1U~xwJ7Dt?+t37.;Y2sf_br#M,'5$Y ;sܶ:wz;mbM >ؠ2'gO]^}hs(iZw,@:i|N#S/> y68c|')Fbku#ӦGd'm\ֺξj{M姽T/UP?ib\?^'?UyT V!*x귲~|Q:iգigKt옥e2M+sE8YV ѕh|i^J0͊0 L/Xxdz)BTnԊ>Myv%}c/1h*w<)qQW4y~.*_#E &H|A0z@ kvǚô+-ȩ)涌}En[p+sBUVFgnz3A]D$8]xFEa tIlZV 86*/P؊IǕ Cp7!sϦ{?'CO$tD& .1KK~P돝KDxU6e$H]ɯQ~8eh)Cag{""}ќhaն͙ &ޏs zթ?W~([nzͽ-~@TJ{3JDiC#IQ82i*ztK·MDN$~G'Ku=U$&klۗ72J "aiDƟ >W40C @9C_uһ{$ʵmFzN{b)E1CiH_b3jP{"CggB54sa/ W@UNEL!y ?qո1#@zE&߂ѭ8R7Ӝ*#[QV]kR f@wL +]PuJY.@GkƲ>57K󦏐! ĺNOXa#1릟ϣo$/MA| 3x 1ŒD)SLc C\#(KR+Ѫ /,UGV 6U^/L_1> HxZݣ$S31G<24tJ!P#b.:|83lCf6(2Q2BX٫ʵM[gf=j)1o5ybb'hɚ ]*JXfdH#lv9|E7T%Ʀ[}ѥ@"=G|Cg;GdNM|v(uƠ/UPu׶stXW/#D?|Cf8IӊӮFu5ȇ?"WW.#獣WF$X1D 97z DښR`3@uPNZC6TaM1З? yLuZҀ)=Iy]f1]ѯlFL 2QlJ$C\}D(p?&|Pg 9WǼPga dJ|E)Mp u6h06oljL7K92>>љTh1̏ķx1>Xf$tbx1p5<3ոocONhZ:uĪ{kﮇgCZ-՜#~ b_9T('ڵn$co'$Q̊wK)&&IŹrzӸjk;a |Ts>, Ӽ;TCԀ_C7ڧVA W| ]STHcԋ 7jTLpeQX>-BAh =FPi Z=l/H#i:m:K/7_e_lM`>C`NrA^' ]u4*Gۀ Ϧ{sU'v~_>`-FUMdң۝ңU}u$<} ='GTbaDO/aK;IrY%;>wIke.aaqS>X2T lo]EX=8nkM5_3\ +bK:RXp-WlrEIh*r) 4uNj0א#V.$$ځ6RLWF keC EӥSFQB'ɘiشkF ~yPZO[h襖E l2)Rt) /fy`*Nf9(G<:ޕ;IE"8#qL5C bp)tr-H*m/ 3ۦFޑFݼgs]UN6EǓ L)%sZ!BD^fVNYNԱh>:ðN֡jK^ +p7Xp/ڑsaVvz H[3qo j,3)_iXw!eIGR^KrV(^w6a ϵ2Oⴿ  d " M Xqڝ/ʌDB/5sJhƲ^=k vO\ͧ6KR1$%7=*,JcʸW|Т|fj5,l\M$t k+~ Jmf#}S<ـq HDZ0BA,-X#IW93B R* R[n[?TE-FzkIʰc> 7ς>CbD c״g_9M7k){zF~ i.T]қS4Jэ<IMmY1[L>|Y';C/l2cCB)Ư*{%)Zc*hv[*@kCWMR:C^)w jڄiOKW:"| endstream endobj 206 0 obj << /Length1 1987 /Length2 14648 /Length3 0 /Length 15867 /Filter /FlateDecode >> stream xڍPҨ %Kظo`!xpwwwww$/3s9W[T^ rbEz![#=3@DNON r%'W:8lmxq:D lmVfV33' mx. @O.bk23wz?>TfnnN?B@ @h~@trTNNv< ֎ ftW9@tp( oh 0xr9/.mmL*R;_Ʋ3G ͟Άƶv6 3) Peprsژahhhob24z73qCThsrdpYQ!aޛ,fc"bkm qr#?Q^_ߦ ?J0qcT;Dc.Gft311qr9U*igk0}/ 2t4tޞV733L@N#b_~ 71lXc2J)ȪY*aa[7'=+7 |(d􏯔-d߻? Ԁ%o>@?dyt?_#leGkh r}^g_}luV}l̬n"Q4Q95*X0+ Pǃgfb_2|4O}iH1c[?``~d~_C۟ `duzw 0u>9B"? `' Qz!n `T?~?ob{{Xw&Bf#_?nj :;=Mể?M]7_^4{m {%T0 s'w[ h?ҿVo{Rv g>ъ^_^ { {jnex5i;ܼ9@71ʢ@j!|WI9}+ΏH0U[B#(bT7D/'-0!JmO^3mXS'Bup^/^~-]\HnukJU2ϥQj~E9F 8$N4hn7shYSoDұާQ, ,ݸd87h3GIKn-DYQXҪ@6M}5.+{ى@JA& }̪6tVK QFzE2*l`8cfĆ&O7"kNV믉R2X;O/Rx ."c5QEfk7 >_eH܆fO "'V9N3!/fL(yY:cbT*=2 [, ;~t*VX\ŭ8m{렭b&##] k`<9NN9/A2rDXh=cphO փ-3EOFYEfՒ: E].%΄ǕqB8']mL";ݎɘkgL 0l*8Qn~:NS -1Pv6؜^73K%8JGݘhW|Y-OMxyLZ]AP4O@7m _# GIt*ysAYGsn6l"> qdI8A[z<|ʹo\?ݫZ:#IR7Bg2+7';a\կmO5*zXsc )!70T>8HH-%k]T3R0Y{Da;y<݅Țy!(G -t:v<6/ RPSvsd&KJsYHz>X^esfhPAܵ++(͙)GFg"mLUWn⧍5סOQˍf ysA|5 R܏O9j9*ZJc@Z#D&B~KM)AXd0Kf׽Z{UY)y>,} Ƽ'" Hu4 jm)^DF\[tk=ɓ3Q(d!=X-5~lGڍȲvJg+G->_R7LW=}@1 2l/{YLjl]wESϡ[<*i+%=zdUnJr'!'4J N\Nݶ j+xFY,̵LK4UTy;ɪue7>j+cr Y @+EhTӴxe;g:uO 28"\XaT#iUXY3t1XK]oyA+)XvItckL-9ءEBGNɱL"E̯f8[h+8niO%矰GP9ȒzziDq GGvnʼWk̯LSi7eA9ovf31۝Y*=HIZoxcm'SwLhk^:h m.{3DيhƲ#={k:nXSSު @4|+/V\CCb^w>bNb7ǘ&BY=9SXpTyE/d nZpK!(5Qʐk1mB ? Ǟb_^B텷)Caqԟ~1O֮EL=XZǒfa0+O#U}RɁuÅ,ZlVZk>XaTh<)Uwqd3 bJzĸ]U՚H59DG[g κ }YUA{gPޣI7EuRB@|њ"f&#Ol#,xWtV`_ER6 r30mNk@=!LE$S 9_8e`(PVdy(e- /\ywRnK#KƔT:B./s_S- C} fTmnG?Dڠټ?)lqF(?6j?N۞ -G^[ n Zd}v_q6ˊO B,qT۶l*7 fsŘd50,dƫ0n~}G/gI>f[gc΀Um#H_ -E߄n/)X/⊚7!g%_JϽCgb2䝨l#"!)  %Gآx=@%|]4#8dnhlD:wWjJ%@uB:Q~q9.`NGGԼS>tɷG08>2h!M/t3RDy '.Օzh9D@Q2s~ N=|B\RK~L_{?9 r.uIOMc{Pf3֋* (b=6sj[j?MW6rŐ^* :WSD Olp{&i?|Q岕w:t}Sps۾l `N|4l3k!B}@26(}$@# PiU1-M}3MՍ. ӍOߵT QW?D|{7-^Rp߅&<$!UERO[4-vC=6; ck3*B"Y#[|,e+>S*N%7xx~m -J7Y6ف_P1 7u>)0msO/mJĆ&Ddc if\G(s1_M- 'u38q^j'CL y:QU\ko2ə[6F5ys,4؊b4[ld(PqX HRg>u\L&I4VZ;h2𪠖4~H1w:kƴo5@}YD:uuLFQ%d@-ΫĬob9P7+2H-+gZF_k>ʺ8k_)F R7*HJgS-_z*Fyx{:y O 8M/9myyQ|C"s8p1HJ~RvRNyrU  xN[bk;MxǢ0Y"Kp¬ ^YIyK+m{T3!e'7QW)+{ fvõTl{}/}_cإB>2V[臯A*˝;vwXW,9JJ7bxBݖyf6U9 iVk"uqFBxj49߇L's^=Qٖ ?k$2ե7Z:p]y|3,eD߂:r a>#e/ ·BhSl|$TC[L|`NZ k̥414'iv1͌ji3רS]~8I3՝Ol}#_pP Ҫ̲6JZ\V7qykgX/D3)^V`vQSF?OB&9Pw]"K B6KcP% ~$(k#%Z(aK)fF'vr(Xm|fJ -7RҎCAEꡠjM?{ _-cmb0\ˮ E4:'Qkl$Oʕs;~1P~LBCX~2 J ?9nikG"`#xF!"7"a[\#AXG oZ[ v5'A6㸹O G2C hztJB˨Q +tlVmq<74R6.Wmka wY۹CWBܝAMP){H^ P?[+ݝBy9 YRׄ}r c{ѥ%UEai)FѡG[efk61U"x—+,# rrEN; ˳óY4FPw˛ƣ v#7!jBׄ1uc/h}1|S'xuKg=(vt"Һc^ne,\賴_Q׽ɘ'=9On 3Oٸ KV"rDteA2uzZR4Fh^k- ;MwIK{wJ#?ipg(tNio9Y]^b]4x1xr3n'kgk%#/X4YqD'˺հ.Xr g09/%p rs~Wze^JsdyeOb j2 JZVS –%ן#6Zzd@܉jCkpP6^[ K?/2'ۄ1/7)3GM U (&[G>Dpj$o9 G,5mSAoj[-V1mFr MeW*']7M.sv4Ks2(0Xx&_մo~1#1U奵11!q[&*YO$'ntta~kCЅRX-!ܵP܏$g~Q9VLOֺ oǑ2>؏c6N4J?Cq16Ḁu:ю5>;<^Dzbǭٛ(FϝFgR qJ F||JS: h~͆z0ZT 6UwKU>񑃴=*,b $K'ҳ<[߇9Y_/"ԓ|v?PMENm3jBF|TzE{$+,-?Ҭ'fk(ai]#U4_u ~o8#6]_+(Q[63>M Q{t /-R҅K 6D$|0b#YY62ܾ;ݙde\*K6@#P`m,:VRt\ZŵMR_[;GqF!Ml*^vໟb N\!9$tuc 0G#S33zĝSypTep\k6נY/8^Ư0jj"cnT &SBUr0M'&Rz5Mznϳ-B/ZP^AՃ څm@ KNj0v4*2hAN;nX#܁bP`U5҅槭n-q_diO/G|YdIʘ)&j3͚N̍׭z5 *1v oIh*S:$*1n'R,Nܐ_CxyD\wSW$>F6j8F15A+%]a],ij+I /^ BK,L xh.iB@ϦnfYLZy{k4j㽾ILtVPnuaqAqO늣_m&px}xP2=/Zp$0=i( α +uif-ݹ0߿r18>9ۈqb,eujnt,ʷKqJ-̷%[P?X(7x8KG-4̢V|uIכ;6+_R(.=ٺ-g35)(`#oX-uo/O@os]\L 0!x` oTR\Z 0ۊT1-=7dcpQ|;dd"Bv?˾%ib<*F 8K|x3uOne>5~J!ZfVx-s\ h:|60o!hrS?o [Vr?g1`3% Ŋ9>К5,. a׆;=[ ϝI2f՘坄6' 9|%[R}΀ K?snnqC_1K9'Nԩ 1Qlkh"3ޫB3+(Z4vҙtX O2'G8z-X|J2oca1W1ں^1}/%-'?&oA[Gj y dƘ3$} /#`EFE!I tf*y+5uxf|ՅG^V2Av@?.o_ {Cى$s_z-\R^3UzWez:ǂ{mU0^|#l\m->8r XڢaPeYo#[M$KCIEO4I4g>OUӘLEG/LzںuKሒY% %6 gTv aF3ރ)3d'$o>Au`+G*[SHh$ݘJ@t&H+>fO$Y CcۭR{ c7!;'ID 6X\tuU8{"Qyub_!Ly3f UU4[~UHV>nRb;X~50V`Ǚ~xj+\Ĥ5#w4\'ݙ)RrįCXؑnXM#q |9X .?Cr3"]E5٤5Mj>Zx,X9Y uN g?׸T񂃙P)//CZa71`\L2WBƚ#dtԍ3v0׎%9ܝxZW·r --~MN7\i[@`O]Y!VVÚ)Qp.xoz;jY>N*4+҆Jh ;7 )ؔ84T7nY"2J8fq2'F"("hUSZsl"y'cLHoå C5Oz]'m/Zhħ_;X $Pfx@;gҴtjRdIMqy5p6ESV u4 n s&dl+?IL#% *E &ASC#NCjF#eaEe"mz˅U't j)V7JBSG5QLDP %ڬ+\Zno$JzЕLbs|Cv@`iS0gm~ŁF`Z[0Kn'p) `,^S`ə5iIc`ҷ]͘yo-_E:'À|'jOLv; L~A#ZE%,{lv5}G~Vٱ# mӹ8.GXM'In.mmsi{:HA}ɪo 0عIy{N_GW]šBStFI9@9?PC~S*03`:iKsn2FSN$V~+gԝ_pZzeR IY,MxS6o6Q 88=m"o*S肨Ef;;hώ  *LC28Yc!>5t*ޗg3>-nn3 hA 0t^(5$C3VA99j% 5Iƕq6!h~oLj@X̮OZD1-Q.(y. KKkZ ;Z1b\-^.12Dco.8d[(ؤBH69~dBIWXGNx=ΓNhoKT39fW|[d# 5zOk_%OsT 5qi.>VoTE7l8||=#FG>ez|FH)(fnc&ZNE).$^7ӳ5Bm[>J$6AgU7 >KZ W@K P@22Ċ]=X<*"+B}YU*j5/8C`H;ی:/;, % vmNԻ̹cΙ\21.yub[7fGgw& zlGM)’uZx>@ꗫ*p/3v%ܻCc :~ȯMVFw~[Mٯru}8QHsA?/"GGq9Wd1ȸ MsXT %(ż⛙g+n\6y FmiKX#n?JEi/}#1(OAmJvۦzzW~[vvf&uQvsKTGiH#$J_, g4)Vf#2POVΪxB4\۬6Oy|}d.8 .Eu\u]sC-@x#Nl y{ EB1Oe- PyꦱhޱeGIsCѠ9Գgӗ3D"Kf+pzx>d:p_nWZ μ("O^S+5f{Y~EF{:730@Ng |XOܖ R)sYT`RЃqh*J%=mo>/G3@8V,>4nt{e|N[o; dzڃ#"%1jw.~&i4 e^c9^Hѽ%Y>4q)xz߮4Lj7xln&[bGsݵm֙z.Ѿgn|G*e jf[jy@Hc!zI:+M&]͌b8^$;Ŭ^RWA'G(=1IPD)E|E^O;sKJ9'+)5 Ӝh5?t:FWd|06x%P6Qݦ ղT4lV~nj`jˈZo*dXYڀT[jȱR Xdǂ_K:|hVGu>g4[CPV΅B}>0Rx`yL2goPlB6v s`[?,Exm:IW֩F/P)[ɡi0xu<3']Y4$lHF(.HųC"KsfLD"fl)A/a~z`d7.fQҟaw􈟝*7vW &y k:hltOtK>TܞJC y6cOHl^H%R}qZ. {( ,{v90]%D$a]ukn.<_?Y+omtA&6i]G2-o5QxatMUBl9i!zI|.?D oU#D3RisI2- X=^:_ݮتȷQ}a7 aK5W ZO LZ& s:ǷhE&>> stream xڍwuTk/tw % C7HwwI0twJww()! %%~~s8k֚y~WWRjY8XY % EMMv d9ii5nv?dZm+A_2. S7M "wsyy@?.IS@ rEptv[YANG9/u=lnP2uCN47h8Ane^IӓޕJ v\A. ʦcEhZ]fi8Zy Qrw 4*N `'=vVG!_ʦN`+%PVdurc:X4suzL 9o SBbO.`'7WVW(~$ZB?I yoJl[,,bĦvvIG BBC@  gܚ!Nɐ8}P@`Kpsq`6wC ˿1 \^ ߟ }f`GB0?lqqG//  aې)?KUDi m);B@n9R5o+}vKD/ S{d -%GP8oQSo)d, 7* Y̭jZRut^5v  fn Y'*`h{8y..@HSqps|!iln$B p~F6?&A<6?AA|=? 8 ~' n4 vr15AV忤8݈0l n1sG;Hq7Sf/9$ :7T qYQf lGw)@DX~_3@6N I@hA6wCeB ۜfտ86?NAL@!8aCL:A.#]7NH8\ οDyT 8';?qpB0WA!TrC]!S θڙZė?A _5/ AH9<!!;_b7U߶k7@,] yy\0Ԧ!NēeoGŝ 9z2m9 W _ZꨵH,tx"T-x+"6N6l)k+K`qR,a# ﯲ甕z"xd*$䕅H* }W P@ڼ@iI'rzS݅m2/8.paFW+=˺KM7gtwˊ4.j_RK$9:nT$e) gq>爐"vLJ&q 2m˨A(&Di=}bHקf$ā!7N%' \X:MA辷Q]kM;9e;<>1qw}HI_225Oxށi<>b!IeqQ:] dD SsvmAaqN>P޿YYڢ_ ľZ/!9ۨ6؝ N(E>o9+-Vj$my~UJ"Vmhe?fb0>k1sؤ gf< W5u:XƕV(%V-jر]:q>OB/G1{ޏ݆&e5T6JC 9vX+O}XeU1v#,mNˮ{i޸MS9Q- o+Tt~sEvTo?! ޲SbbĂ黝6OVt76mg}*"ʥa)\bx5:ww#H< SגaOUlmIVrMq[r/7 T(DWʾ[Ks64i9d`) ,>xO??4p!<+t~-"45>#dtŝg@wVr6z廟S7id2l.IQsi FцkY :mIgǦ5+y7L?x}=d\rI7"G t4G|݌-Q%癶IFPPipdՉiik.>(keG7rpo?5stqRt>~ Q|O9>b=+~h^$K?^=#:i]Ր*vpH'NtY!o@q0f0~NbѴĆYjt:\ܟT@'E5wĺZ+UWz?FsOn l9LY"~־hԗzUyѴ}zt8YqagOn#)\ض|ڦvL\pq.^<:8> !7R>^,تDM)+IeefK=kX`̚:5ޟ(DWgV4iLI''Z-3.<fÛz``*eUӖW7KъwcњY =Id}Ț"T]cnf6:"% xM=cG0(l"m-n^=|"ThЊ,>K*Sݹy"T5=fZKR۟U*/ߒ&v3 ^Qv|3n>2 G-Km``bL\jɍ>^}[Wpb)s#Dg6"Ԡ":LAal&@8~e9"bB*.2eqfc\30N#ݱb"KR%u+rW1[{cZ#!ꮑERǎDbՐȏM-|#"AIΟ}-AUxs &|^W~̰2 :eWDP>s6s(DXP6g| pd{2ĝL ڇt3%sWv60[/zIX56t3,IoNN;<ɕ%(CR[eVqN$- " z~=Rۯ%5]s%7IV$:I0@S(Ya),q ` 5T2ӵ^"{WEV wfxX6a了[{ UN4qn??Df 6~6-u#kFAo1 S`J>>]#M ~+dcӼY>Kl Bt.'6K&eEjdh$~ Hr6+JYܴP2A5qTHNNz!˾[LH4$/^ۡpS^ Ke9ĈRDR>l#x}YjopSFeJM=+87g֛;xf,l"&TgUG^.=T$ ,8Ncёvv6?2_ %?KKqE%= D8+}Gٿq=>ʦ| }wvlE HbaG0,^T*E^W>w pRXZ361~mr)Qf's8B'_kTA:_9ߠic^̚@ԚRUL8]CcS-VuDo=yɄ* PbK /Ӹ"71L3FEOzZE9Ƨݢrce9ǐvזw8 @=RQٗk98xhl '8=" m`%˅t(Lm^pN`ί; 3)WeZw'q`O.׭ׯ[;+9]Ztk^Q3oϏPC9]galѹpتnAS}NSd}n1?GBKâ?.![7z/zԬo3 jFlWN}#4z(^#TxJ.g×:[,-̴Db"b讛;7javv٪}?H7uD/v.EiK~=9-4!V4`wJH)gdGuKƽBμ/.?/I' `YOBY={, eU[@*Yla#&ko5-gp3Km')u3R{ xG b]'$үA m)kɯ^ʚv])͆nB9 )_Io'_H6+aDJvlܦ|EkQ[FD#SdRH0وSsWLht-~G,SejFͮ1E7:`~\g7ʓ2goRQ.X~-d2+ 2~f\#>l^Q_>{zT:Lybs!eiӭ[+ٷ 1W0žwb4Б:^Ȑ{R?٥uk =[54a`;oA6Vz N.naoZﶔΧ{)PW.D&uH=afJs =.#ЅM(B.(1j~$LDE3Le J_k`-a(M!o!jyjA5,=8Qn&^| OOy#,E۩+ɨ<ĘaLjhma2eԔQ,D_#T4 fW5u0fcO{eH[f0U$ŭ"UJ=XbT56_酅5EW@AKi;s5>e:3GwۡJV&[v`)R:fyn^ʅxV&4Og8=Nj}5ZקD,8`o;:" ik1hIbnqnbGS:xn=ӤaY,n9v>Zm%Uk&!iɰ\|zLߒ:ޕS*6P5(ц԰MW42"[Qxsp㽂"rЪ,)f {]o3Q wWLAOȈWp|?#=b̯]k"%G3q6%sY$Tj,\2!~P.qWr5 sUr_`TkNzTy؞&5g\׹؜D)Aw"ǩnv|27N6-zS/S:rjgs>՟ C̘eW#YuɡcrM^`h^fə"Ap9ЎA50Ը/ΧKʄ É'[r9=#9?dHuQ{һoD;_ƥbNt9ۭ:_9Pr ӕ2h@cpo%D߯ #Iȑ~mMBd&=+T섢+i䄥q%C3(ߪea{NKۋ;iM}|3y0Wki:L Ȝg6EZUt=.Dd|͡2  <6yi #Į^e|=(VIф w>:"I˸H̭&k R.10)!(#'7!ųcaWfSl,E)L@߂*R@iB CݜR 7J.6hvǡ簏 ?l Z_7Jh 9;f#g*$ʤz:dIG5:1`})-\ZƦU~@ /mx&BBl]~q=MIss1 6"LbEQ6Fyŗ7;B7~M̔k!ªC8mFAZL g iϷpqZ;~3ͮo5bŴ:~ |rS>׵xyYQCCLm R&+ȃ5F0IBC\jR(lB6oR03{Pa-Rh oh9vGsRc\OĊ6M>(*àV#tXl:myLO< ̨H W,jB2Xn7#*EQu~I0CwĘ`|⻤Fvʦ4 _3}l ıF(z{,;).[.f vBt#FybJ{fg Cg]sT1%DZKZ_ZƗgJ+l^+*2JEPbzIN"<}"J'#Gׅw/icnҌ>D{t5e\~ЙsV95Ä0*m.);p|jӇ:e-X[) 'th?`4cB}eiK٩P˘wF=v {,ڠh8Ov3VL޽Ș1VUnHq%)m[wd44!8Jhǚ-7PP wJm4h aږ!LJN~7nUvTlⓒBD"8Ue-?z[Y|LBGOhX+6, 9Bn+c#(z: GASX"Mt({Gn%$Ͷ̤/tb%\~(՜;^=ȣ- ڌu[(3Bk>exuӮEA;5Gl(-f`3iޙK1 BgWj\Y4 wA2 u0tg)08k[HW { DU*'B?ނ;vu{YWK# ?j/OLUͣNO />ӑΏ)O]\%Szi`B„՛?Yԙ[PG>>HW -dky[-<7efj߾T@*le]w\_UB$S`=p﫢 l]5sJ^5QDP NRu#RқwB G f_0FE6&}|8q s6۹x_w>3sjF:\ἒXZK~;Y"|*۶brtaX86oZp~w5A{1,8ndL)y6ϊݪcq eYn&&DAKd3nx Drïs}LQ-~dR \lxk;{ wT-;k7t4SVFt;kPཫ^`Z}}3o|e6#uK;bҖKJE.|n)gPCM INF+D7qPGŚwD!?=A)KlNPE,tFF^ՁLQWd!tmhy CҖ!qJ{, ڬ'JC3h4jVwҺ A}Kǝ3ë hO*)E.!w%1W$sZ705;a$Tr3hݣ vǜ8cSUZJ/SRhwx7~]vyޤH,SnA}r}\*Lv}&߾Zv2j4 eFf6gx[>&}ee2W1R\#D`w~Hh|):!GIxhH T&5ty 䧈iϗ=, >˥7ifk(y̛{^(h0:o5R2Tơ/[YPIM ea3ܽ mf s]zˈB]O\3,"ɇj ]U [f/5E^ܜQvVjzK֟5-GSJqv÷`ro ꢧ |:F$e[Ya[3lřMg1 җrzf _nYcWhrߐ-7^]MUAgSF*r 6z"fUMXIA깝meE3sZl7`tEas9cyb1b;σHwZ 5YW7lج< >P nۜU9QaY|qC eZAiO⫩J\T-M}`U]FsݭY08.T1L8 i;N7>pa@.Q!՝:ȋ݆y`ڂȿ=uٳclD{ɀ~6w+I;%*h4U9lǶޙ4ť0=AgM01IE$'U."v21&3\6&-q$qlq}[4XswV?97Yݙg )KVˌ7Qf%dUI 2t+o+j%ˎm+. Rs|t.&PHA|&((e}8Y ⵢ [Ioom?-zxOߓ,E&;av%2D)[X<<Ȫbn^B˳ e]5Kw+{*?4e@.MD3,h1J[Zi91UNSjWؘαwWƘLK,]y\/g$wyCo{ lRvx9M/~KZvsXUZl 5̚P\ dHĢ-W̽R[V7ꜻT ھ5]jGNl"|8SF>k" ^KxHojzټ3@9n3iR;hIZbb.fNBmB20 \1]˭YY?X$-`]q!7Ts2}eppM=#.B[# SeuM?*Mw)Z*h;PC]} JH_沵lalEћBYmᤀ6\.$%!>M}]]¼."חSmAj:j<9Fk8C\'`Z  J>CZ `DucCNM:mĘRC8v%}ܳgd಺6vdHU:TX Ye=:QjQkk$?_v3g_ SŮ(♄ɇʜ1nMchR!%9ء )<-Vn8*nK!Q?;i:+j.iJ,V^<.q&ۦ<*dj æqQP!pQ!\y֥6zBT6Ї#[jt%$HNU?/=`R06/ hjIw7Yk"y_rr티X݌Ynz-]?'0+[nS{,e`a/3~.­,kH2(( }LTJrd(73nj?mK2ɼL|]OqC*'"{3G) 3^(uG[+ b@]+a}ڧ,p4p6Ŗ<8oZRԔTJ.:8+hR._ ~mKG 4,]N4$o\- ܴkܸgMkKhݷɋR#ZV{ >~$yЫgp!xO5s~?=tvz O$kR{&sf>-2<[!tvw-B;F}U#mF'G?msB g,wy:L9GaQUtO_:dXZP[K?1AQ(d7/\oa_co,?A3 9AR#݀r}\G]k 7th*JVh 7 i@?2Orc4$).x_`zM y<;Ë*5lQf\]Gr/{ۋN !3 JɬtG\#ab-臯B&ܤ6pWd,H rۧo S|Rax>s8/)Ml״uONwJNW<.% endstream endobj 210 0 obj << /Length1 1384 /Length2 6113 /Length3 0 /Length 7053 /Filter /FlateDecode >> stream xڍwT6" "0t Jw0 ] "HJI H"tw#~{y}k֚y׮gae㕳C@p4HP $ʪC;CB(.$)@ PuwQI1I$""fh8ϪpF >?t@قqh v0%8hWI~~OOO> p0 AA;ʀ&g5>|V@+G{ Q)p;詨Z_`<UOB0d- =h)<n vF!`3{t0,7 sEP0_;*s}Jp; FO^7u#<[05] 07w̵ >( @ qq ^{B~~wuEk@a|_ `h] ˾$ 0]Oav`GxD$*p{ ״(G?ki" 8ssK)?'Rvwv .0g?k⺣EFwT a^;m/74g@~[^bu~I;V?[*mvd&(" H7>K"" ^i z=u/_G[w$Zkp=oaC ^[1TcEhi'R|SsH4l_[JzNj‡hO[Ӄfe1:wysZz; t@,)jN{eXJr&Ԋ2&Ңe6m`F0̣?ƒ!͒U ~`FbOcϼbS>)3IhZ{hIjrU̞ƥ֢0EvF1{> od$y܌y뽭M Úm\qI2}+PkVaD}lE^)qz&B2'1#']3ʦ@+qX\K"L$_pNrf{|H},6|^ZQMTsiyMϒtT2ThEmURTV<ȥ A&h8 ߺu/$LWf/@CM |w[t35>ODh-u?(xjA4b&xbC8dscQt)n <97cnn\+,`="EL k~S@s5کl&hiBAԇd{N;3F Y|swF)j7UN[o$QÙx-x?i=>O)N9tx5^N)CXS\uBĎEɫ'eoq?Tǽ s0&.ƬcjjL C=9U ¦4oL#-ҝƲh]Wūń뺒@­7j".Zn+yk.p虍O@ /LD6oۯC:}r j 0?pJRru߮4Hv|DÍ{Us[%׊"Lɱgv.G~۟ƱVlhtaJMM6>/5&X\\K륤l~5׆A$qamP4GD74>1_:.jRGd򝈱@frMNI" G{a3og1Tm)Iv^]xM\Uy['IAKh^y-;5l8s)3eMc.oLNj'[{qA YRjnɇ"2_іУwb^)H"Gk< O>՚C^zH 4M(C4@J@aM6UWjJδk.~[%ߣGn<|(`֛ϓuI~f^8%jP2T-ꨢWO"s={aN,iJ?S)sHܮ}۹J,'SNY`xsw8rjX 7Őh@ӌa/ƶhb2~5D&MRHhZ E4~oa|t:IIA8aIQ_ƕzLXMQWb#ˌX pqq s;let;Hϸ,TM { &[48N%[ %>^GdCIJžBz|٦,ʼwi+^ lRyȌ|6cw" ڶwHQ3 %IZbGLuaKerJ"̓56^VnVÀkt}I2I.{"uQvJ,֨Ѹ:bQpQ1MAJv̎*-j)1UeWRG'(<6nK:ybW_TCҝBx֊G-@;[ :?,* #%/>dͱ__ ߺS^1CLVmŒ-v3{wK4E^;9\a5L5Q䥡t5|*O=/u^R̰NwΪ}P.Wa6lae:KZ;q֗$og//6?k$juG?⩹Tʨ |OR"ik(zvrCt*91j-y60:,1u䐊O5:A jCbF %Fki Y[XU$#[7Bzc?gn̅<ʺt`3o?aZe`,e K nMQLPx-^2/1EbҞ͒D/}ayxQ=]y2;IϬ: REt}^ki 6LkK;lAW,wGdib *17t=.q=/60oT%5}U$Ή [Z7"2?Ik Wc>V̄?\INSI9YVE d?􊆶1ӏ:L+ c1Eˏ cpC a6w!$ ݗ" {!4l䜾zX7C ٘I[GUf% 5š,$~)ےMĐlsfM~Uq|AO|X5;AL{c̈'e3EX&Lܨ@FĦҥSD[9Nah\;@ӒTb*IKM0gʕ4[A4A~Zssf68K~2-;Oo0 jUR 毮ߑ0+E)[3_ -6}2_sa=τE;~!CL<~E`H&ay%" {ä #藨*pڝw}_AB/kt5Y;8/8]hLF, hsUՂÌfd Y^~'?4u2* 35YJVWސH QV&YŒ!w6|%EvPN~sC;.<=xSo;ZJ69aH\is+o!q5{ǾPId=$is9ޡ?@_ayc*r= t:@lDݗj*=˹zؚGs,̊IOA/{[5Sk.$6r(9iHQ67c뇀2G38V 8R]5onTI?]]UJ ߄"U02]|G|Qmd"jB[(ÇUQfU7;<%>8S|S\NTjz)I.Yyӥк'˷v4R^bd*GQ(a?;)^P#U-ynȳ]U{P מtΛ2:Xʯ# ۨvz֒4bg/ֲ]Ďѻ/'ڏ+mxE+uw~# tdV!HZepŒI^EEnk꼯@9`5mW\v+l!su>.c7J B{R ަ'a";KeJZ"6EZ<%* .QBRzHlM,,)m:vnM4ۋ8xU6qV*}(nz]Gs&fC5czE?&-ڳ^Wet>-t*g;gwη %H]m,/-RM'^>r164EJH0PҮ ތ{ok`];'zJĻ1{),<2 ~kӊxgCbeR}H MM~9+\tJv<݋=8(cN!;ZkS5 o&%)cr4v\<19Q9y; N.tvv}YixƅVƃLv[B?4XN#x/t􅛆[ N燼X7d]r|B㓪s&u{Md]|N8*_rm9No_tZmл(g:2zn٣FpJ t-ɩN< 3=T}ӄdŸ?v:ѥ70| `5f+>Q43DzAA9pO.h!pը0u5O'snl5\~MNޓk6Jnlz=A]R-H]>8ѪBXpn89pC.;`/y(pq{#bbxU˘alwI!Bհg`q [;Q-鉒c`1Z;5X4U/\fKԴ; 'TiſЛ(/]G& h1ZclVRD@qYZHrgIǠ2qcud{2IYt =,O n`\NbC}nc2DŽV`>Ok|7&˂ T 7w*>rHP<by8CdQY7ħKzoNXYlj/ ցs{$6[sW_0EoRSMV$D3h ;;(92)6b"g)N\4ή> stream xڍvPk-i‹PQ*1  ЋA"RT4A M.H/G=9w2kgN MĔap 4 +)z&&$%I"H_fr>s8 F)/*lj,FݑX *@ @Q 'Fn|ho +G@*Dp  AzW A&h(W AE,EABS&<Xxa}3d|m`΀D@(7\;  .`G _(Ay#P  4tű^XQBnh\<@B;F7_A1kD_ip(8w6B{|:!P0_C]$PWw_= Ȁ@k I қz;̸ }].n?!ux,> ?qfݟ3n`q ~}~ F!ޯMK?SQA{bR $9Y4_mF١??{E!;>Z8 d@PCo EnH?g/X8zGzpXN({׈p@xa,[~ @ n_@ '-ᆣoTGAѰ_  ědI{&1 !Bcq!n<!kR/B1~/W?2ýPchPWǕb$3sQw;#e|tIkYz 'Ç؅fMi`;Tr?9ah6AIFWhlRɵI-\l)8i8uܼs؞h1Vf? bG*' V=SSY;ӥvWȖ32MbeJʺ _EP8EH;޳ J}֪So-[$ j5Wqz@pՑ[ T] OR=kxr :UTPimi2q4fY\.PԳU,T}LJ[PepvE$V>W`i]I[<]5.>]v"KY'`@Υu0mAyW>O_[Q G2a{egTQԐMGb.i!c ֠ضO!nx,2.Td5 lv}Eܲ)cG;ZF2Azg!!Z~MvǗq!Ւ;o5'((?!Qevm\/n&a rtmZj- 5L< O35_u|^d&&>Fs^eɍ؝D꾫)6!oYaEne=lf0ڄL N!aft3]o;|#oOI::ia"Ԏ`E7ʝU}~DtiqS"FM"ߠJI4LyJ4]A9ye}!ojf2fٸ,vq+ߺwqduSrإ LGP*^bKK_BiO\u| zVeE%^{,)r])uh%@4wFŮ$kȏJ=`Y#*zܧ|˱]5ڃ_9<֒^_·F1[5FizN3}!gL;{'sl|G,9so6B4_sb :_SIg)Ặ]j!`*RRc̱VmAڱJ!,"C_,;mCtEIW{PvQ~}qs*Hp"Եcs, :e[Ӂk/VwQU0ue{j83XT Sb[{ LlTLaA:R:v3k~ mʣY(sKT+t!r%?+ϳb7ua佛(fa)\ԡYk"_eVvYta~.y/Tǎt(z:Xڥݶ iv`O\K;c #E>?`w$mno< R7M,)+ i~j2'(SvW3$j}V$c&':H~B[rO١kH__GlFˬ4ԉ*6OXanKHNyyv{zyGc o qW+[ͧotaqE6a KG%~>{qGcWdo4G5KLjm}X s>YZisYky}36G]M]$EԔS GN7.wV'V۵6)od]fbx[a*`#('Cw#1@oTW$qa{(3q C,Qr;rll%;D|- Q~`IjT(GºG0;GjpTI*;KUr-q d^z;RR " 6tbH="%VpA=Ԅؾa]CxLlERe Us76ڱNUA'qqGYUfH3̖UW?}b;BsA& t9dVҏn\$~yoɭ0hA}D rZ 8hkBH%>gD.}{4$^ ?ގ3DE;}yLqTF}8ҠcSkzqXAoF\'ȿ*x"5P66~ Kl~rNM^L$(G_$-ߚ,Nѡ`jQH7|1NP (\FWmI?wAWo7T%"R؉U֛1*u˕o)W8t f-fo}Ϲf_`!dG}"5{/Z^Ƙc}Y}㬙m yXq֐b[!& qމ f$:V ϑ+l\7F.z;SAgoxjY4! *0KsD^;7KE%x%$ݪN^ఊT2ztz>3%|M O椤T񊎩Y*~ȹ}p+{jH#CW*FɝNQD6$I% >~ɜgX0Laf,Zlp!Jt(=d*%c1#2~El)KschO5d` pU`ZˠglFҞ>ŻK'kkhϻuY}nj9rrB)~.x,hM<^$Ի<CXv2#˶A#ڛg q2/-) ۮ "V J0xujYҦzAb̗z wiaMNUngcQ/KS| |# `d6b* ;|^WxW.q iv_$a =2'#i1@J Qx <}(:K($SJIrWHNÝ^9za~ClEavV½|._O2 9rxy<,6-y7i)0~kk֬T# Եx:qWЋ+b 2'4-~j|lYvEt}#{圹6(I]W3!|?O7~~F\o, Jt >5: ~Kt-yLӾ7u=Hu4M 3"}*;FfHf̼޽llpѥdjS(b٥K:[4$H|9RJ,* Z mӃ+34ȣ?\kv/,4yq-6ԱoDŽ1T~INl }fz?1ӷ>fe;r3:6)ӵzlgLjvGHM/kIxt)>F8{61<_ѝlf:ojAQUb)V֓f,v:e(j=6 `]}ҬFfs=兊z^_}p%Ӽf5{HMQ  fiyml##F-s^UDACK{{CǸW8u7H;6vI$eEИDLʏ}j 'U/Ꮬ8ubRBBiC>0Q*ݡu~rXsrsk~3J:62e& 4|Ls`zfbopWn͔Zһ !] yB)8ؑ(4MX0:H'nrewCհO_ Tgg:וּ5i;GWxFZ9:~poI\XJ'O};9.|wIJۧ:(YFt2reJ@8^Þwkڋu0RZ&ڵ| 4m$3ؓqn cg|@ww=U}VZ󚖣\rjRGf79S#~F"a7k^@fh"_W;? ԽXz`=(b!H#Ov/ r#XzS ;˷vFю_r۷5"z]YhVq>:%C&;,.T5*E;6(1MdV_UHޏp ᥅mx4 [0I)"ŕpg_Ug<,VvnE2~f:n 0% 6^x^;b^KH+*X_;&^ty_ijބQ[GQI s t?n@ Q'7ry #%!x&#`9 (a,|T2 y3("I#Q?u endstream endobj 214 0 obj << /Length1 1482 /Length2 6699 /Length3 0 /Length 7707 /Filter /FlateDecode >> stream xڍx4־ ZtD{'0f0F-"DoBA{}Ykw}>gf ;-3!  P 򷝀⎄"Ppؠ6E=`!@HTBHLEO@KC Ww# ߏ.07@H\\;@Z6(G zG `C!(rD\%l\w|/(AB=!v_%m\ J `:B{;6`vAjW/_> +_6`0;0@GYS~m`H E~nPؠ+SuE!PدANSCs\g8  UQSAms"@qQQ! ; mFpأˀ@!?'r' Fl!P8C@_=Yf|MbA}MC?% Gx@(@LL86?y+]9 pn?ci#ʅ-@ &oE_){`qnaBO= @]-Q5 zhE E*C!vP/e75o0(@B0h/ 0ѷ-=CW F6aQO=vb ( ]cNB<m6`g6G"D 4Dn@ 1ӿh mG`ww4V׿&A%Ü^]{o,tD'F8f9jfL[U eΕGL\z?~P]?/~dsˈ^#;Lc$66L1 mRtՁ|$ pӣ:v1Ɠgz]a>Ɵ˷~Y3}n_oPZ*:KPr?-eR$șByZ"+mKϩ¾֤~GB'ÍucD4Mю|5lvg X~6cFk QZvn1I(8ͅu\vE4A0&!{Ri :v ]5,m{|^B+MS[M#lٻvި} 3QEj":u[;T$Ɋύ&H f 5712$傦H)_}|):\:I:A-Eڵ;zo[&ں YjwtY& ' UiqaF*}{@Nd3"<po$Xh|*5g{CVC謇EK-z/8DOO]gAS>rڃ'&n!Z8QfKO"  Mu4׬T5#T'ipvy".~h33g+g5'LaH]˄1+P=$wzŤgj,7Fpa()^ cFڏj3dzVGR-Ӻ]W01OYj]!d Ilv(-p}KG$2Y;%Pl$;q8~ aяd}''~dR~YYiC;3? '>K5V^Z8Ci҈#M]);cH.[}E(=]!X # 7s[S!lo8b7N- 9 &Zrgn !:\yy0?^BnZ vaaM 'r%*/MP _2\ëJkc 8/ ͟J}ʐ %uUu,O} .8tdG~>`4ϮhQo4>iSmq%3Gl*d:&Dyv[o׉',tY\&ҟ7,{ٷ9$LCOՠ*I80Hq8x)WEA=؋e6}D4nX_w˛fJ涊8_lt77羅[&t ~tIPX|xa qweLjӓ(S>z2>I,gzz+YowVꌑj5u ɎU>dU ,#:ϳh*NM߬Zo6R&aOorw=j_ gS-@ W'MOZm!b]fϣ0h[L}I]ch:_|U~vIn=m; Q;zU`a*d ׍'ؗt`x9aP+Kƍ箃+{eѾ'z;8f4Xu+vPM:I:jɾ%{u0Ja)PIKRofR#~xlشSѾSA>P믄=j90ECGXF]~8Sjܬ}¿'$xA/ˣ$r/.k">B!52x D m?GGz5>ŹYRD=ޭ%4~r….fȂkubk+7P@u׮xA\\d2ih+_ 1J4 ++c>VÁ*Wݢ$ڔmMѨn3-+|:^`O݋5OWxOCHk2OeٷڥLCw)QN$x(O5ķ͇m<#K#q=6N~H|r=5<;ݘ ƍN?rMd%.h.o[*BˮK$RY]2ៃ~终qخQ̎np夿Ml6Ln2[k)S|F #\_ [iJa2oӄɇ s ۂeCt~JK +БX79d}@=Q/[S|cu#7*]գg2>}v$TB$MBPvXa3=JvcGC$]Kpc"^|y7cЛ/zv{Qyҧ֟ jQvzӇ 4N}SF8֡< N zkB}gBGp ].پDvm5O/wI|QܰN+n]<{z:鶔EM*NqY{@I!&J]L5iE$7I`Ayx]HNV4Ge[^W-9b,շIi/rx2 45y[Mdl@EcNױvyڠNTޑ!Ҥ=&Tzje-oe%uζOl8$!j ;ڜ <@Iw=Wv:O5Lr@2 qZ%Lh%y2'f6]&Ϝ]jJ &)bXIufd*4Yz4UH}WL{ꡏtuZVKvT/{m$`1CWRǓ8&7ܬu? һ=ۇ.)<]Л ҲNUNHEn/z#-Vf+X.Eu> < B$+~Q,jgsc] a~ȥê;RaȌX'iT*eThyn,s9QJCזD_ _s,F-z0Mhu\b_WwPg"} |&TE1G%LrX+xKbP+sF(>FC$vyVQw& llT4+{Fk)'AW \͔nyʃy:yeDJ8`⧦ͺjʛ2ݨԹD#QpyJ&? 1L9C_0PPvK^xsZ@H#fݣ>4MU=^˲}kqL0NWҼxb;:Oڧf8fg^W,,wĔe4ctIWXs:<=?K)O}䑿 bYV#޹ɷ\[ `dZ |WU ʓ{?3Yptq"jujGXjb$t]Qc>[E^p]#[ĮM*i ~L,h6seL9uV6hP@:~li)p(g-rz8C?`N9㘏oFNY=s\N)_'A9w{d߱N#qp  G~G X4oj7*$.tDuüzƣ1,K!VˍnZ{>.IWVA{@ rZah7x-_]kARL25Qjt+,Ag.wq+ >4yZxD1\i)6ְu#$?/?Vgp,C 1*FtNq˕8a>1G(Oi ;$*G>Vw_ڱT|a1)u&jZSQIm}}qPNX!L$r ϗ:9 ·< |l6-k{,yX46DHܞ5Wo_mGQ$Uo~i6Z/U~_X9;ly4<~v#_X39=)Y.~{^XNJ{\3CT.s^/ީxjەUk^l,W6SgC;ѮeZodqd!]Aihw[K]4 Jd w5GǜtxwkKe~޴{MwzTc#w=$zb.>a}} &lrJio b,\v\}ST<,&ŮNy &`c̼DȤ'IV]aנjun\׼]mqe5ͽډ Jlv\-oxp|QP,B騜ʙX)wCnFs"iTT!<)E}!h#ζ߇Ya!)O&-I9vjmUDƎL&3àEmԌREՏ*B!G-d*1B9q,aN<iNq^?_V$DդFJ }""Oz@1=#jj}MuE8{juHE1 _*}/=!nʼ!e~JꔨwUrFYX".;]0}!Iz'"jlkhtz]Ѕ%zpqC,I,si6Cmx3 v9)*p~@Xvr3N&_UK_#Qa^YٌV;=z?qSԑrbI_.!"Tq"98jh8> stream xڍuTݶ-AzWޑBIPHBH&i"EQ"{rιyoFH\s_ M 4 ', UM,e`8 ps"qΈa9EQr A@qQ@wg8PTJNTZ 1r@5u(v pmEee~]$ Cq03 C"pSp\DD<==AP,Wz"q@c@ށ LpM?qAg$ +Qph4pE( 7_DHb( vq({4pB@( uƢP(9l;A ,׈"h𧬎]\(?5$ȟuB=QvHpwW3G`Y)) Y 97vEN 'uEC v @qwNs‘0FY/Bx>~ F9{~Et5̬L +, JJEEe$Ҳ@BVeLO;hj@, D_,/wCο|Gt 7>oC-L#];⍠NjYXTGb5^!s#?q_VsFh,׻_W/w ?UG_>B17}E#~+(Bq ~Fub@wgχOAs`&Zv4ᅀ'0PWG,ޑ~`)|w9CsM>@ ?!/g8-v{M8~X:5jz b0V첕Xp@Ş‚{ݺFcҚ*Is76>'A42{/@etvVH2g$2?ҩHLN`z3G6YA.?|QNi?~5kp)Fy=2x2WKM */׼;/agXW"Y`WSq=)e%mxm\j6ǪA&kV;{^%)z n.0ؕN7רΓ~68bIIu(CKg5fѐĞZߊmu|W wrG{dɋT;m' 39u5Ƨbm=،E܋Xw<J1ńVI:;i [#TH|z\x| px-ƳTM ֭ !BX&?]ՁتWYÿnޚ  ߇qf㦏 h^BܷP/rP;#:YD<|?\I .춷b`5[W?~p ,Zֺyv~sh0!&:=D'bnfS63Cm=/+-]2$| # %$1RHKȂ7UZ#ΦNݾSE~q x, $e:vNK fBxU<- emlRe&sպRod%fdH0)'3l.sVq`溣$-Y%YJ=/ IxƢ_.cijx?bp/yj8M @O v!L)!M =hsu>RW)x.mdkׯwVyD9FǾOu=̡)~^Z_L*i]@1 y bd0(Y7KaZ}<X91cWfQʩ:ݽLe-G6SXT Qx̷P/D-RCm4֖.ۖƷ_x7ek%9?tgL,ܯ}!"dy9" l (cʸW ˾6v*(g\r(/jR{gME HC;u4C(b]fGN5~KF=5+Y$"l)[VGbo㞵z?Z3 m3)uőԍH;Z@COϞ-,Ft-So/%yZF%]Ř\;0 i)=n/&2|aOZfCx1T+Q&EV@/'x^9La^wi "R(/ y(m>0>ޝuHb(jpf-e|Bǫjé*g4\=S3;j gAVtd E3rGեIq6xv7?<:ƲQt˘ "OỸjEUer3m/<,ļa"hJi\G0gQ ʬGvmjJG4?d-qEFCѪ ~!ێ-.b2#{Es=uPWt&Va^¤½ iҡw[R ݌:qjwI<El})nد0.r [Ϋ dNtZC^'{]a*]DdeK!]auTڄԧ1u߽Į 7I%[|ѓ}OMyW TO2Y7I93 2䥽Σhi|nqV^ΒcD@d=aC΢­O>?Dn #ywkdXkp`lN;%†`گG̾1m閵fOSJ??2^>xGY#ÜpآSޝ]U9\a7vZ\s0'>[6-?xk咉bTB~Mjď8 O.oi=/;+0=ɿ8=<ϊy5@{>oVzh(Ho@b`bӐeE2 rډWjҹcuyva\'^ },~l0PmGAOL'_ln(T-1# &}DdQKB5-oEK-ky t!ߢ$ꮓ[yZoIA,)] H)-e%扑ƾ´c0C' 5tIXBQF9*>\z/5͢SP}g/+M6 QKu8T1=xyQsG/0g*EeF˩5VhMfV?QST}![Q>pj֘p>$>4x89CnWᵟ rF}~3 B+s(u"sԵ{ksDaP6j5ݥoj^"Rs؝s/Y^BckpcaKKޫ 1YSҀ=MK๔qN&P4E06%X1!駪mœ=?Su4dէS?%,> KX޾4kJqH870'+')g_G(-񦚯 ,M>F2(v,?2 ^`Nk,Y}\cVB9^h:c hM̖&;JP޸Uye>-op q,?@XD >WuS tpK; M  ȁ(flc}5"YpGgc6I4jxh"k7t 3My|XV7lWix\6:XCK>ڬHJ2M~/ُc B1A#,EƙJ*w #|C$Z8]!߹%emT}J2GWv.e/P@*KwKXڎ/S޻pw6i#R\̏k4hB $vzqY5ߦꜼݘ9\lF'[D6lԳ%."9}")W:N۶c޴usH+} (V>چ햋Q~ {wy !8X3*/ZبU]N- :Ϸcy}UdZ0,'$BlDOK͔CZr< ו\AOl4OGǤJ8}B}*;Z Ne1(ၥ'~6Jm0ۙmc5C31XCZiQTX] UНARMOؼJ? MzeQѠR5RWZλ&!Ăa3 ZD錤`b乨 ~k6{z~ endstream endobj 218 0 obj << /Length1 2394 /Length2 19379 /Length3 0 /Length 20777 /Filter /FlateDecode >> stream xڌP\qwww'xphi%h.!w|rNr6ִiJRf&@){#+ @\Q]†@InG@ tvrBh zI rVv++7 ?| c7+3"@@)lea z#Ɣ;@lejlP4YMmL A#` 9133۹098[2ܭ@5 h+eԘ(V.(;܍7) xcU(;1VǀoqL _v665us4[R L /Cc[7c7c+[c7n Ueo~.V &+ۿrd+[% 'a 4}'͵wp273+ 3WGf {+'WĿ6o"2 :{:V%~`b]*!̬LA=ob?V,o `' 3smw%e5uMJ117#;'~{8*V_Y{s?} 6@Acd1}yv7E{")W[ۿ4l=x\W(:5@3+WmD3r0p#rXL-훭=P͋ޖqyͿU_^I{S `l7 f}J3 `fwr;8#X.N_Y70F<f߈mYҿY7b0Ff]7zcW7v]Fo7v]㿈mk&5޲6q66EAU-[#Kbgm43mkl[I÷VQV2KOGKo?h|V?Nv_1ꯣ9ߎe?`WxY9Q6 ]޽v/hfb?4Ŭo* t.v-?Yߊ|Gc |-U\(o}6ʁ@))u]HQwI6+8I<} qK% #fmluh>vhsmi #W=.]#v{3 a+YZi*SXc&$hX\v$ѬjZٹNY _IDRcl[6 寲>—7RJ>&]Ҙ&ϖݙ؉UhڀHH ;ۀaBeO%Q5j9EȋB\S'ҼVyXi̭G`'xC}f Zcц 9Hn dƐRKKp-}Am"xT)e:F>+.3Vϭۄc!^OVgZiD+|b LBE*S#ǸzNׅwՕ׻]S$_YՓQ) g|\V(| 좢ܵtlկlj k|BQ֜bvb߿ Yxx'0oLtlR=]3ܕ_t0hx,4ntZ1.G*P//EL$C8!`ӽe7QSSp63` ,eAؾhDmL}Q;Tc%O@Oqs(U2S~JUQ,F%v7Nο#d>n-R kŊW3:}sŇ)Y$hIC" U7%begT89v)Q#ܸo$̘ *s,.n#)ד짴h19]eש0+/4OׇJ.w&|:xh/ۚ_0>HM,ta)_^x2v f4Ő>yշ$Ļf`No^qa1-?dY'Y4[;g n«zoH>b~g&+s-ˆ~/})4,٥.{ >d_}:Y٩/B9T\?w\ۋu,rҌ=H`tpyN:.u=gSS5~8fc?: ڏ HМ#}? _S|/DBv0FL ܿ3W %ϲuYn0l")Vfܘ*8 K|ܫD`E^e;փdobjd Yf58Z/*VͽUi*cu;K2@7_5lJvcA6e% GKMPW^§ O4ylpѮ'JTSY>tfΈ*k 7yG[ޥk=R=650?eLCGhѽ>8S.9}Җ'pUT Ʌ^@; +-߅WCt}2mqVG"q:Ĵwlӯ.Š s0c+AWk:}l.t)+wi*Q"< xi.H٠ D!4 \9M2[ňS^kofC7фN:鹭P g͘h/blܦNeh?pKPp+2-sce,eϝVYCĞڃ+ hs \,I3D13Q8BW˭~}jpMc{q/N'`R{3WU+j&Wfa艓(YWkKQOe}[{ҽMĺEpuP!E$ܽO[ LԪ6?\Ѩ衽IʯƊ}G'&&XlN?*UBzb*.:0GQ#UiO6+-ʊth:$BIIF=aãm{ _jx)Ȍ@|~ 9$h@6vwo-f?ng rit>1x}+d%M)mRE:H2Vsf-]v~zND< ԴfR=!8B$_/=0#XN,S]D{:OW*Fl>dShA|[/zy`FԓuH~@Y6Ën=qxFss2?4^k9wa6O{gp4ğ8n⢖?)Qi8_hF7n;'ܧ.my^l.Х/M=|B -Tگqs#Eky+q "/esxO{ ϖl`Ozo lMήwe(pRo8P70d ApZZ3Ot&OJ[# Ts5ߛɳVÙ}ŋٲƴIEӎ lGDVwبU W 쪃37nww! R-D-.Ux+%6r|344gQcT z?4:+iEOC+L@ga aS3_1$B4jC.bqVʮgXIͦibLPląаP sURf <2I,t|3Wrz?xxYr뇰wճw,D68 ;K! by60C*>m x6{>7x<8[6La}Qs'=ARKj/E`~/'@UUwmb<"ԏ w2}Ǐ-Samɠ/n}tGj?#yckdѬzׅFrI'È8ɍ@|a%k/W3u'6=QumvJ=lt*Y*3/s08e ޑszr|ՈAסLڗ݋o IJ^:BΰhAGwb^WB=5us g*N^alUjћ`NWE<{ 9'\JG<2q嵍 ]A4MOKtwu E?Pcao.cl)ͼFNFK< j9e* (&ʴrI#?DZC7ĭBDknKN~gӓ\*ӎ1oךVKXh8m,=DNZvUJgj[X'rCޚ,д N =L/VbsHC= SdRTёޤU%rWmO괗cepI2YQ\*pxL5}L|H5x-w1҂G{AzYNw}wudCH7bp{V1Z8.2æ`u5('rF]}+\u2n}V딶3΂[D|:2 6QHBW-A Xe,~ŮLj4ۉ*(l^mB>((zU&vCQh[R+C:!y31pZhb~މ( :R;G̬pPler(ҏ-eҳ›X紹Y H!b6p\tb}xǃz1hN*v]x/xM+LM.w)  uGg]3J| -UYXjK)܁!-?I,8Hf8l{ }dMB,'$"9?3d׈2ഋ̓k)5Y$3j~ZI.R Gi˹UֻI0|I$|^ c@7IMBX^\ &c ~W*8:I5x&d5寖_Zω?Rul@"L}0DF>/AlH`5㦥}Ux䔴2=|v2xMmvI(S4skq fvrхPdf:M+I`X"9pI9iJJNU$HvΙ˽5oq%aRu!Umf evf& >fHK6I|np';ęq05w YjIJVB62r$z >gVÁzzE1 5Gѣ6jkT7X ʁ ͙au}+}i{xH TL/!^pOnb[RdYg 6Q !'&(v8bZ*F5 >r,e]D|j'? f?6%꿰b@~B?vjE}+0NL CXcp"]ϹgUDgE6,;i/~jFJU j2:mxB^+l=BUZmAP9SNS'mFtlLqcW !^2fj8E_C\D7ZEyA W[%C9C3Oa+a0.iJQі78f`]#*{99?5b;RIUS@,a!\fRc#Ǔ07:A֛أ!ݥ/;N'0 /xW!*HuC@q0.:h  ݙKK..zpmSy\`, =ڷ^E,H;JtM( :ǘ4+n>0>I &*7)9a´AjUVG?j,PZ$}8fP/=vZd>-[a<OI{<ւ:|MR$&ҚD:ԙu<Փ'] YsHzZ_O֗T&* !ԙsv?=`##nާa8}(GeN!{3#SMI/D}Pŋ|W9Tt6$?$DZq3#dJuA)l6T~K}`3>$% 8f雥9Rg-up*{xtFA)Olz0_UjŤ2c> #@x작UӒvڞ`h H,c#M.8:i-ߑV,> 9$h-* c04T\ _IBGG&eX=C6oV6 5:LJ3>A$`c@iy߫靀KB]yl <\_ }j =xFV\ C8w[֟=j$M(]8.5EliMIZ19}2cWZʁguB%5D} k:/ѱC{z*A hJ3+l\0dETn|Hoyy05 Z~pKr&rr52?ZrRpVG Uaա<aј2P;n'lne6hչ Ia2U| %9wB1+0M6jl}uMGvGɕ~1[Mê! a*&~3jv$(E1 hUT>܈ aϧR)(&(EJ;OpӁ֡=",_;ie-Za/U \^sL)s[/ahfp"qB+->Hq7wbTzPR3T).Ҙ?e7>oKӪѝWEHÎvxz&'i|r~J? MՌҴ>}r[pc/#OEAOHhe'˔3D>:vM ѩ+W˃mҗsGsffbrbN9QE@xwA1{ΨDҵwǩ7I޿a7CY3iVsAy|)L3Lͦ-VOjHZ= L|U^#d> llWE9C'MC2֒`(U岪<˪Br5o'NSpIH&5_O&eg Z~>jqyMMV]NJ.xl"-N2LIGyJ Nՠ,xBv?b8h=J<35WKQؒN DY^b8zPy՜ 〾7f=v=¸EO-jԅ>OE4U ,} t'd<܍1y ډl6%1w: |HQC3Hrc BSPd=>mi XRP Ia0mY%M#"C~Ի 7؊W} iA#KY=蓃5 %=~|hTgE`LK -n6PU+*R,UrΤ,BR}{ֿbQ8tYH)5oF4>Q8;2fZwVƸ!m/|_}ٳ1z@M0Y@?=ճ>ʾN+sqboJb~s  .eVa)Wt6/IO*nE2uD_9k$(DFE<:5ʒx l4t-;70= *JƨLXk(~a (ϒBȴH=@k&LQI" Kaf*O~jp:91Ęte1EkJ71ª Oƈ}b6O)!&0n(p0K4$2T 2fqv˙rsrcƶ_eLizβ%u6zJGzL .94BRC`Lmme Q5L9$y}Woy_X#g[ZeCbD%/M y"JA?.2ӵz4-K ѭϑ! ^~r1. 4\dpAA"Yj qwK2˵y6Xe.rt9YNjzr?J #=DYqdFhSo͔DI*:XSjW}9w"T;Y_j:ܭ="+qY׸!Vp28˧:A)~WB$*N 98U7яʋcVqu Y~d27/3 a'dY|RsSB@C#3vdVvٝ3ت`c#ywXfдYRB; zjί̥B'rb+ʒ ߿H~ dϙJe)d` 98TؠZu2XoDM=8s^ыfr&^8"*{nܦ$ %͜$nH@}5;ֶfu${X{3%+)gh)_ˉO=0|3_SP}b/?l.q򾍵A.9$Gfm9 ڎ*D>N0GvDGajpGW4 TַjnS9- "O7YHc곅sƿ$v Z"P1Y*(9(u#4&wTBhk|OOz3kGPQP)!~nXxčM[ 'a5,CVPSβͰdkdk*U5Ҥ[w\. ePz礡wF~8FeȑIH,hOkoqS_Y32uKgkm񶤊:DJ[Z&DcҹcGvHvRzȼ*s{-D*yHk=;$YSP)vLV6Br3c1t65`K @HlMCC Pn3< ! 3!pم*E140 qlFMQn("+.Dw@"P==|=p[EDק/lԎOЅDwŒjlY`kҎ#tYQ9@<3!vLw uCѩ3sC.8 :艠> HcZ@"Z-+i`6@ฯCNӹXK|fp ҁX#ZB֕.$rOqY6jvLJx=c +_i_]V_(Z 6zhaw."c&y^~=6_1b%Q{%wI"QTI ^ѯs)1IM Uda}vfv>.rK_y4EYdTWޝin\H)3za, <1z_m ɦ¨[mk}M*J79WX ObPuML/fj?I!}mPj] |7q)$/EES խ|15^S5uZj'#z~Ԁ4lƔztt~6pFJ6EI߷!i:捕>_(牒7/}7j;>OsZ[> |mS~6nqIOB4&B,{'^T HC)~ϮJqЇBBJڙc> ̝arH5'YULPe&Qr'1:M]BDoQmvA:(h D=wlI3KhuVu0{6_#^ND/>^dc{C j9F;c]{scYQ2+ yPd0zm`T;T_EOH 8DZ6+DnvmO\!yHI.A}­cNBY2=Yyinn5iU|=T$60N{M9:}>w3-JG}p4ОwJ&s1ީ=B>|~0 , 7"']ksUfM[)-n};Q]:O`7,x](wsi(.X^ښ B ݁>B%t "Ƭ v{CБ8c)Ôy~- U43VS׈A7޸D*4W&?vƖ_* ?ÊjV'AAJ2 h/5:W}Mn&OKEXWU/W2tњFc>2G;h5 ֪/QG2j_br D?I>l0ab]h2C_5m:򽤯:@tDp$'-ra%Q}ꈶ?~6Gac A#5I浻.\W)o*SdlIo1o|`rc\޻: ֝X_tJB@Z3">H N]Kp|Gd'&c41YTҕX hq!^o=3FڶBOHS=Fa͇&JFځ3 J42A;uW?|/#^Ob޷GF|y@ω޴t;B_+'cb̺TTkpXHE=*@դc5,|FX w/3Lh9ۨ(/1߯9Ti|fD }1w=xИX5 QuȻgoC \XZ~e/f"Og~d,O9[U<'‰#ॠv >*0QRML3\uL/LDA4VU@wմYՒ"1q\ˋ.Ob;7:E.j] kqU ߬gp^[$FO}K5fnwHݹ;$:]KdVhCp>qAm,hk x.>H_+>ցK`7 (5+U!:eO`,Os?X_=U[py_L%=sPpЮ|?,~ZHw)OVhT`gC#7& QG&~,6[nWkO!^k_Կ-`OZs? 0fߘysVGPrn[40$N$}E&؞ĭ$I 6&o5-Xlxc3=.'\0Ŧ2{BD0؀K?prk,܎Oe+["ZְMk 'rr@L(h%9M&}H,֮:Rޞy/NlI,Đ;6A1&~g ISګ~D PjTYʞN>GU-yN aǍW^Bد/H´k18YL>^G 3Z'Ne;se|O^4jҴO#|CW '7׫Ͽ,O xK_Ձr 'CC$-c }FrR{<[Fxֹ{?+ Vq{h8'm͢ER:8?)v)9hx&f.*۳C_2&Xtp$M6X/iS IT(̈́v̂sW|ENacxdAժj0kOT֨@uo'%e8 'gb1L Vq]\|Ya'q> .M*^b`ӱa'vzחm4)}ĦOuQz'v\췞=o߂=oc%XrA*mWy\){?r׫%sR f6C-/;{W 4vDÞ,|xƶQ{II2_R\5 @6$6 M_[Hz"!8SDʕx"2Jv&ٝaJ珅çm3uԖܱk_Z6䀰0D·GxhQw,kU HY h3\D><-]cWɎ'y=7^C-%N8h\0FGN%KSp@<%k.g&sXaJYWOꑷI ' )mDTZh1\hU,^ #rXB}|JȰɭ_\L9r~\)zCa~t⨏k]Mьx ɦ?J [; 8+j*Uے¡ ~>XGgh+=KyZ~KbZkTLv^U[KԛUx;^nAq|}F 1ZE ý.ߺDV_"#xn1ERMi+8.tv5yoDTHn:)1տ KʹaΒZO<x->֑D2D5t/M +RyHNE.Kf7fZ nYΡM@H6, F-N%gJf_ _TYTV2UFRFjP^ DqL"Άp$dA!#g. K80̘SvZ+6ħ79v^'($i-TW΢ .$`$0ڽ>~ڭ kkugՀ+ǟhӆ)#'a2*CN}j[7I;6 ],T|0=O*4QmzIipd kU,(w;4fFQpN+pMkʆaZ:fˊ ^/g6[{YQbx蓄LHW-IKXT8 ?#$9nlQ6z]HXj/QҨݗt#@`tpXi1 G{{X:XVqſ$1Zij>*ff0%+El\ybˀ5%vCW\7ө\)·dK 3}tD?\*޻#|F9]7MV%K/MK`P.j=\*?UMrviu7hAeŋWFdk~CiA?_,- "y^0 KRi2Z!c=GطWk)'riUN:Ӳ)?#/Uz6P7mߐyP>L .u)22ҽ{2WB%`7(0EzMfL9&$Tq<5`~L`e|:݇VǐӨ3NS⺘PfLD?ص\P H*{pྎru@|~ޙ<pOl/Duh y`hp"R82'@U1#ZWs 0j5eԱ-A.gžǻ3x[\F@YH,$dV[8E\d{%gۃMNV7|ae~ǫZKHʇaFwKIu_P>Xk;Ẅ"LSS]<C懡F0A\g[; W o 5k':c;HWf̖EC87%Ʉ. 9s7CĿuha 7/cBd8fNlv? 7+%˃oCEhGma +(S4|v0sU!>9Y<&5 cO,כ\$% }vWk@T@ٽ[Y:'Ua$C\Ьr p1B7| З5۲s!+.=Cf8(Wm>5!%yf^,o0*Χ]Ȉ?mEOjK".`)amILqL _{ڙk<[Pȥ3b"OMCJu9'\KnJ=M!. C?#oS>P뤨};L)^%8A2$bYI  &yZPq]5.)١nCEn d<gjNŬ endstream endobj 220 0 obj << /Length1 1443 /Length2 7093 /Length3 0 /Length 8071 /Filter /FlateDecode >> stream xڍvTֶHw3tǐ0tw C%HtHJR *"J"|}}k֚9{g9sp (:"j8Z((, P1 spпP$ K@ o|*` Nhz4PRZX ",,/ ) P:MPFx#a.mpCx@))IE(:` fG`huA=|}}(AY C ((50@3 >7B8}H(@ᨛ o# `yB_ٿ ࿓ N0w(@OM[Ꮏ`w&n; A<(A׈Bܜ*QQS!csnp/^w~4L L( *RɛE?a!w.Hձ_K<Eܰ /S U#7;;0w7F@q#C͠Duy{wA|Cf? :?7%5w@~-7Y@wz# LD\F"77}c7tf2@H@ߤnf 8!UJ m@?L @ y)B)B6!Qo"ݴ/A! LkCdy"愈a1ن*ϖAőKs_'"R~fN%fXjG)2_P"zz,ETZ }fy6se9[ո|j$Ks(fdbNszٹn;Pab EJ~ ؇LBOtZSY~UIǝa1#VCDA';!I}{ :톄ul;+,F)q1Qy=1ѕsi,#VPRl+5;ai#qx|EM+&ZE{:S gly4r^5 EONUelVzhki͑AȆ| n'4h(w/-&)ŴxC^Vf\ҥ5_ ;zNq/Xjc]wE iί;}'8`85~(bxYjNO.O1~$HӢYWG BϙOtbL42ӊaҲáƤ7!kR*ܭ.'^=jzƃɽhtȩ wnZw5r U(2i z8>9F1\dŮSoc+IӄVrh#A2~4I}k.[Oz!^̜q uq /;$sz o-C)=O;ULRoă gp#Sql4+Q!k9ULR3mOeDŽEO寛Vz&>zepb]0lĚidK\}Q0Z Jz(.ㅝXUy"Lnؖ1qp& V] D#oo6Q? ~0gThz/J&/%` 3I,qe3ɵEQ=uK@*iư_z[$#<(lA-_C#'KR.YmX\HoxN2RM^k|S\g^3V|Q }W`OfzZE63&/6YAv'1QD솶cV~S-pRH⌟yijV:ĆyOz{oq0I4 | giiKn2Sj쿭=Bڨjq&+}2;B.7\@=Z3cS[dmLN2P])S0&8'fקLa'PZ*QJFKe9fN%oOmvExpsp;bx*sʋ{)"%)jXJߐ)= XSiO-*lRqI4&ZfZ) h jOckR&Q|j;PE+OJ bՠ\mzM՗Xph@!DFmwo}=ZF}oRLO#/hB/f}m {c*<_ĵ=i=^{UշŖ3Ǥõ}4_i@MbQ,SѾ5+eO5m@TjNQ4[+f>."7Iְ2 xhGCVw9un U% Jѥy^_q'ATJ5]^[K55pF5  ݝO%kzl4)b6fq}ۢ.A׬Bnh)}^.< "PaO_,9Lϵt |T9Cxz& 0^1`']ʿ3܄e\jwL6NL gvtNx}]07XG5ZuH@ZK4"0(A9m]s( S_sp͐a>W4le!2d1ilw+~<8a |gǟJ$rlSJ [+MC=#Cx4W?&v_i^9ΡqԩU%=5$Đ0K-K@]\fE.'ek%Ag Ÿ t̤YANwZһ7}M4)WƋdv/D@zWظZV:nkZ 5M,(f0!j+^S,'u_:V{?^eIm<89A/\QAfj[䩉!Di ՙbs.>ʋ'R."!Smā"3 -l^_'Jb^ ynݏ(/EDуղ`{>k$⛜aӋjSZ"l2Y:ӄsIf`N m˦ u7{i@<4K%:VP0K[ųomRͧ؟dgeuoB&#>.K՝lAIM"//M;y{?ButWYﺶ^{:f7F`AzuT)ͽp:P:µH-P#Q-AFjf`րy* ܎1wtͶ& u2(ft!8R Zu_Lj֠n2-D4oHNM:'6m&D|"jؒڭ){6ijA+l?""k4i2YȯX oCJVWTZxHy'A1ζ뫳\;6u/kgl߲4fϓ2ZTA<~AKm[3Srwc(#s@*$1_[n'[v"ٰ"@F.5;Sy%~n@bĭԟeb%]WMAI:! w-+]y{om6Tj<q}."_K4Fqd[w$Qp\'^qv xڪRn2q !_/ Mń=q*e~*4Z@a܇oV>r}?C [UlXiؼoGSp(v}eqs*z=*E ]dHz4 EJp33vÂ3Зm | Nʘg:-0ex9hAf؎lḟ3-xe#~}F2iLv'Eú5>(py#δdESߞӑ;&6,sg7|{̰{CͶKȐ1)R&yFwZ2p}1~=MRru+ Vy]8liL;]yiӂBtdm &(xL4Lů3unɩldzݿ{;Gwʒ92mnؿ?BcVT_f4\ ,w>yۑDk'AG 3w1Y%Jy±B,D.sHZA#ih:q[1r*5`Z/3 + 7wT9\xN:q9%;m6\]=e6g1ave | qm#"Am^UQa)@:-nOQqUg[q-9-\;Ozvݞ7u_z1mF< |Xlw8ks ]TmX4&q%vw#V% e}>@i^N\|D l3o1GA3[嗦?)E v*9K`8^jbzPQH U^: > -wuX2q%A\N|̎|:?@y9~XZRyg3b'}q9߈W*J\UMsH۬*ԒUY$ؑx)! =;?҄46~WChgj:(5ʆdRu4*!˴5Þк /JxƏ/::p/?1/^E*Xx@dq\7}2p6t u:g5eQz S⟙K_sN6{HitA* 훖lBU_$n"$SI^)16:o$s㫬՘}'v~$'Q^Ĝ 1KB.oqf|s% UmwB((dgg-~RݨfNGs5 ζꄹ2zgU=76|.[};9XWsqԏ;y^CVqwv }k}q"G:3Lu3E, N*VX$e6S{C5Q@o'X7湣dQ@b㱘Xa;/$4/B4.l25Ħd%k~ םg KZIZ{V ,XJ^Ϟ){52r Z`#;0ZWK(ou64+ٙYQ~VSx!Oԙ\ t~b\.]$pkGV[93"(`T Fis'>FG]pkeiKڒa0tj-΅F7T[,fgix>5i;EU !Kt g$/3"}ߩ~IX;T~SEyZMt;3Rϫmsڙ)w# j9M؇bOEހ;p{t 6d4xĿx%J8۪{`BMAtցSgFSԉ8 xyŦq̅{bN+Ƕgq4_EyOl4Ii/ I%(iRJ=BHaÅ1 exK?s*h=@x..N`{jӠ1b-"F#%%~: ܛYo͟bҸ$8~F|fƦ|"Hlnc9Y/tkPU5ս\9霒>7<8_|*W7Qbx,I BƕxU ؒ¸e\4$xt7{A* hcb wު<ܼԪwY"- c@#RfITZ`e{,I :b,_](eλHL|ǡ =RBN~~K endstream endobj 222 0 obj << /Length1 2613 /Length2 18713 /Length3 0 /Length 20230 /Filter /FlateDecode >> stream xڌP w{pw[upw=Hp AsO꽢 f{J* &vF@ ;['Ff^* 3B_9":hag/ Q ,3td,lN^.^ff+33 @1C <#@H!jg03w#ژE;@06:mƆ;c 7wrebruue4qd \-@ d )Qؙ:hvq5`v@hcnp{daPctrsښ64vZX J ! 0Ww} {'GFG 52n w~b 1L2Ll-bۀEdf@'3337+3&Pud-iog00 z:N gYX&N#-`1?| 73xX̿0;[k?16%sx2Xl\NNFQ2;yJۚx,KM {=hK<@1e`6b<Q_f$lm??zC k-sy;&_S WhblN]5n@% 'cf?b{fma Ts}X\V<_Fq[c;K 0 do !019]v G`-0A&?$b0IA,&?$ 0 ?. 0?̮>A`>? 0fs1s1Rv0#xT, Lh' 3[gQ4qY矜Kll{$._I/&` r;8 v?.tM-\`?z/%&T>+sw{s,2Ap37OƜ.Xޤ?zp+m@҃`';QكV9Uv{ <['_,5n[;&?F@ǿ.b9Muz,`n런_};2'hmh|d虜A !Nvrp3`οy8ہU muILcg z_R@71꒝1_e}P}0+ԇy}TUP#*|MMfV8i}8ɳi[#|h{r/'+3CӅ D B^^Vm2ܨJXn !K5HOs jQ% yFYob^-cL!zEyjo~~XجTeu'~K}91K)r,YZa9bkbkWGN#9Aُb`O[oUB2_xH(]D%^`gFF~ZcLtqgEdS9[wWeFygہJP3*"|aR:Vaz3hM.B On/(: yބv*/WW&wbi#KsmJ(Դ¥r:B2&BgwyL0ޛ?~h98Y 5mmI PbZƯ]?TxT:K >Y3>E-~xwʴ%LA*WitFOclY^d,ʼR@k+ZLeч] U>+cn#5Qub:qM|d<J_ⶺg o,sƥH6m?ƌ˷Ӻٴ.hU`Om0*cM=z8*sNj{M0ޗ|:Z+mi}iRc/rsؓ%Fb ƔnŴQX Yiܐ".!\U. _J|7c,B4ﳱ,4oė+H: 8;cE;w"TOe\]ƐRi :g(Z]Y:N3sckQ?"Z2w^hWM "JdWe4˼fF=T`5:ݣ/~KG\xaKqj!5A961NmcF.%I|:`e3_e6^Gdb OhY\Y{ؙssZٺ*vuk< =NfYi[.GhQߝpI~º۵d}ʂt?qg#Zybt)l$2aWE}/~+Ebj*ϲqT׊`,nTρ7Db|t{9'ޔ 8WتTHEY~Ý _|J6 #tccƸ$o >"( R{RwcFh(̧g?wEN7iNyK5C!^D%ˑ@y!IZ~0hA"VYХSdWZۏe0f?C4R'US٤=!RΣP `do+)yFI~Dd\M~t+`{Es:ubUZ~Ġnٜ+n D\"DXQ(PkGQa |~'>dU [p^s>Fd\ۥo~˛Rb-T0Z,mjݳLggAoeyE,&eyݤ\vş9crW۟"fZsPm:'K2jwl$a'[5u` owC;Еmm?ބrQm' qFS݌7"ArvӸ7>u&&f駹_k,.9O+–0?8> QfhY+}"Z&S5@"pW^c(o@@8ɀ.ed$Mu_׋o!mɡR, < 4CK1-3tÅ_{_aΰ H6ڀSW%G˯n$TB1Ϟ #&^A(2L-GRT_ɃW!V ? iO},|ϵY#gN sjl-0,MծI֛]E4RU~/YZqcY6w2Ps궛iC\)أy<"f*i$+8͎HDJ=We'[TCڂpng\jgǾT-Pء h3iS,Q_*^KW_7Rx^ع0"%Ѩg^PJQz"Ȫ̘]+ /?Ƥ&:0Fp?Bv$=%KC'fd%~3əyZX]] vhΘ5lƍDs ;Twg-y=q6 E]YPJ7P#=8  2Iy;Cdx ~4pr\+d9`h?:8fB*x7w ]kNX#L*1!#9zPuOj7 C|*p CzX ]ӂkۊ53Ty&u[,i'Dƭ!{yd##瘁NISO6ް`>Em@ IKusDUe=REw[ktw3e)4?zeԯ3zXzLȱ b7b fL(~fj23jA7ǡU#;_eJQ(OcQq; n{䄕:ٞos^7uLCMV~4g'w[7S GL.٥FoT9<O_DPzƔ{$QxO) ې6$vyƞ6@mQeF \Ӣv)WHےN_@tF($E GL}|9+d18Q6bO:>[z~~.\#c"TT28m^A'3RrBS\&cA!q5Uxټx.Ĵdpĩ˻< ҺC招h {rF 85fT8O#UդxB^YpB2|j K+oT焒ɔ ],3p5YnJg`?;OS!كF׏5D@`Bg]JIlYRW\yk |PneƔ֑W0{>4*xm&z_[K^V'a0pJ$JVw (ۧaNSaJC1̪H#"k ̉)/ru(k_  1A B&_Sz]j8N398bZ?(Y@:Vkq/DWȝ eJyU$օߌtw\ޏ5t [<}ܕ^p>D\ /zI ވhyNTLCd,w,\j9%/znf\WQD<^q߄Zo%r4 ʵY-!["nLG[W?M#^QI#(w b9X_ }>Mn%vqRJ$,ـ`@?$(xCe@/_+$? 46Ը)}׻,6@vߚH-hE9gwvIK q7HvFh9">Q|0O@䞌+Ws/6,,E22iW!wl^q;Z+*Rc2;%4>%F:W|89]Cچū8 ɲ59/5tM"d~:zF{* Ӹ9qc J5Á#ȋ1WwNڻ"9E_LTP$ W]Pݍq8WfQҐ7Iޒ'řxc4_$r"ru}e@!mZtsAm Rd/'꼖m'=_3(gxŏ6dK3@I#1qnpRYcTDZ%jqsxԔGŚܫ Q bdMQ9!0c0zcP:<,3KmP1t!FݙE΃^x7>Kg'~RbZį /,&31ex.(Ӥc>o5v`@ҕVlHhؚ{OrN3Rn rI?47ж#,i3 :XxZi: AϭLff5%΍"b`d`Wv8{j]4@ͤ3 ͋Ox BmQ%HS42B6\,\ˠ@F_fؼdozzv[NraQwb,~lZ]+5[|bW/DTeh*KvKzKf#:[Mg!/5T ܮhat.QcdAЭ|w p?4 M /#3rܶpxm;F_v.3ZU @~5e& zWز8Q!MT4O}̅wAXCBaOG[Jo[b߷E9:tF'N,'ޣKƳO5{.gw[K?C&!Gf 6!x&@p_6e85ϔ/婟4--l~cƸ%Q*oѠ%ʈP>QC8en8[4kZiW Jc x0ЛA*-Z2"=ذ_R|6 vgL>7-# gzb*W>}zzKc w)#SBJ)@NIʄ2FJi̷i1Sr{' `BMpn|s_xڠḎ݇7 ({#OD֤"EWz»n2zIҾ'Bq[nP" ^GgUCz;9 _/u6ꢣZ)M!xg:…gj,8X5Z\#WBi}1zWWHI7nu&n ]J4?ږ k@\lH>L5tWb?=ȎH2VDΓgw>xQpG ) T;md1YB@Zpx{8r,~(QB=H3I}+D2{IL]9.޺*4t{S"Z턓xV!{+@tT `<ӐbH) |`%M-=+mNDB%^JϷKMeeLJm[&υSsRV}{tK Nz RcE ܷdaE7% ^MbFG]ruҺxg n0H6w(i%h]15P ^bod0GTj{ x9`P|8XVe4jz5=Q0,q;&F::EnOڨڴ9&f4@^3oZiH=gYK3㞌C;uVsҰx)B_Ha )qj:"$]ވrI`ڣ5pf-ügUQX= HϠusᬎcM]|Ǭ8]A R>\Aq291sYv'IUKc$@Q!jM Dd# ̏KN<4[h~m6IFL~#U)+:3ɯlR$l^rxrzZP zSh=6Y)$eu0P ސ;/pCμeN2VaRg';U˹o&$ie=w`##c#~‡L 4d)Uq7x[MMu,/YKT/0rGGx)-W}7/TrpMk 8#;F>}n9Ns!3$s pl6ފh]9x² 3-n4¶8P"BA52"OFͥתZL1RF=T{O@"=4l,dx77cA@W:;fmGK#[MkDrO5@P3Έ59?Id1N5kəv\ر6u‡%4$®(#L2x vV=USQ JGHH _(ALKփ^x=WyL>WbN4$ 1i@o1TH"_مs!mEGphO#ti"3>Ϻ#1"usoqB,;B=ID#t/oL)oG,SZKpPīPـ+w9"G?^\ݥM=\+ '5~]6,xjOwޞap`>g>G5r&p\XN}%T+ZE=BWmbtԖ~eKjV_y-kom#.g+2;IW'P6 Ki| xg^J$Ƌ0_h^4Z˨c}蠧~Jg{C9~)9V3w[?TWU  ؋*|NL ž Iڥ;_G;lWx&hcAo!Z51B?VS~daa XϟYJRx9a#5I}g Sc/mLz1d+fE6훱pM&O>WGXrŅ&7tQm~G-0 ;Cro0lBԇt'_Qv[9ĸp<7xY<8B$>J<z3d9~##VM>;cu Bl#`οs2_`޸l28!]dxR*e@HpgŬ6%A^DYv}1V/wt#oq,Xo|g-fS$AyiQyx)%;3]I:6QuBg)2__DCf̠$\e EY͑ /v:|Фןt&# }Ã*VڻRދoG;;?W.UB0cd#8pGc[ rߎ ",5Z#oOܵ֝ 3+=7-JJfIpfE()`g?jOm;EgJk7ȄiT^o3:kjzqB:,}E{%hvﳏ9.T1 uw of_"?6N)O#AZ子ŜeLHm:#smޟie#\7|]._K;5Na°<7gRcbm`MFdrzflMXOlB 7kU?µz п^Wg'p58Eaߘ po/T6`XDo)3^߁{qa1H.}d_"ȫˆёHy5Q0tA2C}8 B?9v\"T!Srr5zZPc"CT6C!s Y&?RhݱNEؑͯ^?\[#|iޚYԗ&z *R J{{Tb $mzy\sdڴ:_Xy;}s' x%(Dx,̖X-dR2$Y B5h_0xj<\^ԜL|0O9EpL]n:W#ŋ Og`1Jʖ*4mDVլΖvוOz>|93(C!P9<ۢ._8Z;2>2H.31F ehdE$%a?0 5Ah㼘Eu utkuE##>1؂C~.Y* P嘸V_ .;~&&l KL4!ojጚEؙʸgMJδX,P0g0N!,4kјW7&du0ڏ`'Qu^̧w./P-z|;r>Ed,kEɽG^)t5CR]Wu*!kj*ч9] .HnYvQ4j,/!Ƅ+nT1F(HZOZcϧҹϗW?&)0*tUۜnɤM0!p|n=A  1%aaYkd=xvj1*dC09)MDhsMbilNU;ܛf1t+-66 4CT76~svO0yݗ-+?D)&$;'4?=ʶiwZ/ jbJvP^':ldg(yO%ADj|NP]2dwj81>eNW@_!X}] (}LNB&M{NGo$.~XcY7("a$lIѼ*„˕ t[.UqK" zMBTBt!ʉwlU%(I1-n7%\g }3GUqhSze,4؆σ"AԟˍGZ]EVVUx}v,iP>%ݫ1Ttq}BwVhՉՁ+7-l3*E.͓bA3*kߠڞjs{n,dҭd &&' k2Gℱ8ʣئ79iB W@"3VSOLlªfwJT=a6H37ɹn5+M83jcJVD늮̑!p{2Uo/Kg]tRg zÙ+ &CB+/!b4 t- uG!;#™9bk f$ׇ0#_^ qM QDAajX% KSVbZzOji]RV]XQΔRx\Ͳ:jjiUxgĮ/ԟ?u WMo: g3[jY}m V*a5o策qXLc,T3܏*) !ߓܧFcvU_1N]zE .ķ{u&7c+,]|y`㳏3'Jy;烑"Ǣ9mNmn:/!ͦrߊ$9`C[`toLEtSXaDzatrVt( ":+N_20wChr_[6}4C!ΔTS(> ?V66v}>د>:lT6(˯)M{ywE!I*}soq K^F^K\rlrܵXxD 8Pl_,,sebL&EXĨr d<gTx~VE8B$`إ/MA.u>m4y;HoRKf~kC_&4}5}5>TF.'&v5M>t/p"o}:vK\`C@gu$ʶ5_5XǾK3\zӥ#k *Lo;H O2YbꨨC9XoB\jGAWC6@h>{i6BG>l] I4A  ߛcKX6I-"Lw[ GeAW揱c*)Մ h{=3 qEÃZkKqj>2hl+pR3 xwP39jlo%$gDܐa|nozuKu*S~E:bNtWS$H\B]x#9lfPo#^:1 )ML,Z׻HʹC`84P>v͎ I71BJl }#nZngG'7f@t3N3џ7> rO -ps1 sց '{sHV{*5  ='拠#0lG9,u#PEԅ:GޙHL҈wIb]Lɾ-Bc~YZΚ`Iq=0OvEph2I KđB&}ۣW88Ǜh72]W B\IG~$Ld4V쏣*}\Y жW! Y`=d3b pO ˨5v/>eIEo9?V͢m,TE[C}c6}p}$ϽWlݜ+*!)ꧼZaWkc3~}IΖzyc=;*sz[Z]ɲ$"V-3~y3|+vS0[ ]jrCa|Y3yjX7-T,nm̐L euu6G"ϧQ $=8 uzfʻեx~^Wf36l'='y;yB>h3xb.L ܢ@852ܐ&v| -HYa,AX^ÉbAG`ɇ̵,L윍CflNs"C̉Ͻ=6*F =*#H/TrCI&R#|.M`< ;TtSD^x\6\0 >8L;tҚ^t=/I}(Rtm\V; 6/H-Piwk.Q$◹Bk7x_Ӥx~~V,^uuA$ "^ۆȍ Ǚn% ,nsT2EQj⪒DM;A>0lGmr CT`2 #n˸TtlpRү;%D6at/48(5|u^pm |ԫ.I,Ϝ0N\NofmQd!W[%ڔ7\#4`֐DrF)2[w(roZ"OF;jېl2>a<\ vzB( v4:9`;C}CrE3ӱq\5WIz@!m#̂f$AYq[hc63bLwn 35߈t2|E@\RjU`C Eu Tz)gKDU=hyEJ΂&6j?ѮRX(Ig{zYT|tffUD[2-YH׃i~tVhsŮXILJbm r{D@rFv].(yfCRRk`M8ǢEzF#/_1sw՜<iy2vE}'߳GŚ#Cd kZOr? ߤۯι{vG`*9d3sK\h<:Ws$k )9_plhT(B8'0+]Tp9Gg/kXV"]NhOۚT~Atn2r4u.7s! ϓ[-Bèk N&[;90Z$~=d ? !Ibç"KѓO_uO5݂`ăD.W Vz'6nlmRY Ghq ,A y!@nuS͐qF TP赫N?L51rĕ:JxIy/jky?')ɂ(x&mʦmKՊ;Pi,q>(jQK{ 8G̫q R.Ӹe ">ˎoQPѤ-@\桹䷴w(n$4(YfvO]yvŊcrF82jq”; ^1K Pn0+X9ξ~C. QSf cOջ++ɜ]B/p9$.z'o3o 52Iܔ]}LcԌ0HFAX @B eF& 'z' 5ɉ}Յ4 >nd|,/QDJP ?SRL$$щJשׂ`Aש3pgɑk.1) /Џ8&D"y&)=-HC(GGw[T e0W؍Hq7(8ky.(aK!x28NEDc6LX{['g_ ~j byEͦQ{;'WtnJN>I/ot@nŢ endstream endobj 224 0 obj << /Length1 1629 /Length2 3713 /Length3 0 /Length 4726 /Filter /FlateDecode >> stream xڍt 4m~DHٙ͒e(c23fNEG%-U}o)E$hs93suosݏA kym<řHB5AB@ 6$"nGI ]mzXH4co UU@)4U@Cf0B&!? H$}Xn#$H8,02\ `EH_)] * zaKbV:C#XO`qƕDX $LCx FQ*l 8 CJ#z=(T,ٟDv$pc c1,Nz)`<K:ֱF :NX}oTo%:uXH7F՝pR ]M3fF %_No,qmn}BFZS B6wHR&&& ͔FeS%>ܨT(:,Dʙť;?+V!kTV)Hלl ɛ.DǴ NJ2^zDeRjĞV.E608by9'D67Zw3wY}S]{I,֘1Nr3rvYu0В iv OXjDnbQgOɯV_hi2AZ1n.y8c=Kɴ/p͎֚>\a{G9^AM3'C 8%hLCX|V>`ceCȾ!6֐M9/>Iï3\xs`5bwޛ)Hqq.9OV% .DM/<6f8h7'N^iͨ"J*(iI>hOWj|ç}BJe<33:^VK ymhT?V|ycƢEزZʍ}bt]@4ݫ&Gb4 OT\Z#ַ|"zSi^3v5xǽV_upH8m \f&W2&`@d棪oo99H+t[kPys\y %"*g[z9[etU׻T'(J̤p1) ZWEm s@4DC*}&$5Ao ahjbx[Ĉ@UұYH ȡmMHՃo2oA-npD ! jӗjlEv7OC?Dw5V _sXCKaLk-V%RuW ggi:`sNc[(f޽wj{0L+Scv^  穗혯Reh&9s}p œw.2崫:bFNOQ~xm9~ɒyOƼMXy¡oqs{аj њ,#ïg\R#2پlf2ēp_%ȝVVMKw8|ޓӠk-w"_kmB+R.ۅ4HwVhKn3Q1@ײoшW#[7ˆ'oh&`j]8}C"J? u͔t{sO74"V5O1 _/?څ(+ګȞ#rrI :e;9C%?N>s%vUv`ok7U 2f#EIoA7j^e:q _vlO 4*Qt0|MSJQ;ށOu~-$%Mo/[x% JNu#nSu?F1BѦ2 ^J;I|b^% sHro>3v2x8T,mj;#L}v;j$=1 Փ-2?V|uȔJ$cc9GmKV1s0-;^>I=fטPcVFΣB R;Q =vU&DPm續 v4yQߚCB_0 Xt~j caɿ\t2z, aԙZ6)ǐf.w+v4` .q٭I0,:,o$Yrp9~墥lg% -axzhuۋGfƖ#/=/:G[{k\\.ޥiJ*Bhp c{M]4 /c?[d[HX.A񳦗:n7+=Dq X"@`{'{{mrT^6տHa |x5;`RP[+DDZ Խ.^RhirʎFXf'bDcW6>W9W%S7LUl=DW["ߎ5T;:C 65}c案:kP 5kp^Q[q|:mXձ1v]W̚ov&ߦ]v1gƒȃ˄ӮՓYSnRjlo>َΉy:TGU^rKf%eX=c(/hܐں) M *}$]3^cĉƑ#ʇYt9ԠmN]yiӠx|B.W$Qw-~ooF5MM6aakoĵҔ0[j"dh269!/~XRm3Uz\ׄ[M[LF|idA5?Ix>l2ƓLݢHlhl֝sդZdfJg6e9,ZECSZrÖ%5.%}ק3hLls+Kmv rt7%riZu߾~iEa<!*dEq逦[ʎlr>i[zV"v΃;qG|U{k DKV 6:!_qa 6q!% v7)߮26몠Zwj<\݉nH;%-d>OS2ĕӇ?4g.D*-1N4)أ+x~)vfn(D endstream endobj 226 0 obj << /Length1 1836 /Length2 5368 /Length3 0 /Length 6493 /Filter /FlateDecode >> stream xڍt4>2"D^{Gf[˽KfV!(d'egded%+DP~WMw9_%gb.悁!1h8DhYX`,I+(h»#~ӴX VA≜&O3 }ow"@d!r`0 +U4>(HǠ8ZA '_@. @~j, EFPƒXu1pBnx"D $8 @@3AGPį$h 7oA P, (8#Fx]XX03.y"п 9H@} 1P Q/@.GPwܡ0Ρ)%{<$p(AGivxx xQ(,NFm7@(4qv"@Ǣ|;0Q{|ρ(/ ,LtuEMǦeqI)I@FZUP8R z%}BWCw.c Q@X`0? gOGY7wC?B?r@7(# q jF[P]# EpE[; 0PGo F+U⻁# A\WB1.G%)# @X-(#IB\DO 4O H Bee ) ?H ,2b<<} qG˛(?<b/H1 LT8_ffb'1E#c hb]O`B$v #Ab3c(I,{x_K2po,ϝ&?@"#R𺯥j\^IiW[V8}MC5}ʎSkmeU25t@Z": $l^,*[ACŕmʬ:(.浹0|n1TRjO^ T{^ZRfD j6ke`;}bRi~`P}~Pv]u!$yThij9:&^ ~f{%P]ճL~Zeһ^8T]w^ʼ6-PJǎwKooGQ=t@BZHc> x4>{(Ah[{8.59.-}nȭ&p}eHKJ&:ħ09i*)+EdsFϔ&1}e~-\߇(ilcF|REt_fjt{vf (`cX]7O݅)Fi_<ߦ:A e[mݐGf1SC! ɲ ˅+21k0\yè'b&W0'!R*QQT?Ё\Yfr0߲Υ)b2~ 3 ̳*1/Sp^H4zm8IGqyMa9Xj/ G9tPvϕEq^_tN*"/ R:Nv(W^vo&>_aؓCA=if nɆ~)|r6~ UGQ'㫲RW,Tؕ#DyarW\#U7Ѕ[_J,?fw>KEGZ󡪚نq0^&og Sj~}bJAJ˧YXqCdkƭ-JK!lKV ݳ8+4)M||CPE:[0ŊrC=tݘG3Ԕyj'#|4-d.#,8Dže)w?n2IuxJm/ɽ~K2拢Di|k9z'`hCԳ怄-`n@-Su,֥7=#=gS7nF@3Hq'E;ގd]UߊQK1k:i̻py:]|y[:Z/_Mښsl<2xT蛳ڰ,ByZŵѷQOb+{Me]mVn{:[}ʸ=Rʑ"g$ ]¾-XVsi2bMћ}&wDߦKdԞNN2֧39 kHDb[!o#^b'_/:iʀ}mcsGsӑYŹ˅R`>SRh6WrvIKE^ Jڊ7uLS4%ΥD >.nFh2GQ#qTXvh^c K;_RixoW}[$sWAnύKI V2pRϽr X Tf!EZSO2hƕ&18TfPmMwu16c-H-'U0G߁ &u==z5PEMb;z% s}+{C3/>XxDFlhxؤ%>9l/a63nWp4J=~E5 Q,eLˬFe'-QnIm {elQ]ERotw E^٦z~w/fHRMs'ķPcDMjlX&|7质iu/-U**ȯUMa^g;Tڈ(w@jkrK5s8{wy+'h@'zgw SuЯPmd!T{Ϙw)WF=`i{O-7*YׯRi',fL-wlIE8"B)~*m`3)Ԅ'vI" NP *HC h (y7oSF ]UPȳՄrklX0MlV-o.Y;X~vQuET7|HÙ.;U`8s g4gnߏ|%Mp#QxXIuV *ybir3AV ʼzK=N]k1-ܢ+Nfaane-yUI-Ƿȯu9hթH}΃ zd+}cd?>k?v4ݺW Z+mb}Ogb>yyG,BخrêFgEig/xR[qA9I~oZ;NPerp?IH#vm.- tډݒݧYCr.m ңƋ ºXf>%cyÒsRarz&f-#ؕDiLŧ|5/M<9IK̶ W[ ypO'EHJn&oȹYX0@CKerrmNF芥mTO2:H ێG2gtsӾdEx֤S)^y(4H_K3'i1[v}4+'qO|mظ1A<[BƋ˔)gCņm1% -;TX;`huN-.ϼU@n@ (,yuد<<:Ɨ>!C]Xh#F}eT{ RX@ ޹UX{sWmMIJ-Q\W/-P?ތjW92c:hf96v}B`vS뮣k1RLea,t;Ǥ\*o%mt| ,[U|}U4 u.>`kkNFJ7D6G-\/нRQ4~.Kiι.[qMܕڄ9!hwDFO~+ '7q QCj:{fղ_U\[XMhuBJO~b6yh9h AgPxa}>458 UK^IQUS_/Zb [,@,à+ɱOFioI5~A3WH<{YBp j05k}}K.̱j?n RFys+*ƓV5x -5@Rk/Q[ hq`R1'?󜣅,tHJKBj&N/!ܙ |yNL^.Qv!uDlҎ4fҋ3}K>1Pg(2ԅ6{x7?ni8e+o}d=o#:O"ŇOS8 (?}šs7ZҔ^Z2qHc Cu_[]}V|lCq**QW2fZ6QrFQEqL5(Dõr#i$Z¯Iy㚫%ܖv*5ܵ~MC6VVXfGiix\Vc j-x cSۣڠ&#i.ڳعd4\ےjZҢ\r"SލMu oͮ~εPs'Br@;G &WʴRnb%py'qV-ƚi {_E{TάeE;8*;0k(N:!:2^Nѓh?.$Jܫ[Dty TeL.HѹqcY`tMpRoҮ0e9A ]dXXOS'ϔJ?2椮O>bHb lӿ=`zCp;ƿmqp\ +BxüagS#WP">:nY{~)fk>ӻF7onNR+V/uYD۷$W--F;:Jg1XtI0 Mس"P}BNJ&G\Sg.ho- eѤOMn;5yoP4!wDWz#4W{eR.!ؖD-8yj/ߖW̙z͌ '/=H1^b|݄y@",gMn%{iުcaHx j {a"rڷ~_# mY W(6ۺkJsZ*UvNe6/Q۵-8(Zs ,cىOHxJ{c )ݙ8SKւ ͳ8\ B\ endstream endobj 228 0 obj << /Length1 1564 /Length2 8036 /Length3 0 /Length 9073 /Filter /FlateDecode >> stream xڍT6LHHH C7*ݍ8 003t !]" ҝH+(Rzνk}ߚf{{~ٙu lϠHO_@ eh( Ppf DH nm`-O @AaPH@@_DPjՑ] Gݖ_ (())'(uAeuÁH \2(vrG=zP@}j0P3~;iB8 EF6PWmq&PlNwD0ğ`0tr#`;- (km+$ʌ5s˛J\gn|>77'\ӟn,LP/,W@xQ#vf:{ ZD7£WųdiܶNƝ%S|1Oa}9KÂc x@~I:sv>M=I=w#\c.r{Pȭ֌|dG~/Yzާ(zMv>Kcѕw$ocy*dS?.z6!^ Ծp:K`G6 k7^NVC$qeV"X}μr=?=l [L?;V{";W)p<"!e*ՇaʋO5]zup4ǼL1K+Pz]I+7{vs/RNA"5̧˯N!߈k 3Sgp: j> ƍЍ<.q!+;)73MQu lŨ`G )}-x},w`kOOwG:uK*Šm^w|qw>thr@gJHrԊo/#" !DՍ iK^ oq?%RMiiCo ; >ʔ5v.لv!ÙrYK t=;@?VjmOOi@zE8qsl 1XK3K5wlTULsPtġO53ol2ư= ^/F,S ͂KWmhM=DYNWkc[NKԒ,v-?NjO2)X%QW#=8<=1yUt4|c>:YY`D1Y/[3p rp|dsiF< ;# Zğ^ ޴/P].J\Q%=nWkM>Nٕթ-s2AF2c`?-L8H=}REl+GV+ңw$^a}כ(-CHys{r2~-Q!.^,.zRzPwg3#ݮ ӕ*L.gyK{nޣT(crlA7-9fo1UmZh<ݙ% puVE P94 G!Z4Fq=s썝9D&y2J|/z˼#[e:טwG?7Yd%5KS7T&$G}.($E+n_@Hxu*<2߱BJ& f /`٨Ywݹr响akA ޻g)l%>F^ae)R\+ac̳]gbݯ7' =qgSL$y t?(S3mD.$ʉ_1{E3Fݩ3~S|C*&&BZyW!0-7^;8ÀAs#%M8Bh/`t5m^%yX>-2BG{}߼5X+)4G6{m+Q8ۿO?/!+J wF3,)ѵm)Uјy8͇ E1[Syz9YU*9m|GP)U>]U3%f|ù$%Ċ \i?uj}/p?,/ ?B .uk6P+.|Mvlp(1c6r^(T&> \?:SB\{!8A;GM1,m`q#q`Vx'$MI vSb @mpȾ҂ɮ)iISE2eבW&ξD44M&euBf ZUeYζxPgCldwk %2AO[9~Һ:;dFm&lXwa7+b-駑0VaG"Z5 3Sڝ@ü{:wyEaEL[⅓>z~ڼ~HbN˻"rǁ|cIS_-SV(Ͷ$brt+)ha jG]JItEG*eζݘ DuPjclH7aTd& üqϻ> "ϩ~Z'mPH|Q۩|"e׎@`86?K@*PƛOX4jC٨yJJ\栽Urzk* @QɐMsYdC\4KDi A 1>!HEAZ AIJĩ \³?ELM>VR&IGOh1[5<$=SA_DxXs0- G܄-v0<?) "LHuOEmO?~@mNӐTsQj. YALl!VF8X o9ˋ/qVr<qGc=Ȝbyu&4"^P j IQoacڲl:+ # j`dD/s,2UlK/߯;1q6 36Aq }UNR&u&*aK=BܸkR Ps,ÏkZ~rQGM^?>w[dپѧ#;2>=Fh@F/;;&N:Χ̱ĖB$b2 ?SjKyl#]ч$.T?1_KRc #J_P v`A^ sZ8?YNڳvTf< c8J4p+>G@ލ5w~(n"nz1b!+?$xynҀU 5rIa0t.xgbI g|ɻ+3u%To*^+6Pem uui|V^U`=>bg5xq[PjŕjBیjQnY3o-[/F@ [+⧞fu^OaM1F0.;Y鮯c)<e}1H l ~׀;Ln%I]D wE=8GԨx@jKW n˰ר,,,$) [WSUcb;CEq'* ;G|Řߋc½kz#yKΤL +IN$RE3965ܙ~t'N=Kؒ2zKFQ(-8wՇLit`(2 t ޺~Gېa7u0/ ݎjP{}"mPAf];6@(?Uk%8'0 IlRfǰvx/wzYU UD<2x倯=fkfS$٣<|fexmVKlsg^[J0[/!h-UȫMW9u Tl_g5gNdbJJqBZoʅ͓9M7_18"F,,E(dn@˻;mKk.شu->\W7a!5P0-n#) '?Mgn6)ڸ<ŦsC@_ }*9ILA&,+b6b>D4alJT(sRӠ%E{1^~Kh~\ _{hE΋ݖGAE۳8LQ%)CTwBKǵטcY;ݢsLݬ/imfybIP)Ff Z 6>uc4O~y#a(w@>~a맀sH41Pl`{,ФfEnI؈SeC9fl]\>;vys73þ\6tܱDlquN2/67)AYv:+:9kӦN@duw+ Z^Ho52kȦlY%ʌwkAYwZs)r|c>~Mɾc$'?s:c0NIajrM7M3{Ш@mT؏*% WxsmJ&dS?1fcQi#\\0ck?gzg`ޚ$CH1 ^rOF׵UoVҳI{σ\gU ˽+imP}K6J=1$LMtTPo\~ADG(pl='Wo~T8*[dJNY h̷DJ8v?`,8Cu{گ+']A7WsGF_JϲSWcF )tӎ&¬ACo)lxzdb6ٕO2D׺2M#ZbBT%b6k-uB)[L8WU>6R6I'|JIL^?G5&fVאFTcʯ7j yPґ$ǷdTs,@"ʇ,KqySOck#Zwx3 qɋvy oyYG6LXI6Z)mI}n 1~l!%fKFPVP \$(-N][~E;zNT1Z3G`8B5zsH; H4Ljijo'h3O7 +e9<]34v=?gmௐMYcJaJW ;X.}f .Ay-[U$^4{&$/>~ nq/E`GQƘn ~Xx/0O27L3_oV0s pg񎥳ԅoeF HG,U7^!]P)@Ee W%< d>ԀIH:b|"<ciU5~- >+mn? jz ڄ+7 ?<…Na=+DtXu8a`^gb!^oA's (֠{b#L!Č bOz/(F)Sڰc f\?~^J5ݮ#w֙t.XkC"{(s97ި.&oG.eoRC^Y[$_Q7GŔh g5^x &`OfJχn*B@R|޵eQ5%qH_'كdhuqy L_#KLMrܩ\,%LlMd0cY|by 3 ^qGn!_>8_uWwebdW0V-4~HűImѯ *vؾ 4LC"XM1gPvn_˟iMH T( =~oa1Gh3qZ/tjZ@dA[+@_VebҩOxaz߭oғε('›#UX1R޹1 ^/p'a'e})6E-[trAzaġЇ%TXta"1 vtE]@]T.sTWCT!؋ A՚iZ!E9֡l*1 Jl'2BWL&WM5RS喯M f^3ǠbC)،&'V(ͥ8_vZeXDHUs {oV(\?g#.%dtXi׋=TLOel4jj#-njDk [ߨEja }0OCeJRBfA>⫢OQd--iq4t/g\V+Ǯ˔8CXSU0]82բ֭:NV{Qb2K4{1ƪof]S\_bgPDe^%2@/9ǻy9Kpe%RǸs2RcOIi }b!kyW%n)lc_5]z<;.8jc VI,qSX . Ue'(j=ZQdJ7~,v6J2 LZݓzB]0ID&w\JavcyϠ`{,,لQz~HQLO߬sz֦;M̖nX$QSgAiY3_!*M)p`XkU ьfwtcU6T\.4QVB[RGQƍx~۳+'U^ w0dۓD{|*SkjPWz/]sX7HzQayn;u9<>ܢ]TelŐpT% endstream endobj 230 0 obj << /Length1 721 /Length2 4672 /Length3 0 /Length 5264 /Filter /FlateDecode >> stream xmrg4ju :ѣ D%.E13 3ѣN"D'щ5DF^7]Zz>쳟˥A!0HDT`n `P<V2`pb 2^ `@D!c ȹ*➋`+\7"=`tBTʹ @F`N6NH@ CqA- p'0h8oM8?Ю,Z-A t4x5â>_//u'!p$ A!dM m<?wt-w p f?wrCQ t1p 0YP_z9 $N醀#VB- ]O?ڏcN;z?<50 ⯽bP? \""X7Oa#i|žc4׻9$ #d |r o Y {igKX /(lok} (V{"B-XOΞuZjuӘ'OM{$ަ,}'OίmE3;1|KyzI!TB3`eda0$3;6/3?=KqrytnEGu2rHtn%MbԈpsڧ BJ ;`e`FX(8WD"Q/]*\ұaRƨoV@~CM…bԙe3'3'>]}TJT!{QyŦr؞{ } 2%.Evpz#J, Jc9u}-*;\pf4ѫ&wϯ,3o;!@ LGl** 7$WWpYQ5Ϛ5# o9-ͰEq?sHf =R=]q'b."_{88  8ixxs=e26R>-MԜy$l$Hr*ReK\w:(_``M:ǦBԲmhR@NP >ѝU%' 13atLjgt4O ")<u@VoYA38IG 4_?)o~[u.ᅬpLw$,ttQ[ \6Qb})Ŏ72K@w>T8~5,N乁c-Tlv#$I2<-fJLZ摳lru^Pd<=.m1MMf+km(=[3/71,(m}!\.·ڔe=D{ωM^ E2 !w/3+H6= M4A'Z,Dƞi*s\F. ONޜՍ 6 ۹,W!#%Xfo߷90 )!Us*@>i}ޟ|Gv-z C-d9Du1N,tA po%ǞMݩvIeʾ&Ĵ6flVk;;v^-YlM.#&l^D3 KYOhlu9ZM:IQtf\jwwŶLaG|-;+qm@٧ N4 8$ZTcg3-KVn*?CmY;S^cyס8'"R\R.E(/^,j&Ny[뙧}x0Q;>vdJKo7f>!ʏs5hr\TesnX͈S)lY,W%!%?b:I9;D>b60*/꘤p&8y\/+5D 8ǒܚsϩRXKIHdݢxN m& V}ih6{͎Q z|yń'<3reh;Xy3E ="A`.jbZ_+2f%vI^ف7Ҥz3q|Po_-g畈 eWGߚ&PJ/$/32pDqDwu&:`O#4) =lp7X\~\m+r-]hQ"eG>xTh "#Ud5i\*!' xAE@}oU4gnş5Y,tl:/IZo8io'"v){gdXߟ;ٺE+u7{</&Uiѝ*v|0l (kN1S#k>w?{Y9Ay|'?8*Yf dW(jP ]~:e!=0iټ౱]PEf-|ѝ6%~R)'ryhz`v,z5bphѵ1[$1ʪ{Jb~Կ s;_<9|9t*ʝX|Jy~>M۩^L(ݡ ֣KHڪzԴDjt³ޘy&m=t9+r[lS3΄QDgy+3f^x_hiޠdd357hm Oڻ;=F!}7;\+9n"jqK5T灁?"(l ,A]Dn,,fhaP)Feɻ3o52i@{;H8dg%lo VUÜ{#gZ#K 2f}{UZIݴzEW1M;7I^_w󱛍^1cŐ=!m endstream endobj 232 0 obj << /Length1 725 /Length2 15948 /Length3 0 /Length 16495 /Filter /FlateDecode >> stream xmctn6vضm۶gNVl۶mZ콿~=zUWWWw9&=#7@E\UHCF&lfj`/jj 039̌L0dG/g+ KW տu[#S+;+g%]ōٍN*ffWK3@DAQKJ^@)!07s6(ZdL]̨4&VBofή3wvȉ +ȫDTEFYۻpmfh#d?X=#01LL\fV0 MMrfxٙ(E\͜rfql濮FvV^C2-?*+q+O3SE+vuv3Z?s#gfjffpϬ:z 1(ȫ+i O,fo`jeoPqO#gQ۬hd /f\<:J=73#' d_pMܜ]M?d2343Y_q0 Nm -+1TYa^A458¹Wß 4ۻܕo&63;& [y-&~W׿SǶ3sMXRb9v*C`6,Gډ_[|ң@3;F )6x_ wCm`YPx_e-8%s-J^;$tŲ!r0Y~ë p )SɫZq77K:C# F .{=jϝ!*)=9B_nu2`A\gvLX9 uTl47/i(i[t"\9;#!E>#}@ٌA4Wg A2ĘKFS젷ПUsU02 _5d xϳ${zf6yi^5U^A S!}w)!h %SF;rB90.3=ltf_<9Ka(:y,op#E}r#丂Y |/xISؙAXgbER^9 s-'p'w٫Y5(ӕ|3uVARb$!.D 1@0]I2 g#^pTNYh߽Y~tl2 W*TXQj*zl}t-f:nVMoPX"*Z_n[7*JSkU{uFs'Ldjig&kh֎ wA3tݽJnKn9筼6[o/[x ]V wAeDH~3 }Mg⺈w;k}b21%:woQPK"F\H1^g pHUcf Uovey1-غ aWڠxCL|JRzV>= ;JHA[;`ك;֣'-A!W^ aehīO1]eV O \ =V' }]^Qc(%OOznu<ĜQ؋TIʪ+eA%8d$ d>#gشgAnK}W;2(G5}3.}ysA4Ξ=pdZaQe͆փ$NLjJ)?ɅLo/IKcR!q1hHSEzsu3Mp[HR9"Wq;ED-ˉA0Qkrl(RDRT2;]b׷}7C輀썩$ s4|ɏE]Txp8TQ*}XWױZs۫ozMZǛst!G{~V7N]j[vjxa{L뽱dKc݉Z]`a2&+Wk Mv^a&nhkS/S#7R-nKv՝fŧϴLBCr=m8p cM7=۩ej H 6y'{H@$_MWӦ{_^gf2  B*|Xv-@!G9L5fI";1uCD(T>'p}ua$cc }bu~땺W"tFB@ ]ӶVc+U?0|7$:NW6U 0Oτ: T|w^)3)2ʿLXUܞ~c]'JP2^Yn9g%:N_1P8-vЍ'~{"瘲dzr~a7kTU(jߎyw\t}ƠD񪉸abR3|g$#A^!M{/pU#_§Em? 0i HGam4pqh@!#Eb. .lXp(#\u8"*57ҕ:S):e%eOÆfpgq| gy%CHNmݺm^˭Ƽ]IߕXx0J*_s~.%#]VBoKd-OSmf=mu\> :b( Xs'Jcr-t#wN%TAx @"t-'3<0zCVm*O_> 3Y%rqC{nf \a /E #!8&ѩE(g{`^ay 0"0ۯE&ymC#@;ܝ`(F[.gEq`Sn\^A=.#x腾*/\{9ؾ %:;vv_=}~ZA\7x- ؈#u))I*hof1ZOe43R"=)g*̱$D'Džs3c11զЂ$`LV@L$ 芋R? 9:X<O@WrqAcZդa,̮17yBt1f gtǵ'&"e mڮ 2y ]E&͊bc:xjt:F!3.\:8nty}\y?Z~*gG:{2 HBHU,-0I6v!rQ\WW0qaXx-ؕF(ngm( 9FbGzG YЬ /uV_l!Iar#?Ol\7"2 xϝdwP"/B`pϷ(-jК)j(rgydLlJ^l% ie9,b EU]#'s @{ܜ辧Mv%Rq A>tZ Zjj7?ݨMy+mI\3z'F`rACDiV-!vy}]!h^ UI!Qʉ`Nf?_ E'B_wZzl-ZB _O#R7|pX5J)(P~$hlOq֗߉UI};uA*8qp)/ sna5;]<7@ "{RL+.HlQn5q-&\<2htԹ2z.Ab·uTA??eSC[@0C6T3n&, bTU_!|Jy(9ExףV6e 4'>qR̭n$𨪼S4?ή0LzLQb]{& }qe&U2 ,N2J!F 7؎zotwq1hu{*nղ|Tk Z {hۜխ#4! 42>9N}p$X-o`kkc@&Ds6j,z}tƟ"*BflUbQktw3|$͹GŪ@U#dƀ6oZ9CPQΏG:j% (0knb>f7`*%FXō("یGJ84P~ e9Ϛf*NMW(s &Q ;H膿 *כ>p*,}KUhHJ{寜BZ=p"꫚(0#%)XI|C%[ݖ@45QJR$AU%>"|{e-A; <]brYZpl0C#bѨ cH-'{ -A e%WN" ih5ј*=(VA8;x_jD]|K~= H"ܞqV_Q6O0!ve~Rmܪ}:;3$qJ;*MR*N±):O'ah9 Zsپ|.nЬ#]Y=J{V_DeQ|x\/sr$7]5NFp(mLB7S.4f`=F|D, *l>ELa rC 1",/hR;Mr B4*Y9r)`ߍ!fD@MvHw>X=:rϿKܻ}&Ր;[&~Fiz)v$5BQac!788\.\kV*tXҷp,qX79bVziO('UU Bڎ ,keX*ck4 3ǫE6-3I"#~ϕ&y"`6(eGP{:kiEc [PP,=cVCM=jph6izoOxSvAb7`KidTi[EԛUSx^~Pk*<g>tT͗*υ "`ew9i-(pL~w5JY)l͟-Pe]R,ŝ%FL&F4=' qD?q )3q뽽ob5y%+ Ҳw_ᶟTl/nH9/@JD|#HCp-b3oDǗN3l$̾.yFH:D£Dv"]O@?OSyqd^D?E$d0P?|||Ղނ@7$" WPHԠ=_>qĦ6! _ˋ&s7'VD9!Kf+>U.Ө I.<ՙ@"g}#HkhmA,r3ϛUUUi>ěGgrz鼥 #,dx{kHn*xȧ1zWI=C0{_wmsHs2ء#Β-cwF5K/eI<*~߁_q*.),+w |(-b{2Q%xLaA,;reJ-JusȫxK8RdWS퍙} ^ `ŰFK$s,%ǔ"C%S;5 `AGE"q\UXx=6~^g9o_sd XW Tߴ:gسFlp9ҕyO}4 s~L;Nn Q-zquk#esmFҊ͔?U7drў"kwc)%;Ñw{=LnjҖIxL {޳lیUv`GH$5wtN$ J8f> Tԉ̿sb~^v7V߱Qb}+H1PǤYb1<:,4^4/#o@ъu524Qx13bˉN&%5%=Q$f5d" {^ lBc8I)ni+Hf= ZLtjl֪ĕ;Q P|LȰP~a90y3M8e U>F@?OYxm$G#̲F;i_3@8@HOeC%Pɕv]Y[}`5(qz;^yWmY1`ڨeO9;za0{VS͞V% WkC aBMݼ-VWҋClUZIY$(M IAbrm휹V1l_aAjKC]P \zb=& <&T WōG*nG]("50]QL%W䲋us 8 X #mdǢxgt%WR +t4 0:JV!sjZ,Tv> "[`X 2.6u0V~)ظdp.nRn"X%\A"8]e|X -~O'78vIQkN\G,^wbnQd" ER>-d 8҅AzyXnkfP3AP('NalҮ%Bj_5 F/"I;!(-'U # 懏rΑ8 ?5X:\tL} "o,CVo=Ymc4-r ƕx\oN;.H R@\/ |sN[fv)GF=9G׏~4KMpv]?m?B <SQonW/ʮy. 'Vv"3R0” g/1| ,MK<.j5_(7;=ANʯ`„q2Tu&"RMX1 >rY[P~rnsF'gB]! $i*21Hy .oJyܕ|}vhvax;yY4Ĥ tx #ݟu3籍Z_FgI}] BTllC1 KK߅@HTY>ٴ̺{n#IKɡ(AMդcqɾ)D]Owfen;E~clp 5 G}V7_%%,x%Op}zP+)5`7·9{5Q H2p!Qh߭1N9>^cDL>ezgIrNpՇ;p،V ̬Y}`C|vuES`qc:~X I7Յ79QH:ס\B/i/V&>DuɬLujŒiMwcEJ7=~A=q'QP*G-_ {5Iz]O+N>ӋKN3 %~0qzPieA G>3/3y]M' ˓pEd8щHT5N~ Av7 Z i '6yTt'T f2=4ynS׶61nwGu%m.\SHP K7Zkږ? EpW @x@W#3? d(bAg^r> (6ohpp.@=Sw>h@-Zw* G-:Ƚf3E^@:=ٹCt %A[vr1b wb /Ζj-p |=,aT\.qXĉ.s>mqN;z)k+㊸aT?/۾3tSl3VES46o<`Z*=Acppw=hWciJc8]֨}EM-ȋD詝%فoW-zm"<$7Ԑ @`"Li -3qVnn_DFc )QƲ3$ji@@IP['RފvtBJ.)U1diGRԛIךl[78uw%ϲjK2 pysv@$G™26dpMH*7Ҿ-de QL2;zxTsMv5tVE# KFmAI+hwN/0@M<'-cXH;@҄7J  9ʗG/{*[ӪR@A j(5,!R0H9]c5٪9"$;}O(:a"N)F;.YږKȟ94}NEb錖1 sOվVsУ=4g܆l"`E$1D1}tĔ*MÐr"&vޛq:v{$ ʓт!]c򙬷᭱ݍCs>嫦ByeDli>-eTa;F;far2лcS(ceX~ubO}tr\JE]Æ\KFiK-?R;Jk\fkyWsHFʧrg,3l0B}$(\ޒؿE4 Mg[7aҵ¹/IɁ1iWK fQ7"oF !B)u4f[nۃYK2@(ÿ!+7gn=VZ :kM9쭿bpbiR5Wܓ5-4gʿ"Y $3l ~Ja`m +^%+"G~G=e}QAR&2$Td+3mB&223 ojvς /});;aŧwKaD\mMU|.hըݾ,ߥ4~[_P)+ӻ ed 6.HY sj^?FuC"i?A/;&ăd&L|Nmm3\! J5{ KK6V3Y?sު{hRkG_A V0iC/mCZDA3CČALx"tj\[eJSX мƇӏ$+WU+=׳됰6%;U'R⍜ 4dmj#$i.}ʦz*6̋cA u=ZuNw9?ȣfWW!&NLOlh5FUn9c I'Q W^o!#n@c?%/4}ӈQ6]ݠm&M)Kokq ~#$DfR;ҩ]_ҪۿV]zv@=ǹ19{9fZ"qxlV% 6& dG3@bLzD vÊBmĚL8qՅzΦggh4O͗ [.*(KϢ̃$l~%n"15ܨBKsb_+g-}m\:$m[f݉'Rz&]hDF5T|s<~™`$(ܔ)3ix4 RBPl^ <D uMKEٌ9* U2Ē5KM`0 HlpR((pujh+v9FwGkz%s%}?}A$w^!:3Zj\@{Ed*UKl`vHf4$ PҚ#>a4+ Bd1rqA9_^qZn,њ~\*1oNHg3u <4_0*gL5NpH86]|Aou}Ai2GE"_a?NW֨ dMLxVO'(G5Skz㽷Y3}l8~x1e.v%z:c^|;PZܧdΜF #۵"~VGحnAŌ&9cm 5P&eHxʨ>-%Ps_ɒ5S)p3%A_zꌰ_ UIl7]@5~D p 9$R`7CVDnSC^=ܧ?bk&uY7 3,.cwHCq<`iq,* ['^P @o fx%r˧gmU8 0((˸R\c$ Gp3_p˧ (B`>ч |Ug{Hv$Y j =&M|ˮ5J8]eh1\}hN Zu_v|wغ)4 |8Z0Rʪ 5\B;U7_fi !R܋~=)[Qde]g v$ߨJ-ݖEjiZq2)0;N0z1R*GI{['gM0皈$ 3 Jb_[@XCw]L'Ӂ['qSpL..IS !U]h9 ^^EE<2XRdljog< VE#SQ x{{w5`(,:x,ْ}^᳢/xk 86y00B6ZVb@p$gƅ\x;~(o[_'a,S-w_$Gi)aԟ ~L(O~Jzc}]~ґ»{cE-Yч8~8hmVЋ>5KNs K讁sRnpR4Ò;zkxРjP *L ڇ4\a].܅TW$/ &1ųf GRil4X$0@kN͇ +{咀1j5~ nTmkr!#<`*O#e]IX^\ch ' 7~x$W7>DpHz0զoc@?1NtJMS_\Fd[Ӛ>,䄤=^,]ƹb"F݁_{3ưJf-ceU܄ϯ냚 d\ "ՏT*$ !JAb+%(Jh1 3}L{4P\/D~+I{ubA-FQ >%)q6 0kp(;@PP_;2sb*ˊ_.|.#]<KIVthK+q)OF |?qIFpܖA0:_PCXX\̹4IrOlefB<2YR,cVp9ώn1^|.o>K&Rf}bF]ЛVΜVbֻD$M&)0)l`("̣c H O{'dA&ΊA?W`d gCm)5NƁ r<@Bl4dW+[gBtiּ;LF(TEpl \,jm$ uM/~[6w],}WiB2[#Ni'ȶ[?%FJ`I"Bl,j۝W(cx;V*TRЏ@9[+M10jJ}'fDPP@Y75B6 rbQ1EOQ0N_9h6k,=ƚY^hlCC  7 ?:7$xa] ֺm|O*&ȪľC}_;ɧJZ0D@)m_3Z9F007YA"dZθi| lN0\lsL8= S]s&"AHT\Eq2D 1!菨 fA6& YrOx;AH/=f_GV_00x_C&uò)GgNjyy-{5 2.SPJqݶR8zwu7r|T+Kz6nAYt*QՊU?:>GsO,\1TeyhRSsQf k? nQm%\5lk~U};lSQ69wםqZd>u-vr+ oP$FM]ySA&Ŝ Y؈ ZʭDcb1;KJ2C!࡟p_Lv^)pIN:|hݝ)1z. endstream endobj 154 0 obj << /Type /ObjStm /N 100 /First 915 /Length 4845 /Filter /FlateDecode >> stream x<[S=yr~j @!ʃN|&O_4cs򀬑Z}WwKc,e,D!M,)uԕ֧PH/<9QhN'>ipFIg k-:\ #tPFڈ8R9MnMB5`hVA4 +E8 +h[@VA(m45N1( ҁ%*G*̓7 *CqGp8(n`X= 9g0=hIFQ0a`{0;h W2`Ј_0x %X6: ą;tBQ5Ep ;D p\!@X $ A.ZU|<*>Ư .f6V1?=͊?,m &Aвmp 0q2v!^>`+'T[Ey9+'p>]rSq=5FM!Vq]5y${;ml` :C찎8ʭ2 ƴZ4L#Rz(8~'V֐Fl0]k 0fƐ{:Вh0RJQoA̰ϭH7)ТFVqB i6{0  M'򈢶5J6}R|7ɀl.n*o$9݀Zܱ֒eUR1\$Oph ܖ e@,$Gíc ]ڄ3kV#Py!b-*(9i:@9$<8 Z((*BCR#GBh\+L<6#OIXGrl9^Œjs+՚ܦR(v\8a_Rf? !Uv{KG S'ͥmV 8KϋѼ (et.uT d*kSM[XןZr6#@4/^Q#.,8̬Gp("ڄ/~ꄸTi.h%kdz4ڰHMhìTfYs[{c!lUTKKH|8@)FSQis L4:FrHKCڜ7nyZa=W 9GwUAiR:+G+J6u[ KZ)`R5!հo( 'Q˸^> T5[sH7B՛LUϰOH!l 5Ӝ[-(Eׅ򝎞I 40_ḁ'u[G`eT#mJ$Q% mR覠g6ASN~whT p"3+CYM4.(=Aar )B.G2Du A"x~>2tMXϧU4JI0XeU]}jqJCModK/!8I1o z<TL8J ׆.YӞӑn4AiKwIBJEʄ[ Qp#`6 m(iaf̯eMs]sH-\sLl"F|i-P8+@6 tXTLG ':C3nF+|rXu.͢d<˜;ڬ<]Mg0i-a++:n'21ӛ=,?[ޓ_Wngllv6(&"󃓝&,|OJX \6dbYaΈD|,VrSr"V._;^=XM[o]P~lİe"/s[ kRpůݡtĹd:vw5AOg`@HOyt/,Ĵx~k0v.ݟ4N\)'˫xC^,+5c foʘDa R"(mV+jQA+E䓏vIACAF4PxgY+H ¬=)cRK)JǷ(].~yfow2W[9/BR5BZbbۗG/Pn+{ {^|Sb`W)(0Va϶A:vu(Gx䤫p.Ӡ cATLwPb?eo2}H9, [0OT_ݽBi%VT0ݩLj%VJ/v0w%F,o(.QCR.|GcG;]h_%뚲$Y)8{%й 8EG'0sQ RfDꍾgȾ\mvozTJd]K>>p6jR|>ޗt߂غb1tv'e4 մ7:_1^lػϩ~\zLA+ɕGdp]tW֬m:,5R+Eн3ns>ߔ,C7[7C_9o$\Y=/z*9H}6R9{`qeWRb>&RPͭV2owvIꎭ;Y1f̃W_a]䙙~%+2+@_>6=k|t(?*m)J~;>1_ ~.t 5df|+o>l,E-,XZjj Y(MhIz>:(|>OO:X]4yQ= 8foڧamlhw* /4k\糋)SRkHM߶ېӗ}8L^M޷;w*Wzo&ĥ{(E>EA>f[/<my<o iS_;#~ԃXzCu%263[fo7O;>g3{x|¼M[ߝv\v6M{dSyqo^ xYf e|-rȇ߀_w:2]&\ZI~>iqp0U"QEO* N&$=֜ISR^*:ܰT'9_12f5s(YO3G4 M붃VV[pHW?Du畵TS}LSd\qIHqZ2t Z,E+T:&ra+HXħI6BK䩕.D|T1C Y;!glϞziu<Ƴ|Rpѕ'@-GT{hhZ \f-N, `|c6M N.92(Uo2ʆ`;"^ `T 69CMG}զڮ ʭʞA^fϰ ϠgԭK9lXq| GK10P>AqdWif@ g endstream endobj 246 0 obj << /Producer (pdfTeX-1.40.21) /Author()/Title()/Subject()/Creator(LaTeX with hyperref)/Keywords() /CreationDate (D:20211208182948+01'00') /ModDate (D:20211208182948+01'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.21 (TeX Live 2020/Debian) kpathsea version 6.3.2) >> endobj 241 0 obj << /Type /ObjStm /N 5 /First 38 /Length 264 /Filter /FlateDecode >> stream xڅOk1sjdb*PT<$ҍ~N!iC@BPrՠ)U2$&!_ySU U9bNHMqئA*^`LXKB>]饘N) GdzPV&ߨEU)cX({zwM`O5ϏճUN3_gA>F7ὡ<#_qLLCŦ?iZ{};̲/sQ Щ endstream endobj 247 0 obj << /Type /XRef /Index [0 248] /Size 248 /W [1 3 1] /Root 245 0 R /Info 246 0 R /ID [<0DA04AC776884F23644A3736F328A99C> <0DA04AC776884F23644A3736F328A99C>] /Length 623 /Filter /FlateDecode >> stream x%OUQg^@A\AP=v]TPDQq66&PZ`l@4.3(-My͗ߛ3s|""LDaj [$SIJ@ NP'0 `#6G*`uRP%m"k \l6)!;.PK58 7#48s@#ثR%>_j 'n謁tL4T.ŎfbtJc.z@/` }ZT@htF!ppKcI[eQ43&bģ.n&d?>fjgA7pL>)0M;Cz fTp>XO5]}O`cccccccccccccר,Ԫ4G*($Rl5RjH]IHog#5~Y[[Ɗ}mj޽ԡ'SH] dz"R^{k58R&_#jSOߑ5i@W5}>{%FixЌ'x,gRX]{#  endstream endobj startxref 322490 %%EOF Matrix/inst/doc/Announce.txt0000644000176200001440000000732311620523257015557 0ustar liggesusersBasically the text of the R-packages posting on Mar 28, 2008 : https://stat.ethz.ch/pipermail/r-packages/2008/000911.html ------------------------------------------------------------------------ This weekend, a new version of "the Matrix" (well, actually the R package named "Matrix") will become available on the CRAN mirrors. As some of you have noticed, the version numbers (current is version 0.999375-8) are converging to one, and we feel that we have solved enough of the many (mostly small) problems to announce that release 1.0-0 is imminent. In the DESCRIPTION of the package we say -------------------------------------------------------------- Title: A Matrix package for R Author: Douglas Bates <....> and Martin Maechler <....> Maintainer: Doug and Martin Description: Classes and methods for dense and sparse matrices and operations on them using Lapack, CSparse and CHOLMOD -------------------------------------------------------------- The Matrix package provides efficient methods for several formal (i.e. S4) classes of matrices where each of the actual classes are some combination of the following three categories 1) dense or sparse 2) symmmetric, triangular, diagonal or "general" (or "permutation") 3) numeric ("d"ouble), logical (TRUE/FALSE/NA) or "patter[n]" (0/1) matrices Interfaces to many efficient algorithms from Lapack (for "dense") and from CHOLMOD / Csparse (for "sparse") are all implemented via method definitions for the customary linear algebra functions %*%, t(), crossprod(), tcrossprod(), chol(), qr(), solve(), colSums(), rowSums(), kronecker(), determinant(), ... and for various formal groups of generics, such as "Math" (sin,exp,gamma,..) "Arith" (+,-,*,...), "Logic" (>, <=, ..), "Summary" (sum, max, ...) etc; is.na() Furthermore, 'indexing' : "A[...]" and "A[..] <- value" of all(!) kinds of S/R indexing and some new generic functions such as lu() {LU decomposition} Schur(), BunchKaufman(), norm(), rcond() {Matrix norms and condition numbers} expm() {Matrix exponential}, band(), triu(), tril() {extract band-diagonal or triangular sub-matrices} symmpart(), skewpart() { (x + t(x))/2 and (x - t(x)) / 2 } are provided. Further, an extension to the xtabs function xtabs(*, sparse=TRUE) for large sparse, two-way contingency tables and coercion of one *factor* (possibly crossed with one ) to the corresponding (potentially huge) sparse model matrix for sparse least squares and related computations. Further to the above, "Matrix" objects are also constructed by Matrix(), spMatrix(), bdiag() {block-diagonal}, Diagonal() and many as(., "....Matrix") possibilities. The Matrix package also provides a C level API (header files of exported C functions providing low-level functionality) to many of its internal algorithms that other packages can link to. Currently, the 'lme4' package makes heavy use of these exported C functions. --------------------------------------------------------------------------- One of the things we plan to improve considerably is the documentation for the package. Currently there are four vignettes but all but the Comparisons: Comparisons of Least Squares calculation speeds are really not complete in one way or another. --------------------------------------------------------------------------- We would appreciate current users of the Matrix package (and also generally interested useRs) exploring the package's capabilities and giving us feedback about problems that they might encounter or missing features, inefficiencies and maybe even "infelicities" (a.k.a. bugs). Fixing problems before the release of the 1.0-0 version of "The Matrix", rather than after its release, is our preferred approach Matrix/inst/doc/Design-issues.Rnw0000644000176200001440000001377013253770612016470 0ustar liggesusers\documentclass{article} % \usepackage{myVignette} \usepackage[authoryear,round]{natbib} \bibliographystyle{plainnat} \newcommand{\noFootnote}[1]{{\small (\textit{#1})}} \newcommand{\myOp}[1]{{$\left\langle\ensuremath{#1}\right\rangle$}} %% vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv %%\VignetteIndexEntry{Design Issues in Matrix package Development} %%\VignetteDepends{Matrix} \SweaveOpts{engine=R,eps=FALSE,pdf=TRUE,width=5,height=3,strip.white=true,keep.source=TRUE} % ^^^^^^^^^^^^^^^^ \title{Design Issues in Matrix package Development} \author{Martin Maechler and Douglas Bates\\R Core Development Team \\\email{maechler@stat.math.ethz.ch}, \email{bates@r-project.org}} \date{Spring 2008 ({\tiny typeset on \tiny\today})} % \begin{document} \maketitle \begin{abstract} This is a (\textbf{currently very incomplete}) write-up of the many smaller and larger design decisions we have made in organizing functionalities in the Matrix package. Classes: There's a rich hierarchy of matrix classes, which you can visualize as a set of trees whose inner (and ``upper'') nodes are \emph{virtual} classes and only the leaves are non-virtual ``actual'' classes. Functions and Methods: - setAs() - others \end{abstract} %% Note: These are explained in '?RweaveLatex' : <>= options(width=75) @ \section{The Matrix class structures} \label{sec:classes} Take Martin's DSC 2007 talk to depict class hierarchy. \\ --- --- --- %% \hrule[1pt]{\textwidth} \subsection{Diagonal Matrices} \label{ssec:diagMat} The class of diagonal matrices is worth mentioning for several reasons. First, we have wanted such a class, because \emph{multiplication} methods are particularly simple with diagonal matrices. The typical constructor is \Rfun{Diagonal} whereas the accessor (as for traditional matrices), \Rfun{diag} simply returns the \emph{vector} of diagonal entries: <>= library(Matrix) (D4 <- Diagonal(4, 10*(1:4))) str(D4) diag(D4) @ We can \emph{modify} the diagonal in the traditional way (via method definition for \Rfun{diag<-}): <>= diag(D4) <- diag(D4) + 1:4 D4 @ Note that \textbf{unit-diagonal} matrices (the identity matrices of linear algebra) with slot \code{diag = "U"} can have an empty \code{x} slot, very analogously to the unit-diagonal triangular matrices: <>= str(I3 <- Diagonal(3)) ## empty 'x' slot getClass("diagonalMatrix") ## extending "sparseMatrix" @ Originally, we had implemented diagonal matrices as \emph{dense} rather than sparse matrices. After several years it became clear that this had not been helpful really both from a user and programmer point of view. So now, indeed the \code{"diagonalMatrix"} class does extend the \code{"sparseMatrix"} one. However, we do \emph{not} store explicitly where the non-zero entries are, and the class does \emph{not} extend any of the typical sparse matrix classes, \code{"CsparseMatrix"}, \code{"TsparseMatrix"}, or \code{"RsparseMatrix"}. Rather, the \code{diag()}onal (vector) is the basic part of such a matrix, and this is simply the \code{x} slot unless the \code{diag} slot is \code{"U"}, the unit-diagonal case, which is the identity matrix. Further note, e.g., from the \code{?$\,$Diagonal} help page, that we provide (low level) utility function \code{.sparseDiagonal()} with wrappers \code{.symDiagonal()} and \code{.trDiagonal()} which will provide diagonal matrices inheriting from \code{"CsparseMatrix"} which may be advantageous in \emph{some cases}, but less efficient in others, see the help page. \section{Matrix Transformations} \label{sec:trafos} \subsection{Coercions between Matrix classes} \label{ssec:coerce} You may need to transform Matrix objects into specific shape (triangular, symmetric), content type (double, logical, \dots) or storage structure (dense or sparse). Every useR should use \code{as(x, )} to this end, where \code{} is a \emph{virtual} Matrix super class, such as \code{"triangularMatrix"} \code{"dMatrix"}, or \code{"sparseMatrix"}. In other words, the user should \emph{not} coerce directly to a specific desired class such as \code{"dtCMatrix"}, even though that may occasionally work as well. Here is a set of rules to which the Matrix developers and the users should typically adhere: \begin{description} \item[Rule~1]: \code{as(M, "matrix")} should work for \textbf{all} Matrix objects \code{M}. \item[Rule~2]: \code{Matrix(x)} should also work for matrix like objects \code{x} and always return a ``classed'' Matrix. Applied to a \code{"matrix"} object \code{m}, \code{M. <- Matrix(m)} can be considered a kind of inverse of \code{m <- as(M, "matrix")}. For sparse matrices however, \code{M.} well be a \code{CsparseMatrix}, and it is often ``more structured'' than \code{M}, e.g., <>= (M <- spMatrix(4,4, i=1:4, j=c(3:1,4), x=c(4,1,4,8))) # dgTMatrix m <- as(M, "matrix") (M. <- Matrix(m)) # dsCMatrix (i.e. *symmetric*) @ \item[Rule~3]: All the following coercions to \emph{virtual} matrix classes should work:\\ \begin{enumerate} \item \code{as(m, "dMatrix")} \item \code{as(m, "lMatrix")} \item \code{as(m, "nMatrix")} \item \code{as(m, "denseMatrix")} \item \code{as(m, "sparseMatrix")} \item \code{as(m, "generalMatrix")} \end{enumerate} whereas the next ones should work under some assumptions: \begin{enumerate} \item \code{as(m1, "triangularMatrix")} \\ should work when \code{m1} is a triangular matrix, i.e. the upper or lower triangle of \code{m1} contains only zeros. \item \code{as(m2, "symmetricMatrix")} should work when \code{m2} is a symmetric matrix in the sense of \code{isSymmetric(m2)} returning \code{TRUE}. Note that this is typically equivalent to something like \code{isTRUE(all.equal(m2, t(m2)))}, i.e., the lower and upper triangle of the matrix have to be equal \emph{up to small numeric fuzz}. \end{enumerate} \end{description} \section{Session Info} <>= toLatex(sessionInfo()) @ %not yet %\bibliography{Matrix} \end{document} Matrix/inst/doc/Introduction.R0000644000176200001440000000032714154165622016054 0ustar liggesusers### R code from vignette source 'Introduction.Rnw' ################################################### ### code chunk number 1: preliminaries ################################################### options(width=75) Matrix/inst/doc/Design-issues.R0000644000176200001440000000236614154165610016117 0ustar liggesusers### R code from vignette source 'Design-issues.Rnw' ################################################### ### code chunk number 1: preliminaries ################################################### options(width=75) ################################################### ### code chunk number 2: diag-class ################################################### library(Matrix) (D4 <- Diagonal(4, 10*(1:4))) str(D4) diag(D4) ################################################### ### code chunk number 3: diag-2 ################################################### diag(D4) <- diag(D4) + 1:4 D4 ################################################### ### code chunk number 4: unit-diag ################################################### str(I3 <- Diagonal(3)) ## empty 'x' slot getClass("diagonalMatrix") ## extending "sparseMatrix" ################################################### ### code chunk number 5: Matrix-ex ################################################### (M <- spMatrix(4,4, i=1:4, j=c(3:1,4), x=c(4,1,4,8))) # dgTMatrix m <- as(M, "matrix") (M. <- Matrix(m)) # dsCMatrix (i.e. *symmetric*) ################################################### ### code chunk number 6: sessionInfo ################################################### toLatex(sessionInfo()) Matrix/inst/doc/Intro2Matrix.Rnw0000644000176200001440000004450713775317466016327 0ustar liggesusers\documentclass{article} % \usepackage{myVignette} \usepackage{fullpage}% save trees ;-) \usepackage[authoryear,round]{natbib} \bibliographystyle{plainnat} \newcommand{\noFootnote}[1]{{\small (\textit{#1})}} \newcommand{\myOp}[1]{{$\left\langle\ensuremath{#1}\right\rangle$}} % %%\VignetteIndexEntry{2nd Introduction to the Matrix Package} %%\VignetteDepends{Matrix} \SweaveOpts{engine=R,eps=FALSE,pdf=TRUE,width=7,height=4,strip.white=true,keep.source=TRUE} % ^^^^^^^^^^^^^^^^ \title{2nd Introduction to the Matrix package} \author{Martin Maechler and Douglas Bates\\ R Core Development Team \\\email{maechler@stat.math.ethz.ch}, \email{bates@r-project.org}} \date{September 2006 ({\tiny typeset on \tiny\today})} % \begin{document} \maketitle \begin{abstract} % \emph{\Large Why should you want to work with this package and what % does it do for you?} Linear algebra is at the core of many areas of statistical computing and from its inception the \Slang{} has supported numerical linear algebra via a matrix data type and several functions and operators, such as \code{\%*\%}, \code{qr}, \code{chol}, and \code{solve}. However, these data types and functions do not provide direct access to all of the facilities for efficient manipulation of dense matrices, as provided by the Lapack subroutines, and they do not provide for manipulation of sparse matrices. The \pkg{Matrix} package provides a set of S4 classes for dense and sparse matrices that extend the basic matrix data type. Methods for a wide variety of functions and operators applied to objects from these classes provide efficient access to BLAS (Basic Linear Algebra Subroutines), Lapack (dense matrix), CHOLMOD including AMD and COLAMD and \code{Csparse} (sparse matrix) routines. One notable characteristic of the package is that whenever a matrix is factored, the factorization is stored as part of the original matrix so that further operations on the matrix can reuse this factorization. \end{abstract} %% Note: These are explained in '?RweaveLatex' : <>= options(width=75) @ \section{Introduction} \label{sec:Intro} The most automatic way to use the \pkg{Matrix} package is via the \Rfun{Matrix} function which is very similar to the standard \RR\ function \Rfun{matrix}, @ <>= library(Matrix) M <- Matrix(10 + 1:28, 4, 7) M tM <- t(M) @ %def Such a matrix can be appended to (using \Rfun{cbind} or \Rfun{rbind}) or indexed, <>= (M2 <- cbind(-1, M)) M[2, 1] M[4, ] @ where the last two statements show customary matrix indexing, returning a simple numeric vector each\footnote{because there's an additional default argument to indexing, \code{drop = TRUE}. If you add \hbox{``\code{\ ,\ drop = FALSE}\ ''} you will get submatrices instead of simple vectors.}. We assign 0 to some columns and rows to ``sparsify'' it, and some \code{NA}s (typically ``missing values'' in data analysis) in order to demonstrate how they are dealt with; note how we can \emph{``subassign''} as usual, for classical \RR{} matrices (i.e., single entries or whole slices at once), @ <>= M2[, c(2,4:6)] <- 0 M2[2, ] <- 0 M2 <- rbind(0, M2, 0) M2[1:2,2] <- M2[3,4:5] <- NA @ and then coerce it to a sparse matrix, @ <>= sM <- as(M2, "sparseMatrix") 10 * sM identical(sM * 2, sM + sM) is(sM / 10 + M2 %/% 2, "sparseMatrix") @ %def where the last three calls show that multiplication by a scalar keeps sparcity, as does other arithmetic, but addition to a ``dense'' object does not, as you might have expected after some thought about ``sensible'' behavior: @ <>= sM + 10 @ %def Operations on our classed matrices include (componentwise) arithmetic ($+$, $-$, $*$, $/$, etc) as partly seen above, comparison ($>$, $\le$, etc), e.g., <>= Mg2 <- (sM > 2) Mg2 @ returning a logical sparse matrix. When interested in the internal \textbf{str}ucture, \Rfun{str} comes handy, and we have been using it ourselves more regulary than \Rfun{print}ing (or \Rfun{show}ing as it happens) our matrices; alternatively, \Rfun{summary} gives output similar to Matlab's printing of sparse matrices. @ <>= str(Mg2) summary(Mg2) @ As you see from both of these, \code{Mg2} contains ``extra zero'' (here \code{FALSE}) entries; such sparse matrices may be created for different reasons, and you can use \Rfun{drop0} to remove (``drop'') these extra zeros. This should \emph{never} matter for functionality, and does not even show differently for logical sparse matrices, but the internal structure is more compact: <>= Mg2 <- drop0(Mg2) str(Mg2@x) # length 13, was 16 @ For large sparse matrices, visualization (of the sparsity pattern) is important, and we provide \Rfun{image} methods for that, e.g., <>= data(CAex) print(image(CAex, main = "image(CAex)")) # print(.) needed for Sweave @ \smallskip Further, i.e., in addition to the above implicitly mentioned \code{"Ops"} operators (\code{+}, \code{*},\dots, \code{<=},\code{>},\dots, \code{\&} which all work with our matrices, notably in conjunction with scalars and traditional matrices), the \code{"Math"}-operations (such as \Rfun{exp}, \Rfun{sin} or \Rfun{gamma}) and \code{"Math2"} (\Rfun{round} etc) and the \code{"Summary"} group of functions, \Rfun{min}, \Rfun{range}, \Rfun{sum}, all work on our matrices as they should. Note that all these are implemented via so called \emph{group methods}, see e.g., \code{?Arith} in \RR. The intention is that sparse matrices remain sparse whenever sensible, given the matrix \emph{classes} and operators involved, but not content specifically. E.g., + gives even for the rare cases where it would be advantageous to get a result. These classed matrices can be ``indexed'' (more technically ``subset'') as traditional \Slang{} (and hence \RR) matrices, as partly seen above. This also includes the idiom \code{M [ M \myOp{\mathit{op}} \myOp{\mathrm{num}}~]} which returns simple vectors, @ <>= sM[sM > 2] sml <- sM[sM <= 2] sml @ %def and \emph{``subassign''}ment similarly works in the same generality as for traditional \Slang{} matrices. %% We have seen that already above! %% This was the 2005 - Introduction vignette's first section: \subsection{\pkg{Matrix} package for numerical linear algebra} \label{ssec:intro-linalg} Linear algebra is at the core of many statistical computing techniques and, from its inception, the \Slang{} has supported numerical linear algebra via a matrix data type and several functions and operators, such as \code{\%*\%}, \code{qr}, \code{chol}, and \code{solve}. %% Initially the numerical linear algebra functions in \RR{} called underlying Fortran routines from the Linpack~\citep{Linpack} and Eispack~\citep{Eispack} libraries but over the years most of these functions have been switched to use routines from the Lapack~\citep{Lapack} library which is the state-of-the-art implementation of numerical dense linear algebra. %% Furthermore, \RR{} can be configured to use accelerated BLAS (Basic Linear Algebra Subroutines), such as those from the Atlas~\citep{Atlas} project or other ones, see the \RR~manual ``Installation and Administration''. Lapack provides routines for operating on several special forms of matrices, such as triangular matrices and symmetric matrices. Furthermore, matrix decompositions like the QR decompositions produce multiple output components that should be regarded as parts of a single object. There is some support in \RR{} for operations on special forms of matrices (e.g. the \code{backsolve}, \code{forwardsolve} and \code{chol2inv} functions) and for special structures (e.g. a QR structure is implicitly defined as a list by the \code{qr}, \code{qr.qy}, \code{qr.qty}, and related functions) but it is not as fully developed as it could be. Also there is no direct support for sparse matrices in \RR{} although \citet{koen:ng:2003} have developed the \pkg{SparseM} package for sparse matrices based on SparseKit. The \pkg{Matrix} package provides S4 classes and methods for dense and sparse matrices. The methods for dense matrices use Lapack and BLAS. The sparse matrix methods use CHOLMOD~\citep{Cholmod}, CSparse~\citep{Csparse} and other parts (AMD, COLAMD) of Tim Davis' ``SuiteSparse'' collection of sparse matrix libraries, many of which also use BLAS. \TODO{\Rfun{triu}, \Rfun{tril}, \Rfun{diag}, ... and \command{as(.,.)} , but of course only when they've seen a few different ones.} \TODO{matrix operators include \code{\%*\%}, \Rfun{crossprod}, \Rfun{tcrossprod}, \Rfun{solve}} \TODO{\Rfun{expm} is the matrix exponential ... ...} \TODO{\Rfun{symmpart} and \Rfun{skewpart} compute the symmetric part, \code{(x + t(x))/2} and the skew-symmetric part, \code{(x - t(x))/2} of a matrix \code{x}.} \TODO{factorizations include \Rfun{Cholesky} (or \Rfun{chol}), \Rfun{lu}, \Rfun{qr} (not yet for dense)} \TODO{Although generally the result of an operation on dense matrices is a dgeMatrix, certain operations return matrices of special types.} \TODO{E.g. show the distinction between \code{t(mm) \%*\% mm} and \code{crossprod(mm)}.} % \bigskip % ... ... ... The following is the old \file{Introduction.Rnw} ... FIXME ... ... \bigskip \section{Matrix Classes} The \pkg{Matrix} package provides classes for real (stored as double precision), logical and so-called ``pattern'' (binary) dense and sparse matrices. There are provisions to also provide integer and complex (stored as double precision complex) matrices. Note that in \RR, \code{logical} means entries \code{TRUE}, \code{FALSE}, or \code{NA}. To store just the non-zero pattern for typical sparse matrix algorithms, the pattern matrices are \emph{binary}, i.e., conceptually just \code{TRUE} or \code{FALSE}. In \pkg{Matrix}, the pattern matrices all have class names starting with \code{"n"} (patter\textbf{n}). \subsection{Classes for dense matrices} \label{ssec:DenseClasses} For the sake of brevity, we restrict ourselves to the \emph{real} (\textbf{d}ouble) classes, but they are paralleled by \textbf{l}ogical and patter\textbf{n} matrices for all but the positive definite ones. \begin{description} \item[dgeMatrix] Real matrices in general storage mode \item[dsyMatrix] Symmetric real matrices in non-packed storage \item[dspMatrix] Symmetric real matrices in packed storage (one triangle only) \item[dtrMatrix] Triangular real matrices in non-packed storage \item[dtpMatrix] Triangular real matrices in packed storage (triangle only) \item[dpoMatrix] Positive semi-definite symmetric real matrices in non-packed storage \item[dppMatrix] \ \ ditto \ \ in packed storage \end{description} Methods for these classes include coercion between these classes, when appropriate, and coercion to the \code{matrix} class; methods for matrix multiplication (\code{\%*\%}); cross products (\code{crossprod}), matrix norm (\code{norm}); reciprocal condition number (\code{rcond}); LU factorization (\code{lu}) or, for the \code{poMatrix} class, the Cholesky decomposition (\code{chol}); and solutions of linear systems of equations (\code{solve}). %-- mentioned above already: % Further, group methods have been defined for the \code{Arith} (basic % arithmetic, including with scalar numbers) and the \code{Math} (basic % mathematical functions) group.. Whenever a factorization or a decomposition is calculated it is preserved as a (list) element in the \code{factors} slot of the original object. In this way a sequence of operations, such as determining the condition number of a matrix then solving a linear system based on the matrix, do not require multiple factorizations of the same matrix nor do they require the user to store the intermediate results. \subsection{Classes for sparse matrices} \label{sec:SparseClasses} Used for large matrices in which most of the elements are known to be zero (or \code{FALSE} for logical and binary (``pattern'') matrices). Sparse matrices are automatically built from \Rfun{Matrix} whenever the majority of entries is zero (or \code{FALSE} respectively). Alternatively, \Rfun{sparseMatrix} builds sparse matrices from their non-zero entries and is typically recommended to construct large sparse matrices, rather than direct calls of \Rfun{new}. \TODO{E.g. model matrices created from factors with a large number of levels} \TODO{ or from spline basis functions (e.g. COBS, package \pkg{cobs}), etc.} \TODO{Other uses include representations of graphs. indeed; good you mentioned it! particularly since we still have the interface to the \pkg{graph} package. I think I'd like to draw one graph in that article --- maybe the undirected graph corresponding to a crossprod() result of dimension ca. $50^2$} \TODO{Specialized algorithms can give substantial savings in amount of storage used and execution time of operations.} \TODO{Our implementation is based on the CHOLMOD and CSparse libraries by Tim Davis.} \subsection{Representations of sparse matrices} \label{ssec:SparseReps} \subsubsection{Triplet representation (\class{TsparseMatrix})} Conceptually, the simplest representation of a sparse matrix is as a triplet of an integer vector \code{i} giving the row numbers, an integer vector \code{j} giving the column numbers, and a numeric vector \code{x} giving the non-zero values in the matrix.\footnote{For efficiency reasons, we use ``zero-based'' indexing in the \pkg{Matrix} package, i.e., the row indices \code{i} are in \code{0:(nrow(.)-1)} and the column indices \code{j} accordingly.} In \pkg{Matrix}, the \class{TsparseMatrix} class is the virtual class of all sparse matrices in triplet representation. Its main use is for easy input or transfer to other classes. As for the dense matrices, the class of the \code{x} slot may vary, and the subclasses may be triangular, symmetric or unspecified (``general''), such that the \class{TsparseMatrix} class has several\footnote{the $3 \times 3$ actual subclasses of \class{TsparseMatrix} are the three structural kinds, namely \textbf{t}riangular, \textbf{s}ymmetric and \textbf{g}eneral, times three entry classes, \textbf{d}ouble, \textbf{l}ogical, and patter\textbf{n}.} `actual'' subclasses, the most typical (numeric, general) is \class{dgTMatrix}: <>= getClass("TsparseMatrix") # (i,j, Dim, Dimnames) slots are common to all getClass("dgTMatrix") @ Note that the \emph{order} of the entries in the \code{(i,j,x)} vectors does not matter; consequently, such matrices are not unique in their representation. \footnote{ Furthermore, there can be \emph{repeated} \code{(i,j)} entries with the customary convention that the corresponding \code{x} entries are \emph{added} to form the matrix element $m_{ij}$. } %% The triplet representation is row-oriented if elements in the same row %% were adjacent and column-oriented if elements in the same column were %% adjacent. \subsubsection{Compressed representations: \class{CsparseMatrix} and \class{RsparseMatrix}} For most sparse operations we use the compressed column-oriented representation (virtual class \class{CsparseMatrix}) (also known as ``csc'', ``compressed sparse column''). Here, instead of storing all column indices \code{j}, only the \emph{start} index of every column is stored. Analogously, there is also a compressed sparse row (csr) representation, which e.g. is used in in the \pkg{SparseM} package, and we provide the \class{RsparseMatrix} for compatibility and completeness purposes, in addition to basic coercion (\code({as(., \textit{})} between the classes. %% (column-oriented triplet) except that \code{i} (\code{j}) just stores %% the index of the first element in the row (column). (There are a %% couple of other details but that is the gist of it.) These compressed representations remove the redundant row (column) indices and provide faster access to a given location in the matrix because you only need to check one row (column). There are certain advantages \footnote{routines can make use of high-level (``level-3'') BLAS in certain sparse matrix computations} to csc in systems like \RR{}, Octave and Matlab where dense matrices are stored in column-major order, therefore it is used in sparse matrix libraries such as CHOLMOD or CSparse of which we make use. For this reason, the \class{CsparseMatrix} class and subclasses are the principal classes for sparse matrices in the \pkg{Matrix} package. The Matrix package provides the following classes for sparse matrices \FIXME{many more --- maybe explain naming scheme?} \begin{description} \item[dgTMatrix] general, numeric, sparse matrices in (a possibly redundant) triplet form. This can be a convenient form in which to construct sparse matrices. \item[dgCMatrix] general, numeric, sparse matrices in the (sorted) compressed sparse column format. \item[dsCMatrix] symmetric, real, sparse matrices in the (sorted) compressed sparse column format. Only the upper or the lower triangle is stored. Although there is provision for both forms, the lower triangle form works best with TAUCS. \item[dtCMatrix] triangular, real, sparse matrices in the (sorted) compressed sparse column format. \end{description} \TODO{Can also read and write the Matrix Market and read the Harwell-Boeing representations.} \TODO{Can convert from a dense matrix to a sparse matrix (or use the Matrix function) but going through an intermediate dense matrix may cause problems with the amount of memory required.} \TODO{similar range of operations as for the dense matrix classes.} \section{More detailed examples of ``Matrix'' operations} Have seen \texttt{drop0()} above, %(p.3); only with logical showe a nice double example (where you see ``.'' and ``0''). Show the use of \code{dim<-} for \emph{resizing} a (sparse) matrix. Maybe mention \Rfun{nearPD}. \TODO{Solve a sparse least squares problem and demonstrate memory / speed gain} \TODO{mention \code{lme4} and \Rfun{lmer}, maybe use one example to show the matrix sizes.} \section{Notes about S4 classes and methods implementation} Maybe we could % even here (for R News, not only for JSS) give some glimpses of implementations at least on the \RR{} level ones? \TODO{The class hierarchy: a non-trivial tree where only the leaves are ``actual'' classes.} \TODO{The main advantage of the multi-level hierarchy is that methods can often be defined on a higher (virtual class) level which ensures consistency [and saves from ``cut \& paste'' and forgetting things]} \TODO{Using Group Methods} \section{Session Info} <>= toLatex(sessionInfo()) @ \bibliography{Matrix} \end{document} Matrix/inst/doc/Introduction.Rnw0000644000176200001440000001753412070262574016430 0ustar liggesusers\documentclass{article} \usepackage{myVignette} \usepackage[authoryear,round]{natbib} \bibliographystyle{plainnat} %%\VignetteIndexEntry{Introduction to the Matrix Package} %%\VignetteDepends{Matrix} \SweaveOpts{engine=R,eps=FALSE,pdf=TRUE,width=5,height=3,strip.white=true,keep.source=TRUE} \title{Introduction to the Matrix package --- as of Feb.~2005\footnote{ There's an unfinished ``2nd Introduction to the Matrix package'' which contains partly newer information, but is not at all self-contained. Eventually that will replace this one.}} \author{Douglas Bates\\R Core Development Group\\\email{bates@r-project.org}} \date{\today} \begin{document} \maketitle \begin{abstract} Linear algebra is at the core of many areas of statistical computing and from its inception the \Slang{} has supported numerical linear algebra via a matrix data type and several functions and operators, such as \code{\%*\%}, \code{qr}, \code{chol}, and \code{solve}. However, these data types and functions do not provide direct access to all of the facilities for efficient manipulation of dense matrices, as provided by the Lapack subroutines, and they do not provide for manipulation of sparse matrices. The \code{Matrix} package provides a set of S4 classes for dense and sparse matrices that extend the basic matrix data type. Methods for a wide variety of functions and operators applied to objects from these classes provide efficient access to BLAS (Basic Linear Algebra Subroutines), Lapack (dense matrix), TAUCS (sparse matrix) and UMFPACK (sparse matrix) routines. One notable characteristic of the package is that whenever a matrix is factored, the factorization is stored as part of the original matrix so that further operations on the matrix can reuse this factorization. \end{abstract} <>= options(width=75) @ \section{Introduction} \label{sec:Intro} Linear algebra is at the core of many statistical computing techniques and, from its inception, the \Slang{} has supported numerical linear algebra via a matrix data type and several functions and operators, such as \code{\%*\%}, \code{qr}, \code{chol}, and \code{solve}. Initially the numerical linear algebra functions in \RR{} called underlying Fortran routines from the Linpack~\citep{Linpack} and Eispack~\cite{Eispack} libraries but over the years most of these functions have been switched to use routines from the Lapack~\cite{Lapack} library. Furthermore, \RR{} can be configured to use accelerated BLAS (Basic Linear Algebra Subroutines), such as those from the Atlas~\cite{Atlas} project or Goto's BLAS~\cite{GotosBLAS}. Lapack provides routines for operating on several special forms of matrices, such as triangular matrices and symmetric matrices. Furthermore,matrix decompositions like the QR decompositions produce multiple output components that should be regarded as parts of a single object. There is some support in R for operations on special forms of matrices (e.g. the \code{backsolve}, \code{forwardsolve} and \code{chol2inv} functions) and for special structures (e.g. a QR structure is implicitly defined as a list by the \code{qr}, \code{qr.qy}, \code{qr.qty}, and related functions) but it is not as fully developed as it could be. Also there is no direct support for sparse matrices in R although \citet{koen:ng:2003} have developed a contributed package for sparse matrices based on SparseKit. The \code{Matrix} package provides S4 classes and methods for dense and sparse matrices. The methods for dense matrices use Lapack and BLAS. The sparse matrix methods use TAUCS~\citep{Taucs}, UMFPACK~\citep{Umfpack}, and Metis~\citep{Metis}. \section{Classes for dense matrices} \label{sec:DenseClasses} The \code{Matrix} package will provide classes for real (stored as double precision) and complex (stored as double precision complex) dense matrices. At present only the real classes have been implemented. These classes are \begin{description} \item[dgeMatrix] Real matrices in general storage mode \item[dsyMatrix] Symmetric real matrices in non-packed storage \item[dspMatrix] Symmetric real matrices in packed storage (one triangle only) \item[dtrMatrix] Triangular real matrices in non-packed storage \item[dtpMatrix] Triangular real matrices in packed storage (triangle only) \item[dpoMatrix] Positive semi-definite symmetric real matrices in non-packed storage \item[dppMatrix] \ \ ditto \ \ in packed storage \end{description} Methods for these classes include coercion between these classes, when appropriate, and coercion to the \code{matrix} class; methods for matrix multiplication (\code{\%*\%}); cross products (\code{crossprod}), matrix norm (\code{norm}); reciprocal condition number (\code{rcond}); LU factorization (\code{lu}) or, for the \code{poMatrix} class, the Cholesky decomposition (\code{chol}); and solutions of linear systems of equations (\code{solve}). Further, group methods have been defined for the \code{Arith} (basic arithmetic, including with scalar numbers) and the \code{Math} (basic mathematical functions) group.. Whenever a factorization or a decomposition is calculated it is preserved as a (list) element in the \code{factors} slot of the original object. In this way a sequence of operations, such as determining the condition number of a matrix then solving a linear system based on the matrix, do not require multiple factorizations of the same matrix nor do they require the user to store the intermediate results. \section{Classes for sparse matrices} \label{sec:SparseClasses} \subsection{Representations of sparse matrices} \label{ssec:SparseReps} Conceptually, the simplest representation of a sparse matrix is as a triplet of an integer vector \code{i} giving the row numbers, an integer vector \code{j} giving the column numbers, and a numeric vector \code{x} giving the non-zero values in the matrix. An S4 class definition might be \begin{Schunk} \begin{Sinput} setClass("dgTMatrix", representation(i = "integer", j = "integer", x = "numeric", Dim = "integer")) \end{Sinput} \end{Schunk} The triplet representation is row-oriented if elements in the same row were adjacent and column-oriented if elements in the same column were adjacent. The compressed sparse row (csr) (or compressed sparse column - csc) representation is similar to row-oriented triplet (column-oriented triplet) except that \code{i} (\code{j}) just stores the index of the first element in the row (column). (There are a couple of other details but that is the gist of it.) These compressed representations remove the redundant row (column) indices and provide faster access to a given location in the matrix because you only need to check one row (column). The preferred representation of sparse matrices in the SparseM package is csr. Matlab uses csc. We hope that Octave will also use this representation. There are certain advantages to csc in systems like R and Matlab where dense matrices are stored in column-major order. For example, Sivan Toledo's TAUCS~\cite{Taucs} library and Tim Davis's UMFPACK~\cite{Umfpack} library are both based on csc and can both use level-3 BLAS in certain sparse matrix computations. The Matrix package provides the following classes for sparse matrices \begin{description} \item[dgTMatrix] general, numeric, sparse matrices in (a possibly redundant) triplet form. This can be a convenient form in which to construct sparse matrices. \item[dgCMatrix] general, numeric, sparse matrices in the (sorted) compressed sparse column format. \item[dsCMatrix] symmetric, real, sparse matrices in the (sorted) compressed sparse column format. Only the upper or the lower triangle is stored. Although there is provision for both forms, the lower triangle form works best with TAUCS. \item[dtCMatrix] triangular, real, sparse matrices in the (sorted) compressed sparse column format. \end{description} \bibliography{Matrix} \end{document} Matrix/inst/doc/sparseModels.Rnw0000644000176200001440000002520213775317466016415 0ustar liggesusers\documentclass{article} % \usepackage{fullpage} \usepackage{myVignette} \usepackage[authoryear,round]{natbib} \bibliographystyle{plainnat} \newcommand{\noFootnote}[1]{{\small (\textit{#1})}} \newcommand{\myOp}[1]{{$\left\langle\ensuremath{#1}\right\rangle$}} %%\VignetteIndexEntry{Sparse Model Matrices} %%\VignetteDepends{Matrix,MASS} \title{Sparse Model Matrices} \author{Martin Maechler\\ R Core Development Team \\\email{maechler@R-project.org}} \date{July 2007, 2008 ({\tiny typeset on \tiny\today})} % \begin{document} \maketitle \SweaveOpts{engine=R, keep.source=TRUE} \SweaveOpts{eps=FALSE, pdf=TRUE, width=8, height=5.5, strip.white=true} \setkeys{Gin}{width=\textwidth} % \begin{abstract} % ............................ FIXME % \end{abstract} %% Note: These are explained in '?RweaveLatex' : <>= options(width=75) @ \section*{Introduction} Model matrices in the very widely used (generalized) linear models of statistics, (typically fit via \Rfun{lm} or \Rfun{glm} in \RR) are often practically sparse --- whenever categorical predictors, \code{factor}s in \RR, are used. %% FIXME: Introduce lm.fit.sparse() or not ? We show for a few classes of such linear models how to construct sparse model matrices using sparse matrix (S4) objects from the \pkg{Matrix} package, and typically \emph{without} using dense matrices in intermediate steps. %% only the latter is really novel, since "SparseM" (and others) %% have used the equivalent of %% as( model.matrix(.....), "sparseMatrix") \section{One factor: \texttt{y $\sim$ f1}} Let's start with an artifical small example: <>= (ff <- factor(strsplit("statistics_is_a_task", "")[[1]], levels=c("_",letters))) factor(ff) # drops the levels that do not occur f1 <- ff[, drop=TRUE] # the same, more transparently @ and now assume a model $$y_i = \mu + \alpha_{j(i)} + E_i,$$ for $i=1,\dots,n =$~\code{length(f1)}$= 20$, and $\alpha_{j(i)}$ with a constraint such as $\sum_j \alpha_j = 0$ (``sum'') or $\alpha_1 = 0$ (``treatment'') and $j(i) =$\code{as.numeric(f1[i])} being the level number of the $i$-th observation. For such a ``design'', the model is only estimable if the levels \code{c} and \code{k} are merged, and <>= levels(f1)[match(c("c","k"), levels(f1))] <- "ck" library(Matrix) Matrix(contrasts(f1)) # "treatment" contrasts by default -- level "_" = baseline Matrix(contrasts(C(f1, sum))) Matrix(contrasts(C(f1, helmert)), sparse=TRUE) # S-plus default; much less sparse @ where \Rfun{contrasts} is (conceptually) just one major ingredient in the well-known \Rfun{model.matrix} function to build the linear model matrix $\mathbf{X}$ of so-called ``dummy variables''. %% Since 2007, the \pkg{Matrix} package has been providing coercion from a \code{factor} object to a \code{sparseMatrix} one to produce the transpose of the model matrix corresponding to a model with that factor as predictor (and no intercept): <>= as(f1, "sparseMatrix") @ which is really almost the transpose of using the above sparsification of \Rfun{contrasts} (and arranging for nice printing), <>= printSpMatrix( t( Matrix(contrasts(f1))[as.character(f1) ,] ), col.names=TRUE) @ and that is the same as the ``sparsification'' of \Rfun{model.matrix}, apart from the column names (here transposed), <>= t( Matrix(model.matrix(~ 0+ f1))) # model with*OUT* intercept @ A more realistic small example is the \code{chickwts} data set, <>= str(chickwts)# a standard R data set, 71 x 2 x.feed <- as(chickwts$feed, "sparseMatrix") x.feed[ , (1:72)[c(TRUE,FALSE,FALSE)]] ## every 3rd column: @ % FIXME: Move this to ../../../MatrixModels/inst/doc/ ??? % ## Provisional (hence unexported) sparse lm.fit(): % Matrix:::lm.fit.sparse(x = t(x.feed), y = chickwts[,1]) %- for emacs: $ \section{One factor, one continuous: \texttt{y $\sim$ f1 + x}} To create the model matrix for the case of one factor and one continuous predictor---called ``analysis of covariance'' in the historical literature--- we can adopt the following simple scheme. %% Possible examples: %% - Puromycin %% - ToothGrowth %--- FIXME --- The final model matrix is the concatenation of: 1) create the sparse 0-1 matrix \code{m1} from the f1 main-effect 2) the single row/column 'x' == 'x' main-effect 3) replacing the values 1 in \code{m1@x} (the x-slot of the factor model matrix), by the values of \code{x} (our continuous predictor). \section{Two (or more) factors, main effects only: \texttt{y $\sim$ f1 + f2}} %% FIXME: 'warpbreaks' is smaller and more natural as fixed effect model! Let us consider the \code{warpbreaks} data set of 54 observations, <>= data(warpbreaks)# a standard R data set str(warpbreaks) # 2 x 3 (x 9) balanced two-way with 9 replicates: xtabs(~ wool + tension, data = warpbreaks) @ %It is \emph{not} statistically sensible to assume that \code{Run} is a %fixed effect, however the example is handy to depict how a model matrix This example depicts how a model matrix would be built for the model \code{breaks ~ wool + tension}. Since this is a main effects model (no interactions), the desired model matrix is simply the concatenation of the model matrices of the main effects. There are two here, but the principle applies to general main effects of factors. The most sparse matrix is reached by \emph{not} using an intercept, (which would give an all-1-column) but rather have one factor fully coded (aka ``swallow'' the intercept), and all others being at \code{"treatment"} contrast, i.e., here, the \emph{transposed} model matrix, \code{tmm}, is <>= tmm <- with(warpbreaks, rbind(as(tension, "sparseMatrix"), as(wool, "sparseMatrix")[-1,,drop=FALSE])) print( image(tmm) ) # print(.) the lattice object @ \\ The matrices are even sparser when the factors have more than just two or three levels, e.g., for the morley data set, <>= data(morley) # a standard R data set morley$Expt <- factor(morley$Expt) morley$Run <- factor(morley$Run) str(morley) t.mm <- with(morley, rbind(as(Expt, "sparseMatrix"), as(Run, "sparseMatrix")[-1,])) print( image(t.mm) ) # print(.) the lattice object @ %% Also see Doug's E-mail to R-help % From: "Douglas Bates" % Subject: Re: [R] Large number of dummy variables % Date: Mon, 21 Jul 2008 18:07:26 -0500 \section{Interactions of two (or more) factors,.....} %% Of course, this is *the* interesting part %% To form interactions, we would have to ``outer-multiply'' %% the single-factor model-matrices (after "[, -1]") In situations with more than one factor, particularly with interactions, the model matrix is currently not directly available via \pkg{Matrix} functions --- but we still show to build them carefully. The easiest---but not at memory resources efficient---way is to go via the dense \Rfun{model.matrix} result: <>= data(npk, package="MASS") npk.mf <- model.frame(yield ~ block + N*P*K, data = npk) ## str(npk.mf) # the data frame + "terms" attribute m.npk <- model.matrix(attr(npk.mf, "terms"), data = npk) class(M.npk <- Matrix(m.npk)) dim(M.npk)# 24 x 13 sparse Matrix t(M.npk) # easier to display, column names readably displayed as row.names(t(.)) @ %% printSpMatrix(M.npk, col.names = "abb1") Another example was reported by a user on R-help (July 15, 2008, {\small \url{https://stat.ethz.ch/pipermail/r-help/2008-July/167772.html}}) about an ``aov error with large data set''. \begin{citation} % RAS: in my PDF, I don't see the first character I I'm looking to analyze a large data set: a within-Ss 2*2*1500 design with 20 Ss. However, aov() gives me an error. %, reproducible as follows: \end{citation} And gave the following code example (slightly edited): <>= id <- factor(1:20) a <- factor(1:2) b <- factor(1:2) d <- factor(1:1500) aDat <- expand.grid(id=id, a=a, b=b, d=d) aDat$y <- rnorm(length(aDat[, 1])) # generate some random DV data dim(aDat) # 120'000 x 5 (120'000 = 2*2*1500 * 20 = 6000 * 20) @ %% ^^^^^^^ MM: "fix" and generate much more interesting data and then continued with \begin{Sinput} m.aov <- aov(y ~ a*b*d + Error(id/(a*b*d)), data=aDat) \end{Sinput} \begin{citation}\sffamily which yields the following error:\\ \ttfamily Error in model.matrix.default(mt, mf, contrasts) :\\ allocMatrix: too many elements specified\\ \end{citation} to which he got the explanation by Peter Dalgaard that the formal model matrix involved was much too large in this case, and that PD assumed, \pkg{lme4} would be able to solve the problem. However, currently there would still be a big problem with using \pkg{lme4}, because of the many levels of \emph{fixed} effects: Specifically\footnote{the following is not run in \RR\ on purpose, rather just displayed here}, \begin{Sinput} dim(model.matrix( ~ a*b*d, data = aDat)) # 120'000 x 6000 \end{Sinput} where we note that $120'000 \times 6000 = 720 \textrm{mio}$, which is $720'000'000 * 8 / 2^{20} \approx 5500$ Megabytes. \emph{Unfortunately} \pkg{lme4} does \emph{not} use a sparse $X$-matrix for the fixed effects (yet), it just uses sparse matrices for the $Z$-matrix of random effects and sparse matrix operations for computations related to $Z$. Let us use a smaller factor \code{d} in order to investigate how sparse the $X$ matrix would be: <>= d2 <- factor(1:150) # 10 times smaller tmp2 <- expand.grid(id=id, a=a, b=b, d=d2) dim(tmp2) dim(mm <- model.matrix( ~ a*b*d, data=tmp2)) ## is 100 times smaller than original example class(smm <- Matrix(mm)) # automatically coerced to sparse round(object.size(mm) / object.size(smm), 1) @ shows that even for the small \code{d} here, the memory reduction would be more than an order of magnitude. \\ %% Reasons to fake here: %% 1) print() is needed for lattice -- but looks ugly, %% 2) the resulting pdf file is too large -- use png instead: <>= image(t(smm), aspect = 1/3, lwd=0, col.regions = "red") <>= png("sparseModels-X-sparse-image.png", width=6, height=3, units='in', res=150) print( <> ) dev.off() @ %%--NB: 'keep.source=FALSE' above is workaround-a-bug-in-R-devel-(2.13.x)--- \par\vspace*{-1ex} \centerline{% \includegraphics[width=1.1\textwidth]{sparseModels-X-sparse-image.png}} and working with the sparse instead of the dense model matrix is considerably faster as well, <>= x <- 1:600 system.time(y <- smm %*% x) ## sparse is much faster system.time(y. <- mm %*% x) ## than dense identical(as.matrix(y), y.) ## TRUE @ <>= toLatex(sessionInfo()) @ \end{document} Matrix/inst/doc/Intro2Matrix.R0000644000176200001440000000467714154165615015753 0ustar liggesusers### R code from vignette source 'Intro2Matrix.Rnw' ################################################### ### code chunk number 1: preliminaries ################################################### options(width=75) ################################################### ### code chunk number 2: ex1 ################################################### library(Matrix) M <- Matrix(10 + 1:28, 4, 7) M tM <- t(M) ################################################### ### code chunk number 3: ex2 ################################################### (M2 <- cbind(-1, M)) M[2, 1] M[4, ] ################################################### ### code chunk number 4: set0 ################################################### M2[, c(2,4:6)] <- 0 M2[2, ] <- 0 M2 <- rbind(0, M2, 0) M2[1:2,2] <- M2[3,4:5] <- NA ################################################### ### code chunk number 5: asSparse ################################################### sM <- as(M2, "sparseMatrix") 10 * sM identical(sM * 2, sM + sM) is(sM / 10 + M2 %/% 2, "sparseMatrix") ################################################### ### code chunk number 6: add1 ################################################### sM + 10 ################################################### ### code chunk number 7: Comp1 ################################################### Mg2 <- (sM > 2) Mg2 ################################################### ### code chunk number 8: str_mat ################################################### str(Mg2) summary(Mg2) ################################################### ### code chunk number 9: drop0 ################################################### Mg2 <- drop0(Mg2) str(Mg2@x) # length 13, was 16 ################################################### ### code chunk number 10: image ################################################### data(CAex) print(image(CAex, main = "image(CAex)")) # print(.) needed for Sweave ################################################### ### code chunk number 11: sub_logi ################################################### sM[sM > 2] sml <- sM[sM <= 2] sml ################################################### ### code chunk number 12: Tsparse-class ################################################### getClass("TsparseMatrix") # (i,j, Dim, Dimnames) slots are common to all getClass("dgTMatrix") ################################################### ### code chunk number 13: sessionInfo ################################################### toLatex(sessionInfo()) Matrix/inst/doc/SuiteSparse/0000755000176200001440000000000014154165362015516 5ustar liggesusersMatrix/inst/doc/SuiteSparse/SPQR.txt0000644000176200001440000000434311072415476017050 0ustar liggesusersSuiteSparseQR version 1.1.0, Sept 20, 2008, Copyright (c) 2008, Timothy A. Davis SuiteSparseQR is a a multithread, multifrontal, rank-revealing sparse QR factorization method. QUICK START FOR MATLAB USERS (on Windows, Linux, Solaris, or the Mac OS): To compile and test the MATLAB mexFunctions, do this in the MATLAB command window: cd SuiteSparse/SPQR/MATLAB spqr_install spqr_demo FOR MORE DETAILS: please see the User Guide in Doc/spqr_user_guide.pdf. FOR LINUX/UNIX/Mac USERS who want to use the C++ callable library: To compile the C++ library and run a short demo, just type "make" in the Unix shell. To compile the SuiteSparseQR C++ library, in the Unix shell, do: cd Lib ; make To compile and test an exhaustive test, edit the Tcov/Makefile to select the LAPACK and BLAS libraries, and then do (in the Unix shell): cd Tcov ; make Compilation options in UFconfig/UFconfig.mk, SPQR/*/Makefile, or SPQR/MATLAB/spqr_make.m: -DNPARTITION to compile without METIS (default is to use METIS) -DNEXPERT to compile without the min 2-norm solution option (default is to include the Expert routines) -DHAVE_TBB to compile with Intel's Threading Building Blocks (default is to not use Intel TBB) -DTIMING to compile with timing and exact flop counts enabled (default is to not compile with timing and flop counts) -------------------------------------------------------------------------------- SuiteSparseQR 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 of the License, or (at your option) any later version. SuiteSparseQR 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 Module; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. Matrix/inst/doc/SuiteSparse/SuiteSparse_config.txt0000644000176200001440000000445013652535054022057 0ustar liggesusersSuiteSparse_config, 2020, Timothy A. Davis, http://www.suitesparse.com (formerly the UFconfig package) This directory contains a default SuiteSparse_config.mk file. It tries to detect your system (Linux, SunOS, or Mac), which compiler to use (icc or cc), which BLAS and LAPACK library to use (Intel MKL is strongly preferred), and whether or not to compile with CUDA. For alternatives, see the comments in the SuiteSparse_config.mk file. License: No licensing restrictions apply to this file or to the SuiteSparse_config directory. -------------------------------------------------------------------------------- SuiteSparse_config contains configuration settings for all many of the software packages that I develop or co-author. Note that older versions of some of these packages do not require SuiteSparse_config. Package Description ------- ----------- AMD approximate minimum degree ordering CAMD constrained AMD COLAMD column approximate minimum degree ordering CCOLAMD constrained approximate minimum degree ordering UMFPACK sparse LU factorization, with the BLAS CXSparse int/long/real/complex version of CSparse CHOLMOD sparse Cholesky factorization, update/downdate KLU sparse LU factorization, BLAS-free BTF permutation to block triangular form LDL concise sparse LDL' LPDASA LP Dual Active Set Algorithm RBio read/write files in Rutherford/Boeing format SPQR sparse QR factorization (full name: SuiteSparseQR) SuiteSparse_config is not required by these packages: CSparse a Concise Sparse matrix package MATLAB_Tools toolboxes for use in MATLAB GraphBLAS graph algorithms in the language of linear algebra In addition, the xerbla/ directory contains Fortan and C versions of the BLAS/LAPACK xerbla routine, which is called when an invalid input is passed to the BLAS or LAPACK. The xerbla provided here does not print any message, so the entire Fortran I/O library does not need to be linked into a C application. Most versions of the BLAS contain xerbla, but those from K. Goto do not. Use this if you need too. If you edit this directory (SuiteSparse_config.mk in particular) then you must do "make purge ; make" in the parent directory to recompile all of SuiteSparse. Otherwise, the changes will not necessarily be applied. Matrix/inst/doc/SuiteSparse/CHOLMOD.txt0000644000176200001440000000614313652535054017351 0ustar liggesusersCHOLMOD: a sparse CHOLesky MODification package, Copyright (c) 2005-2020. http://www.suitesparse.com ----------------------------------------------- CHOLMOD is a set of routines for factorizing sparse symmetric positive definite matrices of the form A or AA', updating/downdating a sparse Cholesky factorization, solving linear systems, updating/downdating the solution to the triangular system Lx=b, and many other sparse matrix functions for both symmetric and unsymmetric matrices. Its supernodal Cholesky factorization relies on LAPACK and the Level-3 BLAS, and obtains a substantial fraction of the peak performance of the BLAS. Both real and complex matrices are supported. CHOLMOD is written in ANSI/ISO C, with both C and MATLAB interfaces. This code works on Microsoft Windows and many versions of Unix and Linux. Some Modules of CHOLMOD are copyrighted by the University of Florida (the Core and Partition Modules). The rest are copyrighted by the authors: Timothy A. Davis (all of them), and William W. Hager (the Modify Module). CHOLMOD relies on several other packages: AMD, CAMD, COLAMD, CCOLAMD, SuiteSparse_config, METIS, the BLAS, and LAPACK. All but METIS, the BLAS, and LAPACK are part of SuiteSparse. AMD is authored by T. Davis, Iain Duff, and Patrick Amestoy. COLAMD is authored by T. Davis and Stefan Larimore, with algorithmic design in collaboration with John Gilbert and Esmond Ng. CCOLAMD is authored by T. Davis and Siva Rajamanickam. CAMD is authored by T. Davis and Y. Chen. LAPACK and the BLAS are authored by Jack Dongarra and many others. LAPACK is available at http://www.netlib.org/lapack METIS 5.1.0 is authored by George Karypis, Univ. of Minnesota. Its use in CHOLMOD is optional. A copy is in SuiteSparse/metis-5.1.0. If you do not wish to use METIS, you must edit SuiteSparse_config and change the line: CHOLMOD_CONFIG = to CHOLMOD_CONFIG = -DNPARTITION The CHOLMOD, AMD, COLAMD, CCOLAMD, and SuiteSparse)config directories must all reside in a common parent directory. To compile all these libraries, edit SuiteSparse)config/SuiteSparse)config.mk to reflect your environment (C compiler, location of the BLAS, and so on) and then type "make" in either the CHOLMOD directory or in the parent directory of CHOLMOD. See each package for more details on how to compile them. For use in MATLAB (on any system, including Windows): start MATLAB, cd to the CHOLMOD/MATLAB directory, and type cholmod_make in the MATLAB Command Window. This is the best way to compile CHOLMOD for MATLAB; it provides a workaround for a METIS design feature, in which METIS terminates your program (and thus MATLAB) if it runs out of memory. Using cholmod_make also ensures your mexFunctions are compiled with -fexceptions, so that exceptions are handled properly (when hitting control-C in the MATLAB command window, for example). Acknowledgements: this work was supported in part by the National Science Foundation (NFS CCR-0203270 and DMS-9803599), and a grant from Sandia National Laboratories (Dept. of Energy) which supported the development of CHOLMOD's Partition Module. Matrix/inst/doc/SuiteSparse/COLAMD.txt0000644000176200001440000001236413652535054017225 0ustar liggesusersCOLAMD, Copyright 1998-2016, Timothy A. Davis. http://www.suitesparse.com ------------------------------------------------------------------------------- The COLAMD column approximate minimum degree ordering algorithm computes a permutation vector P such that the LU factorization of A (:,P) tends to be sparser than that of A. The Cholesky factorization of (A (:,P))'*(A (:,P)) will also tend to be sparser than that of A'*A. SYMAMD is a symmetric minimum degree ordering method based on COLAMD, available as a MATLAB-callable function. It constructs a matrix M such that M'*M has the same pattern as A, and then uses COLAMD to compute a column ordering of M. Colamd and symamd tend to be faster and generate better orderings than their MATLAB counterparts, colmmd and symmmd. To compile and test the colamd m-files and mexFunctions, just unpack the COLAMD/ directory from the COLAMD.tar.gz file, and run MATLAB from within that directory. Next, type colamd_test to compile and test colamd and symamd. This will work on any computer with MATLAB (Unix, PC, or Mac). Alternatively, type "make" (in Unix) to compile and run a simple example C code, without using MATLAB. To compile and install the colamd m-files and mexFunctions, just cd to COLAMD/MATLAB and type colamd_install in the MATLAB command window. A short demo will run. Optionally, type colamd_test to run an extensive tests. Type "make" in Unix in the COLAMD directory to compile the C-callable library and to run a short demo. Colamd is a built-in routine in MATLAB, available from The Mathworks, Inc. Under most cases, the compiled COLAMD from Versions 2.0 to the current version do not differ. Colamd Versions 2.2 and 2.3 differ only in their mexFunction interaces to MATLAB. v2.4 fixes a bug in the symamd routine in v2.3. The bug (in v2.3 and earlier) has no effect on the MATLAB symamd mexFunction. v2.5 adds additional checks for integer overflow, so that the "int" version can be safely used with 64-bit pointers. Refer to the ChangeLog for more details. Other "make" targets: make library compiles a C-callable library containing colamd make clean removes all files not in the distribution, but keeps the compiled libraries. make distclean removes all files not in the distribution make install installs the library in /usr/local/lib and /usr/local/include make uninstall uninstalls the library from /usr/local/lib and /usr/local/include To use colamd and symamd within an application written in C, all you need are colamd.c, and colamd.h, which are the C-callable colamd/symamd codes. See colamd.c for more information on how to call colamd from a C program. Requires SuiteSparse_config, in the ../SuiteSparse_config directory relative to this directory. See COLAMD/Doc/License.txt for the License. Related papers: T. A. Davis, J. R. Gilbert, S. Larimore, E. Ng, An approximate column minimum degree ordering algorithm, ACM Transactions on Mathematical Software, vol. 30, no. 3., pp. 353-376, 2004. T. A. Davis, J. R. Gilbert, S. Larimore, E. Ng, Algorithm 836: COLAMD, an approximate column minimum degree ordering algorithm, ACM Transactions on Mathematical Software, vol. 30, no. 3., pp. 377-380, 2004. "An approximate minimum degree column ordering algorithm", S. I. Larimore, MS Thesis, Dept. of Computer and Information Science and Engineering, University of Florida, Gainesville, FL, 1998. CISE Tech Report TR-98-016. Approximate Deficiency for Ordering the Columns of a Matrix, J. L. Kern, Senior Thesis, Dept. of Computer and Information Science and Engineering, University of Florida, Gainesville, FL, 1999. Authors: Stefan I. Larimore and Timothy A. Davis, in collaboration with John Gilbert, Xerox PARC (now at UC Santa Barbara), and Esmong Ng, Lawrence Berkeley National Laboratory (much of this work he did while at Oak Ridge National Laboratory). COLAMD files: Demo simple demo Doc additional documentation (see colamd.c for more) Include include file Lib compiled C-callable library Makefile primary Unix Makefile MATLAB MATLAB functions README.txt this file Source C source code ./Demo: colamd_example.c simple example colamd_example.out output of colamd_example.c colamd_l_example.c simple example, long integers colamd_l_example.out output of colamd_l_example.c Makefile Makefile for C demos ./Doc: ChangeLog change log License.txt license ./Include: colamd.h include file ./Lib: Makefile Makefile for C-callable library ./MATLAB: colamd2.m MATLAB interface for colamd2 colamd_demo.m simple demo colamd_install.m compile and install colamd2 and symamd2 colamd_make.m compile colamd2 and symamd2 colamdmex.ca MATLAB mexFunction for colamd2 colamd_test.m extensive test colamdtestmex.c test function for colamd Contents.m contents of the MATLAB directory luflops.m test code Makefile Makefile for MATLAB functions symamd2.m MATLAB interface for symamd2 symamdmex.c MATLAB mexFunction for symamd2 symamdtestmex.c test function for symamd ./Source: colamd.c primary source code Matrix/inst/doc/SuiteSparse/AMD.txt0000644000176200001440000001612113652535054016662 0ustar liggesusersAMD, Copyright (c) 2009-2013 by Timothy A. Davis (http://www.suitesparse.com), Patrick R. Amestoy, and Iain S. Duff. All Rights Reserved. AMD is available under alternate licences; contact T. Davis for details. AMD: a set of routines for permuting sparse matrices prior to factorization. Includes a version in C, a version in Fortran, and a MATLAB mexFunction. Requires SuiteSparse_config, in the ../SuiteSparse_config directory relative to this directory. Quick start (Unix, or Windows with Cygwin): To compile, test, and install AMD, you may wish to first configure the installation by editting the ../SuiteSparse_config/SuiteSparse_config.mk file. Next, cd to this directory (AMD) and type "make" (or "make lib" if you do not have MATLAB). To compile and run a demo program for the Fortran version, type "make fortran". When done, type "make clean" to remove unused *.o files (keeps the compiled libraries and demo programs). See the User Guide (Doc/AMD_UserGuide.pdf), or ../SuiteSparse_config/SuiteSparse_config.mk for more details. To install do "make install" Quick start (for MATLAB users); To compile, test, and install the AMD mexFunction, cd to the AMD/MATLAB directory and type amd_make at the MATLAB prompt. ------------------------------------------------------------------------------- AMD License: refer to the AMD/Doc/License.txt file for the license. Availability: http://www.suitesparse.com ------------------------------------------------------------------------------- This is the AMD README file. It is a terse overview of AMD. Refer to the User Guide (Doc/AMD_UserGuide.pdf) for how to install and use AMD. Description: AMD is a set of routines for pre-ordering sparse matrices prior to Cholesky or LU factorization, using the approximate minimum degree ordering algorithm. Written in ANSI/ISO C with a MATLAB interface, and in Fortran 77. Authors: Timothy A. Davis (DrTimothyAldenDavis@gmail.com) Patrick R. Amestory, ENSEEIHT, Toulouse, France. Iain S. Duff, Rutherford Appleton Laboratory, UK. Acknowledgements: This work was supported by the National Science Foundation, under grants DMS-9504974, DMS-9803599, and CCR-0203270. Portions of this work were done while on sabbatical at Stanford University and Lawrence Berkeley National Laboratory (with funding from the SciDAC program). I would like to thank Gene Golub, Esmond Ng, and Horst Simon for making this sabbatical possible. ------------------------------------------------------------------------------- Files and directories in the AMD distribution: ------------------------------------------------------------------------------- --------------------------------------------------------------------------- Subdirectories of the AMD directory: --------------------------------------------------------------------------- Doc documentation Source primary source code Include include file for use in your code that calls AMD Demo demo programs. also serves as test of the AMD installation. MATLAB AMD mexFunction for MATLAB, and supporting m-files Lib where the compiled C-callable and Fortran-callable AMD libraries placed. --------------------------------------------------------------------------- Files in the AMD directory: --------------------------------------------------------------------------- Makefile top-level Makefile Windows users would require Cygwin to use "make" README.txt this file --------------------------------------------------------------------------- Doc directory: documentation --------------------------------------------------------------------------- ChangeLog change log License.txt the AMD License Makefile for creating the documentation AMD_UserGuide.bib AMD User Guide (references) AMD_UserGuide.tex AMD User Guide (LaTeX) AMD_UserGuide.pdf AMD User Guide (PDF) --------------------------------------------------------------------------- Source directory: --------------------------------------------------------------------------- amd_order.c user-callable, primary AMD ordering routine amd_control.c user-callable, prints the control parameters amd_defaults.c user-callable, sets default control parameters amd_info.c user-callable, prints the statistics from AMD amd_1.c non-user-callable, construct A+A' amd_2.c user-callable, primary ordering kernel (a C version of amd.f and amdbar.f, with post-ordering added) amd_aat.c non-user-callable, computes nnz (A+A') amd_dump.c non-user-callable, debugging routines amd_postorder.c non-user-callable, postorder amd_post_tree.c non-user-callable, postorder just one tree amd_valid.c non-user-callable, verifies a matrix amd_preprocess.c non-user-callable, computes A', removes duplic amd.f user-callable Fortran 77 version amdbar.f user-callable Fortran 77 version --------------------------------------------------------------------------- Include directory: --------------------------------------------------------------------------- amd.h include file for C programs that use AMD amd_internal.h non-user-callable, include file for AMD --------------------------------------------------------------------------- Demo directory: --------------------------------------------------------------------------- Makefile to compile the demos amd_demo.c C demo program for AMD amd_demo.out output of amd_demo.c amd_demo2.c C demo program for AMD, jumbled matrix amd_demo2.out output of amd_demo2.c amd_l_demo.c C demo program for AMD (long integer version) amd_l_demo.out output of amd_l_demo.c amd_simple.c simple C demo program for AMD amd_simple.out output of amd_simple.c amd_f77demo.f Fortran 77 demo program for AMD amd_f77demo.out output of amd_f77demo.f amd_f77simple.c simple Fortran 77 demo program for AMD amd_f77simple.out output of amd_f77simple.f amd_f77cross.f Fortran 77 demo, calls the C version of AMD amd_f77cross.out output of amd_f77cross.f amd_f77wrapper.c Fortran-callable wrapper for C version of AMD --------------------------------------------------------------------------- MATLAB directory: --------------------------------------------------------------------------- Contents.m for "help amd2" listing of toolbox contents amd2.m MATLAB help file for AMD amd_make.m MATLAB m-file for compiling AMD mexFunction amd_install.m compile and install the AMD mexFunction amd_mex.c AMD mexFunction for MATLAB amd_demo.m MATLAB demo for AMD amd_demo.m.out diary output of amd_demo.m can_24.mat input file for AMD demo --------------------------------------------------------------------------- Lib directory: libamd.a and libamd.so library placed here --------------------------------------------------------------------------- Makefile Makefile for both shared and static libraries Matrix/inst/doc/SuiteSparse/UserGuides.txt0000644000176200001440000000133710500056651020331 0ustar liggesusersPDF files of the User's Guides for the CHOLMOD, AMD and CAMD sparse matrix libraries are available from Tim Davis's web site for his sparse matrix packages. The base URL for the web site is http://www.cise.ufl.edu/research/sparse A direct link to "The CHOLMOD User's Guide" is http://www.cise.ufl.edu/research/sparse/cholmod/current/CHOLMOD/Doc/UserGuide.pdf A direct link to "The AMD User's Guide" is http://www.cise.ufl.edu/research/sparse/amd/current/AMD/Doc/AMD_UserGuide.pdf (Apparently Tim has taken Oscar Wilde's observation that "consistency is the last refuge of the unimaginative" to heart.) A direct link to "The CAMD User's Guide" is http://www.cise.ufl.edu/research/sparse/camd/current/CAMD/Doc/AMD_UserGuide.pdf Matrix/inst/test-tools-Matrix.R0000644000176200001440000006552213711014777016217 0ustar liggesusers#### Tools for Package Testing --- in Matrix, sourced by ./test-tools.R #### ------------------------- ### ------- Part III -- "Matrix" (classes) specific ---------------------- ## lower.tri() and upper.tri() -- masking base definitions ## R/src/library/base/R/lower.tri.R ## R/src/library/base/R/upper.tri.R ## but we do __not__ want to coerce to "base R" 'matrix' via as.matrix(): ## lower.tri <- function(x, diag = FALSE) if(diag) row(x) >= col(x) else row(x) > col(x) upper.tri <- function(x, diag = FALSE) if(diag) row(x) <= col(x) else row(x) < col(x) lsM <- function(...) { for(n in ls(..., envir=parent.frame())) if(is((. <- get(n)),"Matrix")) cat(sprintf("%5s: '%s' [%d x %d]\n",n,class(.), nrow(.),ncol(.))) } asD <- function(m) { ## as "Dense" if(canCoerce(m, "denseMatrix")) as(m, "denseMatrix") else if(canCoerce(m, (cl <- paste(.M.kind(m), "denseMatrix", sep='')))) as(m, cl) else if(canCoerce(m, "dgeMatrix")) as(m, "dgeMatrix") else stop("cannot coerce to a typical dense Matrix") } ## "normal" sparse Matrix: Csparse, no diag="U" asCsp <- function(x) diagU2N(as(x, "CsparseMatrix")) ##' @title quasi-identical dimnames Qidentical.DN <- function(dx, dy) { stopifnot(is.list(dx) || is.null(dx), is.list(dy) || is.null(dy)) ## "empty" (is.null.DN(dx) && is.null.DN(dy)) || identical(dx, dy) } ##' quasi-identical() for 'Matrix' matrices Qidentical <- function(x,y, strictClass = TRUE) { if(!identical(class(x), cy <- class(y))) { if(strictClass || !is(x, cy)) return(FALSE) ## else try further } slts <- slotNames(x) if("Dimnames" %in% slts) { ## always (or we have no 'Matrix') slts <- slts[slts != "Dimnames"] if(!Qidentical.DN(x@Dimnames, y@Dimnames) && ## allow for "completion" of (NULL, ) dimnames of symmetricMatrix: !Qidentical.DN(dimnames(x), dimnames(y))) return(FALSE) } if("factors" %in% slts) { ## allow one empty and one non-empty 'factors' slts <- slts[slts != "factors"] ## if both are not empty, they must be the same: if(length(xf <- x@factors) && length(yf <- y@factors)) if(!identical(xf, yf)) return(FALSE) } for(sl in slts) if(!identical(slot(x,sl), slot(y,sl))) return(FALSE) TRUE } ##' quasi-identical() for traditional ('matrix') matrices mQidentical <- function(x,y, strictClass = TRUE) { if(!identical(class(x), cy <- class(y))) { if(strictClass || !is(x, cy)) return(FALSE) ## else try further } if(!Qidentical.DN(dimnames(x), dimnames(y))) return(FALSE) identical(unname(x), unname(y)) } Q.C.identical <- function(x,y, sparse = is(x,"sparseMatrix"), checkClass = TRUE, strictClass = TRUE) { if(checkClass && class(x) != class(y)) { if(strictClass || !is(x, class(y))) return(FALSE) ## else try further } if(sparse) Qidentical(as(x,"CsparseMatrix"), as(y,"CsparseMatrix"), strictClass=strictClass) else Qidentical(x,y, strictClass=strictClass) } ##' ##' ##'
    ##' @title Quasi-equal for 'Matrix' matrices ##' @param x Matrix ##' @param y Matrix ##' @param superclasses x and y must coincide in (not) extending these; set to empty, ##' if no class/inheritance checks should happen. ##' @param dimnames.check logical indicating if dimnames(.) much match ##' @param tol NA (--> use "==") or numerical tolerance for all.equal() ##' @return logical: Are x and y (quasi) equal ? Q.eq <- function(x, y, superclasses = c("sparseMatrix", "denseMatrix", "dMatrix", "lMatrix", "nMatrix"), dimnames.check = TRUE, tol = NA) { ## quasi-equal - for 'Matrix' matrices if(any(dim(x) != dim(y))) return(FALSE) if(dimnames.check && !identical(dimnames(x), dimnames(y))) return(FALSE) xcl <- getClassDef(class(x)) ycl <- getClassDef(class(y)) for(SC in superclasses) { if( extends(xcl, SC) && !extends(ycl, SC)) return(FALSE) } asC <- ## asCommon if((isDense <- extends(xcl,"denseMatrix"))) function(m) as(m, "matrix") else function(m) as(as(as(m,"CsparseMatrix"), "dMatrix"), "dgCMatrix") if(is.na(tol)) { if(isDense) all(x == y | (is.na(x) & is.na(y))) else ## 'x == y' blows up for large sparse matrices: isTRUE(all.equal(asC(x), asC(y), tolerance = 0., check.attributes = dimnames.check)) } else if(is.numeric(tol) && tol >= 0) { isTRUE(all.equal(asC(x), asC(y), tolerance = tol, check.attributes = dimnames.check)) } else stop("'tol' must be NA or non-negative number") } Q.eq2 <- function(x, y, superclasses = c("sparseMatrix", "denseMatrix"), dimnames.check = FALSE, tol = NA) Q.eq(x,y, superclasses=superclasses, dimnames.check=dimnames.check, tol=tol) ##' ##' ##'
    ##' @title Quasi-equality of symmpart(m) + skewpart(m) with m ##' @param m Matrix ##' @param tol numerical tolerance for all.equal() ##' @return logical ##' @author Martin Maechler Q.eq.symmpart <- function(m, tol = 8 * .Machine$double.eps) { ss <- symmpart(m) + skewpart(m) if(hasNA <- any(iNA <- is.na(ss))) { ## ss has the NA's symmetrically, but typically m has *not* iiNA <- which(iNA) # <- useful! -- this tests which() methods! ## assign NA's too -- using correct kind of NA: m[iiNA] <- as(NA, Matrix:::.type.kind[Matrix:::.M.kind(m)]) } Q.eq2(m, ss, tol = tol) } ##' sample.int(n, size, replace=FALSE) for really large n: sampleL <- function(n, size) { if(n < .Machine$integer.max) sample.int(n, size) else { i <- unique(round(n * runif(1.8 * size))) while(length(i) < size) { i <- unique(c(i, round(n * runif(size)))) } i[seq_len(size)] } } ## Useful Matrix constructors for testing: ##' @title Random Sparse Matrix ##' @param n ##' @param m number of columns; default (=n) ==> square matrix ##' @param density the desired sparseness density: ##' @param nnz number of non-zero entries; default from \code{density} ##' @param repr character string specifying the sparseness kind of the result. ##' @param giveCsparse *deprecated* logical specifying if result should be CsparseMatrix ##' @return a [CTR]sparseMatrix, n x m ##' @author Martin Maechler, Mar 2008; July 2020 ('repr' instead og 'giveCsparse') rspMat <- function(n, m = n, density = 1/4, nnz = round(density * n*m), repr = c("C","T","R"), giveCsparse) { stopifnot(length(n) == 1, n == as.integer(n), length(m) == 1, m == as.integer(m), 0 <= density, density <= 1, 0 <= nnz, nnz <= (N <- n*m)) in0 <- sampleL(N, nnz) x <- sparseVector(i = in0, x = as.numeric(1L + seq_along(in0)), length = N) dim(x) <- c(n,m)#-> sparseMatrix ## silent, back compatible (not yet warning about 'giveCsparse' deprecation): repr <- if(missing(repr) && !missing(giveCsparse)) if(giveCsparse) "C" else "T" else match.arg(repr) switch(repr, "C" = as(x, "CsparseMatrix"), "T" = x,# TsparseMatrix "R" = as(x, "RsparseMatrix")) } ## __DEPRECATED__ !! rSparseMatrix <- function(nrow, ncol, nnz, rand.x = function(n) round(rnorm(nnz), 2), ...) { stopifnot((nnz <- as.integer(nnz)) >= 0, nrow >= 0, ncol >= 0, nnz <= nrow * ncol) .Deprecated("rsparsematrix") ##========= sparseMatrix(i = sample(nrow, nnz, replace = TRUE), j = sample(ncol, nnz, replace = TRUE), x = rand.x(nnz), dims = c(nrow, ncol), ...) } rUnitTri <- function(n, upper = TRUE, ...) { ## Purpose: random unit-triangular sparse Matrix .. built from rspMat() ## ---------------------------------------------------------------------- ## Arguments: n: matrix dimension ## upper: logical indicating if upper or lower triangular ## ... : further arguments passed to rspMat(), eg. 'density' ## ---------------------------------------------------------------------- ## Author: Martin Maechler, Date: 5 Mar 2008, 11:35 r <- (if(upper) triu else tril)(rspMat(n, ...)) ## make sure the diagonal is empty diag(r) <- 0 r <- drop0(r) r@diag <- "U" r } ##' Construct a nice (with exact numbers) random artificial \eqn{A = L D L'} ##' decomposition with a sparse \eqn{n \times n}{n x n} matrix \code{A} of ##' density \code{density} and square root \eqn{D} determined by \code{d0}. ##' ##' If one of \code{rcond} or \code{condest} is true, \code{A} must be ##' non-singular, both use an \eqn{LU} decomposition requiring ##' non-singularity. ##' @title Make Nice Artificial A = L D L' (With Exact Numbers) Decomposition ##' @param n matrix dimension \eqn{n \times n}{n x n} ##' @param density ratio of number of non-zero entries to total number ##' @param d0 The sqrt of the diagonal entries of D default \code{10}, to be ##' \dQuote{different} from \code{L} entries. ##' @param rcond logical indicating if \code{\link{rcond}(A, useInv=TRUE)} ##' should be returned which requires non-singular A and D. ##' @param condest logical indicating if \code{\link{condest}(A)$est} ##' should be returned which requires non-singular A and D. ##' @return list with entries A, L, d.half, D, ..., where A inherits from ##' class \code{"\linkS4class{symmetricMatrix}"} and should be equal to ##' \code{as(L \%*\% D \%*\% t(L), "symmetricMatrix")}. ##' @author Martin Maechler, Date: 15 Mar 2008 mkLDL <- function(n, density = 1/3, d0 = 10, d.half = d0 * sample.int(n), # random permutation rcond = (n < 99), condest = (n >= 100)) { stopifnot(n == round(n), density <= 1) n <- as.integer(n) stopifnot(n >= 1, is.numeric(d.half), length(d.half) == n, d.half >= 0) L <- Matrix(0, n,n) nnz <- round(density * n*n) L[sample(n*n, nnz)] <- seq_len(nnz) L <- tril(L, -1L) diag(L) <- 1 dh2 <- d.half^2 non.sing <- sum(dh2 > 0) == n D <- Diagonal(x = dh2) A <- tcrossprod(L * rep(d.half, each=n)) ## = as(L %*% D %*% t(L), "symmetricMatrix") list(A = A, L = L, d.half = d.half, D = D, rcond.A = if (rcond && non.sing) rcond(A, useInv=TRUE), cond.A = if(condest && non.sing) condest(A)$est) } eqDeterminant <- function(m1, m2, NA.Inf.ok=FALSE, tol=.Machine$double.eps^0.5, ...) { d1 <- determinant(m1) ## logarithm = TRUE d2 <- determinant(m2) d1m <- as.vector(d1$modulus)# dropping attribute d2m <- as.vector(d2$modulus) if((identical(d1m, -Inf) && identical(d2m, -Inf)) || ## <==> det(m1) == det(m2) == 0, then 'sign' may even differ ! (is.na(d1m) && is.na(d2m))) ## if both are NaN or NA, we "declare" that's fine here return(TRUE) else if(NA.Inf.ok && ## first can be NA, second infinite: ## wanted: base::determinant.matrix() sometimes gives -Inf instead ## of NA,e.g. for matrix(c(0,NA,0,0,NA,NA,0,NA,0,0,1,0,0,NA,0,1), 4,4)) is.na(d1m) && is.infinite(d2m)) return(TRUE) ## else if(is.infinite(d1m)) d1$modulus <- sign(d1m)* .Machine$double.xmax if(is.infinite(d2m)) d2$modulus <- sign(d2m)* .Machine$double.xmax ## now they are finite or *one* of them is NA/NaN, and all.equal() will tell so: all.equal(d1, d2, tolerance=tol, ...) } ##' @param A a non-negative definite sparseMatrix, typically "dsCMatrix" ##' ##' @return a list with components resulting from calling ##' Cholesky(., perm = .P., LDL = .L., super = .S.) ##' ##' for all 2*2*3 combinations of (.P., .L., .S.) allCholesky <- function(A, verbose = FALSE, silentTry = FALSE) { ## Author: Martin Maechler, Date: 16 Jul 2009 ##' @param r list of CHMfactor objects, typically with names() as '. | .' ##' ##' @return an is(perm,LDL,super) matrix with interesting and *named* rownames CHM_to_pLs <- function(r) { is.perm <- function(.) if(inherits(., "try-error")) NA else !all(.@perm == 0:(.@Dim[1]-1)) is.LDL <- function(.)if(inherits(., "try-error")) NA else isLDL(.) r.st <- cbind(perm = sapply(r, is.perm), LDL = sapply(r, is.LDL), super = sapply(r, class) == "dCHMsuper") names(dimnames(r.st)) <- list(" p L s", "") r.st } my.Cholesky <- { if(verbose) function (A, perm = TRUE, LDL = !super, super = FALSE, Imult = 0, ...) { cat(sprintf("Chol..(*, perm= %1d, LDL= %1d, super=%1d):", perm, LDL, super)) r <- Cholesky(A, perm=perm, LDL=LDL, super=super, Imult=Imult, ...) cat(" [Ok]\n") r } else Cholesky } logi <- c(FALSE, TRUE) d12 <- expand.grid(perm = logi, LDL = logi, super = c(logi,NA), KEEP.OUT.ATTRS = FALSE) r1 <- lapply(seq_len(nrow(d12)), function(i) try(do.call(my.Cholesky, c(list(A = A), as.list(d12[i,]))), silent=silentTry)) names(r1) <- apply(d12, 1, function(.) paste(symnum(.), collapse=" ")) dup.r1 <- duplicated(r1) r.all <- CHM_to_pLs(r1) if(!identical(dup.r1, duplicated(r.all))) warning("duplicated( ) differs from duplicated( )", immediate. = TRUE) list(Chol.A = r1, dup.r.all = dup.r1, r.all = r.all, r.uniq = CHM_to_pLs(r1[ ! dup.r1])) } ##' Cheap Boolean Arithmetic Matrix product ##' Should be equivalent to %&% which is faster [not for large dense!]. ##' Consequently mainly used in checkMatrix() boolProd <- function(x,y) as((abs(x) %*% abs(y)) > 0, "nMatrix") ###----- Checking a "Matrix" ----------------------------------------- ##' Check the compatibility of \pkg{Matrix} package Matrix with a ##' \dQuote{traditional} \R matrix and perform a host of internal consistency ##' checks. ##' ##' @title Check Compatibility of Matrix Package Matrix with Traditional R Matrices ##' ##' @param m a "Matrix" ##' @param m.m as(m, "matrix") {if 'do.matrix' } ##' @param do.matrix logical indicating if as(m, "matrix") should be applied; ##' typically false for large sparse matrices ##' @param do.t logical: is t(m) "feasible" ? ##' @param doNorm ##' @param doOps ##' @param doSummary ##' @param doCoerce ##' @param doCoerce2 ##' @param do.prod ##' @param verbose logical indicating if "progress output" is produced. ##' @param catFUN (when 'verbose' is TRUE): function to be used as generalized cat() ##' @return TRUE (invisibly), unless an error is signalled ##' @author Martin Maechler, since 11 Apr 2008 checkMatrix <- function(m, m.m = if(do.matrix) as(m, "matrix"), do.matrix = !isSparse || prod(dim(m)) < 1e6, do.t = TRUE, doNorm = TRUE, doOps = TRUE, doSummary = TRUE, doCoerce = TRUE, doCoerce2 = doCoerce && !isRsp, doDet = do.matrix, do.prod = do.t && do.matrix && !isRsp, verbose = TRUE, catFUN = cat) { ## is also called from dotestMat() in ../tests/Class+Meth.R stopifnot(is(m, "Matrix")) validObject(m) # or error(....) clNam <- class(m) cld <- getClassDef(clNam) ## extends(cld, FOO) is faster than is(m, FOO) isCor <- extends(cld, "corMatrix") isSym <- extends(cld, "symmetricMatrix") if(isSparse <- extends(cld, "sparseMatrix")) { # also true for these isRsp <- extends(cld, "RsparseMatrix") isDiag <- extends(cld, "diagonalMatrix") isInd <- extends(cld, "indMatrix") isPerm <- extends(cld, "pMatrix") } else isRsp <- isDiag <- isInd <- isPerm <- FALSE isTri <- !isSym && !isDiag && !isInd && extends(cld, "triangularMatrix") is.n <- extends(cld, "nMatrix") nonMatr <- clNam != (Mcl <- MatrixClass(clNam, cld)) Cat <- function(...) if(verbose) cat(...) CatF <- function(...) if(verbose) catFUN(...) ## warnNow <- function(...) warning(..., call. = FALSE, immediate. = TRUE) DO.m <- function(expr) if(do.matrix) eval(expr) else TRUE vec <- function(x) { dim(x) <- c(length(x), 1L) dimnames(x) <- list(NULL,NULL) x } eps16 <- 16 * .Machine$double.eps ina <- is.na(m) if(do.matrix) { stopifnot(all(ina == is.na(m.m)), all(is.finite(m) == is.finite(m.m)), all(is.infinite(m) == is.infinite(m.m)), all(m == m | ina), ## check all() , "==" [Compare], "|" [Logic] if(ncol(m) > 0) identical3(unname(m[,1]), unname(m.m[,1]), as(m[,1,drop=FALSE], "vector")) else identical(as(m, "vector"), as.vector(m.m))) if(any(m != m & !ina)) stop(" any (m != m) should not be true") } else { if(any(m != m)) stop(" any (m != m) should not be true") if(ncol(m) > 0) stopifnot(identical(unname(m[,1]), as(m[,1,drop=FALSE], "vector"))) else stopifnot(identical(as(m, "vector"), as.vector(as(m, "matrix")))) } if(do.t) { tm <- t(m) if(isSym) ## check that t() swaps 'uplo' L <--> U : stopifnot(c("L","U") == sort(c(m@uplo, tm@uplo))) ttm <- t(tm) ## notInd: "pMatrix" ok, but others inheriting from "indMatrix" are not notInd <- (!isInd || isPerm) if(notInd && (extends(cld, "CsparseMatrix") || extends(cld, "generalMatrix") || isDiag)) stopifnot(Qidentical(m, ttm, strictClass = !nonMatr)) else if(do.matrix) { if(notInd) stopifnot(nonMatr || class(ttm) == clNam) stopifnot(all(m == ttm | ina)) ## else : not testing } ## crossprod() %*% etc if(do.prod) { c.m <- crossprod(m) tcm <- tcrossprod(m) tolQ <- if(isSparse) NA else eps16 stopifnot(dim(c.m) == rep.int(ncol(m), 2), dim(tcm) == rep.int(nrow(m), 2), ## FIXME: %*% drops dimnames Q.eq2(c.m, tm %*% m, tol = tolQ), Q.eq2(tcm, m %*% tm, tol = tolQ), ## should work with dimnames: Q.eq(m %&% tm, boolProd(m, tm), superclasses=NULL, tol = 0) , Q.eq(tm %&% m, boolProd(tm, m), superclasses=NULL, tol = 0) ) } } if(!do.matrix) { CatF(" will *not* coerce to 'matrix' since do.matrix is FALSE\n") } else if(doNorm) { CatF(sprintf(" norm(m [%d x %d]) :", nrow(m), ncol(m))) for(typ in c("1","I","F","M")) { Cat('', typ, '') stopifnot(all.equal(norm(m,typ), norm(m.m,typ))) } Cat(" ok\n") } if(do.matrix && doSummary) { summList <- lapply(getGroupMembers("Summary"), get, envir = asNamespace("Matrix")) CatF(" Summary: ") for(f in summList) { ## suppressWarnings(): e.g. any() would warn here: r <- suppressWarnings(if(isCor) all.equal(f(m), f(m.m)) else identical(f(m), f(m.m))) if(!isTRUE(r)) { f.nam <- sub("..$", '', sub("^\\.Primitive..", '', format(f))) ## prod() is delicate: NA or NaN can both happen (if(f.nam == "prod") message else stop)( sprintf("%s(m) [= %g] differs from %s(m.m) [= %g]", f.nam, f(m), f.nam, f(m.m))) } } if(verbose) cat(" ok\n") } ## and test 'dim()' as well: d <- dim(m) isSqr <- d[1] == d[2] if(do.t) stopifnot(identical(diag(m), diag(t(m)))) ## TODO: also === diag(band(m,0,0)) if(prod(d) < .Machine$integer.max && !extends(cld, "modelMatrix")) { vm <- vec(m) stopifnot(is(vm, "Matrix"), validObject(vm), dim(vm) == c(d[1]*d[2], 1)) } if(!isInd) m.d <- local({ m. <- m; diag(m.) <- diag(m); m. }) if(do.matrix) stopifnot(identical(dim(m.m), dim(m)), ## base::diag() keeps names [Matrix FIXME] ## now that "pMatrix" subsetting gives *LOGICAL* ## if(isPerm) { ## identical(as.integer(unname(diag(m))), unname(diag(m.m))) ## } else identical(unname(diag(m)), unname(diag(m.m))),## not for NA: diag(m) == diag(m.m), identical(nnzero(m), sum(m.m != 0)), identical(nnzero(m, na.= FALSE), sum(m.m != 0, na.rm = TRUE)), identical(nnzero(m, na.= TRUE), sum(m.m != 0 | is.na(m.m))) ) if(isSparse) { n0m <- drop0(m) #==> n0m is Csparse has0 <- !Qidentical(n0m, as(m,"CsparseMatrix")) if(!isInd && !isRsp && !(extends(cld, "TsparseMatrix") && anyDuplicatedT(m, di = d))) # 'diag<-' is does not change attrib: stopifnot(Qidentical(m, m.d))# e.g., @factors may differ } else if(!identical(m, m.d)) { # dense : 'diag<-' is does not change attrib if(isTri && m@diag == "U" && m.d@diag == "N" && all(m == m.d)) message("unitriangular m: diag(m) <- diag(m) lost \"U\" .. is ok") else stop("diag(m) <- diag(m) has changed 'm' too much") } ## use non-square matrix when "allowed": ## m12: sparse and may have 0s even if this is not: if(isSparse && has0) m12 <- as(as( m, "lMatrix"),"CsparseMatrix") m12 <- drop0(m12) if(do.matrix) { ## "!" should work (via as(*, "l...")) : m11 <- as(as(!!m,"CsparseMatrix"), "lMatrix") if(!Qidentical(m11, m12)) stopifnot(Qidentical(as(m11, "generalMatrix"), as(m12, "generalMatrix"))) } if(isSparse && !is.n) { ## ensure that as(., "nMatrix") gives nz-pattern CatF("as(., \"nMatrix\") giving full nonzero-pattern: ") n1 <- as(m, "nMatrix") ns <- as(m, "nsparseMatrix") stopifnot(identical(n1,ns), isDiag || ((if(isSym) Matrix:::nnzSparse else sum)(n1) == length(if(isInd) m@perm else diagU2N(m)@x))) Cat("ok\n") } if(doOps) { ## makes sense with non-trivial m (!) CatF("2*m =?= m+m: ") if(identical(2*m, m+m)) Cat("identical\n") else if(do.matrix) { eq <- as(2*m,"matrix") == as(m+m, "matrix") # but work for NA's: stopifnot(all(eq | (is.na(m) & is.na(eq)))) Cat("ok\n") } else {# !do.matrix stopifnot(identical(as(2*m, "CsparseMatrix"), as(m+m, "CsparseMatrix"))) Cat("ok\n") } if(do.matrix) { ## m == m etc, now for all, see above CatF("m >= m for all: "); stopifnot(all(m >= m | ina)); Cat("ok\n") } if(prod(d) > 0) { CatF("m < m for none: ") mlm <- m < m if(!any(ina)) stopifnot(!any(mlm)) else if(do.matrix) stopifnot(!any(mlm & !ina)) else { ## !do.matrix & any(ina) : !ina can *not* be used mlm[ina] <- FALSE stopifnot(!any(mlm)) } Cat("ok\n") } if(isSqr) { if(do.matrix) { ## determinant() "fails" for triangular with NA such as ## (m <- matrix(c(1:0,NA,1), 2)) CatF("symmpart(m) + skewpart(m) == m: ") Q.eq.symmpart(m) CatF("ok; determinant(): ") if(!doDet) Cat(" skipped (!doDet): ") else if(any(is.na(m.m)) && extends(cld, "triangularMatrix")) Cat(" skipped: is triang. and has NA: ") else stopifnot(eqDeterminant(m, m.m, NA.Inf.ok=TRUE)) Cat("ok\n") } } else assertError(determinant(m)) }# end{doOps} if(doCoerce && do.matrix && canCoerce("matrix", clNam)) { CatF("as(, ",clNam,"): ", sep='') m3 <- as(m.m, clNam) Cat("valid:", validObject(m3), "\n") ## m3 should ``ideally'' be identical to 'm' } if(doCoerce2 && do.matrix) { ## not for large m: !m will be dense if(is.n) { mM <- if(nonMatr) as(m, Mcl) else m stopifnot(identical(mM, as(as(m, "dMatrix"),"nMatrix")), identical(mM, as(as(m, "lMatrix"),"nMatrix")), identical(which(m), which(m.m))) } else if(extends(cld, "lMatrix")) { ## should fulfill even with NA: stopifnot(all(m | !m | ina), !any(!m & m & !ina)) if(extends(cld, "TsparseMatrix")) # allow modify, since at end here m <- uniqTsparse(m, clNam) stopifnot(identical(m, m & TRUE), identical(m, FALSE | m)) ## also check the coercions to [dln]Matrix m. <- if(isSparse && has0) n0m else m m1. <- m. # replace NA by 1 in m1. , carefully not changing class: if(any(ina)) m1.@x[is.na(m1.@x)] <- TRUE stopifnot(identical(m. , as(as(m. , "dMatrix"),"lMatrix")), clNam == "ldiMatrix" || # <- there's no "ndiMatrix" ## coercion to n* and back: only identical when no extra 0s: identical(m1., as(as(m1., "nMatrix"),"lMatrix")), identical(which(m), which(m.m))) } else if(extends(cld, "dMatrix")) { m. <- if(isSparse && has0) n0m else m m1 <- (m. != 0)*1 if(!isSparse && substr(clNam,1,3) == "dpp") ## no "nppMatrix" possible m1 <- unpack(m1) m1. <- m1 # replace NA by 1 in m1. , carefully not changing class: if(any(ina)) m1.@x[is.na(m1.@x)] <- 1 ## coercion to n* (nz-pattern!) and back: only identical when no extra 0s and no NAs: stopifnot(Q.C.identical(m1., as(as(m., "nMatrix"),"dMatrix"), isSparse, checkClass = FALSE), Q.C.identical(m1 , as(as(m., "lMatrix"),"dMatrix"), isSparse, checkClass = FALSE)) } if(extends(cld, "triangularMatrix")) { mm. <- m i0 <- if(m@uplo == "L") upper.tri(mm.) else lower.tri(mm.) n.catchWarn <- if(is.n) suppressWarnings else identity n.catchWarn( mm.[i0] <- 0 ) # ideally, mm. remained triangular, but can be dge* CatF("as(, ",clNam,"): ", sep='') tm <- as(as(mm., "triangularMatrix"), clNam) Cat("valid:", validObject(tm), "\n") if(m@uplo == tm@uplo) ## otherwise, the matrix effectively was *diagonal* ## note that diagU2N() |-> dtC : stopifnot(Qidentical(tm, as(diagU2N(m), clNam))) } else if(isDiag) { ## TODO } else { ## TODO } }# end {doCoerce2 && ..} if(doCoerce && isSparse) { ## coerce to sparseVector and back : v <- as(m, "sparseVector") stopifnot(length(v) == prod(d)) dim(v) <- d stopifnot(Q.eq2(m, v)) } invisible(TRUE) } ### --- These use ##' Check QR-consistency of dense and sparse chk.qr.D.S <- function(d., s., y, Y = Matrix(y), force = FALSE, tol = 1e-10) { stopifnot(is.qr(d.), is(s., "sparseQR")) cc <- qr.coef(d.,y) rank.def <- any(is.na(cc)) && d.$rank < length(d.$pivot) if(rank.def && force) cc <- mkNA.0(cc) ## set NA's to 0 .. ok, in some case ## when system is rank deficient, have differing cases, not always just NA <-> 0 coef ## FIXME though: resid & fitted should be well determined if(force || !rank.def) stopifnot( ### FIXME: temporary: ### is.all.equal3( cc , drop(qr.coef (s.,y)), drop(qr.coef (s.,Y)), tol=tol), is.all.equal3( unname( cc ) , drop(qr.coef (s.,y)), drop(qr.coef (s.,Y)), tol=tol), ### END{FIXME} is.all.equal3(qr.resid (d.,y), drop(qr.resid (s.,y)), drop(qr.resid (s.,Y)), tol=tol), is.all.equal3(qr.fitted(d.,y), drop(qr.fitted(s.,y)), drop(qr.fitted(s.,Y)), tol=tol) ) } ##' "Combi" calling chkQR() on both "(sparse)Matrix" and 'traditional' version ##' ------ and combine the two qr decompositions using chk.qr.D.S() ##' [ chkQR() def. in >>>>> ./test-tools-1.R <<<<< ] ##' ##' @title check QR-decomposition, and compare sparse and dense one ##' @param A a 'Matrix' , typically 'sparseMatrix' ##' @param Qinv.chk ##' @param QtQ.chk ##' @param quiet ##' @return list with 'qA' (sparse QR) and 'qa' (traditional (dense) QR) ##' @author Martin Maechler checkQR.DS.both <- function(A, Qinv.chk, QtQ.chk=NA, quiet=FALSE, giveRE=TRUE, tol = 1e-13) { stopifnot(is(A,"Matrix")) if(!quiet) cat("classical: ") qa <- chkQR(as(A, "matrix"), Qinv.chk=TRUE, QtQ.chk=TRUE, tol=tol, giveRE=giveRE)# works always if(!quiet) cat("[Ok] --- sparse: ") qA <- chkQR(A, Qinv.chk=Qinv.chk, QtQ.chk=QtQ.chk, tol=tol, giveRE=giveRE) validObject(qA) if(!quiet) cat("[Ok]\n") chk.qr.D.S(qa, qA, y = 10 + 1:nrow(A), tol = 256*tol)# ok [not done in rank deficient case!] invisible(list(qA=qA, qa=qa)) } Matrix/inst/include/0000755000176200001440000000000014154165362014125 5ustar liggesusersMatrix/inst/include/Matrix.h0000644000176200001440000001103214154104143015525 0ustar liggesusers#ifndef MATRIX_H #define MATRIX_H #ifdef __cplusplus extern "C" { // and bool is defined #else # define bool Rboolean #endif // From ../../src/Mutils.h : #ifdef __GNUC__ # undef alloca # define alloca(x) __builtin_alloca((x)) #elif defined(__sun) || defined(_AIX) /* this is necessary (and sufficient) for Solaris 10 and AIX 6: */ # include #endif /* For R >= 3.2.2, the 'elif' above shall be replaced by #elif defined(HAVE_ALLOCA_H) */ #include #include #include "cholmod.h" //---> M_cholmod_*() declarations // "Implementation" of these in ---> ./Matrix_stubs.c #ifdef HAVE_VISIBILITY_ATTRIBUTE # define attribute_hidden __attribute__ ((visibility ("hidden"))) #else # define attribute_hidden #endif // Copied from ../../src/Mutils.h ---------------------------------------- #define MATRIX_VALID_ge_dense \ "dmatrix", "dgeMatrix", \ "lmatrix", "lgeMatrix", \ "nmatrix", "ngeMatrix", \ "zmatrix", "zgeMatrix" #define MATRIX_VALID_ddense \ "dgeMatrix", "dtrMatrix", \ "dsyMatrix", "dpoMatrix", "ddiMatrix", \ "dtpMatrix", "dspMatrix", "dppMatrix", \ /* sub classes of those above:*/ \ /* dtr */ "Cholesky", "LDL", "BunchKaufman",\ /* dtp */ "pCholesky", "pBunchKaufman", \ /* dpo */ "corMatrix" #define MATRIX_VALID_ldense \ "lgeMatrix", "ltrMatrix", \ "lsyMatrix", "ldiMatrix", \ "ltpMatrix", "lspMatrix" #define MATRIX_VALID_ndense \ "ngeMatrix", "ntrMatrix", \ "nsyMatrix", \ "ntpMatrix", "nspMatrix" #define MATRIX_VALID_dCsparse \ "dgCMatrix", "dsCMatrix", "dtCMatrix" #define MATRIX_VALID_nCsparse \ "ngCMatrix", "nsCMatrix", "ntCMatrix" #define MATRIX_VALID_Csparse \ MATRIX_VALID_dCsparse, \ "lgCMatrix", "lsCMatrix", "ltCMatrix", \ MATRIX_VALID_nCsparse, \ "zgCMatrix", "zsCMatrix", "ztCMatrix" #define MATRIX_VALID_Tsparse \ "dgTMatrix", "dsTMatrix", "dtTMatrix", \ "lgTMatrix", "lsTMatrix", "ltTMatrix", \ "ngTMatrix", "nsTMatrix", "ntTMatrix", \ "zgTMatrix", "zsTMatrix", "ztTMatrix" #define MATRIX_VALID_Rsparse \ "dgRMatrix", "dsRMatrix", "dtRMatrix", \ "lgRMatrix", "lsRMatrix", "ltRMatrix", \ "ngRMatrix", "nsRMatrix", "ntRMatrix", \ "zgRMatrix", "zsRMatrix", "ztRMatrix" #define MATRIX_VALID_tri_Csparse \ "dtCMatrix", "ltCMatrix", "ntCMatrix", "ztCMatrix" #define MATRIX_VALID_sym_Csparse \ "dsCMatrix", "lsCMatrix", "nsCMatrix", "zsCMatrix" #define MATRIX_VALID_CHMfactor "dCHMsuper", "dCHMsimpl", "nCHMsuper", "nCHMsimpl" CHM_SP M_as_cholmod_sparse (CHM_SP ans, SEXP x, Rboolean check_Udiag, Rboolean sort_in_place); CHM_TR M_as_cholmod_triplet(CHM_TR ans, SEXP x, Rboolean check_Udiag); CHM_DN M_as_cholmod_dense(CHM_DN ans, SEXP x); CHM_DN M_numeric_as_chm_dense(CHM_DN ans, double *v, int nr, int nc); CHM_FR M_as_cholmod_factor(CHM_FR ans, SEXP x); double M_chm_factor_ldetL2(const_CHM_FR f); CHM_FR M_chm_factor_update(CHM_FR f, const_CHM_SP A, double mult); #define AS_CHM_DN(x) M_as_cholmod_dense((CHM_DN)alloca(sizeof(cholmod_dense)), x ) #define AS_CHM_FR(x) M_as_cholmod_factor((CHM_FR)alloca(sizeof(cholmod_factor)), x ) #define AS_CHM_SP(x) M_as_cholmod_sparse ((CHM_SP)alloca(sizeof(cholmod_sparse)), x, (Rboolean)TRUE, (Rboolean)FALSE) #define AS_CHM_TR(x) M_as_cholmod_triplet((CHM_TR)alloca(sizeof(cholmod_triplet)),x, (Rboolean)TRUE) /* the non-diagU2N-checking versions : */ #define AS_CHM_SP__(x) M_as_cholmod_sparse ((CHM_SP)alloca(sizeof(cholmod_sparse)), x, (Rboolean)FALSE, (Rboolean)FALSE) #define AS_CHM_TR__(x) M_as_cholmod_triplet((CHM_TR)alloca(sizeof(cholmod_triplet)), x, (Rboolean)FALSE) #define N_AS_CHM_DN(x,nr,nc) M_numeric_as_chm_dense((CHM_DN)alloca(sizeof(cholmod_dense)), x , nr, nc ) SEXP M_Csparse_diagU2N(SEXP x); SEXP M_chm_factor_to_SEXP(const_CHM_FR f, int dofree); SEXP M_chm_sparse_to_SEXP(const_CHM_SP a, int dofree, int uploT, int Rkind, const char *diag, SEXP dn); SEXP M_chm_triplet_to_SEXP(const CHM_TR a, int dofree, int uploT, int Rkind, const char* diag, SEXP dn); SEXP M_dpoMatrix_chol(SEXP x); int M_Matrix_check_class_etc(SEXP x, const char **valid); // ./Matrix_stubs.c "illustrative example code" (of the above): bool Matrix_isclass_Csparse(SEXP x); bool Matrix_isclass_triplet(SEXP x); bool Matrix_isclass_ge_dense(SEXP x); bool Matrix_isclass_ddense(SEXP x); bool Matrix_isclass_ldense(SEXP x); bool Matrix_isclass_ndense(SEXP x); bool Matrix_isclass_dense(SEXP x); bool Matrix_isclass_CHMfactor(SEXP x); /* TODO: Utilities for C level of model_matrix(*, sparse) */ #ifdef __cplusplus } #endif #endif /* MATRIX_H */ Matrix/inst/include/cholmod.h0000644000176200001440000014526414033605737015740 0ustar liggesusers#ifndef MATRIX_CHOLMOD_H #define MATRIX_CHOLMOD_H #include #include // Rather use C99 -- which we require in R anyway #include #ifdef __cplusplus extern "C" { #endif // from ../../src/SuiteSparse_config/SuiteSparse_config.h : #ifndef SuiteSparse_long /* #ifdef _WIN64 */ /* #define SuiteSparse_long __int64 */ /* #define SuiteSparse_long_max _I64_MAX */ /* #define SuiteSparse_long_idd "I64d" */ /* #else */ /* #define SuiteSparse_long long */ /* #define SuiteSparse_long_max LONG_MAX */ /* #define SuiteSparse_long_idd "ld" */ /* #endif */ #define SuiteSparse_long int64_t // typically long (but on WIN64) #define SuiteSparse_ulong uint64_t // only needed for ../COLAMD/Source/colamd.c (original has 'unsigned Int' which fails!!) #define SuiteSparse_long_max 9223372036854775801 // typically LONG_MAX (but ..) #define SuiteSparse_long_idd PRId64 // typically "ld" #define SuiteSparse_long_id "%" SuiteSparse_long_idd #endif /* For backward compatibility with prior versions of SuiteSparse. The UF_* * macros are deprecated and will be removed in a future version. */ #ifndef UF_long #define UF_long SuiteSparse_long #define UF_long_max SuiteSparse_long_max #define UF_long_idd SuiteSparse_long_idd #define UF_long_id SuiteSparse_long_id #endif // from ../../src/CHOLMOD/Include/cholmod_core.h : <<<<< #define CHOLMOD_HAS_VERSION_FUNCTION #define CHOLMOD_DATE "Oct 22, 2019" #define CHOLMOD_VER_CODE(main,sub) ((main) * 1000 + (sub)) #define CHOLMOD_MAIN_VERSION 3 #define CHOLMOD_SUB_VERSION 0 #define CHOLMOD_SUBSUB_VERSION 14 #define CHOLMOD_VERSION \ CHOLMOD_VER_CODE(CHOLMOD_MAIN_VERSION,CHOLMOD_SUB_VERSION) /* ========================================================================== */ /* === CUDA BLAS for the GPU ================================================ */ /* ========================================================================== */ /* The number of OMP threads should typically be set to the number of cores */ /* per socket inthe machine being used. This maximizes memory performance. */ #ifndef CHOLMOD_OMP_NUM_THREADS #define CHOLMOD_OMP_NUM_THREADS 4 #endif /* Define buffering parameters for GPU processing */ #ifndef SUITESPARSE_GPU_EXTERN_ON #ifdef GPU_BLAS #include #endif #endif #define CHOLMOD_DEVICE_SUPERNODE_BUFFERS 6 #define CHOLMOD_HOST_SUPERNODE_BUFFERS 8 #define CHOLMOD_DEVICE_STREAMS 2 // from ../../src/CHOLMOD/Include/cholmod_core.h - line 295 : <<<<< /* Each CHOLMOD object has its own type code. */ #define CHOLMOD_COMMON 0 #define CHOLMOD_SPARSE 1 #define CHOLMOD_FACTOR 2 #define CHOLMOD_DENSE 3 #define CHOLMOD_TRIPLET 4 /* ========================================================================== */ /* === CHOLMOD Common ======================================================= */ /* ========================================================================== */ /* itype defines the types of integer used: */ #define CHOLMOD_INT 0 /* all integer arrays are int */ #define CHOLMOD_INTLONG 1 /* most are int, some are SuiteSparse_long */ #define CHOLMOD_LONG 2 /* all integer arrays are SuiteSparse_long */ /* The itype of all parameters for all CHOLMOD routines must match. * FUTURE WORK: CHOLMOD_INTLONG is not yet supported. */ /* dtype defines what the numerical type is (double or float): */ #define CHOLMOD_DOUBLE 0 /* all numerical values are double */ #define CHOLMOD_SINGLE 1 /* all numerical values are float */ /* The dtype of all parameters for all CHOLMOD routines must match. * * Scalar floating-point values are always passed as double arrays of size 2 * (for the real and imaginary parts). They are typecast to float as needed. * FUTURE WORK: the float case is not supported yet. */ /* xtype defines the kind of numerical values used: */ #define CHOLMOD_PATTERN 0 /* pattern only, no numerical values */ #define CHOLMOD_REAL 1 /* a real matrix */ #define CHOLMOD_COMPLEX 2 /* a complex matrix (ANSI C99 compatible) */ #define CHOLMOD_ZOMPLEX 3 /* a complex matrix (MATLAB compatible) */ /* Definitions for cholmod_common: */ #define CHOLMOD_MAXMETHODS 9 /* maximum number of different methods that */ /* cholmod_analyze can try. Must be >= 9. */ /* Common->status values. zero means success, negative means a fatal error, * positive is a warning. */ #define CHOLMOD_OK 0 /* success */ #define CHOLMOD_NOT_INSTALLED (-1) /* failure: method not installed */ #define CHOLMOD_OUT_OF_MEMORY (-2) /* failure: out of memory */ #define CHOLMOD_TOO_LARGE (-3) /* failure: integer overflow occured */ #define CHOLMOD_INVALID (-4) /* failure: invalid input */ #define CHOLMOD_GPU_PROBLEM (-5) /* failure: GPU fatal error */ #define CHOLMOD_NOT_POSDEF (1) /* warning: matrix not pos. def. */ #define CHOLMOD_DSMALL (2) /* warning: D for LDL' or diag(L) or */ /* LL' has tiny absolute value */ /* ordering method (also used for L->ordering) */ #define CHOLMOD_NATURAL 0 /* use natural ordering */ #define CHOLMOD_GIVEN 1 /* use given permutation */ #define CHOLMOD_AMD 2 /* use minimum degree (AMD) */ #define CHOLMOD_METIS 3 /* use METIS' nested dissection */ #define CHOLMOD_NESDIS 4 /* use CHOLMOD's version of nested dissection:*/ /* node bisector applied recursively, followed * by constrained minimum degree (CSYMAMD or * CCOLAMD) */ #define CHOLMOD_COLAMD 5 /* use AMD for A, COLAMD for A*A' */ /* POSTORDERED is not a method, but a result of natural ordering followed by a * weighted postorder. It is used for L->ordering, not method [ ].ordering. */ #define CHOLMOD_POSTORDERED 6 /* natural ordering, postordered. */ /* supernodal strategy (for Common->supernodal) */ #define CHOLMOD_SIMPLICIAL 0 /* always do simplicial */ #define CHOLMOD_AUTO 1 /* select simpl/super depending on matrix */ #define CHOLMOD_SUPERNODAL 2 /* always do supernodal */ typedef struct cholmod_common_struct { /* ---------------------------------------------------------------------- */ /* parameters for symbolic/numeric factorization and update/downdate */ /* ---------------------------------------------------------------------- */ double dbound ; /* Smallest absolute value of diagonal entries of D * for LDL' factorization and update/downdate/rowadd/ * rowdel, or the diagonal of L for an LL' factorization. * Entries in the range 0 to dbound are replaced with dbound. * Entries in the range -dbound to 0 are replaced with -dbound. No * changes are made to the diagonal if dbound <= 0. Default: zero */ double grow0 ; /* For a simplicial factorization, L->i and L->x can * grow if necessary. grow0 is the factor by which * it grows. For the initial space, L is of size MAX (1,grow0) times * the required space. If L runs out of space, the new size of L is * MAX(1.2,grow0) times the new required space. If you do not plan on * modifying the LDL' factorization in the Modify module, set grow0 to * zero (or set grow2 to 0, see below). Default: 1.2 */ double grow1 ; size_t grow2 ; /* For a simplicial factorization, each column j of L * is initialized with space equal to * grow1*L->ColCount[j] + grow2. If grow0 < 1, grow1 < 1, or grow2 == 0, * then the space allocated is exactly equal to L->ColCount[j]. If the * column j runs out of space, it increases to grow1*need + grow2 in * size, where need is the total # of nonzeros in that column. If you do * not plan on modifying the factorization in the Modify module, set * grow2 to zero. Default: grow1 = 1.2, grow2 = 5. */ size_t maxrank ; /* rank of maximum update/downdate. Valid values: * 2, 4, or 8. A value < 2 is set to 2, and a * value > 8 is set to 8. It is then rounded up to the next highest * power of 2, if not already a power of 2. Workspace (Xwork, below) of * size nrow-by-maxrank double's is allocated for the update/downdate. * If an update/downdate of rank-k is requested, with k > maxrank, * it is done in steps of maxrank. Default: 8, which is fastest. * Memory usage can be reduced by setting maxrank to 2 or 4. */ double supernodal_switch ; /* supernodal vs simplicial factorization */ int supernodal ; /* If Common->supernodal <= CHOLMOD_SIMPLICIAL * (0) then cholmod_analyze performs a * simplicial analysis. If >= CHOLMOD_SUPERNODAL (2), then a supernodal * analysis is performed. If == CHOLMOD_AUTO (1) and * flop/nnz(L) < Common->supernodal_switch, then a simplicial analysis * is done. A supernodal analysis done otherwise. * Default: CHOLMOD_AUTO. Default supernodal_switch = 40 */ int final_asis ; /* If TRUE, then ignore the other final_* parameters * (except for final_pack). * The factor is left as-is when done. Default: TRUE.*/ int final_super ; /* If TRUE, leave a factor in supernodal form when * supernodal factorization is finished. If FALSE, * then convert to a simplicial factor when done. * Default: TRUE */ int final_ll ; /* If TRUE, leave factor in LL' form when done. * Otherwise, leave in LDL' form. Default: FALSE */ int final_pack ; /* If TRUE, pack the columns when done. If TRUE, and * cholmod_factorize is called with a symbolic L, L is * allocated with exactly the space required, using L->ColCount. If you * plan on modifying the factorization, set Common->final_pack to FALSE, * and each column will be given a little extra slack space for future * growth in fill-in due to updates. Default: TRUE */ int final_monotonic ; /* If TRUE, ensure columns are monotonic when done. * Default: TRUE */ int final_resymbol ;/* if cholmod_factorize performed a supernodal * factorization, final_resymbol is true, and * final_super is FALSE (convert a simplicial numeric factorization), * then numerically zero entries that resulted from relaxed supernodal * amalgamation are removed. This does not remove entries that are zero * due to exact numeric cancellation, since doing so would break the * update/downdate rowadd/rowdel routines. Default: FALSE. */ /* supernodal relaxed amalgamation parameters: */ double zrelax [3] ; size_t nrelax [3] ; /* Let ns be the total number of columns in two adjacent supernodes. * Let z be the fraction of zero entries in the two supernodes if they * are merged (z includes zero entries from prior amalgamations). The * two supernodes are merged if: * (ns <= nrelax [0]) || (no new zero entries added) || * (ns <= nrelax [1] && z < zrelax [0]) || * (ns <= nrelax [2] && z < zrelax [1]) || (z < zrelax [2]) * * Default parameters result in the following rule: * (ns <= 4) || (no new zero entries added) || * (ns <= 16 && z < 0.8) || (ns <= 48 && z < 0.1) || (z < 0.05) */ int prefer_zomplex ; /* X = cholmod_solve (sys, L, B, Common) computes * x=A\b or solves a related system. If L and B are * both real, then X is real. Otherwise, X is returned as * CHOLMOD_COMPLEX if Common->prefer_zomplex is FALSE, or * CHOLMOD_ZOMPLEX if Common->prefer_zomplex is TRUE. This parameter * is needed because there is no supernodal zomplex L. Suppose the * caller wants all complex matrices to be stored in zomplex form * (MATLAB, for example). A supernodal L is returned in complex form * if A is zomplex. B can be real, and thus X = cholmod_solve (L,B) * should return X as zomplex. This cannot be inferred from the input * arguments L and B. Default: FALSE, since all data types are * supported in CHOLMOD_COMPLEX form and since this is the native type * of LAPACK and the BLAS. Note that the MATLAB/cholmod.c mexFunction * sets this parameter to TRUE, since MATLAB matrices are in * CHOLMOD_ZOMPLEX form. */ int prefer_upper ; /* cholmod_analyze and cholmod_factorize work * fastest when a symmetric matrix is stored in * upper triangular form when a fill-reducing ordering is used. In * MATLAB, this corresponds to how x=A\b works. When the matrix is * ordered as-is, they work fastest when a symmetric matrix is in lower * triangular form. In MATLAB, R=chol(A) does the opposite. This * parameter affects only how cholmod_read returns a symmetric matrix. * If TRUE (the default case), a symmetric matrix is always returned in * upper-triangular form (A->stype = 1). */ int quick_return_if_not_posdef ; /* if TRUE, the supernodal numeric * factorization will return quickly if * the matrix is not positive definite. Default: FALSE. */ int prefer_binary ; /* cholmod_read_triplet converts a symmetric * pattern-only matrix into a real matrix. If * prefer_binary is FALSE, the diagonal entries are set to 1 + the degree * of the row/column, and off-diagonal entries are set to -1 (resulting * in a positive definite matrix if the diagonal is zero-free). Most * symmetric patterns are the pattern a positive definite matrix. If * this parameter is TRUE, then the matrix is returned with a 1 in each * entry, instead. Default: FALSE. Added in v1.3. */ /* ---------------------------------------------------------------------- */ /* printing and error handling options */ /* ---------------------------------------------------------------------- */ int print ; /* print level. Default: 3 */ int precise ; /* if TRUE, print 16 digits. Otherwise print 5 */ /* CHOLMOD print_function replaced with SuiteSparse_config.print_func */ int try_catch ; /* if TRUE, then ignore errors; CHOLMOD is in the middle * of a try/catch block. No error message is printed * and the Common->error_handler function is not called. */ void (*error_handler) (int status, const char *file, int line, const char *message) ; /* Common->error_handler is the user's error handling routine. If not * NULL, this routine is called if an error occurs in CHOLMOD. status * can be CHOLMOD_OK (0), negative for a fatal error, and positive for * a warning. file is a string containing the name of the source code * file where the error occured, and line is the line number in that * file. message is a string describing the error in more detail. */ /* ---------------------------------------------------------------------- */ /* ordering options */ /* ---------------------------------------------------------------------- */ /* The cholmod_analyze routine can try many different orderings and select * the best one. It can also try one ordering method multiple times, with * different parameter settings. The default is to use three orderings, * the user's permutation (if provided), AMD which is the fastest ordering * and generally gives good fill-in, and METIS. CHOLMOD's nested dissection * (METIS with a constrained AMD) usually gives a better ordering than METIS * alone (by about 5% to 10%) but it takes more time. * * If you know the method that is best for your matrix, set Common->nmethods * to 1 and set Common->method [0] to the set of parameters for that method. * If you set it to 1 and do not provide a permutation, then only AMD will * be called. * * If METIS is not available, the default # of methods tried is 2 (the user * permutation, if any, and AMD). * * To try other methods, set Common->nmethods to the number of methods you * want to try. The suite of default methods and their parameters is * described in the cholmod_defaults routine, and summarized here: * * Common->method [i]: * i = 0: user-provided ordering (cholmod_analyze_p only) * i = 1: AMD (for both A and A*A') * i = 2: METIS * i = 3: CHOLMOD's nested dissection (NESDIS), default parameters * i = 4: natural * i = 5: NESDIS with nd_small = 20000 * i = 6: NESDIS with nd_small = 4, no constrained minimum degree * i = 7: NESDIS with no dense node removal * i = 8: AMD for A, COLAMD for A*A' * * You can modify the suite of methods you wish to try by modifying * Common.method [...] after calling cholmod_start or cholmod_defaults. * * For example, to use AMD, followed by a weighted postordering: * * Common->nmethods = 1 ; * Common->method [0].ordering = CHOLMOD_AMD ; * Common->postorder = TRUE ; * * To use the natural ordering (with no postordering): * * Common->nmethods = 1 ; * Common->method [0].ordering = CHOLMOD_NATURAL ; * Common->postorder = FALSE ; * * If you are going to factorize hundreds or more matrices with the same * nonzero pattern, you may wish to spend a great deal of time finding a * good permutation. In this case, try setting Common->nmethods to 9. * The time spent in cholmod_analysis will be very high, but you need to * call it only once. * * cholmod_analyze sets Common->current to a value between 0 and nmethods-1. * Each ordering method uses the set of options defined by this parameter. */ int nmethods ; /* The number of ordering methods to try. Default: 0. * nmethods = 0 is a special case. cholmod_analyze * will try the user-provided ordering (if given) and AMD. Let fl and * lnz be the flop count and nonzeros in L from AMD's ordering. Let * anz be the number of nonzeros in the upper or lower triangular part * of the symmetric matrix A. If fl/lnz < 500 or lnz/anz < 5, then this * is a good ordering, and METIS is not attempted. Otherwise, METIS is * tried. The best ordering found is used. If nmethods > 0, the * methods used are given in the method[ ] array, below. The first * three methods in the default suite of orderings is (1) use the given * permutation (if provided), (2) use AMD, and (3) use METIS. Maximum * allowed value is CHOLMOD_MAXMETHODS. */ int current ; /* The current method being tried. Default: 0. Valid * range is 0 to nmethods-1. */ int selected ; /* The best method found. */ /* The suite of ordering methods and parameters: */ struct cholmod_method_struct { /* statistics for this method */ double lnz ; /* nnz(L) excl. zeros from supernodal amalgamation, * for a "pure" L */ double fl ; /* flop count for a "pure", real simplicial LL' * factorization, with no extra work due to * amalgamation. Subtract n to get the LDL' flop count. Multiply * by about 4 if the matrix is complex or zomplex. */ /* ordering method parameters */ double prune_dense ;/* dense row/col control for AMD, SYMAMD, CSYMAMD, * and NESDIS (cholmod_nested_dissection). For a * symmetric n-by-n matrix, rows/columns with more than * MAX (16, prune_dense * sqrt (n)) entries are removed prior to * ordering. They appear at the end of the re-ordered matrix. * * If prune_dense < 0, only completely dense rows/cols are removed. * * This paramater is also the dense column control for COLAMD and * CCOLAMD. For an m-by-n matrix, columns with more than * MAX (16, prune_dense * sqrt (MIN (m,n))) entries are removed prior * to ordering. They appear at the end of the re-ordered matrix. * CHOLMOD factorizes A*A', so it calls COLAMD and CCOLAMD with A', * not A. Thus, this parameter affects the dense *row* control for * CHOLMOD's matrix, and the dense *column* control for COLAMD and * CCOLAMD. * * Removing dense rows and columns improves the run-time of the * ordering methods. It has some impact on ordering quality * (usually minimal, sometimes good, sometimes bad). * * Default: 10. */ double prune_dense2 ;/* dense row control for COLAMD and CCOLAMD. * Rows with more than MAX (16, dense2 * sqrt (n)) * for an m-by-n matrix are removed prior to ordering. CHOLMOD's * matrix is transposed before ordering it with COLAMD or CCOLAMD, * so this controls the dense *columns* of CHOLMOD's matrix, and * the dense *rows* of COLAMD's or CCOLAMD's matrix. * * If prune_dense2 < 0, only completely dense rows/cols are removed. * * Default: -1. Note that this is not the default for COLAMD and * CCOLAMD. -1 is best for Cholesky. 10 is best for LU. */ double nd_oksep ; /* in NESDIS, when a node separator is computed, it * discarded if nsep >= nd_oksep*n, where nsep is * the number of nodes in the separator, and n is the size of the * graph being cut. Valid range is 0 to 1. If 1 or greater, the * separator is discarded if it consists of the entire graph. * Default: 1 */ double other_1 [4] ; /* future expansion */ size_t nd_small ; /* do not partition graphs with fewer nodes than * nd_small, in NESDIS. Default: 200 (same as * METIS) */ size_t other_2 [4] ; /* future expansion */ int aggressive ; /* Aggresive absorption in AMD, COLAMD, SYMAMD, * CCOLAMD, and CSYMAMD. Default: TRUE */ int order_for_lu ; /* CCOLAMD can be optimized to produce an ordering * for LU or Cholesky factorization. CHOLMOD only * performs a Cholesky factorization. However, you may wish to use * CHOLMOD as an interface for CCOLAMD but use it for your own LU * factorization. In this case, order_for_lu should be set to FALSE. * When factorizing in CHOLMOD itself, you should *** NEVER *** set * this parameter FALSE. Default: TRUE. */ int nd_compress ; /* If TRUE, compress the graph and subgraphs before * partitioning them in NESDIS. Default: TRUE */ int nd_camd ; /* If 1, follow the nested dissection ordering * with a constrained minimum degree ordering that * respects the partitioning just found (using CAMD). If 2, use * CSYMAMD instead. If you set nd_small very small, you may not need * this ordering, and can save time by setting it to zero (no * constrained minimum degree ordering). Default: 1. */ int nd_components ; /* The nested dissection ordering finds a node * separator that splits the graph into two parts, * which may be unconnected. If nd_components is TRUE, each of * these connected components is split independently. If FALSE, * each part is split as a whole, even if it consists of more than * one connected component. Default: FALSE */ /* fill-reducing ordering to use */ int ordering ; size_t other_3 [4] ; /* future expansion */ } method [CHOLMOD_MAXMETHODS + 1] ; int postorder ; /* If TRUE, cholmod_analyze follows the ordering with a * weighted postorder of the elimination tree. Improves * supernode amalgamation. Does not affect fundamental nnz(L) and * flop count. Default: TRUE. */ int default_nesdis ; /* Default: FALSE. If FALSE, then the default * ordering strategy (when Common->nmethods == 0) * is to try the given ordering (if present), AMD, and then METIS if AMD * reports high fill-in. If Common->default_nesdis is TRUE then NESDIS * is used instead in the default strategy. */ /* ---------------------------------------------------------------------- */ /* memory management, complex divide, and hypot function pointers moved */ /* ---------------------------------------------------------------------- */ /* Function pointers moved from here (in CHOLMOD 2.2.0) to SuiteSparse_config.[ch]. See CHOLMOD/Include/cholmod_back.h for a set of macros that can be #include'd or copied into your application to define these function pointers on any version of CHOLMOD. */ /* ---------------------------------------------------------------------- */ /* METIS workarounds */ /* ---------------------------------------------------------------------- */ /* These workarounds were put into place for METIS 4.0.1. They are safe to use with METIS 5.1.0, but they might not longer be necessary. */ double metis_memory ; /* This is a parameter for CHOLMOD's interface to * METIS, not a parameter to METIS itself. METIS * uses an amount of memory that is difficult to estimate precisely * beforehand. If it runs out of memory, it terminates your program. * All routines in CHOLMOD except for CHOLMOD's interface to METIS * return an error status and safely return to your program if they run * out of memory. To mitigate this problem, the CHOLMOD interface * can allocate a single block of memory equal in size to an empirical * upper bound of METIS's memory usage times the Common->metis_memory * parameter, and then immediately free it. It then calls METIS. If * this pre-allocation fails, it is possible that METIS will fail as * well, and so CHOLMOD returns with an out-of-memory condition without * calling METIS. * * METIS_NodeND (used in the CHOLMOD_METIS ordering option) with its * default parameter settings typically uses about (4*nz+40n+4096) * times sizeof(int) memory, where nz is equal to the number of entries * in A for the symmetric case or AA' if an unsymmetric matrix is * being ordered (where nz includes both the upper and lower parts * of A or AA'). The observed "upper bound" (with 2 exceptions), * measured in an instrumented copy of METIS 4.0.1 on thousands of * matrices, is (10*nz+50*n+4096) * sizeof(int). Two large matrices * exceeded this bound, one by almost a factor of 2 (Gupta/gupta2). * * If your program is terminated by METIS, try setting metis_memory to * 2.0, or even higher if needed. By default, CHOLMOD assumes that METIS * does not have this problem (so that CHOLMOD will work correctly when * this issue is fixed in METIS). Thus, the default value is zero. * This work-around is not guaranteed anyway. * * If a matrix exceeds this predicted memory usage, AMD is attempted * instead. It, too, may run out of memory, but if it does so it will * not terminate your program. */ double metis_dswitch ; /* METIS_NodeND in METIS 4.0.1 gives a seg */ size_t metis_nswitch ; /* fault with one matrix of order n = 3005 and * nz = 6,036,025. This is a very dense graph. * The workaround is to use AMD instead of METIS for matrices of dimension * greater than Common->metis_nswitch (default 3000) or more and with * density of Common->metis_dswitch (default 0.66) or more. * cholmod_nested_dissection has no problems with the same matrix, even * though it uses METIS_ComputeVertexSeparator on this matrix. If this * seg fault does not affect you, set metis_nswitch to zero or less, * and CHOLMOD will not switch to AMD based just on the density of the * matrix (it will still switch to AMD if the metis_memory parameter * causes the switch). */ /* ---------------------------------------------------------------------- */ /* workspace */ /* ---------------------------------------------------------------------- */ /* CHOLMOD has several routines that take less time than the size of * workspace they require. Allocating and initializing the workspace would * dominate the run time, unless workspace is allocated and initialized * just once. CHOLMOD allocates this space when needed, and holds it here * between calls to CHOLMOD. cholmod_start sets these pointers to NULL * (which is why it must be the first routine called in CHOLMOD). * cholmod_finish frees the workspace (which is why it must be the last * call to CHOLMOD). */ size_t nrow ; /* size of Flag and Head */ SuiteSparse_long mark ; /* mark value for Flag array */ size_t iworksize ; /* size of Iwork. Upper bound: 6*nrow+ncol */ size_t xworksize ; /* size of Xwork, in bytes. * maxrank*nrow*sizeof(double) for update/downdate. * 2*nrow*sizeof(double) otherwise */ /* initialized workspace: contents needed between calls to CHOLMOD */ void *Flag ; /* size nrow, an integer array. Kept cleared between * calls to cholmod rouines (Flag [i] < mark) */ void *Head ; /* size nrow+1, an integer array. Kept cleared between * calls to cholmod routines (Head [i] = EMPTY) */ void *Xwork ; /* a double array. Its size varies. It is nrow for * most routines (cholmod_rowfac, cholmod_add, * cholmod_aat, cholmod_norm, cholmod_ssmult) for the real case, twice * that when the input matrices are complex or zomplex. It is of size * 2*nrow for cholmod_rowadd and cholmod_rowdel. For cholmod_updown, * its size is maxrank*nrow where maxrank is 2, 4, or 8. Kept cleared * between calls to cholmod (set to zero). */ /* uninitialized workspace, contents not needed between calls to CHOLMOD */ void *Iwork ; /* size iworksize, 2*nrow+ncol for most routines, * up to 6*nrow+ncol for cholmod_analyze. */ int itype ; /* If CHOLMOD_LONG, Flag, Head, and Iwork are * SuiteSparse_long. Otherwise all three are int. */ int dtype ; /* double or float */ /* Common->itype and Common->dtype are used to define the types of all * sparse matrices, triplet matrices, dense matrices, and factors * created using this Common struct. The itypes and dtypes of all * parameters to all CHOLMOD routines must match. */ int no_workspace_reallocate ; /* this is an internal flag, used as a * precaution by cholmod_analyze. It is normally false. If true, * cholmod_allocate_work is not allowed to reallocate any workspace; * they must use the existing workspace in Common (Iwork, Flag, Head, * and Xwork). Added for CHOLMOD v1.1 */ /* ---------------------------------------------------------------------- */ /* statistics */ /* ---------------------------------------------------------------------- */ /* fl and lnz are set only in cholmod_analyze and cholmod_rowcolcounts, * in the Cholesky modudle. modfl is set only in the Modify module. */ int status ; /* error code */ double fl ; /* LL' flop count from most recent analysis */ double lnz ; /* fundamental nz in L */ double anz ; /* nonzeros in tril(A) if A is symmetric/lower, * triu(A) if symmetric/upper, or tril(A*A') if * unsymmetric, in last call to cholmod_analyze. */ double modfl ; /* flop count from most recent update/downdate/ * rowadd/rowdel (excluding flops to modify the * solution to Lx=b, if computed) */ size_t malloc_count ; /* # of objects malloc'ed minus the # free'd*/ size_t memory_usage ; /* peak memory usage in bytes */ size_t memory_inuse ; /* current memory usage in bytes */ double nrealloc_col ; /* # of column reallocations */ double nrealloc_factor ;/* # of factor reallocations due to col. reallocs */ double ndbounds_hit ; /* # of times diagonal modified by dbound */ double rowfacfl ; /* # of flops in last call to cholmod_rowfac */ double aatfl ; /* # of flops to compute A(:,f)*A(:,f)' */ int called_nd ; /* TRUE if the last call to * cholmod_analyze called NESDIS or METIS. */ int blas_ok ; /* FALSE if BLAS int overflow; TRUE otherwise */ /* ---------------------------------------------------------------------- */ /* SuiteSparseQR control parameters: */ /* ---------------------------------------------------------------------- */ double SPQR_grain ; /* task size is >= max (total flops / grain) */ double SPQR_small ; /* task size is >= small */ int SPQR_shrink ; /* controls stack realloc method */ int SPQR_nthreads ; /* number of TBB threads, 0 = auto */ /* ---------------------------------------------------------------------- */ /* SuiteSparseQR statistics */ /* ---------------------------------------------------------------------- */ /* was other1 [0:3] */ double SPQR_flopcount ; /* flop count for SPQR */ double SPQR_analyze_time ; /* analysis time in seconds for SPQR */ double SPQR_factorize_time ; /* factorize time in seconds for SPQR */ double SPQR_solve_time ; /* backsolve time in seconds */ /* was SPQR_xstat [0:3] */ double SPQR_flopcount_bound ; /* upper bound on flop count */ double SPQR_tol_used ; /* tolerance used */ double SPQR_norm_E_fro ; /* Frobenius norm of dropped entries */ /* was SPQR_istat [0:9] */ SuiteSparse_long SPQR_istat [10] ; /* ---------------------------------------------------------------------- */ /* GPU configuration and statistics */ /* ---------------------------------------------------------------------- */ /* useGPU: 1 if gpu-acceleration is requested */ /* 0 if gpu-acceleration is prohibited */ /* -1 if gpu-acceleration is undefined in which case the */ /* environment CHOLMOD_USE_GPU will be queried and used. */ /* useGPU=-1 is only used by CHOLMOD and treated as 0 by SPQR */ int useGPU; /* for CHOLMOD: */ size_t maxGpuMemBytes; double maxGpuMemFraction; /* for SPQR: */ size_t gpuMemorySize; /* Amount of memory in bytes on the GPU */ double gpuKernelTime; /* Time taken by GPU kernels */ SuiteSparse_long gpuFlops; /* Number of flops performed by the GPU */ int gpuNumKernelLaunches; /* Number of GPU kernel launches */ /* If not using the GPU, these items are not used, but they should be present so that the CHOLMOD Common has the same size whether the GPU is used or not. This way, all packages will agree on the size of the CHOLMOD Common, regardless of whether or not they are compiled with the GPU libraries or not */ #ifdef GPU_BLAS /* in CUDA, these three types are pointers */ #define CHOLMOD_CUBLAS_HANDLE cublasHandle_t #define CHOLMOD_CUDASTREAM cudaStream_t #define CHOLMOD_CUDAEVENT cudaEvent_t #else /* ... so make them void * pointers if the GPU is not being used */ #define CHOLMOD_CUBLAS_HANDLE void * #define CHOLMOD_CUDASTREAM void * #define CHOLMOD_CUDAEVENT void * #endif CHOLMOD_CUBLAS_HANDLE cublasHandle ; /* a set of streams for general use */ CHOLMOD_CUDASTREAM gpuStream[CHOLMOD_HOST_SUPERNODE_BUFFERS]; CHOLMOD_CUDAEVENT cublasEventPotrf [3] ; CHOLMOD_CUDAEVENT updateCKernelsComplete; CHOLMOD_CUDAEVENT updateCBuffersFree[CHOLMOD_HOST_SUPERNODE_BUFFERS]; void *dev_mempool; /* pointer to single allocation of device memory */ size_t dev_mempool_size; void *host_pinned_mempool; /* pointer to single allocation of pinned mem */ size_t host_pinned_mempool_size; size_t devBuffSize; int ibuffer; double syrkStart ; /* time syrk started */ /* run times of the different parts of CHOLMOD (GPU and CPU) */ double cholmod_cpu_gemm_time ; double cholmod_cpu_syrk_time ; double cholmod_cpu_trsm_time ; double cholmod_cpu_potrf_time ; double cholmod_gpu_gemm_time ; double cholmod_gpu_syrk_time ; double cholmod_gpu_trsm_time ; double cholmod_gpu_potrf_time ; double cholmod_assemble_time ; double cholmod_assemble_time2 ; /* number of times the BLAS are called on the CPU and the GPU */ size_t cholmod_cpu_gemm_calls ; size_t cholmod_cpu_syrk_calls ; size_t cholmod_cpu_trsm_calls ; size_t cholmod_cpu_potrf_calls ; size_t cholmod_gpu_gemm_calls ; size_t cholmod_gpu_syrk_calls ; size_t cholmod_gpu_trsm_calls ; size_t cholmod_gpu_potrf_calls ; } cholmod_common ; // in ../../src/CHOLMOD/Include/cholmod_core.h skip forward to - line 1212 : <<<<< /* A sparse matrix stored in compressed-column form. */ typedef struct cholmod_sparse_struct { size_t nrow ; /* the matrix is nrow-by-ncol */ size_t ncol ; size_t nzmax ; /* maximum number of entries in the matrix */ /* pointers to int or SuiteSparse_long: */ void *p ; /* p [0..ncol], the column pointers */ void *i ; /* i [0..nzmax-1], the row indices */ /* for unpacked matrices only: */ void *nz ; /* nz [0..ncol-1], the # of nonzeros in each col. In * packed form, the nonzero pattern of column j is in * A->i [A->p [j] ... A->p [j+1]-1]. In unpacked form, column j is in * A->i [A->p [j] ... A->p [j]+A->nz[j]-1] instead. In both cases, the * numerical values (if present) are in the corresponding locations in * the array x (or z if A->xtype is CHOLMOD_ZOMPLEX). */ /* pointers to double or float: */ void *x ; /* size nzmax or 2*nzmax, if present */ void *z ; /* size nzmax, if present */ int stype ; /* Describes what parts of the matrix are considered: * * 0: matrix is "unsymmetric": use both upper and lower triangular parts * (the matrix may actually be symmetric in pattern and value, but * both parts are explicitly stored and used). May be square or * rectangular. * >0: matrix is square and symmetric, use upper triangular part. * Entries in the lower triangular part are ignored. * <0: matrix is square and symmetric, use lower triangular part. * Entries in the upper triangular part are ignored. * * Note that stype>0 and stype<0 are different for cholmod_sparse and * cholmod_triplet. See the cholmod_triplet data structure for more * details. */ int itype ; /* CHOLMOD_INT: p, i, and nz are int. * CHOLMOD_INTLONG: p is SuiteSparse_long, * i and nz are int. * CHOLMOD_LONG: p, i, and nz are SuiteSparse_long */ int xtype ; /* pattern, real, complex, or zomplex */ int dtype ; /* x and z are double or float */ int sorted ; /* TRUE if columns are sorted, FALSE otherwise */ int packed ; /* TRUE if packed (nz ignored), FALSE if unpacked * (nz is required) */ } cholmod_sparse ; // in ../../src/CHOLMOD/Include/cholmod_core.h skip forward to - line 1606 : <<<<< /* A symbolic and numeric factorization, either simplicial or supernodal. * In all cases, the row indices in the columns of L are kept sorted. */ typedef struct cholmod_factor_struct { /* ---------------------------------------------------------------------- */ /* for both simplicial and supernodal factorizations */ /* ---------------------------------------------------------------------- */ size_t n ; /* L is n-by-n */ size_t minor ; /* If the factorization failed, L->minor is the column * at which it failed (in the range 0 to n-1). A value * of n means the factorization was successful or * the matrix has not yet been factorized. */ /* ---------------------------------------------------------------------- */ /* symbolic ordering and analysis */ /* ---------------------------------------------------------------------- */ void *Perm ; /* size n, permutation used */ void *ColCount ; /* size n, column counts for simplicial L */ void *IPerm ; /* size n, inverse permutation. Only created by * cholmod_solve2 if Bset is used. */ /* ---------------------------------------------------------------------- */ /* simplicial factorization */ /* ---------------------------------------------------------------------- */ size_t nzmax ; /* size of i and x */ void *p ; /* p [0..ncol], the column pointers */ void *i ; /* i [0..nzmax-1], the row indices */ void *x ; /* x [0..nzmax-1], the numerical values */ void *z ; void *nz ; /* nz [0..ncol-1], the # of nonzeros in each column. * i [p [j] ... p [j]+nz[j]-1] contains the row indices, * and the numerical values are in the same locatins * in x. The value of i [p [k]] is always k. */ void *next ; /* size ncol+2. next [j] is the next column in i/x */ void *prev ; /* size ncol+2. prev [j] is the prior column in i/x. * head of the list is ncol+1, and the tail is ncol. */ /* ---------------------------------------------------------------------- */ /* supernodal factorization */ /* ---------------------------------------------------------------------- */ /* Note that L->x is shared with the simplicial data structure. L->x has * size L->nzmax for a simplicial factor, and size L->xsize for a supernodal * factor. */ size_t nsuper ; /* number of supernodes */ size_t ssize ; /* size of s, integer part of supernodes */ size_t xsize ; /* size of x, real part of supernodes */ size_t maxcsize ; /* size of largest update matrix */ size_t maxesize ; /* max # of rows in supernodes, excl. triangular part */ void *super ; /* size nsuper+1, first col in each supernode */ void *pi ; /* size nsuper+1, pointers to integer patterns */ void *px ; /* size nsuper+1, pointers to real parts */ void *s ; /* size ssize, integer part of supernodes */ /* ---------------------------------------------------------------------- */ /* factorization type */ /* ---------------------------------------------------------------------- */ int ordering ; /* ordering method used */ int is_ll ; /* TRUE if LL', FALSE if LDL' */ int is_super ; /* TRUE if supernodal, FALSE if simplicial */ int is_monotonic ; /* TRUE if columns of L appear in order 0..n-1. * Only applicable to simplicial numeric types. */ /* There are 8 types of factor objects that cholmod_factor can represent * (only 6 are used): * * Numeric types (xtype is not CHOLMOD_PATTERN) * -------------------------------------------- * * simplicial LDL': (is_ll FALSE, is_super FALSE). Stored in compressed * column form, using the simplicial components above (nzmax, p, i, * x, z, nz, next, and prev). The unit diagonal of L is not stored, * and D is stored in its place. There are no supernodes. * * simplicial LL': (is_ll TRUE, is_super FALSE). Uses the same storage * scheme as the simplicial LDL', except that D does not appear. * The first entry of each column of L is the diagonal entry of * that column of L. * * supernodal LDL': (is_ll FALSE, is_super TRUE). Not used. * FUTURE WORK: add support for supernodal LDL' * * supernodal LL': (is_ll TRUE, is_super TRUE). A supernodal factor, * using the supernodal components described above (nsuper, ssize, * xsize, maxcsize, maxesize, super, pi, px, s, x, and z). * * * Symbolic types (xtype is CHOLMOD_PATTERN) * ----------------------------------------- * * simplicial LDL': (is_ll FALSE, is_super FALSE). Nothing is present * except Perm and ColCount. * * simplicial LL': (is_ll TRUE, is_super FALSE). Identical to the * simplicial LDL', except for the is_ll flag. * * supernodal LDL': (is_ll FALSE, is_super TRUE). Not used. * FUTURE WORK: add support for supernodal LDL' * * supernodal LL': (is_ll TRUE, is_super TRUE). A supernodal symbolic * factorization. The simplicial symbolic information is present * (Perm and ColCount), as is all of the supernodal factorization * except for the numerical values (x and z). */ int itype ; /* The integer arrays are Perm, ColCount, p, i, nz, * next, prev, super, pi, px, and s. If itype is * CHOLMOD_INT, all of these are int arrays. * CHOLMOD_INTLONG: p, pi, px are SuiteSparse_long, others int. * CHOLMOD_LONG: all integer arrays are SuiteSparse_long. */ int xtype ; /* pattern, real, complex, or zomplex */ int dtype ; /* x and z double or float */ int useGPU; /* Indicates the symbolic factorization supports * GPU acceleration */ } cholmod_factor ; // in ../../src/CHOLMOD/Include/cholmod_core.h skip forward to - line 1890 : <<<<< /* A dense matrix in column-oriented form. It has no itype since it contains * no integers. Entry in row i and column j is located in x [i+j*d]. */ typedef struct cholmod_dense_struct { size_t nrow ; /* the matrix is nrow-by-ncol */ size_t ncol ; size_t nzmax ; /* maximum number of entries in the matrix */ size_t d ; /* leading dimension (d >= nrow must hold) */ void *x ; /* size nzmax or 2*nzmax, if present */ void *z ; /* size nzmax, if present */ int xtype ; /* pattern, real, complex, or zomplex */ int dtype ; /* x and z double or float */ } cholmod_dense ; // in ../../src/CHOLMOD/Include/cholmod_core.h skip forward to - line 2089 : <<<<< /* A sparse matrix stored in triplet form. */ typedef struct cholmod_triplet_struct { size_t nrow ; /* the matrix is nrow-by-ncol */ size_t ncol ; size_t nzmax ; /* maximum number of entries in the matrix */ size_t nnz ; /* number of nonzeros in the matrix */ void *i ; /* i [0..nzmax-1], the row indices */ void *j ; /* j [0..nzmax-1], the column indices */ void *x ; /* size nzmax or 2*nzmax, if present */ void *z ; /* size nzmax, if present */ int stype ; /* Describes what parts of the matrix are considered: * * 0: matrix is "unsymmetric": use both upper and lower triangular parts * (the matrix may actually be symmetric in pattern and value, but * both parts are explicitly stored and used). May be square or * rectangular. * >0: matrix is square and symmetric. Entries in the lower triangular * part are transposed and added to the upper triangular part when * the matrix is converted to cholmod_sparse form. * <0: matrix is square and symmetric. Entries in the upper triangular * part are transposed and added to the lower triangular part when * the matrix is converted to cholmod_sparse form. * * Note that stype>0 and stype<0 are different for cholmod_sparse and * cholmod_triplet. The reason is simple. You can permute a symmetric * triplet matrix by simply replacing a row and column index with their * new row and column indices, via an inverse permutation. Suppose * P = L->Perm is your permutation, and Pinv is an array of size n. * Suppose a symmetric matrix A is represent by a triplet matrix T, with * entries only in the upper triangular part. Then the following code: * * Ti = T->i ; * Tj = T->j ; * for (k = 0 ; k < n ; k++) Pinv [P [k]] = k ; * for (k = 0 ; k < nz ; k++) Ti [k] = Pinv [Ti [k]] ; * for (k = 0 ; k < nz ; k++) Tj [k] = Pinv [Tj [k]] ; * * creates the triplet form of C=P*A*P'. However, if T initially * contains just the upper triangular entries (T->stype = 1), after * permutation it has entries in both the upper and lower triangular * parts. These entries should be transposed when constructing the * cholmod_sparse form of A, which is what cholmod_triplet_to_sparse * does. Thus: * * C = cholmod_triplet_to_sparse (T, 0, &Common) ; * * will return the matrix C = P*A*P'. * * Since the triplet matrix T is so simple to generate, it's quite easy * to remove entries that you do not want, prior to converting T to the * cholmod_sparse form. So if you include these entries in T, CHOLMOD * assumes that there must be a reason (such as the one above). Thus, * no entry in a triplet matrix is ever ignored. */ int itype ; /* CHOLMOD_LONG: i and j are SuiteSparse_long. Otherwise int */ int xtype ; /* pattern, real, complex, or zomplex */ int dtype ; /* x and z are double or float */ } cholmod_triplet ; // -------- our (Matrix) short and const_ forms of of the pointers : typedef cholmod_common* CHM_CM; typedef cholmod_dense* CHM_DN; typedef const cholmod_dense* const_CHM_DN; typedef cholmod_factor* CHM_FR; typedef const cholmod_factor* const_CHM_FR; typedef cholmod_sparse* CHM_SP; typedef const cholmod_sparse* const_CHM_SP; typedef cholmod_triplet* CHM_TR; typedef const cholmod_triplet* const_CHM_TR; // --------- Matrix ("M_") R ("R_") pkg routines "re-exported": --------------- // "Implementation" of these in ./Matrix_stubs.c int M_R_cholmod_start(CHM_CM); void M_R_cholmod_error(int status, const char *file, int line, const char *message); int M_cholmod_finish(CHM_CM); CHM_SP M_cholmod_allocate_sparse(size_t nrow, size_t ncol, size_t nzmax, int sorted, int packed, int stype, int xtype, CHM_CM); int M_cholmod_free_factor(CHM_FR *L, CHM_CM); int M_cholmod_free_dense(CHM_DN *A, CHM_CM); int M_cholmod_free_sparse(CHM_SP *A, CHM_CM); int M_cholmod_free_triplet(CHM_TR *T, CHM_CM); long M_cholmod_nnz(const_CHM_SP, CHM_CM); CHM_SP M_cholmod_speye(size_t nrow, size_t ncol, int xtype, CHM_CM); CHM_SP M_cholmod_transpose(const_CHM_SP, int values, CHM_CM); int M_cholmod_sort(CHM_SP A, CHM_CM); CHM_SP M_cholmod_vertcat(const_CHM_SP, const_CHM_SP, int values, CHM_CM); CHM_SP M_cholmod_copy(const_CHM_SP, int stype, int mode, CHM_CM); CHM_SP M_cholmod_add(const_CHM_SP, const_CHM_SP, double alpha [2], double beta [2], int values, int sorted, CHM_CM); // from ../../src/CHOLMOD/Include/cholmod_cholesky.h - line 178 : <<<<< #define CHOLMOD_A 0 /* solve Ax=b */ #define CHOLMOD_LDLt 1 /* solve LDL'x=b */ #define CHOLMOD_LD 2 /* solve LDx=b */ #define CHOLMOD_DLt 3 /* solve DL'x=b */ #define CHOLMOD_L 4 /* solve Lx=b */ #define CHOLMOD_Lt 5 /* solve L'x=b */ #define CHOLMOD_D 6 /* solve Dx=b */ #define CHOLMOD_P 7 /* permute x=Px */ #define CHOLMOD_Pt 8 /* permute x=P'x */ CHM_DN M_cholmod_solve(int, const_CHM_FR, const_CHM_DN, CHM_CM); CHM_SP M_cholmod_spsolve(int, const_CHM_FR, const_CHM_SP, CHM_CM); int M_cholmod_sdmult(const_CHM_SP, int, const double*, const double*, const_CHM_DN, CHM_DN Y, CHM_CM); CHM_SP M_cholmod_ssmult(const_CHM_SP, const_CHM_SP, int, int, int, CHM_CM); int M_cholmod_factorize(const_CHM_SP, CHM_FR L, CHM_CM); int M_cholmod_factorize_p(const_CHM_SP, double *beta, int *fset, size_t fsize, CHM_FR L, CHM_CM); CHM_SP M_cholmod_copy_sparse(const_CHM_SP, CHM_CM); CHM_DN M_cholmod_copy_dense(const_CHM_DN, CHM_CM); CHM_SP M_cholmod_aat(const_CHM_SP, int *fset, size_t fsize, int mode, CHM_CM); int M_cholmod_band_inplace(CHM_SP A, int k1, int k2, int mode, CHM_CM); CHM_SP M_cholmod_add(const_CHM_SP, const_CHM_SP, double alpha[2], double beta[2], int values, int sorted, CHM_CM); CHM_DN M_cholmod_allocate_dense(size_t nrow, size_t ncol, size_t d, int xtype, CHM_CM); CHM_FR M_cholmod_analyze(const_CHM_SP, CHM_CM); CHM_FR M_cholmod_analyze_p(const_CHM_SP, int *Perm, int *fset, size_t fsize, CHM_CM); int M_cholmod_change_factor(int to_xtype, int to_ll, int to_super, int to_packed, int to_monotonic, CHM_FR L, CHM_CM); CHM_FR M_cholmod_copy_factor(const_CHM_FR, CHM_CM); CHM_SP M_cholmod_factor_to_sparse(const_CHM_FR, CHM_CM); CHM_SP M_cholmod_dense_to_sparse(const_CHM_DN, int values, CHM_CM); int M_cholmod_defaults (CHM_CM); CHM_SP M_cholmod_triplet_to_sparse(const cholmod_triplet*, int nzmax, CHM_CM); CHM_SP M_cholmod_submatrix(const_CHM_SP, int *rset, int rsize, int *cset, int csize, int values, int sorted, CHM_CM); CHM_TR M_cholmod_sparse_to_triplet(const_CHM_SP, CHM_CM); CHM_DN M_cholmod_sparse_to_dense(const_CHM_SP, CHM_CM); CHM_TR M_cholmod_allocate_triplet (size_t nrow, size_t ncol, size_t nzmax, int stype, int xtype, CHM_CM); // from ../../src/CHOLMOD/Include/cholmod_matrixops.h - line 104 : <<<<< /* scaling modes, selected by the scale input parameter: */ #define CHOLMOD_SCALAR 0 /* A = s*A */ #define CHOLMOD_ROW 1 /* A = diag(s)*A */ #define CHOLMOD_COL 2 /* A = A*diag(s) */ #define CHOLMOD_SYM 3 /* A = diag(s)*A*diag(s) */ int M_cholmod_scale(const_CHM_DN, int scale, CHM_SP, CHM_CM); #ifdef __cplusplus } #endif #endif /* MATRIX_CHOLMOD_H */ Matrix/inst/include/Matrix_stubs.c0000644000176200001440000004773114060361566016771 0ustar liggesusers#include #include #include #include #include #include "cholmod.h" #include "Matrix.h" #ifdef __cplusplus extern "C" { // and bool is defined #else # define bool Rboolean #endif #ifdef HAVE_VISIBILITY_ATTRIBUTE # define attribute_hidden __attribute__ ((visibility ("hidden"))) #else # define attribute_hidden #endif CHM_DN attribute_hidden M_as_cholmod_dense(CHM_DN ans, SEXP x) { static CHM_DN(*fun)(CHM_DN,SEXP) = NULL; if(fun == NULL) fun = (CHM_DN(*)(CHM_DN,SEXP)) R_GetCCallable("Matrix", "as_cholmod_dense"); return fun(ans, x); } CHM_FR attribute_hidden M_as_cholmod_factor(CHM_FR ans, SEXP x) { static CHM_FR(*fun)(CHM_FR,SEXP) = NULL; if(fun == NULL) fun = (CHM_FR(*)(CHM_FR,SEXP)) R_GetCCallable("Matrix", "as_cholmod_factor"); return fun(ans, x); } CHM_SP attribute_hidden M_as_cholmod_sparse(CHM_SP ans, SEXP x, Rboolean check_Udiag, Rboolean sort_in_place) { static CHM_SP(*fun)(CHM_SP,SEXP,Rboolean,Rboolean)= NULL; if(fun == NULL) fun = (CHM_SP(*)(CHM_SP,SEXP,Rboolean,Rboolean)) R_GetCCallable("Matrix", "as_cholmod_sparse"); return fun(ans, x, check_Udiag, sort_in_place); } CHM_TR attribute_hidden M_as_cholmod_triplet(CHM_TR ans, SEXP x, Rboolean check_Udiag) { static CHM_TR(*fun)(CHM_TR,SEXP,Rboolean)= NULL; if(fun == NULL) fun = (CHM_TR(*)(CHM_TR,SEXP,Rboolean)) R_GetCCallable("Matrix", "as_cholmod_triplet"); return fun(ans, x, check_Udiag); } SEXP attribute_hidden M_Csparse_diagU2N(SEXP x) { static SEXP(*fun)(SEXP) = NULL; if(fun == NULL) fun = (SEXP(*)(SEXP)) R_GetCCallable("Matrix", "Csparse_diagU2N"); return fun(x); } SEXP attribute_hidden M_chm_factor_to_SEXP(const_CHM_FR f, int dofree) { static SEXP(*fun)(const_CHM_FR,int) = NULL; if(fun == NULL) fun = (SEXP(*)(const_CHM_FR,int)) R_GetCCallable("Matrix", "chm_factor_to_SEXP"); return fun(f, dofree); } double attribute_hidden M_chm_factor_ldetL2(const_CHM_FR f) { static double(*fun)(const_CHM_FR) = NULL; if(fun == NULL) fun = (double(*)(const_CHM_FR)) R_GetCCallable("Matrix", "chm_factor_ldetL2"); return fun(f); } CHM_FR attribute_hidden M_chm_factor_update(CHM_FR f, const_CHM_SP A, double mult) { static CHM_FR(*fun)(CHM_FR,const_CHM_SP,double) = NULL; if(fun == NULL) fun = (CHM_FR(*)(CHM_FR,const_CHM_SP,double)) R_GetCCallable("Matrix", "chm_factor_update"); return fun(f, A, mult); } SEXP attribute_hidden M_chm_sparse_to_SEXP(const_CHM_SP a, int dofree, int uploT, int Rkind, const char *diag, SEXP dn) { static SEXP(*fun)(const_CHM_SP,int,int,int,const char*,SEXP) = NULL; if(fun == NULL) fun = (SEXP(*)(const_CHM_SP,int,int,int,const char*,SEXP)) R_GetCCallable("Matrix", "chm_sparse_to_SEXP"); return fun(a, dofree, uploT, Rkind, diag, dn); } SEXP attribute_hidden M_chm_triplet_to_SEXP(const CHM_TR a, int dofree, int uploT, int Rkind, const char *diag, SEXP dn) { static SEXP(*fun)(const CHM_TR,int,int,int,const char*,SEXP) = NULL; if(fun == NULL) fun = (SEXP(*)(const CHM_TR,int,int,int,const char*,SEXP)) R_GetCCallable("Matrix", "chm_triplet_to_SEXP"); return fun(a, dofree, uploT, Rkind, diag, dn); } CHM_SP attribute_hidden M_cholmod_aat(const_CHM_SP A, int *fset, size_t fsize, int mode, CHM_CM Common) { static CHM_SP(*fun)(const_CHM_SP,int*,size_t, int,CHM_CM) = NULL; if(fun == NULL) fun = (CHM_SP(*)(const_CHM_SP,int*,size_t, int,CHM_CM)) R_GetCCallable("Matrix", "cholmod_aat"); return fun(A, fset, fsize, mode, Common); } int attribute_hidden M_cholmod_band_inplace(CHM_SP A, int k1, int k2, int mode, CHM_CM Common) { static int(*fun)(CHM_SP,int,int,int,CHM_CM) = NULL; if (fun == NULL) fun = (int(*)(CHM_SP,int,int,int,CHM_CM)) R_GetCCallable("Matrix", "cholmod_band_inplace"); return fun(A, k1, k2, mode, Common); } CHM_SP attribute_hidden M_cholmod_add(const_CHM_SP A, const_CHM_SP B, double alpha[2], double beta[2], int values, int sorted, CHM_CM Common) { static CHM_SP(*fun)(const_CHM_SP,const_CHM_SP, double*,double*,int,int, CHM_CM) = NULL; if (fun == NULL) fun = (CHM_SP(*)(const_CHM_SP,const_CHM_SP, double*,double*,int,int, CHM_CM)) R_GetCCallable("Matrix", "cholmod_add"); return fun(A, B, alpha, beta, values, sorted, Common); } CHM_DN attribute_hidden M_cholmod_allocate_dense(size_t nrow, size_t ncol, size_t d, int xtype, CHM_CM Common) { static CHM_DN(*fun)(size_t,size_t,size_t, int,CHM_CM) = NULL; if (fun == NULL) fun = (CHM_DN(*)(size_t,size_t,size_t, int,CHM_CM)) R_GetCCallable("Matrix", "cholmod_allocate_dense"); return fun(nrow, ncol, d, xtype, Common); } CHM_SP attribute_hidden M_cholmod_allocate_sparse(size_t nrow, size_t ncol, size_t nzmax, int sorted, int packed, int stype, int xtype, CHM_CM Common) { static CHM_SP(*fun)(size_t,size_t,size_t,int,int, int,int,CHM_CM) = NULL; if (fun == NULL) fun = (CHM_SP(*) (size_t,size_t,size_t,int,int,int,int,CHM_CM)) R_GetCCallable("Matrix", "cholmod_allocate_sparse"); return fun(nrow,ncol,nzmax,sorted,packed,stype,xtype,Common); } CHM_TR attribute_hidden M_cholmod_allocate_triplet(size_t nrow, size_t ncol, size_t nzmax, int stype, int xtype, CHM_CM Common) { static CHM_TR(*fun)(size_t,size_t,size_t, int,int,CHM_CM) = NULL; if (fun == NULL) fun = (CHM_TR(*)(size_t,size_t,size_t,int,int,CHM_CM)) R_GetCCallable("Matrix", "cholmod_allocate_triplet"); return fun(nrow,ncol,nzmax,stype,xtype,Common); } CHM_SP attribute_hidden M_cholmod_triplet_to_sparse(const cholmod_triplet* T, int nzmax, CHM_CM Common) { static CHM_SP(*fun)(const cholmod_triplet*,int,CHM_CM) = NULL; if (fun == NULL) fun = (CHM_SP(*)(const cholmod_triplet*,int,CHM_CM)) R_GetCCallable("Matrix", "cholmod_triplet_to_sparse"); return fun(T, nzmax, Common); } CHM_TR attribute_hidden M_cholmod_sparse_to_triplet(const_CHM_SP A, CHM_CM Common) { static CHM_TR(*fun)(const_CHM_SP,CHM_CM) = NULL; if (fun == NULL) fun = (CHM_TR(*)(const_CHM_SP,CHM_CM)) R_GetCCallable("Matrix", "cholmod_sparse_to_triplet"); return fun(A, Common); } CHM_DN attribute_hidden M_cholmod_sparse_to_dense(const_CHM_SP A, CHM_CM Common) { static CHM_DN(*fun)(const_CHM_SP,CHM_CM) = NULL; if (fun == NULL) fun = (CHM_DN(*)(const_CHM_SP,CHM_CM)) R_GetCCallable("Matrix", "cholmod_sparse_to_dense"); return fun(A, Common); } CHM_FR attribute_hidden M_cholmod_analyze(const_CHM_SP A, CHM_CM Common) { static CHM_FR(*fun)(const_CHM_SP,CHM_CM) = NULL; if (fun == NULL) fun = (CHM_FR(*)(const_CHM_SP,CHM_CM)) R_GetCCallable("Matrix", "cholmod_analyze"); return fun(A, Common); } CHM_FR attribute_hidden M_cholmod_analyze_p(const_CHM_SP A, int *Perm, int *fset, size_t fsize, CHM_CM Common) { static CHM_FR(*fun)(const_CHM_SP,int*,int*,size_t, CHM_CM) = NULL; if (fun == NULL) fun = (CHM_FR(*)(const_CHM_SP,int*,int*, size_t,CHM_CM)) R_GetCCallable("Matrix", "cholmod_analyze_p"); return fun(A, Perm, fset, fsize, Common); } CHM_SP attribute_hidden M_cholmod_copy(const_CHM_SP A, int stype, int mode, CHM_CM Common) { static CHM_SP(*fun)(const_CHM_SP,int,int,CHM_CM) = NULL; if (fun == NULL) fun = (CHM_SP(*)(const_CHM_SP,int,int,CHM_CM)) R_GetCCallable("Matrix", "cholmod_copy"); return fun(A, stype, mode, Common); } CHM_DN attribute_hidden M_cholmod_copy_dense(const_CHM_DN A, CHM_CM Common) { static CHM_DN(*fun)(const_CHM_DN,CHM_CM) = NULL; if (fun == NULL) fun = (CHM_DN(*)(const_CHM_DN,CHM_CM)) R_GetCCallable("Matrix", "cholmod_copy_dense"); return fun(A, Common); } CHM_FR attribute_hidden M_cholmod_copy_factor(const_CHM_FR L, CHM_CM Common) { static CHM_FR(*fun)(const_CHM_FR,CHM_CM) = NULL; if (fun == NULL) fun = (CHM_FR(*)(const_CHM_FR,CHM_CM)) R_GetCCallable("Matrix", "cholmod_copy_factor"); return fun(L, Common); } int attribute_hidden M_cholmod_change_factor(int to_xtype, int to_ll, int to_super, int to_packed, int to_monotonic, CHM_FR L, CHM_CM Common) { static int(*fun)(int,int,int,int,int,CHM_FR,CHM_CM) = NULL; if (fun == NULL) fun = (int(*)(int,int,int,int,int,CHM_FR,CHM_CM)) R_GetCCallable("Matrix", "cholmod_change_factor"); return fun(to_xtype, to_ll, to_super, to_packed, to_monotonic, L, Common); } CHM_SP attribute_hidden M_cholmod_copy_sparse(const_CHM_SP A, CHM_CM Common) { static CHM_SP(*fun)(const_CHM_SP,CHM_CM) = NULL; if (fun == NULL) fun = (CHM_SP(*)(const_CHM_SP,CHM_CM)) R_GetCCallable("Matrix", "cholmod_copy_sparse"); return fun(A, Common); } CHM_SP attribute_hidden M_cholmod_factor_to_sparse(const_CHM_FR L, CHM_CM Common) { static CHM_SP(*fun)(const_CHM_FR,CHM_CM) = NULL; if (fun == NULL) fun = (CHM_SP(*)(const_CHM_FR,CHM_CM)) R_GetCCallable("Matrix", "cholmod_factor_to_sparse"); return fun(L, Common); } CHM_SP attribute_hidden M_cholmod_submatrix(const_CHM_SP A, int *rset, int rsize, int *cset, int csize, int values, int sorted, CHM_CM Common) { static CHM_SP(*fun)(const_CHM_SP,int*,int,int*,int, int,int,CHM_CM) = NULL; if (fun == NULL) fun = (CHM_SP(*)(const_CHM_SP,int*,int,int*, int,int,int,CHM_CM)) R_GetCCallable("Matrix", "cholmod_submatrix"); return fun(A, rset, rsize, cset, csize, values, sorted, Common); } CHM_SP attribute_hidden M_cholmod_dense_to_sparse(const_CHM_DN X, int values, CHM_CM Common) { static CHM_SP(*fun)(const_CHM_DN,int,CHM_CM) = NULL; if (fun == NULL) fun = (CHM_SP(*)(const_CHM_DN,int,CHM_CM)) R_GetCCallable("Matrix", "cholmod_dense_to_sparse"); return fun(X, values, Common); } int attribute_hidden M_cholmod_factorize(const_CHM_SP A, CHM_FR L, CHM_CM Common) { static int(*fun)(const_CHM_SP,CHM_FR,CHM_CM) = NULL; if (fun == NULL) fun = (int(*)(const_CHM_SP,CHM_FR,CHM_CM)) R_GetCCallable("Matrix", "cholmod_factorize"); return fun(A, L, Common); } int attribute_hidden M_cholmod_factorize_p(const_CHM_SP A, double *beta, int *fset, size_t fsize, CHM_FR L, CHM_CM Common) { static int(*fun)(const_CHM_SP,double*,int*,size_t, CHM_FR,CHM_CM) = NULL; if (fun == NULL) fun = (int(*)(const_CHM_SP,double*,int*,size_t, CHM_FR,CHM_CM)) R_GetCCallable("Matrix", "cholmod_factorize_p"); return fun(A, beta, fset, fsize, L, Common); } int attribute_hidden M_cholmod_finish(CHM_CM Common) { static int(*fun)(CHM_CM) = NULL; if (fun == NULL) fun = (int(*)(CHM_CM)) R_GetCCallable("Matrix", "cholmod_finish"); return fun(Common); } int attribute_hidden M_cholmod_sort(CHM_SP A, CHM_CM Common) { static int(*fun)(CHM_SP,CHM_CM) = NULL; if (fun == NULL) fun = (int(*)(CHM_SP,CHM_CM)) R_GetCCallable("Matrix", "cholmod_sort"); return fun(A, Common); } int attribute_hidden M_cholmod_free_dense(CHM_DN *A, CHM_CM Common) { static int(*fun)(CHM_DN*,CHM_CM) = NULL; if (fun == NULL) fun = (int(*)(CHM_DN*,CHM_CM)) R_GetCCallable("Matrix", "cholmod_free_dense"); return fun(A, Common); } int attribute_hidden M_cholmod_free_factor(CHM_FR *L, CHM_CM Common) { static int(*fun)(CHM_FR*,CHM_CM) = NULL; if (fun == NULL) fun = (int(*)(CHM_FR*,CHM_CM)) R_GetCCallable("Matrix", "cholmod_free_factor"); return fun(L, Common); } int attribute_hidden M_cholmod_free_sparse(CHM_SP *A, CHM_CM Common) { static int(*fun)(CHM_SP*,CHM_CM) = NULL; if (fun == NULL) fun = (int(*)(CHM_SP*,CHM_CM)) R_GetCCallable("Matrix", "cholmod_free_sparse"); return fun(A, Common); } int attribute_hidden M_cholmod_free_triplet(cholmod_triplet **T, CHM_CM Common) { static int(*fun)(cholmod_triplet**,CHM_CM) = NULL; if (fun == NULL) fun = (int(*)(cholmod_triplet**,CHM_CM)) R_GetCCallable("Matrix", "cholmod_free_triplet"); return fun(T, Common); } long attribute_hidden M_cholmod_nnz(const_CHM_SP A, CHM_CM Common) { static long(*fun)(const_CHM_SP,CHM_CM) = NULL; if (fun == NULL) fun = (long(*)(const_CHM_SP,CHM_CM)) R_GetCCallable("Matrix", "cholmod_nnz"); return fun(A, Common); } int attribute_hidden M_cholmod_sdmult(const_CHM_SP A, int transpose, const double *alpha, const double *beta, const_CHM_DN X, CHM_DN Y, CHM_CM Common) { static int(*fun)(const_CHM_SP,int,const double*, const double*,const_CHM_DN, CHM_DN,CHM_CM) = NULL; if (fun == NULL) fun = (int(*)(const_CHM_SP,int,const double*, const double*, const_CHM_DN, CHM_DN,CHM_CM)) R_GetCCallable("Matrix", "cholmod_sdmult"); return fun(A, transpose, alpha, beta, X, Y, Common); } CHM_SP attribute_hidden M_cholmod_ssmult(const_CHM_SP A, const_CHM_SP B, int stype, int values, int sorted, CHM_CM Common) { static CHM_SP(*fun)(const_CHM_SP,const_CHM_SP, int,int,int,CHM_CM) = NULL; if (fun == NULL) fun = (CHM_SP(*)(const_CHM_SP,const_CHM_SP, int,int,int,CHM_CM)) R_GetCCallable("Matrix", "cholmod_ssmult"); return fun(A, B, stype, values, sorted, Common); } CHM_DN attribute_hidden M_cholmod_solve(int sys, const_CHM_FR L, const_CHM_DN B, CHM_CM Common) { static CHM_DN(*fun)(int,const_CHM_FR,const_CHM_DN, CHM_CM) = NULL; if (fun == NULL) fun = (CHM_DN(*)(int,const_CHM_FR,const_CHM_DN, CHM_CM)) R_GetCCallable("Matrix", "cholmod_solve"); return fun(sys, L, B, Common); } /* Feature Requests #6064, 2015-03-27 https://r-forge.r-project.org/tracker/?func=detail&atid=297&aid=6064&group_id=61 */ int attribute_hidden M_cholmod_solve2(int sys, CHM_FR L, CHM_DN B, // right CHM_DN *X,// solution CHM_DN *Yworkspace, CHM_DN *Eworkspace, cholmod_common *c) { static int(*fun)( int, const_CHM_FR, // L const_CHM_DN, // B CHM_SP, // Bset CHM_DN*, // X CHM_DN*, // Xset CHM_DN*, // Y CHM_DN*, // E cholmod_common*) = NULL; // Source: ../../src/CHOLMOD/Cholesky/cholmod_solve.c if (fun == NULL) fun = (int(*)(int, const_CHM_FR, // L const_CHM_DN, // B CHM_SP, // Bset CHM_DN*, // X CHM_DN*, // Xset CHM_DN*, // Y CHM_DN*, // E cholmod_common*) )R_GetCCallable("Matrix", "cholmod_solve2"); return fun(sys, L, B, NULL, X, NULL, Yworkspace, Eworkspace, c); } CHM_SP attribute_hidden M_cholmod_speye(size_t nrow, size_t ncol, int xtype, CHM_CM Common) { static CHM_SP(*fun)(size_t,size_t,int,CHM_CM) = NULL; if (fun == NULL) fun = (CHM_SP(*)(size_t,size_t,int,CHM_CM)) R_GetCCallable("Matrix", "cholmod_speye"); return fun(nrow, ncol, xtype, Common); } CHM_SP attribute_hidden M_cholmod_spsolve(int sys, const_CHM_FR L, const_CHM_SP B, CHM_CM Common) { static CHM_SP(*fun)(int,const_CHM_FR, const_CHM_SP, CHM_CM) = NULL; if (fun == NULL) fun = (CHM_SP(*)(int,const_CHM_FR, const_CHM_SP, CHM_CM)) R_GetCCallable("Matrix", "cholmod_spsolve"); return fun(sys, L, B, Common); } int attribute_hidden M_cholmod_defaults (CHM_CM Common) { static int(*fun)(CHM_CM) = NULL; if (fun == NULL) fun = (int(*)(CHM_CM)) R_GetCCallable("Matrix", "cholmod_defaults"); return fun(Common); } int attribute_hidden M_cholmod_updown(int update, const_CHM_SP C, const_CHM_FR L, CHM_CM Common) { static int(*fun)(int,const_CHM_SP,const_CHM_FR, CHM_CM) = NULL; if (fun == NULL) fun = (int(*)(int,const_CHM_SP,const_CHM_FR, CHM_CM)) R_GetCCallable("Matrix", "cholmod_updown"); return fun(update, C, L, Common); } /* extern cholmod_common c; */ void attribute_hidden M_R_cholmod_error(int status, const char *file, int line, const char *message) { /* NB: keep in sync with R_cholmod_error(), ../../src/chm_common.c */ if(status < 0) { /* Note: Matrix itself uses CHM_set_common_env, CHM_store_common * and CHM_restore_common to preserve settings through error calls. * Consider defining your own error handler, *and* possibly restoring * *your* version of the cholmod_common that *you* use. */ error("Cholmod error '%s' at file '%s', line %d", message, file, line); } else warning("Cholmod warning '%s' at file '%s', line %d", message, file, line); } #if 0 /* no longer used */ /* just to get 'int' instead of 'void' as required by CHOLMOD's print_function */ static int R_cholmod_printf(const char* fmt, ...) { va_list(ap); va_start(ap, fmt); Rprintf((char *)fmt, ap); va_end(ap); return 0; } #endif int attribute_hidden M_R_cholmod_start(CHM_CM Common) { int val; static int(*fun)(CHM_CM) = NULL; if (fun == NULL) fun = (int(*)(CHM_CM)) R_GetCCallable("Matrix", "cholmod_start"); val = fun(Common); /*-- NB: keep in sync with R_cholmod_start() --> ../../src/chm_common.c */ /* do not allow CHOLMOD printing - currently */ /*- *NOMORE* with SuiteSparse 5.7.1: *- Common->print_function = NULL; *- was R_cholmod_printf (Rprintf gives warning) */ /* Consider using your own error handler: */ Common->error_handler = M_R_cholmod_error; return val; } CHM_SP attribute_hidden M_cholmod_transpose(const_CHM_SP A, int values, CHM_CM Common) { static CHM_SP(*fun)(const_CHM_SP,int,CHM_CM) = NULL; if (fun == NULL) fun = (CHM_SP(*)(const_CHM_SP,int,CHM_CM)) R_GetCCallable("Matrix", "cholmod_transpose"); return fun(A, values, Common); } CHM_SP attribute_hidden M_cholmod_vertcat(const_CHM_SP A, const_CHM_SP B, int values, CHM_CM Common) { static CHM_SP(*fun)(const_CHM_SP,const_CHM_SP,int,CHM_CM) = NULL; if (fun == NULL) fun = (CHM_SP(*)(const_CHM_SP,const_CHM_SP, int, CHM_CM)) R_GetCCallable("Matrix", "cholmod_vertcat"); return fun(A, B, values, Common); } SEXP attribute_hidden M_dpoMatrix_chol(SEXP x) { static SEXP(*fun)(SEXP) = NULL; if (fun == NULL) fun = (SEXP(*)(SEXP)) R_GetCCallable("Matrix", "dpoMatrix_chol"); return fun(x); } CHM_DN attribute_hidden M_numeric_as_chm_dense(CHM_DN ans, double *v, int nr, int nc) { static CHM_DN(*fun)(CHM_DN,double*,int,int) = NULL; if (fun == NULL) fun = (CHM_DN(*)(CHM_DN,double*,int,int)) R_GetCCallable("Matrix", "numeric_as_chm_dense"); return fun(ans, v, nr, nc); } int attribute_hidden M_cholmod_scale(const_CHM_DN S, int scale, CHM_SP A, CHM_CM Common) { static int(*fun)(const_CHM_DN,int,CHM_SP, CHM_CM) = NULL; if (fun == NULL) fun = (int(*)(const_CHM_DN,int,CHM_SP, CHM_CM)) R_GetCCallable("Matrix", "cholmod_scale"); return fun(S, scale, A, Common); } // for now still *export* M_Matrix_check_class_etc() int M_Matrix_check_class_etc(SEXP x, const char **valid) { REprintf("M_Matrix_check_class_etc() is deprecated; use R_check_class_etc() instead"); return R_check_class_etc(x, valid); } const char *Matrix_valid_ge_dense[] = { MATRIX_VALID_ge_dense, ""}; const char *Matrix_valid_ddense[] = { MATRIX_VALID_ddense, ""}; const char *Matrix_valid_ldense[] = { MATRIX_VALID_ldense, ""}; const char *Matrix_valid_ndense[] = { MATRIX_VALID_ndense, ""}; const char *Matrix_valid_dense[] = { MATRIX_VALID_ddense, MATRIX_VALID_ldense, MATRIX_VALID_ndense, ""}; const char *Matrix_valid_Csparse[] = { MATRIX_VALID_Csparse, ""}; const char *Matrix_valid_triplet[] = { MATRIX_VALID_Tsparse, ""}; const char *Matrix_valid_Rsparse[] = { MATRIX_VALID_Rsparse, ""}; const char *Matrix_valid_CHMfactor[]={ MATRIX_VALID_CHMfactor, ""}; bool Matrix_isclass_Csparse(SEXP x) { return R_check_class_etc(x, Matrix_valid_Csparse) >= 0; } bool Matrix_isclass_triplet(SEXP x) { return R_check_class_etc(x, Matrix_valid_triplet) >= 0; } bool Matrix_isclass_ge_dense(SEXP x) { return R_check_class_etc(x, Matrix_valid_ge_dense) >= 0; } bool Matrix_isclass_ddense(SEXP x) { return R_check_class_etc(x, Matrix_valid_ddense) >= 0; } bool Matrix_isclass_ldense(SEXP x) { return R_check_class_etc(x, Matrix_valid_ldense) >= 0; } bool Matrix_isclass_ndense(SEXP x) { return R_check_class_etc(x, Matrix_valid_ndense) >= 0; } bool Matrix_isclass_dense(SEXP x) { return R_check_class_etc(x, Matrix_valid_dense) >= 0; } bool Matrix_isclass_CHMfactor(SEXP x) { return R_check_class_etc(x, Matrix_valid_CHMfactor) >= 0; } #ifdef __cplusplus } #endif Matrix/inst/external/0000755000176200001440000000000014154165362014324 5ustar liggesusersMatrix/inst/external/utm300.rua0000644000176200001440000024553510275433311016073 0ustar liggesusersUTM300 UTM300 1290 16 122 1052 100 RUA 300 300 3155 1 (20I4) (26I3) (3D21.15) (3D21.15) FNN 1 1 3 9 13 17 20 22 28 32 36 44 46 52 56 60 68 69 70 72 74 82 83 84 86 88 96 97 98 100 102 110 111 112 114 116 124 126 132 136 140 148 150 156 160 164 172 174 178 182 186 189 191 196 201 208 217 225 242 257 279 297 306 324 339 355 374 382 399 415 431 451 458 475 491 511 531 538 555 571 591 611 619 637 653 669 689 697 714 729 744 763 771 775 790 812 831 833 837 842 849 858 860 865 870 877 886 895 912 928 950 970 979 9971013103110511060107710931111 11311140115711731195121512241241125712791299130813261342136013801389140614221440 14601469147314891511153115331537154215491558156015651570157715861594161116271649 16691677169417101732175217611778179418161836184518621878190019201929194619621984 20042013203020462068208820972114213021522172218021842200222222422244224822532260 22692271227622812288229723052322233723592379238724042419244124612470248725022524 25442553257025852607262726362653266826902710271927362751277327922800281728322854 28742883288729022924294329452949295429612970297229782980298229852987299329952997 30053007301330153017302530273033303530373045304730533055305730653067307330753077 30853087309330953097310431063112311431163124312631323134313631433145314931513153 3156 1 51 1 2 6 51 52 56 1 3 51 53 1 4 51 54 5 10 55 6 56 6 7 11 56 57 61 6 8 56 58 6 9 56 59 6 8 9 10 56 58 59 60 11 61 11 12 36 61 62 86 11 13 61 63 11 14 61 64 11 13 14 15 61 63 64 65 16 17 16 18 16 19 16 18 19 20 66 68 69 70 21 22 21 23 21 24 21 23 24 25 71 73 74 75 26 27 26 28 26 29 26 28 29 30 76 78 79 80 31 32 31 33 31 34 31 33 34 35 81 83 84 85 36 86 36 37 41 86 87 91 36 38 86 88 36 39 86 89 36 38 39 40 86 88 89 90 41 91 41 42 46 91 92 96 41 43 91 93 41 44 91 94 41 43 44 45 91 93 94 95 46 96 46 47 96 97 46 48 96 98 46 49 96 99 45 50100 51 56 51 52 53 54 56 51 52 53 56 58 51 52 54 56 57 59 61 51 52 53 54 55 56 58 59 60 6 51 52 56 57 58 60106 6 7 11 51 52 56 57 58 59 61 62 63 64 86106107111 6 8 51 52 53 56 57 58 59 60 61 63106108109 1 2 6 7 9 11 51 52 54 56 57 58 59 60 61 64101102106107109111 6 9 10 51 54 55 56 58 59 60 61 63 64 65106108109110 11 56 57 61 62 63 65 86111 11 12 36 56 57 61 62 63 64 86 87 88 89 91111112116136 11 13 56 57 58 61 62 63 64 65 86 88111113114 6 7 11 14 56 57 59 61 62 63 64 65 86 89111114 11 14 15 56 58 59 60 61 63 64 65 86 88 89 90111113114115 16 66 67 68 70 81 82116 16 17 21 66 67 68 69 71 72 73 74 76 81 82116117121 16 18 19 66 67 68 69 70 71 73 81 82 83116118119 16 17 19 32 66 67 68 69 70 71 74 81 82 84116119 16 18 19 20 66 68 69 70 71 73 74 75 81 83 84 85116118119120 21 67 71 72 73 75121 21 22 26 66 67 71 72 73 74 76 77 78 79 81121122126 21 23 24 66 67 68 71 72 73 74 75 76 78121123124 17 21 22 24 66 67 69 71 72 73 74 75 76 79116117121122124126 21 23 24 25 66 68 69 70 71 73 74 75 76 78 79 80121123124125 26 72 76 77 78 80126 26 27 31 66 71 72 76 77 78 79 81 82 83 84126127131 26 28 29 71 72 73 76 77 78 79 80 81 83126128129 22 26 27 29 71 72 74 76 77 78 79 80 81 84121122126127129131 26 28 29 30 71 73 74 75 76 78 79 80 81 83 84 85126128129130 31 66 77 81 82 83 85131 16 31 32 66 67 68 69 71 76 77 81 82 83 84116131132136 31 33 34 66 68 76 77 78 81 82 83 84 85131 133134 27 31 32 34 66 69 76 77 79 81 82 83 84 85131134 31 33 34 35 66 68 69 70 76 78 79 80 81 83 84 85131133134135 36 61 62 86 87 88 90136 36 37 41 61 62 86 87 88 89 91 92 93 94 96136137141 36 38 61 62 63 86 87 88 89 90 91 93136138139 36 37 39 61 62 64 86 87 88 89 90 91 94136139 36 39 40 61 63 64 65 86 88 89 90 91 93 94 95136138139140 41 86 87 91 92 93 95141 91 92 96 97 41 43 86 87 88 91 92 93 94 95 96 98141143144 36 37 41 42 44 46 86 87 89 91 92 93 94 95 96 99136 137141142144146 41 44 45 86 88 89 90 91 93 94 95 96 98 99100141143144145 91 96 96 97 98 99 91 92 93 96 98 86 87 91 92 94 96 99 91 92 93 94 95 96 98 99100101 106101102103104106101102103106108101102104106107109111101102103104105106108109 110 56101102106107108110111156 56 57 61101102106107108109111112113114116156157 161 56 58 59101102103106107108109110111113156158159 51 52 56 57 59 61101102104 106107108109110111114151152156157159161 56 58 59 60101103104105106108109110111 113114115156158159160 61106107111112113115116161 61 62 86106107111112113114116 117118119121136161162166 61 63 64106107108111112113114115116118161163164 61 64 106107109111112113114115116119156157161162164166 61 63 64 65106108109110111113 114115116118119120161163164165 66111112116117118120121166 66 67 71111112116117 118119121122123124126166167171 66 68 69111112113116117118119120121123166168169 66 69111112114116117118119120121124161162166167169171 66 68 69 70111113114115 116118119120121123124125166168169170 71116117121122123125126171 71 72 76116117 121122123124126127128129131171172176 71 73 74116117118121122123124125126128171 173174 66 67 71 72 74 76116117119121122123124125126129166167171172174176 71 73 74 75116118119120121123124125126128129130171173174175 76121122126127128130131 176 76 77 81121122126127128129131132133134136176177181 76 78 79121122123126127 128129130131133176178179 71 72 76 77 79 81121122124126127128129130131134171172 176177179181 76 78 79 80121123124125126128129130131133134135176178179180 81126 127131132133135136181 66 81 82116126127131132133134136137138139141181182186 81 83 84126127128131132133134135136138181183184 81 84126127129131132133134135136 139176177181182184186 81 83 84 85126128129130131133134135136138139140181183184 185 86131132136137138140141186 86 87 91131132136137138139141142143144146186187 191 86 88 89131132133136137138139140141143186188189 86 89131132134136137138139 140141144181182186187189191 86 88 89 90131133134135136138139140141143144145186 188189190 91136137141142143145146191141142146147 91 93 94136137138141142143144 145146148191193194 86 87 91 92 94 96136137139141142143144145146149186187191192 194196 91 93 94 95136138139140141143144145146148149150191193194195141146146147 148149141142143146148136137141142144146149141142143144145146148149150151156151 152153154156151152153156158151152154156157159161151152153154155156158159160106 151152156157158160206106107111151152156157158159161162163164166206207211106108 109151152153156157158159160161163206208209101102106107109111151152154156157158 159160161164201202206207209211106108109110151153154155156158159160161163164165 206208209210111157161162163165166211111112116156157161162163164166167168169171 211212216111113114156157158161162163164165166168211213214106107111112114116156 157159161162163164165166169206207211212214216111113114115156158159160161163164 165166168169170211213214215116161162166167168170171216116117121161162166167168 169171172173174176216217221116118119161162163166167168169170171173216218219111 112116117119121161162164166167168169170171174211212216217219221116118119120161 163164165166168169170171173174175216218219220121166167171172173175176221121122 126166167171172173174176177178179181221222226121123124166167168171172173174175 176178221223224116117121122124126166167169171172173174175176179216217221222224 226121123124125166168169170171173174175176178179180221223224225126171172176177 178180181226126127131171172176177178179181182183184186226227231126128129171172 173176177178179180181183226228229121122126127129131171172174176177178179180181 184221222226227229231126128129130171173174175176178179180181183184185226228229 230131176177181182183185186231131132136176177181182183184186187188189191231232 236131133134176177178181182183184185186188231233234126127131132134136176177179 181182183184185186189226227231232234236131133134135176178179180181183184185186 188189190231233234235136181182186187188190191236136137141181182186187188189191 192193194196236237241136138139181182183186187188189190191193236238239131132136 137139141181182184186187188189190191194231232236237239241136138139140181183184 185186188189190191193194195236238239240141186187191192193195241191192196197141 143144186187188191192193194195196198241243244136137141142144146186187189191192 193194195196199236237241242244246141143144145186188189190191193194195196198199 200241243244245191196196197198199191192193196198186187191192194196199191192193 194195196198199200201206201202203204206201202203206208201202204206207209211201 202203204205206208209210156202206207208210211256156157161201202206207208209211 212213214216256257261156158159201202203206207208209210211213256258151152156157 159161201202204206207208209210211214251252256257259261156158159160201203204205 206208209210211213214215256258259260161207211212213215216261161162166206207211 212213214216217218219221261262266161163164206207208211212213214215216218261263 156157161162164166206207209211212213214215216219256257261262264266161163164165 206208209210211213214215216218219220261263264265166211212216217218220221266166 167171211212216217218219221222223224226266267271166168169211212213216217218219 220221223266268161162166167169171211212214216217218219220221224261262266267269 271166168169170211213214215216218219220221223224225266268269270171216217221222 223225226271171172176216217221222223224226227228229231271272276171173174216217 218221222223224225226228271273166167171172174176216217219221222223224225226229 266267271272274276171173174175216218219220221223224225226228229230271273274275 176221222226227228230231276176177181221222226227228229231232233234236276277281 176178179221222223226227228229230231233276278171172176177179181221222224226227 228229230231234271272276277279281176178179180221223224225226228229230231233234 235276278279280181226227231232233235236281181182186226227231232233234236237238 239241281282286181183184226227228231232233234235236238281283176177181182184186 226227229231232233234235236239276277281282284286181183184185226228229230231233 234235236238239240281284285186231232236237238240286186187191231232236237238239 241242243244246286287291186188189231232233236237238239240241243286288181182186 187189191231232234236237238239240241244281282286287289291186188189190231233234 235236238239240241243244245286288289290191236237241242243245246291241242246247 191193194236237238241242243244245246248291293186187191192194196236237239241242 243244245246249286287291292294296191193194195236238239240241243244245246248249 250291294295241246246247248249241242243246248236237241242244246249241242243244 245246248249250201251201202206251252256251253251254205255260206256206207211256 257261256258256259206208209210256258259260211261211212216261262266261263261264 211213214215261263264265216266216217221266267271266268266269216218219220266268 269270221271221222226271272276271273271274221223224225271273274275226276226227 231276277281276278276279226228229230276278279280231281231232236281282286281283 281284231233234235281284285236286236237241286287291286288286289236238239240286 288289290241291241242246291292296291293291294241243244245291294295246296246247 296297296298296299250295300 -.707106816579618E+000.707106745793467E+00-.844334130890272E-01 -.696951911168316E+00-.844334130890552E-010.844333971430866E-01 0.696951959550198E+000.844333971430866E-010.169379293548785E-01 -.706903887803993E+00-.169379269811943E-010.706903887799719E+00 0.245538507221060E-01-.706680324381466E+00-.245538469074249E-01 0.706680363494609E+00-.816418512372678E+000.416234647777442E+00 0.400261827613855E+00-.707106816579739E+000.707106745793357E+00 -.692246657276026E-01-.700297003669988E+00-.692246686484270E-01 0.692246561667109E-010.700297003664129E+000.692246429669856E-01 0.201259425073776E-01-.706820307066788E+00-.201259404946509E-01 0.706820307062134E+000.247547275541103E-01-.706673335798275E+00 -.247547250784765E-010.706673335793667E+000.244951179721711E-01 0.141798045683355E-19-.699515386900931E+00-.100390257306135E+00 -.244951125432383E-010.403797585699602E-130.699515399846145E+00 0.100390257306048E+00-.707106840518851E+000.707106721854245E+00 -.132398684210425E-02-.707104302076665E+00-.132398682112846E-02 0.132398661033321E-020.707104302222497E+000.132398652689601E-02 0.251871166539414E-01-.706658056811822E+00-.251871127758866E-01 0.706658056805146E+000.264048027660490E-01-.706613622993380E+00 -.264047987662912E-010.706613586618012E+000.250107227346610E-01 0.259324348882091E-18-.669582765977545E+00-.225905619309715E+00 -.250107188007798E-010.166054197615496E-120.669582814615445E+00 0.225905627940471E+00-.999999999999996E+00-.100000000000000E+01 0.707106751263410E+00-.707106811109693E+000.707106751263400E+00 -.707106811109696E+000.594184615923025E-04-.522534802243499E-12 -.594354881940039E-04-.764126330976698E+00-.654895649435869E-04 -.555850754291422E-100.775951072359707E-040.645066611238772E+00 -.999999999999996E+00-.100000000000000E+010.707106751263410E+00 -.707106811109693E+000.707106751263407E+00-.707106811109700E+00 0.265041818209181E-04-.508541053041430E-12-.265118042346652E-04 -.757862392871900E+00-.311410747072004E-04-.431724688636464E-10 0.361816791523382E-040.652414431007056E+00-.999999999999996E+00 -.100000000000000E+010.707106751263410E+00-.707106811109693E+00 0.707106794782394E+00-.707106767590709E+000.247298538585594E-04 0.173057137779142E-12-.247369664563574E-04-.758133034802306E+00 -.288203567500599E-04-.373198365066270E-100.335135601768647E-04 0.652099914402839E+00-.999999999999996E+00-.100000000000000E+01 0.707106751263410E+00-.707106811109693E+000.707106773022893E+00 -.707106789350199E+000.526001426328733E-04-.686257777907160E-12 -.526151918089806E-04-.763904838719903E+00-.579153207211495E-04 -.480634147895882E-100.685730564085902E-040.645328895826580E+00 -.707106816579021E+000.707106745794075E+000.907453690126752E-01 -.695363616933204E+000.907453584845728E-01-.907453530938325E-01 0.695363616931083E+00-.907453541634382E-010.388412996851262E-01 -.706039176488765E+00-.388412958008106E-010.706039225852471E+00 0.405384669021764E-01-.705943788823106E+00-.405384601326821E-01 0.705943788819880E+000.374910477226837E-010.836910668696327E-19 -.653009130497729E+00-.268651354886250E+00-.374910441557599E-01 0.139197855810201E-120.653009053988256E+000.268651341635424E+00 -.707106816577767E+000.707106745795336E+000.110699028877342E+00 -.689558863568468E+000.110699028877342E+00-.110699023342189E+00 0.689558899694259E+00-.110699023342207E+000.353901421432703E-01 -.706220615039452E+00-.353901386042155E-010.706220587934077E+00 0.400455576932894E-01-.705971921162636E+00-.400455536886817E-01 0.705971921161698E+000.397033469335430E-010.518711104785870E-19 -.700067560303143E+00-.912639778518622E-01-.397033514193168E-01 0.669670689866494E-130.700067476628409E+000.912639778518489E-01 -.707106816577706E+000.707106745795397E+000.216163600604371E+00 -.673255732353994E+00-.216163567662612E+000.673255767625957E+00 0.343171978221466E-01-.706273565834579E+00-.343171943903884E-01 0.706273537877586E+000.384789098875664E-01-.706059044020112E+00 -.384789060396264E-010.706059044019181E+000.428340687803781E+00 -.816002001388647E+000.388155882219383E+00-.707106781186546E+00 0.707106781186546E+000.919164088258896E-12-.323903147050126E+00 -.668411207904565E+00-.668411136933422E+00-.392397821342358E-01 0.126741961371568E-010.848341585451701E-02-.686488249101334E+00 -.164737403383030E-010.726794259837522E+000.253811998949423E-01 0.427304877010395E-02-.713017416797165E+00-.242972297547323E-01 -.379326587583946E-020.700241968358579E+00-.374966055507997E-03 0.244954510496371E-01-.107305914771803E-020.854576884136081E-09 -.704999716109445E+00-.101177314154959E+00-.240417637527367E-01 0.106896353468138E-020.693652910717219E+000.101999329282549E+00 0.369802367784965E-02-.998478946766033E-080.628213615438288E+00 -.111695501554557E-01-.639775962557707E+000.441805243310407E+00 0.264916681259199E-010.150179388402961E-02-.323621717853948E-03 0.878267323059556E-020.250020432185017E-03-.492283767812116E-02 -.406353565923736E-010.234750587315863E-02-.173455232422632E+00 0.500624797585161E+000.467986775089445E+00-.171309845650195E-01 0.108659111149954E+00-.500624772325725E+00-.485548310627230E+00 0.203453546805473E-030.924723892346221E-040.596021551608855E-02 0.144977252778252E-030.727990528604067E-040.170446169406913E-02 -.713900928598815E-020.219802264290567E-010.370608562041904E+00 0.207893595583177E-01-.258848244250827E-01-.903242099366874E+00 0.922248994905455E-01-.305257817801369E-02-.700818827730815E-02 0.191302757843644E+000.148579185954640E-040.171121650781410E-02 0.486934889722714E-030.150620182701511E-040.124328766057256E-03 0.239016721169981E-030.115323810912666E-030.404520413743159E-02 0.113998101983268E-04-.207057801906026E-020.590390599498483E-01 0.229989382973123E+000.126638864121696E-01-.636607683510642E-01 0.320190435990360E+00-.860187903320348E+000.144893930539319E-02 -.120356442673852E-010.311102756171715E+00-.160900125595186E-05 -.788680156986552E-05-.220582013341250E-04-.808877643315356E-05 0.290559263145904E-02-.124362898928145E-05-.455696078386797E-02 0.130134687021089E+000.186761496719130E-01-.209760100786787E-01 0.603707240598609E+000.866404279134079E-010.268410288213005E-01 -.160761288050858E-02-.771455917360623E+00-.118795008750806E+00 0.233433259368892E-030.357198977531906E-020.125468663142325E-01 0.105518298214813E-01-.219409073721873E-03-.516770485999043E-03 0.155737420002396E-020.475170697294222E-020.375437524196078E-02 0.125599035320910E-080.160955314931229E+00-.223800543931700E-01 -.167424614451373E+000.958946814478864E+000.161130765277663E+00 0.196534771283384E-030.229515992283831E-020.576258431242573E-05 0.123745953025444E-01-.106995672755502E-04-.451052406900802E-04 -.456298622807265E-03-.275196027305474E-03-.305282850369034E+00 0.519423576775914E+000.505241937641198E+00-.130908849130573E-01 0.201635085589468E-01-.519423633116087E+00-.333293227117524E+00 -.263134929283539E-020.118328199171819E-030.104150622740462E-01 0.193141117505181E-03-.154345791282011E-030.173868931704905E-03 0.325208290050746E-02-.373216687782401E-030.149265726829690E-01 0.635804228599679E-010.820369767656903E-02-.212632332341540E-01 -.863649530175426E+000.489006964790317E+00-.348933539662262E-01 -.515727866020910E-020.944324418994364E-010.774875938152194E-04 0.482971314170869E-020.112759618007829E-020.222168874154256E-11 -.469066568608033E-100.220035735034216E-030.392555412688333E-02 0.141255360917606E-030.174989934363485E-010.515531740150388E-01 -.461588326613025E-03-.250983472579693E-010.684732202756503E+00 -.726228124582573E+000.842387322611238E-02-.317841553099293E-03 0.582455539039689E-02-.217823676656004E-040.446878338884266E-02 -.200617977872690E-010.537091052490130E+000.181205202614563E+00 -.379058590472633E-02-.114631325054326E-020.100346775148016E+00 0.271648560515299E-010.259196853345346E-01-.272445450180131E-01 -.728159919978982E+00-.314123286436018E+00-.938624176704406E-02 -.362203896936131E-020.153775041043447E+000.781378322348654E-01 0.426720954014265E-030.112760204809835E-02-.167938108847192E-02 0.854993026183699E-010.457577468747559E-03-.644980511474331E-03 -.215375382943762E-020.354875964291731E-050.999992692546311E+00 0.164898274978811E-070.304934046331858E-020.228760962681150E-03 -.247128995183060E-100.118007080764899E+00-.123564497591530E-09 0.162728422837746E-01-.819861260960444E+000.141941206609466E+00 0.125775224074353E+000.393535557751079E-020.178021559472064E+00 -.141941215640452E+00-.147146706681122E+000.753144190049640E-03 0.236859750590249E-020.447439294418169E+000.359129436315990E-02 0.627754930398190E-01-.139244701906877E-020.214783034756772E-03 0.131512191293389E-030.124438240310255E-040.487697648747908E+00 -.148174054632193E-02-.535785553537011E+000.309890918116741E-03 -.688115252161152E-01-.283340125674097E-010.310257496437506E-01 -.461205326885983E+000.191293743934847E-020.505833990447865E+00 0.750983511657879E-040.705267092317584E-04-.786060719406271E-05 0.565417053429881E-020.369600487362671E-040.443122584382949E-02 0.369600487362671E-040.389809678124690E+00-.480919973513487E-01 0.104050264453308E-01-.489891790728507E+000.512175326664710E+00 -.251878239510859E-010.293966079442228E-01-.374941991066111E+00 0.641782125495638E-010.443884509856657E+000.415631588510590E-02 0.291724739467156E-02-.315602200752062E-040.276258179505761E-12 0.315692669405107E-040.405867061011481E+000.378690131926348E-04 -.918882285479390E-06-.585087468913459E-04-.901978941696008E+00 0.113474779210659E-090.132088859541395E-090.452016593238905E-08 0.153981616917685E-03-.187604508266648E-060.449094630629618E-09 0.238044864556349E-060.236695170296057E-02-.429542502073789E-04 -.134103249836867E-040.103819281934490E-030.147310120826308E+00 0.289572954091881E-010.166544091372661E-01-.414623249348314E-01 -.271830205766233E-01-.834413463006351E-060.998136392031476E+00 0.122395916553052E-010.632739099986892E-090.212633687143486E+00 0.632739099986892E-09-.110266703181475E-030.137411102806595E+00 -.541373056555355E-02-.813199727026674E+000.185364035933384E+00 0.189529013238867E+000.865340666265890E-020.342605965282138E+00 -.185364035366044E+00-.194177150813847E+000.294623504846971E-02 -.481686497086705E-030.121545876488085E+00-.530804639167663E-03 0.456286581451462E-020.286575521807902E-020.404296415827950E-03 -.687084666871018E-010.346805266614458E-020.753574515516031E-01 0.505627623174092E+00-.574252270940695E-02-.564511679616764E+00 -.357473139901688E-04-.231037907805869E-01-.434238694510366E+00 0.475492620831160E+000.115770063050651E-020.134140728510668E-02 -.263260049701307E-030.105471222881001E-020.116593856850648E+00 0.105471222881001E-020.922493324714324E-01-.579437302697594E-01 0.121570291545597E+000.685873943808266E-010.273378233184083E+00 -.204837707484476E+000.360576001215734E-02-.677988803582434E+00 0.173174484916547E+00-.380656063886276E+000.442368547231428E+00 -.558513583720547E-04-.823757328985934E-030.669330729666884E-01 -.959833802074539E-030.601389213056274E-010.962184060000759E-05 -.187827323783031E-040.360387968584401E-120.187881360370489E-04 0.537074764821504E+00-.241847150836626E-08-.239399430153665E-10 0.201204711161572E-080.245123711639579E-040.343859473382981E-04 0.142820901368339E-07-.395427510919049E-04-.803141296002529E+00 -.308798916471791E-080.372565513480860E-110.372134699667619E-08 0.695751722977721E-04-.206823361952197E-04-.867594640014316E-07 0.320490380387678E-040.257904527488446E+000.251527713105688E-01 0.160670486494815E-01-.359427383128825E-01-.208315603223150E-01 -.106749103877009E-050.998634620717329E+000.105947158447703E-01 0.786357166775589E-090.644554062825855E-010.147441968768947E-09 0.283415543445799E-020.685059169690794E-030.161928254063469E+00 -.734658112367259E-02-.795436981644603E+000.112005113951728E+00 0.116112410074604E+00-.122748344137133E-010.535385505713645E+00 -.112005114710728E+00-.101694000626255E+000.376112318286562E-03 0.337223222160585E-01-.160461773121821E-020.572257030714030E-02 0.358983271090535E-020.483648722770236E-03-.374378469350919E+00 0.491681099797348E-020.409889093974485E+000.530964917213129E+00 -.627250620485439E-02-.595098741464305E+00-.241170615534876E-04 -.334285861829879E-01-.157354286153396E+000.172548982335806E+00 0.149808311102240E-020.164824307470865E-02-.307153539074260E-03 -.106756314785166E-020.139626387190351E+00-.106756314785166E-02 0.110156897634196E+00-.309911159440874E+000.167408292491309E+00 0.360213501196167E+000.241963975861273E+00-.208694806147609E+00 0.493267448076731E-02-.709971239067276E+000.237100559219863E+00 -.131217716617825E+000.154290771975884E+00-.959074851003528E-05 0.956731538415544E-030.794297126275660E-010.783541617392965E-03 0.693456870140263E-01-.453325254228497E-04-.176585350383745E-04 -.123562725125358E-120.176636156078052E-040.541350527616704E+00 -.240773125362821E-08-.233457660732528E-110.271455532902927E-08 0.477531482574202E-040.318748202945685E-040.168773004647976E-07 -.366100077933934E-04-.802382883088274E+00-.189243713536815E-08 -.175937555189488E-100.161357154454997E-080.220750984082187E-04 -.182827311837541E-04-.810192048052132E-070.287394278084876E-04 0.251239543599436E+000.460154655563629E-030.109020541892817E-07 0.301020760096669E-02-.676020538863894E-03-.201397582313553E-02 0.265255685432536E-050.999993076694352E+000.245686508966199E-03 0.528725086162795E-100.528725086162795E-100.139137638304773E-01 -.931476122820135E-020.187667088561186E+00-.806168464489319E-01 -.741318518217202E-01-.150594948497854E-030.496927937442151E-02 0.577857814421090E+000.106703220081005E-01-.779133836752166E+00 0.806168453826879E-010.695241882699640E-01-.515203579148082E-04 -.229418112929880E-030.809403648149187E-02-.283211984912348E-03 0.309218219416329E-030.189421944285213E-030.177162332103893E-04 -.436862641845423E+000.479152582846512E+00-.712381219969140E-01 0.294435744654024E-020.780917998203279E-010.502921115640390E+00 -.181070913767124E-02-.552926222784265E+000.443750531523610E-03 -.985965310703518E-010.118852928374641E-030.109862679157740E-03 -.109006539468286E-040.144672961940265E-030.716786890076843E-02 0.144672961940265E-030.561128618870810E-02-.311695309851634E+00 0.369140461343607E+00-.564818818963682E-010.843996016463362E-01 0.683479449787785E-010.353180746937538E+00-.525397161080030E-01 0.131036844385976E-01-.456640065049356E+000.644420456556119E+00 0.559396888735261E-020.394650581663461E-02-.276030758828090E-04 0.359262044720999E-120.276109760275352E-040.400875800538385E+00 -.153565440406287E-06-.284270058405151E-090.171772862729932E-06 0.153454876917201E-02-.233754388154802E-090.978810924525225E-10 0.373622626632746E-080.130985708337576E-030.345983153605038E-04 -.692008542158418E-06-.515924281953249E-04-.901011303111012E+00 -.327069748284931E-04-.724156296312873E-050.719917974521585E-04 0.165755363482073E+000.474803594620760E-020.116474496930673E-03 0.161427927008894E+00-.319233613834862E-01-.199249049476415E+00 0.943952542138753E+000.205279273142504E+000.363324353033546E-02 -.108482676139213E-020.157536226523168E-010.130255045013827E-02 0.301913162646137E-030.161243332301578E+000.606695718965107E-01 -.397526540444055E+000.554748860175678E+000.383966542560385E+00 -.236530864243820E-010.493155556414269E-01-.554748767500591E+00 -.214301755749183E+00-.791692179238457E-02-.552245530472999E-03 0.117804913038090E-010.534077055607152E-040.359651953275203E-03 0.435838693521165E-020.413002012631367E-030.215005754443115E-01 -.121296060755018E-010.287291230583004E-01-.295083695975163E-01 -.936024399941001E+000.150963209808127E+00-.471083210162908E-01 -.930017973181041E-020.310435446284620E+000.200383312665818E-03 0.797662512256087E-020.202677154721335E-020.821695118252034E-03 0.185995596284431E-090.953942751065062E-020.579222037124909E-04 0.419784017723221E-01-.482975532332040E-030.904470811910962E-02 -.574430934800443E-010.451700983218531E+00-.847632099722912E+00 0.206216564248354E-01-.952089249595826E-030.267683914514290E+00 -.442089263297538E-040.130227346463139E-01-.334575236633050E-01 0.582754336569465E+000.239748154997497E+00-.232703116519158E-02 0.632586030004597E-030.656015033332231E-010.269019293740100E-01 0.372932091845224E-01-.227602290610941E-01-.680109638438260E+00 -.349237624883250E+00-.320426217305454E-02-.232449893005120E-02 0.496936332823237E-010.161945477273113E-010.379014284144202E-03 0.396327632422365E-03-.858744763106854E-030.871345710795191E-01 0.870146384175541E-020.110748991451490E-070.647459393211122E+00 -.211020858629368E-01-.655608719224489E+000.387108539259607E+00 0.241779008380115E-010.386469431151273E-020.112081023309811E+00 -.698167490986286E+00-.112081012101691E+000.698167490986229E+00 0.609105524539040E-040.810324884139280E-03-.604954208771893E-02 0.822458556079886E-020.108535292536380E+000.377476685106857E-01 -.774936024964465E-02-.787880717753179E+000.225369702812543E-02 -.562892718869109E-03-.285497312308102E-010.604196076303872E+00 0.134876218565383E-040.885850836022477E-030.240861803747173E-03 0.320725483445566E-04-.245765498175867E-030.518563563274593E-03 -.258064430088833E-030.523073530082049E-020.414286362962317E-04 -.134296280739007E-010.454147960865441E-010.246095955438665E+00 0.381810162664600E-01-.458578109756278E-010.309247721541881E-01 -.840168641477295E+000.726706384663128E-03-.200805330145389E-01 0.475756927113320E+00-.348987049372346E-050.163014746453075E-04 -.406433530604126E-040.174811555826052E-040.416347324487490E-02 -.503900886600453E-05-.243879091555047E-010.430018804227158E+00 0.560591961221790E-010.114237883088519E-020.652452798290859E-02 -.245918402416141E-020.608972012498249E-020.461425942228189E-01 -.102539319935843E-02-.815026724296231E+00-.117156972700854E+00 -.195325680784950E-010.236697927830689E-080.358408016308951E+00 0.467236881616071E-01-.528487928757052E-03-.344478060267522E-03 0.327754210659766E-020.101409566262696E-010.707106781186500E+00 -.707106781186603E+000.662262870273973E-01-.412532285002360E+00 0.642429494386874E+000.642429402719959E+00-.339222881485481E-01 -.440624356497263E-020.721314558783405E+000.318354889292678E-01 -.691029429413945E+00-.298330170970555E-020.228604569444274E-01 -.372782349555383E-01-.271115201819383E-010.688164533706434E+00 0.441086820619143E-01-.722376492423855E+00-.383619480806987E-01 0.123858524819484E-020.211675332716350E-020.682478888494490E+00 0.970441548327741E-010.390369360953282E-01-.238759561039506E-08 -.716298578374737E+00-.933799186770630E-01-.707106781186575E+00 0.707106781186525E+00-.167263560147883E-07-.497215731964989E+00 -.609297473009121E+00-.609297508136205E+00-.101437921164760E+00 0.396808464685394E-010.145837777501628E-01-.681042143793224E+00 -.504664615069257E-010.729278738542803E+000.681269617691656E-01 0.666444114418943E-02-.712408745146810E+00-.648638844371203E-01 -.636842463844503E-020.695369860658179E+00-.979129339670780E-03 0.300892878154688E-01-.298674746023331E-010.482956299067998E-07 -.322605724633322E+00-.646186912478413E+00-.121318406636933E-01 0.582015570576082E-010.215407605396003E+000.653173445595279E+00 0.570507474805564E-030.942716646294706E-080.298476109835370E+00 -.229767996041610E-01-.303221070862048E+000.602037576303353E+00 0.675266720258527E+000.245053547811273E-020.585960686889018E-03 0.513031006915004E-030.865194342723113E-020.787352240189772E-03 -.123009456216638E-01-.602952293381838E-010.100813384569477E-01 -.235623029749862E+000.486151508253275E+000.442775079628557E+00 -.405512246939388E-010.216904069577573E+00-.486151536353640E+00 -.472136317138705E+000.126301180815325E-010.792403668237731E-04 0.413297540850655E-020.352171169359473E-03-.329573224578663E-04 0.652940718111332E-03-.256262482273700E-03-.234114335976204E-01 0.337110002433409E-010.381021013468887E+000.601463636725532E-01 -.545256280105584E-01-.868532468572194E+000.679937091073461E-01 -.847858651657671E-01-.411597864503930E-010.280521986517897E+00 0.105879134718726E-040.416765143704468E-03-.123099030948993E-03 0.301756375767690E-040.249083843067110E-030.209120900143790E-03 0.231043094154576E-030.257036870345741E-020.228387047244176E-04 -.574755821099979E-020.974467519929338E-010.236333894525561E+00 0.396680034546653E-01-.132253076018475E+000.265114915419996E+00 -.853424947855451E+000.479397847921161E-01-.427817436974369E-01 0.335850084444527E+00-.148408460429058E-04-.748161136435617E-04 0.110753604160756E-03-.706119611472251E-040.152624617518191E-02 -.110951858901099E-04-.644113284807349E-020.650828991401486E-02 0.228749967414610E+000.600635730865104E-01-.223553067564437E-01 -.358150776105921E-070.239684957296783E+000.480094650288983E+00 0.192145309729517E-01-.836123635137684E-01-.225899275367096E+00 -.765138432844402E+000.313411371419374E-020.742995638243971E-02 -.136119349521726E-010.825709237069057E-01-.389328976578801E-02 0.308727616620548E-020.502762790374560E-010.457631940177901E-01 0.210671082150144E-030.136670157899477E-030.177999280509586E-01 -.174707401413546E-02-.146934442009727E-010.371048542182972E-01 0.999042801658376E+000.917293575579656E-030.136933469979301E-03 0.442668224180858E-030.123494540316625E-010.557234391914227E-04 -.570137556406672E-02-.370827223466650E-01-.472433665133362E-02 -.278122948398114E+000.410144945494006E+000.397557322797068E+00 0.448319999663166E-030.493871784844263E+00-.410144933519769E+00 -.425418904107767E+000.334848699759163E-010.127375877370595E-03 0.110532019406746E-020.237091582126644E-01-.113844312723035E-03 -.380925034819731E-040.158908676155912E-02-.494574442295410E-03 -.136516243012434E-020.289433905657649E-010.514912248937955E-01 -.303914167730759E-02-.422251074843907E-01-.203227767720065E+00 0.153753347019584E+00-.917153830215156E+00-.763258755002147E-01 0.287706323687985E+000.216506567822838E-040.829796579240233E-03 -.283433609785619E-030.559390318691268E-030.633501377261939E-02 0.131319120514597E-020.701963998257549E-010.905217459477781E-01 0.357923735038388E-01-.123891945774251E+000.395903508691244E+00 -.702671794969916E+000.557691797337480E+00-.205098607153493E-01 0.909184509497725E-01-.190654151029481E-04-.121336165082983E-03 0.328915099482047E-03-.149272779124686E-030.338462654696031E-02 -.112851204297636E-04-.445463552536016E-02-.835576313571940E-02 0.752932544467666E-010.137534847523132E+00-.259114738485208E-03 -.563852731001187E-030.190774804903477E-020.242779688270085E-01 -.194309000886799E-02-.285769460002899E-010.895054924400790E-02 -.983116941827859E+000.212645158251803E-030.125707197364705E-03 -.350836204080841E-030.430592564883796E-01-.853469359816533E-03 -.777078218862946E-030.742620013435782E-020.734967290854320E-01 0.381446313628261E-030.124845056146456E-030.414383331747861E-02 -.940271526508416E-03-.404221951901942E-020.644204016897479E-03 0.999982450334638E+000.102526910708690E-030.342667220082544E-03 0.539407713885730E-030.112182650588275E+000.291963953692846E-02 0.243306172940037E-020.417843161548503E-01-.339945353959363E-01 -.797488637176752E+000.274980044994610E+000.286636867608651E+00 -.136712222555940E+000.267568964966806E+00-.274980025426080E+00 -.117859587300834E+00-.268224051763144E-020.846984655215149E-02 0.104013252256216E+00-.706725077066978E-020.221871308732617E-02 0.219868236428274E-020.201981444706414E-030.458618437592934E-02 0.126809928213090E-01-.320380956077024E-010.204506522896203E-01 -.148582793941879E-01-.113780442017961E+000.374335203551583E-01 -.990721098034612E+00-.210726169380195E-010.426373790397174E-01 0.136555208806411E-030.224198476974885E-02-.571391145031755E-03 0.566586344120537E-020.959780379361985E-020.318911180367516E-02 0.620827710669931E-01-.568901108942749E-02-.180691343789712E-01 -.740521161628900E-010.209179385162360E+00-.195609548916247E+00 0.952445669749881E+00-.250646268674595E-010.131476157327279E-01 -.369071287024797E-04-.488185333132813E-030.346924020436468E-02 -.801030241372621E-030.135234270359219E-01-.699427244703543E-04 -.227371817304806E-040.305526739861381E-070.280327128925278E-04 0.499079983149445E+00-.678543881782044E-05-.141311621891559E-04 0.323882026853012E-040.296376197095334E-020.557320090650802E-05 -.203285194749962E-03-.242749015745857E-03-.829871103648760E+00 0.275295157139778E-080.407862664671703E-080.240492921342678E-07 0.447132367465700E-03-.196841317648305E-03-.835445317130868E-04 0.803921598880989E-030.249446072407021E+000.188844328303154E-01 0.538455289838268E-030.291708523636470E-01-.372703108642742E-01 -.496393478982733E-010.254758647814956E-050.997313376037241E+00 0.179944080258892E-040.174653471249788E-01-.387280835249212E-03 0.135120879213858E+00-.332591407056297E-030.839200840958193E-02 0.123774549670626E+000.710355862613081E-01-.816903955833649E+00 0.259111769955954E+000.169922195433962E+00-.967589717675854E-01 0.295181562913193E+00-.259111775222573E+00-.121879896040359E+00 -.170780062460303E-01-.456215445186038E-030.138493391082666E+00 -.756584484839288E-030.462615585354142E-020.747070123653290E-02 0.121523955801067E-020.121318890601466E-020.855595803629244E-02 -.618607852540523E-020.306525760240591E+00-.136562251008736E-01 -.673592315256137E+000.589580615384586E-03-.573566359288367E-01 -.288004951243023E+000.604707526771186E+000.152712274111098E-02 0.506016895702041E-02-.105440009914927E-02-.424305489168350E-06 0.528751207416300E-030.254336715238593E-010.543992283805514E-03 0.769918527154085E-010.230146570594166E-050.776291852346123E-02 0.118061461199013E+00-.143472302037430E-010.270617786854460E+00 -.198234957495660E+000.136950886553168E-01-.726560688324639E+00 0.141188296603900E+00-.294523042192644E+000.472157830749985E+00 -.110872557472870E-03-.126978546655609E-020.577296043463924E-01 -.144384353054288E-020.752577368093954E-010.243418539483478E-04 -.142888328684564E-04-.114490935915299E-070.161979153767801E-04 0.390904820917777E+00-.107263660415500E-07-.465323015112817E-08 0.223347461190187E-070.281951787649733E-040.642263470427003E-04 0.343724131105744E-06-.989576291726829E-04-.832242768277343E+00 -.120177009576371E-070.103799950061146E-090.199722827564297E-07 0.126564714211728E-03-.692324238576580E-04-.138592840130219E-05 0.152324103553164E-030.393147982873812E+000.154917438959898E-01 0.104654297961220E-040.278259108674488E-01-.303490991488291E-01 -.354216368215474E-01-.374358936472513E-060.998306540843242E+00 0.583345098154626E-030.139166982303768E-01-.219188756453223E-02 0.757662900455562E-01-.152524631871661E-03-.321278040358060E-02 0.320493204006391E+000.101985556245574E+00-.783316817911260E+00 0.276533341997327E+000.164610994180330E+000.186915934215290E-01 0.109466950808409E+00-.276533344763605E+00-.262128799339971E+00 -.711582411610634E-020.316741118718987E-020.798075059151104E-01 -.549305914149587E-020.680591161936855E-020.103957194354297E-01 0.165449572551216E-02-.297305272856413E+000.133512169424708E-01 0.620313041634109E+000.288681103087594E+00-.177630992643315E-01 -.657895338706556E+000.101100937639440E-02-.995075900155844E-01 0.378031371560238E-03-.715073997670865E-020.226932302359274E-02 0.680513181941886E-02-.134886288914828E-02-.489664457071443E-05 -.115741943188504E-020.340181330921379E-01-.112000827068954E-02 0.949249299187529E-01-.963143805549435E-05-.279314130074537E+00 0.159118172145863E+000.440690486502383E+000.219264647394360E+00 -.223531848223986E+000.209613224177962E-01-.730529530601576E+00 0.216119903392971E+000.149639207047947E-01-.229194735289877E-01 -.501177261368179E-040.297277225627281E-020.694032145798862E-01 0.257686371432962E-020.885479588062585E-01-.207970163074130E-03 -.138923090909384E-04-.127238716380106E-070.157058480423797E-04 0.409492189251564E+00-.102996885080796E-07-.678584712436506E-10 0.157848450480880E-070.936451399983214E-040.583579087160737E-04 0.356385494683888E-06-.910641984638006E-04-.829776111590451E+00 -.749823348792695E-08-.249102776330744E-080.140200580837383E-07 0.281551872354774E-04-.595312905301544E-04-.125463596060752E-05 0.134246582370566E-030.379193497185602E+000.426249993318591E-03 0.138136677625042E-030.600027532935093E-02-.104715937420707E-02 -.410412425692858E-020.360816358907135E-030.999972748532237E+00 0.815344840941258E-040.470003277126032E-03-.975581912704339E-03 -.758387765641282E-030.311201162620555E-010.163127700276862E-03 -.379406664406015E-010.655778353245633E+000.196424421346421E-01 -.478876541054886E+000.310326047253723E+000.286814367728409E+00 0.475138107439813E-02-.411328427070017E-01-.310326040307785E+00 -.244615833492320E+000.880585133137490E-02-.212605409102574E-02 0.364624809606826E-01-.259201452975158E-020.224527879066681E-02 0.209234382545644E-020.156319489577705E-03-.307758905489842E-01 0.220261326059213E-010.671643419853845E-010.118321296739216E+00 -.103277528307138E-01-.428144170934312E+000.286625510817101E-01 -.869306495280380E+00-.510672066662528E-010.193647111457262E+00 -.378647105337771E-040.317666846458886E-02-.835552638858626E-03 0.701619192360112E-020.105374907692704E-01-.522925349009331E-01 0.132709858923520E+000.526721064437783E-01-.202405945294266E-01 -.725368516726221E-010.194688239718319E+00-.189260055568609E+00 0.946300940701786E+000.792544711088228E-02-.355764043826012E-01 -.246135745872575E-030.304975551354759E-020.420239640621067E-02 0.261040112096898E-020.218379335165771E-01-.341978135298371E-03 -.172457015309441E-040.431356008346286E-070.219590871210806E-04 0.442659543701007E+000.620442416979269E-090.258920030491552E-08 0.168861954232395E-070.306596243662881E-030.323138773456644E-04 -.960348097112365E-04-.218166081265305E-03-.838067704175618E+00 -.589914917310024E-05-.416409183798882E-050.216992518203371E-04 0.171734903009034E-02-.172262703654395E-03-.255366933603604E-04 0.588840143324276E-030.318891160231964E+000.323051769754980E-03 0.527812440603705E-030.184483412376782E-010.172904899351989E-02 -.209517265408227E-010.158263229092178E-010.999483262596492E+00 0.789622357502747E-090.215857232441392E-03-.225609164740967E-02 0.149823816969244E-01-.499062773662014E-03-.236548692000563E-01 0.363896924656256E+000.107483034761124E+00-.391270672966822E+00 0.502192301820578E+000.405412180298002E+00-.678056199914652E-01 -.960614884631456E-02-.502192338841198E+00-.169129058584629E+00 0.276901186419182E-02-.169243266660495E-020.927155007066666E-02 0.145412623807367E-030.264674993738985E-040.763553538678154E-03 -.274044971065333E-03-.206553196141291E+000.192544222065392E-01 0.710409976253818E+000.130366138371823E+00-.228795553119039E-01 -.549279079167324E+000.144877887368590E-01-.339041201676814E+00 -.242405803695270E-010.131562971065629E+00-.258376806382172E-05 0.656278446202110E-03-.236769424458550E-030.141355471070267E-02 0.105244043606728E-01-.660332708148621E-010.210625908749795E+00 0.206019596480891E+000.666155188911710E-01-.131785375279779E+00 0.629358709986443E-01-.579139160435087E+000.687848108070714E+00 0.249885689824524E-020.272623878087522E+00-.189083942331165E-03 0.144332387792429E-02-.964970276958600E-040.142997186912260E-02 0.905906105727050E-02-.335003383098555E-03-.761567012733616E-02 -.106277964677985E-010.104274987796965E+000.200717863329688E+00 0.167157754026795E-030.800103307358312E-04-.239487412514881E-03 0.288613812865254E-01-.280311412689388E-02-.102833078885913E-01 -.246652115998060E-02-.958907097949439E+00-.199282635800055E-03 -.133451307121677E-030.122389068203788E-020.121150111192682E-01 -.553097739420755E-02-.738697421077239E-030.291299759234546E-01 0.164877272058817E+000.176933543460421E-020.636048637279320E-08 0.386389399803415E+000.837523572201287E-02-.392389715572957E+00 0.177968659061121E+000.815465158463628E+000.145621272878538E-07 0.199985867714712E-020.195851833059782E+00-.679442478235078E+00 -.195851722041146E+000.679442478235217E+00-.357201584439584E-05 0.104508299723225E-03-.430429753409975E-04-.161992044701792E-01 0.665913332291113E-020.627943984135420E-010.158766162588137E+00 -.580681991929644E-02-.725442566426469E+000.389377340629332E-03 -.543997834523727E-02-.141418550919330E+000.651316976488143E+00 0.103704333512308E-040.760162068660251E-04-.215295048130131E-04 0.814462510058118E-04-.624103587955855E-030.512727498773690E-03 -.655337427526513E-030.405937494843178E-020.105205018006757E-03 -.430493797466982E-010.888089058101809E-010.296501401773398E+00 0.820849426591335E-01-.704003772035664E-010.934683955500087E-02 -.849557747276744E+000.299284353890857E-01-.307351278117629E-01 0.408597009486543E+00-.477326696952231E-040.203748305369640E-03 0.145051551564250E-030.213311096242107E-030.268327332614296E-02 -.611874011102725E-04-.337262668853664E-010.924166207019878E-02 0.621949633428841E+000.161210309761146E+000.165557847623496E-02 0.133402559164063E-02-.540323718323402E-020.349527344820291E-01 0.158972038010233E-01-.191896754436189E-01-.167295225035774E+00 -.680665052123196E+00-.120576509551053E-01-.194282041054332E-07 0.106218810781638E+000.201171754213052E+00-.152846247993426E-01 0.126495382860975E-020.105728483537333E+000.171716077268080E+00 0.707106781186532E+00-.707106781186564E+000.179199321427276E+00 -.621672299758036E+000.539171163068275E+000.539171226818681E+00 -.150859012548334E+00-.346779801559453E-020.696421358249040E+00 0.147705689688260E+00-.685864311448068E+00-.549676070744279E-02 0.256758327647866E-01-.750726041803840E-01-.317246623417171E-01 0.668536882366567E+000.938655702018445E-01-.732745439276634E+00 0.170870172221987E-010.583898068138768E-010.619301667958476E-01 0.600138230146652E-010.677664207154702E+000.385190232285779E-01 0.619119497642184E-07-.339323566159786E+00-.642657517212704E+00 -.707106781186557E+000.707106781186543E+00-.245736663857741E-07 -.487017594237811E+00-.613791894359277E+00-.613791883445462E+00 -.966069207569462E-010.429174371243619E-010.113832073170950E-01 -.678381985760620E+00-.504298591343777E-010.731630526211845E+00 0.635386735290795E-010.125742853429528E-01-.716745907330516E+00 -.583613871779776E-01-.110212329091957E-010.691772730437950E+00 -.173175445674593E-020.383841621124299E-01-.110416382473008E-01 0.256741288464596E-07-.453880443429687E+00-.554991234753238E+00 -.318174114684711E-010.218019157967283E-010.404853975196401E+00 0.564789870930429E+000.102068503593475E-020.285623013061450E-07 0.492754819127494E+00-.203842046987441E-01-.499362468921001E+00 0.587824361647918E+000.402336839078275E+000.918169007117501E-03 0.700012494926306E-040.377013393139683E-020.158061746585615E-03 -.923345838286210E-02-.465479735545722E-010.161317275038019E-01 -.241725710157609E+000.498377849088563E+000.419438718550452E+00 -.424078491233497E-010.210523737367770E+00-.498377789898282E+00 -.469006127421801E+000.159157362192407E-010.971442723612329E-04 0.370429343061676E-020.185402222885231E-030.140361401801025E-04 0.454359178768059E-030.828774296805545E-04-.312157931261559E-01 0.221644959830577E-010.467147250894710E+000.605956757459247E-01 -.286080598138955E-01-.839766996204144E+000.216291917452147E-01 -.219985152720672E-01-.281124096984636E-010.262424344259733E+00 0.116417805123626E-040.267635114197098E-03-.672215219544455E-04 -.813735173184751E-06-.398866592646904E-050.204362284917030E-04 -.409081302153415E-050.158462400066490E-02-.628949975187434E-06 -.111533654039953E-010.945756611763469E-010.309305220492670E+00 0.491707927664971E-01-.110293923293886E+000.131202023612183E+00 -.859274284355457E+000.187676429483093E-01-.364156143118406E-01 0.351325562001735E+000.302673825658693E-050.179685592317993E-04 0.140441788487869E-030.172457286836458E-040.142844320681775E-02 0.256541507301178E-05-.135974180846842E-02-.135228523273871E-02 0.124160279154033E-010.226781889854867E-01-.333271203637093E-01 -.223082863493948E-070.394082533781187E+000.481872165055281E+00 0.354794598302177E-01-.290941802402022E-01-.430896016118760E+00 -.640798137718591E+000.185037448827823E-020.962525823705057E-02 -.494931284124744E-020.815259078185888E-01-.366652507262709E-02 0.308654674398379E-020.634740521082287E-010.386973240214517E-01 0.920203922416232E-030.108629350498719E+00-.143184031301651E-01 -.103310610340044E+000.268157434783449E+000.951507667518300E+00 0.667459177312360E-020.957709173457184E-030.603352690579251E-03 0.211234307770364E-01-.913404167729270E-04-.490567395888047E-02 -.312206895692159E-01-.377826865054100E-02-.253367241251457E+00 0.457238405489630E+000.431443403923000E+00-.580916488736549E-02 0.327729924464284E+00-.457238455836453E+00-.470035771580013E+00 0.286160495778913E-010.162251095002671E-020.295291942973934E-01 -.510593888156111E-030.133176045858044E-030.288550864294607E-02 0.326671120515064E-03-.119940694302481E-010.493611977238944E-01 0.200835967502284E+000.375222748159743E-01-.763181518223535E-01 -.607170442032405E+000.141924071866228E+00-.357268263812569E+00 -.111584072433367E+000.648806072874006E+000.101939051155568E-03 0.200605309319850E-02-.579965588212036E-030.258630208821450E-05 0.168217775562306E-040.144330153595768E-030.232887229287876E-04 0.675044602369196E-020.135607924906647E-05-.512253262244723E-03 0.115533485002037E+000.143965680843651E+000.283648332042478E-01 -.214797768570874E+000.391457522572237E+00-.810085558883003E+00 0.188501006513896E+00-.442767460955475E-010.268178435111368E+00 -.134851379999611E-04-.906524042141700E-040.706947400427236E-03 -.102644794357619E-030.682221155305948E-02-.107940584113467E-04 0.116235358609001E-030.166025085883410E-020.156776146399450E-02 0.189682979375326E+00-.361695504819792E-02-.346080365688096E-02 0.364161680538411E-010.123107662892829E+000.479565835504608E-02 -.696332330928824E-01-.557688540661065E-01-.907343267826924E+00 0.167427784956671E-020.249525019706888E-02-.429288818316120E-02 0.715872231770214E-01-.122267448202732E-01-.590040106779471E-02 0.156528369965063E+000.293967791211871E+000.175081783184165E-02 0.771184964438607E-030.221373065832482E-01-.621763107712101E-02 -.194592641016047E-010.714969543950864E-020.999514994545450E+00 0.597860704577673E-030.269402465479075E-020.515023791883851E-02 0.121292326773534E+00-.392528020472177E-020.118992126450666E-02 0.157395445789034E-01-.394082381129670E-01-.733003478782031E+00 0.337599559770288E+000.349142686729564E+00-.139463400368514E+00 0.227145186540549E+00-.337599510291875E+00-.916649623724561E-01 -.382942486348092E-020.925240648625014E-020.129158226356516E+00 -.853888047471263E-020.140096596740043E-020.126071176579125E-01 0.124720535117440E-020.303634316616343E-020.377300486494654E-01 -.294767602556083E-010.567360891048372E-01-.465498595571141E-01 -.420230611207414E+000.880228217424541E-01-.881922252676869E+00 -.505991235370717E-010.165262464703570E+000.146288106742103E-02 0.119437537909616E-01-.215022129020119E-020.937096633811036E-05 0.160932871380580E-030.293463833607639E-020.286155735433417E-03 0.429322788825650E-010.194015643940606E-040.838523134684283E-02 0.161717170334286E+00-.203051876371348E-02-.246917146462747E-01 -.230101940514772E+000.430203686138714E+00-.518676737549693E+00 0.666606010923658E+00-.696498178573828E-010.109439876538281E+00 -.849241779494426E-04-.807577859098053E-030.152659284083099E-01 -.110538323322089E-020.532650783719748E-01-.106908413345438E-03 0.521037564689083E-050.395491098356925E-040.916942038480008E-04 0.267445501897429E+00-.146929108520377E-04-.414381105364060E-04 0.883752978684304E-040.203583744031505E-020.552720532282201E-03 -.353106948059371E-03-.268158909150081E-02-.877321689364557E+00 0.129483762335851E-060.943389430578574E-07-.520801832045056E-07 0.542619061617278E-03-.897761281568731E-03-.531645372045277E-03 0.721153625769991E-020.398389736428573E+000.339439726157846E-01 0.127008998561281E-020.558849142773434E-01-.700047885835571E-01 -.972864026383786E-010.120387721105454E-030.990042699494239E+00 0.104923379909149E-030.342517600102390E-01-.374697094457425E-03 0.152312877545830E+00-.478817790311942E-030.872860861790242E-02 0.999657868488493E-010.761029238391244E-01-.789918683778005E+00 0.312925273563142E+000.179124695926111E+00-.106456692876792E+00 0.254396861436815E+00-.312925287652934E+00-.969397708740387E-01 -.205315405806358E-010.172023645205085E-030.152210304270155E+00 -.330338109710651E-030.459563407489116E-020.143990070124588E-01 0.222644377622351E-020.800563370830329E-030.104489137273485E-01 -.602561369632559E-020.201418904467542E+00-.171281646426121E-01 -.737384008805705E+000.102553883472058E-02-.588018158817250E-01 -.181397584082343E+000.615273770267933E+000.216302320816593E-02 0.949387888312259E-02-.138702989735942E-020.152795495644916E-04 0.225359384945996E-030.225891473319397E-010.262583707734798E-03 0.105723087052347E+00-.263236897139808E-050.655669812546020E-02 0.110649523915327E+00-.129806789078049E-010.165077126998700E+00 -.192799365643284E+000.282186057827035E-01-.807718334950653E+00 0.102142581525374E+00-.192428566915823E+000.444747023264972E+00 -.548606964381622E-04-.567233548395388E-030.635340804994158E-01 -.626317548109333E-030.945045541747214E-010.789273378979099E-05 -.288979693703195E-04-.182319839053481E-060.443515421301361E-04 0.379919944695107E+00-.409896592504587E-07-.502833020468807E-07 0.120494589988032E-060.308036843749235E-040.140521908879047E-03 0.816277654525576E-05-.295259341239829E-03-.861438578734898E+00 -.277471726737075E-070.876533127563630E-090.662575211226712E-07 0.129028505756325E-03-.126377308405864E-03-.370449666662370E-04 0.550391609228765E-030.337022199602707E+000.254458699117238E-01 0.592584625065294E-040.514303172879869E-01-.512809050778411E-01 -.660648944428663E-010.951604713061685E-040.994540487621631E+00 0.100924642958156E-020.245217454649157E-010.184864876070133E-02 0.884721194989155E-01-.324244362088066E-02-.510930961910458E-02 0.303062330901710E+000.112878700333972E+00-.734565742176333E+00 0.347055364976695E+000.162412105382276E+00-.955021556489723E-03 0.848583542242443E-01-.347055368580516E+00-.250105923935497E+00 -.111169531807995E-010.355726590647559E-020.103808638914381E+00 -.419452883677787E-020.629179201941255E-020.186690274364628E-01 0.284594451775678E-02-.187651556580809E+000.162329962057502E-01 0.630915974421175E+000.187697560444679E+00-.210296554317769E-01 -.720224407521837E+000.223339360929664E-02-.104660843730164E+00 -.610626897833574E-020.229830867380655E-010.282458435792497E-02 0.118792023957512E-01-.170210445347221E-020.280196207015836E-05 -.279505004776387E-030.277071634101624E-01-.228909652598038E-03 0.119275380848415E+000.132437572800541E-04-.187601509624841E+00 0.141896128311551E+000.422365578665326E+000.128760036033913E+00 -.204838957235195E+000.434078772092150E-01-.806694510076191E+00 0.157787515993729E+000.591835161997387E-020.747010198847334E-02 -.805107391111651E-050.638873231222047E-030.680896813628902E-01 0.535850756882113E-030.102376722309374E+00-.412953070633613E-04 -.276931733144833E-04-.197474903775786E-060.430124026148356E-04 0.398149815745455E+00-.263184149901006E-07-.620746678004172E-09 0.576570088020053E-070.103875521776964E-030.125421883145019E-03 0.739661812433390E-05-.270405853635920E-03-.857409440491406E+00 -.277976071921764E-07-.193794904133083E-070.662509931437069E-07 0.348154383702452E-04-.110067008670377E-03-.330352097595245E-04 0.493295101362000E-030.326075781848338E+000.261637800500639E-02 0.593341606111460E-030.314880806247675E-01-.856875384808786E-02 -.235422243388757E-010.258747526082075E-020.999168100504882E+00 0.319275874645435E-030.547296896534694E-02-.116992826176418E-02 0.338370513154134E-01-.142777025302056E-02-.406778354377311E-01 0.504020403061023E+000.882092418045004E-01-.541496381623848E+00 0.411585398853575E+000.256567719316976E+00-.245588779787715E-01 0.823411976718524E-02-.411585419791624E+00-.183646426853795E+00 -.192903059548171E-020.123785362328905E-030.558759547771277E-01 -.250818717172438E-020.733379618122733E-030.955412980135956E-02 0.892865110995397E-03-.540490019218027E-010.372660426311295E-01 0.185501518436011E+000.158352234759734E+00-.216219089020215E-01 -.753414549089406E+000.241909096941899E-01-.408978751559392E+00 -.892679382602970E-010.438255593031304E+000.202475991596905E-02 0.108697778577146E-01-.151558617647810E-020.158189155579921E-04 -.273419002779876E-030.226951112635693E-02-.192207014371830E-03 0.576369410134945E-010.124942742956545E-04-.131329073179166E+00 0.305611774621079E+000.254739263535127E+000.552445048191232E-01 -.164344958886550E+000.206564820276684E+00-.662834178384440E+00 0.544315066876567E+00-.396148205477567E-020.698461846680987E-01 -.954984862955493E-040.123919551849472E-020.329652662042095E-01 0.103982753519749E-020.824191920632282E-01-.137575992812755E-03 -.118262824998473E-040.123526003258420E-040.707450826197362E-04 0.199578367733588E+000.363708976451750E-070.321899201930129E-07 -.250041569150016E-080.225985817010339E-030.399465008189380E-03 -.383274536444598E-04-.146616509322618E-02-.883662801063188E+00 -.664010684521299E-05-.735402308780296E-050.216923907460852E-04 0.824256599274688E-03-.523153796336422E-03-.266383346326575E-03 0.361288604263049E-020.423428960439017E+000.173851036205211E-02 0.222870073788660E-020.147323973899202E+00-.145602763087638E-02 -.153553351053440E+000.124330762289657E+000.969144432517211E+00 -.670088769709058E-080.279928963613627E-02-.535336505050603E-03 0.571786431162824E-020.501111613013933E-04-.375294159509387E-01 0.286470981196203E+000.189845534980769E+00-.635875367893217E+00 0.398691041336605E+000.186217324361401E+00-.114177856312955E+00 0.244995441534964E+00-.398691042678259E+000.213291086621552E+00 -.702759278074976E-01-.285865195571977E-030.607323396528475E-02 0.177522666938543E-030.232624905150071E-040.871528520081471E-03 0.104242811764133E-03-.117190708001031E+000.172804418631202E-01 0.531354146114651E+000.147827925084915E+00-.173568415846287E-01 -.754028144632404E+000.362393328445694E-02-.504753734217587E-01 -.606045340700605E-010.326623017330199E+000.140948202581589E-03 0.702783387652478E-03-.107036079108171E-030.590209447893790E-07 -.908741189140752E-06-.537857176299051E-04-.821800159702671E-06 0.742259477778545E-020.175891555799017E-06-.127575373639961E+00 0.173884621836369E+000.488642885545859E+000.101063732588886E+00 -.130420282060893E+000.415306618536464E-01-.760148095701464E+00 0.976580937993439E-01-.254359609712527E-010.312471985413515E+00 -.574123283391161E-060.433910605356674E-050.205862756366894E-02 0.430410468022567E-050.783406586305063E-02-.778456164311075E-06 -.423214058359036E-030.919140921167062E-030.661874120526856E-02 0.117109755045484E+000.562189141098998E-030.519894877621451E-03 -.109887397286355E-020.184158676355906E-010.128559805126469E-01 -.985063481572301E-02-.793770939849137E-01-.885499725592162E+00 -.183772385564369E-02-.887523056274150E-030.105538790154888E-01 0.403343983135072E-01-.178576536206106E-01-.109963830700987E-01 0.165007678884550E+000.407206303906568E+000.306348529486999E-02 0.239930764984804E-070.601420059751685E+00-.141146313644592E-02 -.605225595551520E+000.230075880325225E+000.468016488374206E+00 0.318887906876394E-020.194968143237539E+00-.679696569745449E+00 -.194968123740749E+000.679696569745495E+000.433921650703326E-05 0.686239809673315E-040.134914310172025E-04-.158714965443381E-01 0.332719906827371E-020.784843725910340E-010.139678381750007E+00 -.317681035662774E-02-.734092568722168E+000.988288218555025E-04 -.128106164851903E-02-.122669376425973E+000.648163369247435E+00 0.894069909141543E-050.405720798599522E-04-.531085987799746E-05 -.171919591025308E-050.803049222354254E-050.130444794348500E-04 0.861156968395583E-050.110231449582210E-02-.248231645536447E-05 -.375937616255964E-010.355819759338922E-010.229692292043488E+00 0.108667338908260E+00-.264758743157882E-010.393712049859257E-02 -.813756878731386E+000.512266270133843E-02-.668002364102831E-01 0.515117604605447E+000.492260750079268E-05-.272219895394282E-04 0.208694217366870E-03-.283952525261720E-040.917376031998474E-03 0.581122815426736E-05-.455060985419248E-02-.919535789492620E-03 0.349190607723191E-010.763767596648188E-010.265591381650204E-02 0.521301039994967E-02-.401859423332637E-020.732525315960548E-01 0.535241281320955E-01-.115977550287200E-01-.375723852306493E+00 -.771464840486708E+00-.315965957352218E-01-.143459287868964E-07 0.227393868069098E+000.322787116054316E+00-.215711586956064E-01 0.108257024347966E-020.242983985741911E+000.178264096966029E+00 0.707106766183749E+00-.707106796189347E+000.177843854234752E+00 -.619997921177283E+000.540358273709987E+000.540358286028759E+00 -.131869994779899E+00-.196304501085975E-020.698246561864295E+00 0.130169226789683E+00-.691457997403106E+00-.128013211249068E-01 0.546427753459058E-01-.934052075111080E-01-.664941001276631E-01 0.678859335665877E+000.119191372805422E+00-.713195424947486E+00 -.404938617540185E-010.181062659918079E-010.232791185547601E-01 0.321138225103363E+000.619279730616487E+000.570137931646475E-01 0.258785337293530E-07-.410315942496114E+00-.582446223508185E+00 -.707106781186560E+000.707106781186535E+00-.721341536320415E-08 -.428989822532113E+00-.636689094459996E+00-.636689104237412E+00 -.722614261203267E-010.282343743720400E-010.938364903717614E-02 -.678889534403801E+00-.334569836275536E-010.732874066643181E+00 0.490057224614373E-010.139296369817684E-01-.713288124764123E+00 -.453244904721617E-01-.128587843097479E-010.697424647376202E+00 -.191282821385874E-020.400397255563485E-01-.392330176179403E-02 0.585593361868326E-08-.614848650012675E+00-.364459981119449E+00 -.378769195029760E-010.669732104564358E-020.591610797545009E+00 0.368820602608620E+000.123195855168806E-020.621112322271792E+00 -.142906888883486E-01-.629115104083898E+000.451903369348001E+00 0.118349072475903E+00-.110429569969675E-070.218385917379393E-02 0.474020131646410E-040.341856293650974E-020.106540652945231E-03 -.645360819374788E-02-.383127542619521E-010.125973858299685E-01 -.215314667589504E+000.493886045857771E+000.440903158857425E+00 -.363141787614656E-010.220456050264233E+00-.493886011421948E+00 -.468226459066813E+000.231829628021786E-01-.362744711248249E-04 0.492042069801937E-020.330696552912518E-040.202644371713308E-04 0.496659907643311E-030.736840121878654E-04-.198191879706170E-01 0.183303009260840E-010.449742417866469E+000.410829172385245E-01 -.221035301005096E-01-.845083570129830E+000.229988122217302E-01 -.633862858502668E-02-.190597419343020E-010.282360542508567E+00 -.915253709884024E-050.467860617318541E-03-.936082013898601E-06 -.471900999515919E-050.360154552581113E-04-.445382936066878E-05 0.161761440053278E-02-.699826636234017E-06-.100518297978727E-01 0.813344640279481E-010.322240982462986E+000.365348966340719E-01 -.898377311847809E-010.138505009350467E+00-.847528994615232E+00 0.484822858208514E-02-.286713955100532E-010.376428436355344E+00 0.305214288653784E-050.181194673226224E-040.148033919232344E-03 0.173905350410810E-040.178925671284225E-020.258695791232144E-05 -.135493060354600E-02-.135066372724518E-020.135603142952304E-01 0.185868253362159E-01-.352836497074884E-01-.511901396462545E-08 0.541814512743478E+000.321167993263074E+000.399514083113646E-01 -.879433456844653E-02-.619330290540681E+00-.454991628886887E+00 -.105596987591205E-020.705649764873231E-020.285295653675024E-01 0.585189397982255E-01-.120981119976275E-02-.164054205324875E-07 0.605748606344640E-010.359064075394220E-010.286188393180971E-02 0.302723797596224E+00-.393634811399195E-01-.303819324099225E+00 0.770938930261185E+000.468969096158830E+000.138220192540853E-01 0.495490516333219E-020.992452014486792E-030.282067170458185E-01 -.526320537210620E-03-.626140892699711E-02-.420916642531304E-01 -.372664848981284E-02-.271564230509885E+000.464750601983194E+00 0.441452754120364E+00-.154463635706786E-010.286305584915958E+00 -.464750603183541E+00-.459710281950070E+000.276903753399330E-01 0.164107973795033E-020.494331015087113E-01-.288169856338215E-02 0.181384528842341E-030.371596182844276E-020.528440319457944E-03 -.941885934972875E-020.370997823273176E-010.231848896187434E+00 0.366243340421597E-01-.532260858845199E-01-.799048803738820E+00 0.134190051866849E+00-.785968234612202E-01-.524280946553506E-01 0.524565851490170E+00-.969902988985165E-040.332166998097683E-02 0.178393887634442E-050.113533332194821E-040.181974060923368E-03 0.139673311333751E-040.748922993006937E-020.105594089085603E-05 -.125119713273718E-020.902096536931047E-010.147246951099762E+00 0.149737886688360E-01-.133913301824410E+000.418936033466391E+00 -.811341515728799E+000.369333524141069E-01-.333282371384749E-01 0.340069402844183E+00-.681313090765745E-05-.458006071986632E-04 0.684063550008274E-03-.518596031454553E-040.780440694537957E-02 -.545350364764260E-05-.188819474609356E-020.169410258829227E-02 0.212175769390214E-010.173958315025131E+00-.797638722213490E-02 -.293947799718114E-020.113587530023477E+000.109694252187022E+00 0.142919996767946E-01-.337701654742926E-01-.209384087697011E+00 -.845567642095652E+000.201133506974394E-020.616308901856066E-02 -.971356627744613E-020.292603070320401E-01-.560758539688166E-02 -.946440555507977E-070.280843258259704E+000.322810651789196E+00 0.100624941112454E-010.259672364681204E-020.817713789100689E-01 -.378487363357314E-01-.713365278141413E-010.523743917330373E-01 0.991717031383619E+000.197738512819566E-020.208413168788660E-01 0.650446596813922E-020.135072660963680E+00-.621746918612862E-02 -.966281355133967E-03-.918875977233796E-02-.289501236543810E-01 -.685382822420014E+000.361708105505221E+000.357137550448023E+00 -.266613412827571E-010.782040935170842E-01-.361708121793891E+00 -.239799476892995E+00-.985520373764162E-030.124217593525461E-01 0.238575082904427E+00-.196146477726306E-010.488773826113334E-02 0.349527507620209E-010.379484360472854E-02-.190335388122274E-02 0.447950884527639E-010.432841152042769E-010.388755048096654E-01 -.538304662046303E-01-.789807137487042E+000.235705022604824E+00 -.513957403747273E+00-.370616288007413E-010.209032049105300E+00 -.288368196965015E-020.432040578288786E-010.127521601121691E-04 0.168677884713730E-030.617877501892261E-020.276772111811215E-03 0.600611597756269E-010.241666265834041E-040.303528049568012E-02 0.942997003617236E-010.379042102331497E-01-.330454305947829E-01 -.128113287104398E+000.555973181880454E+00-.775895571131535E+00 0.198144727494078E+00-.310709714778411E-010.100592357864689E+00 -.672609772397682E-04-.639611891632221E-030.104051260731826E-01 -.875477524731695E-030.832817668969010E-01-.846727903271358E-04 -.207408821420728E-030.486560668082637E-050.979491912068454E-03 0.277397787870578E+00-.138842323987768E-04-.406202819318755E-04 0.110309257668976E-030.939959189060195E-030.569551259786794E-03 -.294882488065178E-03-.498973942338665E-02-.880817149857464E+00 0.187425605060980E-060.501129676429758E-06-.300671605978139E-06 0.241872213478973E-03-.255178043170943E-03-.120288168640803E-07 0.127780982294317E-010.383433180051282E+000.725838932670944E-01 0.252083195843648E-020.117006173486548E+00-.223393012118206E+00 -.208342404872242E+000.234209847200587E-020.930605964661460E+00 0.173828081375503E-030.147277990800831E+000.181434246890757E-03 0.170536287384264E+00-.309107241232440E-030.259166691097343E-02 0.267966291631130E-010.188199924025729E-01-.669691184768908E+00 0.369388402445399E+000.298437454764436E+00-.279860191285971E-01 0.602660083184696E-01-.369388385141567E+00-.248022967896360E+00 -.464439367770653E-020.500024221342130E-030.305677755406208E+00 -.444449132690379E-030.124526942124952E-010.412389063954632E-01 0.477962868100348E-020.121324350674267E-030.172316413671693E-01 0.206626091962812E-020.826042674682101E-01-.291949989074805E-01 -.807935585115537E+000.719562126724321E-02-.844418266345479E-01 -.865202850613294E-010.565496269575906E+00-.854734894082898E-02 0.534551683245710E-010.248113583813972E-040.284156083985196E-03 0.468661828942036E-010.323108007624496E-030.188307985273998E+00 -.544725160151694E-050.322850342593503E-020.113497207464359E+00 0.155469184155135E-01-.196939954403634E+00-.194657514389626E+00 0.969404504569904E-01-.859164413239739E+000.872264017923245E-01 -.388952182996452E-010.189593190383465E+00-.795671796675343E-04 -.822688558144623E-030.606453458049934E-01-.908377415704067E-03 0.276089968873254E+000.114472964265622E-04-.488773078956015E-04 -.396188336235372E-050.999659673670207E-040.310777183676489E+00 -.571298251501996E-07-.143066131598022E-060.317328824163547E-06 0.183060084594285E-040.886359900474387E-040.190300654410858E-04 -.393117861683414E-03-.877646247157486E+00-.373857766313145E-07 0.404625131158292E-080.185231894502927E-060.706529209549547E-04 -.204895952319792E-04-.194471437864013E-080.102610554232600E-02 0.364901867847999E+000.517095658659024E-010.980626985835659E-04 0.109751994430230E+00-.156570782738845E+00-.139532788543006E+00 0.213245059817445E-020.964892906217063E+000.251687159024994E-02 0.101329163413399E+000.277117162597201E-020.118636768143132E+00 -.352176514804628E-02-.151217924652192E-020.119996119063301E+00 0.301941926097845E-01-.609479618054216E+000.407610676820285E+00 0.303999762041851E+000.761324043901745E-020.710147150771023E-02 -.407610668100491E+00-.356147653325360E+00-.939570530183214E-03 0.763317786414497E-020.217680817050759E+00-.493762301165418E-02 0.146000447120399E-010.479479620035907E-010.566504813998350E-02 -.844499638835638E-010.256283929519846E-010.544801062552938E+00 0.737368671651306E-01-.326618131262042E-01-.812123287123367E+00 0.154297518539648E-01-.144246520083369E+00-.462193369264405E-02 0.445557502386635E-01-.935867171427351E-020.605927338092271E-01 -.336190661502138E-050.199412672691505E-030.450587704881531E-01 0.172855825862255E-030.183127683802625E+00-.139506417990564E-04 -.371032128812401E-010.136441962315432E+000.173292355829121E+00 -.191031363946136E+00-.181314220103855E+000.140001406724419E+00 -.858012964858887E+000.124946578064121E+000.319424061996110E-02 0.399157810449760E-010.690865516433771E-05-.548226189109581E-03 0.563223050755544E-01-.459820360442181E-030.262427675882098E+00 0.354360602071234E-04-.450936989333873E-04-.377667649549115E-05 0.945332035517973E-040.319025562226798E+00-.368743805844936E-07 -.308404229414676E-080.169494334962014E-060.602269526486935E-04 0.812755972306230E-040.174914793561078E-04-.370843264734492E-03 -.875757998566261E+00-.335945798006633E-07-.675440572999075E-07 0.170899586778266E-060.198556153617846E-04-.186285422087375E-04 -.200657120064962E-080.932994787873637E-030.362311452102434E+00 0.191936222893093E-010.258518345891082E-020.109774305627631E+00 -.678956495743090E-01-.847535774245336E-010.232392489249417E-01 0.986521218946578E+000.106117819809660E-020.449024629045529E-01 0.124017224428534E-030.574386556615052E-01-.199965617249553E-02 -.247780638305697E-010.321522084088771E+000.379770340137811E-01 -.428306904638573E+000.454704028913566E+000.379204249645586E+00 -.148852886838934E-02-.367461131823450E-01-.454704049118167E+00 -.369132510355556E+000.664495198760334E-020.334719861886340E-02 0.113293303776695E+00-.281077382106382E-020.819596959668489E-02 0.379111551975742E-010.321568225388857E-02-.459084942734722E-01 0.541417868140426E-010.284992838760775E+000.576708222071649E-01 -.319166382924372E-01-.850884680215138E+000.981709154419468E-01 -.314558014739248E+00-.238292299646862E-010.267247900942539E+00 -.476409274846684E-020.572696388851242E-01-.253434325420875E-05 0.314019523401166E-040.175619612277255E-010.268781992242801E-04 0.102137732079325E+00-.352118389928833E-05-.431151846300100E-01 0.194195952369355E+000.171383771689655E+00-.727889707064056E-01 -.105037796330727E+000.373070405104482E+00-.832876291198495E+00 0.185201328324870E+00-.210719287242549E-020.883704590081362E-01 0.759148616038630E-05-.985068757445580E-040.241611227450762E-01 -.826584349992673E-040.168592324349136E+000.109363536546192E-04 -.140286296725473E-03-.128215836815657E-040.494558244488533E-03 0.280847654126040E+000.321515679088376E-070.120434247248497E-06 -.156044392922250E-070.887469968549317E-040.309083310171081E-03 -.137384777211738E-04-.226540409047954E-02-.880128001169638E+00 -.382651653993193E-05-.108131101348007E-040.233963836825757E-04 0.270492489874145E-03-.122252666299678E-030.612356227618477E-02 0.382695975727179E+000.732428021226023E-020.547713996664140E-02 0.396049984501415E+00-.481141822977436E-01-.405642629586525E+00 0.635749564952352E+000.521347508869209E+000.148024935841334E-01 -.301295407799686E-030.723544959371664E-020.207642865415858E-03 -.348694792387385E-010.263550631173699E+000.889595566279424E-01 -.418984214602752E+000.500266357695299E+000.408119429597393E+00 -.363233885356471E-010.804413318688337E-01-.500266373002098E+00 -.265517664767941E+00-.164627094124487E-01-.292271209593851E-03 0.124794323490641E-010.336449804275239E-030.498076969884902E-03 0.271691736959086E-020.231277279264080E-03-.567655532785492E-01 0.271848648436447E-010.503661384603298E+000.655366565640398E-01 -.243230693129746E-01-.789632788520066E+000.183179034548534E-01 -.311651765431028E-01-.255025625534976E-010.334633855693646E+00 -.190063900887600E-030.353945762482508E-02-.977710956462515E-05 0.746309618330485E-040.131595722141013E-020.739405964402529E-04 0.119008502370693E-01-.173222930707446E-04-.555999356456072E-01 0.142824249504943E+000.430859451845448E+000.458944077528358E-01 -.115195465102762E+000.132957232431433E+00-.828429389734122E+00 0.298427846700954E-01-.960653777292320E-020.264770324901898E+00 0.294775292625976E-04-.222797414239782E-030.199648632405749E-02 -.221026344617562E-030.169463786498493E-010.399691019732668E-04 -.412776023938866E-020.252572320635840E-030.233873710864906E-01 0.259719891251546E+000.415140740182975E-030.113529818985204E-02 -.174804710873652E-020.578214115132270E-020.122117368574587E-01 -.751426870967600E-02-.124904020763724E+00-.845228958797211E+00 -.212620236485092E-02-.168622369330729E-020.211514253839871E-01 0.215369670240951E-01-.534820692965796E-02-.144346899834284E-06 0.267863054400291E+000.359203496211911E+000.331086374854943E-02 -.845474757581534E-080.632504086378518E+00-.235118751978227E-01 -.638143102372112E+000.422974828693201E+000.114871343439142E+00 0.183672600439000E-070.671269422302639E-020.141774326820363E+00 -.692748182182047E+00-.141774300990027E+000.692748182182314E+00 0.481957392698951E-040.270388157735588E-030.258091963527867E-04 -.154613472923139E-010.788913409868525E-020.166281063480095E+00 0.631548573348084E-01-.719098717124253E-02-.783605853008467E+00 0.133352995840027E-02-.155351765852490E-02-.469231283040379E-01 0.593097595003567E+00-.145124296629042E-040.363129440721168E-03 -.755130544285567E-050.322329789563514E-040.162865732101339E-03 0.337458039242355E-040.188676716333058E-02-.967983875236429E-05 -.280294852982924E-010.560451599699661E-010.283514625914695E+00 0.623656558031793E-01-.513514652564355E-010.206258387156799E-01 -.826238746166489E+000.239687498883366E-02-.329344008682935E-01 0.474308373685584E+000.161872833336829E-04-.895145426991688E-04 0.315360387518861E-03-.933730942829438E-040.280130679481694E-02 0.191092696904015E-04-.835451218901018E-02-.224824288339140E-02 0.516928270523294E-010.109704348827131E+000.108269387812490E-02 0.107731305293616E-010.427800356853278E-020.368562069578784E-01 0.485484135495873E-01-.102507986038446E-01-.552216485696899E+00 -.594260620325315E+00-.316691755671850E-01-.132825140699132E-07 0.364597166754599E+000.174700089420081E+00-.717406486290489E-02 0.359222945921040E+000.172123612118179E+000.707106781186543E+00 -.707106781186557E+000.101992154740172E+00-.498361637024495E+00 0.608782920354223E+000.608782912866900E+00-.563724703278934E-01 -.438434828311532E-020.716766147603742E+000.537258122841962E-01 -.692937766919190E+00-.627170199294769E-020.346820800292373E-01 -.597760582014308E-01-.390085053120361E-010.691950856253261E+00 0.704045963162265E-01-.714079956171652E+00-.518737623309080E-01 0.761022812732684E-020.159550167655143E-010.604843345813386E+00 0.321896613542082E+000.567209593954754E-010.237137403293247E-07 -.653010405795925E+00-.312895948443595E+000.707106728865803E+00 -.707106833507286E+000.115866760025710E+000.687858841009181E+00 0.115866760025706E+00-.115866777390875E+00-.687858841015537E+00 -.115866765820121E+000.199959993541363E-01-.999800060016923E+00 0.199959993541364E-01-.999800060016920E+000.591447559760272E+00 -.774079952713837E+000.225809678402336E+000.707106745792210E+00 -.707106816580882E+000.102933637605961E+000.691960495020240E+00 0.102933654691574E+00-.102933654674223E+00-.691960495026485E+00 -.102933660046180E+000.199959993541364E-01-.999800060016920E+00 0.199960012762684E-01-.999800059978472E+00-.127452310568665E-01 -.132034018886979E-060.193643357350621E+000.641757529728320E+00 0.127452468624267E-010.175461378776522E-06-.638150377049360E+00 -.378270719499168E+000.707106745792551E+00-.707106816580538E+00 0.735498311658631E-010.699414631300659E+000.735498231523910E-01 -.735498255093039E-01-.699414659275387E+00-.735498261761447E-01 0.199960012762683E-01-.999800059978476E+000.199960003152027E-01 -.999800059997703E+00-.793687288626499E-02-.801466233668395E-07 0.109332282606681E+000.788133320380449E+000.793689353370808E-02 0.133933796941923E-06-.397501359005163E+00-.456901524012506E+00 0.707106745794469E+00-.707106816578630E+000.677577761723365E-01 0.700583874311953E+000.677577840360550E-01-.677577956934772E-01 -.700583874313761E+00-.677577869993615E-010.199960022373348E-01 -.999800059959256E+000.199960012762687E-01-.999800059978472E+00 -.319883555175909E-03-.118986023366735E-070.281838347380330E-02 0.876754646848632E+000.319884871920509E-030.150806759592284E-07 -.160183057271965E-01-.480662620945026E+000.707106745795564E+00 -.707106816577532E+00-.890947474946424E-020.706994528505650E+00 -.890947463346475E-020.890947671897219E-02-.706994499014701E+00 0.890947653156449E-020.199960022373347E-01-.999800059959259E+00 0.199960012762683E-01-.999800059978472E+00-.260858972545533E-04 -.191844269302226E-080.122620469735823E-030.885535385661900E+00 0.260860624298151E-040.247588712962808E-08-.130637283259506E-02 -.464570078388519E+000.707106732355502E+00-.707106830017597E+00 -.541723283909854E-010.702944338249317E+00-.541723317379545E-01 0.541723443718538E-01-.702944299891371E+000.541723452463965E-01 0.199960003152022E-01-.999800059997696E+000.199959993541364E-01 -.999800060016920E+00-.239127687416373E-04-.151460465105004E-08 0.115672896862657E-030.885262435736919E+000.239129677845735E-04 0.257585781747041E-08-.119766065837865E-02-.465090282588456E+00 0.707106725206366E+00-.707106837166720E+00-.919589760709782E-01 0.695044669841039E+00-.919589734520017E-010.919589804407779E-01 -.695044669843202E+000.919589782786625E-010.199960022373347E-01 -.999800059959252E+000.199960022373348E-01-.999800059959256E+00 -.151924628664646E-03-.510312341108572E-080.114456686280757E-02 0.879637007792521E+000.151925412556267E-03-.760985148748386E-02 -.475583292900870E+000.707106745794441E+00-.707106816578655E+00 -.123882094148375E+000.685059468109205E+00-.123882083877434E+00 0.123882100598866E+00-.685059436248697E+000.123882101836301E+00 0.199960012762683E-01-.999800059978476E+000.199960012762682E-01 -.999800059978480E+00-.678767592186647E-02-.117643398718500E-06 0.687172030420897E-010.819622591650248E+000.678770879243693E-02 0.183330445795151E-06-.339959963271509E+00-.455885765406123E+00 0.707106745794739E+00-.707106816578357E+00-.139007785337744E+00 0.679230170872582E+00-.139007785337747E+000.139007815139815E+00 -.679230226703378E+000.139007815139786E+000.199960003152020E-01 -.999800059997686E+000.199960003152021E-01-.999800059997696E+00 -.141044682813303E-01-.262174622790849E-060.157938172071501E+00 0.601128701028703E+000.141045167897438E-01-.706247527620910E+00 -.338402681597202E+000.707106745794821E+00-.707106816578275E+00 -.267856550417132E+000.654410317897785E+000.267856566195439E+00 -.654410317899671E+000.199960012762682E-01-.999800059978476E+00 0.199960012762681E-01-.999800059978476E+000.593949158047806E+00 0.223352700169129E+00-.772876425427416E+00 0.202394105899437E-120.274823389968666E-14-.554892366794151E-15 -.819274160312709E-15-.668810055472496E-160.212241558104048E-12 0.526299506130443E-14-.489385623532121E-15-.677032376568762E-15 -.451623379287585E-150.374666605049989E-120.222425138831361E-13 -.181544572943050E-14-.147988975572570E-14-.186104552378963E-14 0.000000000000000E+000.000000000000000E+000.435189840959789E-14 -.382967060044728E-130.505291153767714E-160.000000000000000E+00 0.000000000000000E+000.435189840959789E-14-.226298717299133E-13 0.121146683837838E-140.000000000000000E+000.000000000000000E+00 0.435189840959789E-140.130556952287927E-130.445674391403092E-14 0.000000000000000E+000.000000000000000E+000.435189840959789E-14 -.783341737833116E-140.234227328474855E-140.108206124046458E-12 -.215883859283577E-14-.403946870939676E-15-.686616926286516E-15 -.862012111631899E-150.303533244284811E-130.138010344467711E-14 -.404018824222715E-15-.286385196638407E-15-.390704401891710E-15 0.273411624622911E-13-.765610157434584E-15-.268141684612874E-15 -.132194093079351E-15-.601621965854667E-150.000000000000000E+00 0.384762796083885E-13-.193731562836694E-15-.413645768293773E-14 -.114278485295537E-050.807508878162117E-13-.380818779406990E-13 0.223648500602427E-14-.909889585701067E-140.331562834926780E-05 0.285043306029678E-12-.207058352673703E-13-.636970533077854E-14 0.524252010357629E-140.269297853105648E-050.171627453082871E-14 0.717975632069722E-14-.527448437137286E-140.464287948246645E-13 0.771098257180396E-080.234809096656618E-14-.359395808792810E-14 0.665552106043155E-140.757280959611803E-140.143718570281886E-11 0.222572869532307E-14-.139716009607018E-130.780446860517369E-15 0.362157028369366E-130.536540168957500E-100.307875265929601E-14 -.705504318733115E-140.337799402074240E-140.500401555294291E-13 0.426280731858752E-080.913287848754867E-130.103614716445489E-13 -.522859350784418E-140.499148370186354E-140.478624017132153E-05 0.121456366975691E-130.101624213254850E-140.216701101200512E-14 -.345271197980365E-140.110880789697911E-050.301216196618491E-14 -.540428228214019E-14-.222140164388316E-140.434955330079947E-15 -.160601989555048E-050.157559231112031E-130.420001628718037E-12 0.150572252957974E-13-.606223423353496E-13-.281774303279372E-03 -.161762764929301E-12-.342092744508673E-120.108249355143259E-12 -.615731698119600E-120.114252946436998E-030.846620542762694E-13 -.152621157809399E-12-.109809342763844E-12-.217943874621490E-12 0.797723962847499E-050.180888084740301E-130.122644376958020E-12 0.888551767886481E-130.204169584974151E-120.639904466172473E-07 0.102694065070745E-130.185542222646612E-13-.980356568716921E-14 0.213689007015383E-130.148657983204524E-100.938171534597355E-14 0.386707150480676E-130.185686924559307E-130.629279530815653E-13 0.178538186267594E-090.303591605636916E-130.247507485473141E-12 0.601948765785340E-130.259328208787118E-130.825012119453497E-07 0.165489865824259E-130.126909717971805E-12-.809972621173125E-15 0.260221066762617E-120.440673145488575E-04-.577391192374903E-13 -.141685739715840E-13-.898379506962308E-14-.587589075806416E-13 0.854336895419281E-040.695114309023588E-14-.183400756501765E-12 -.351268034790456E-13-.212800439402798E-13-.786196346629773E-03 0.231704757800883E-140.428729786047385E-12-.921006657969298E-13 -.722393149668797E-13-.500822403978593E-04-.114151854183011E-12 -.219912598762636E-120.126673756206235E-12-.382620831589828E-12 0.297225488674877E-040.234508048410960E-12-.218856288176897E-12 -.406403766139363E-12-.198463290029409E-120.217128723459237E-04 0.756454004598282E-130.728205498076627E-130.218097882502026E-12 0.166565512837028E-120.194699855455599E-060.325953303999443E-13 0.141059018716547E-120.163148755045124E-140.168350227066847E-13 0.364655761535216E-100.318693236147873E-130.629300865896806E-12 0.832072227609808E-130.104391586556431E-120.219566882979375E-08 0.966294840559207E-130.105322792611619E-120.154817975688185E-11 -.129150687222302E-120.159284559755380E-060.255359618793750E-12 -.669568573719880E-12-.140319512989452E-11-.148808193119654E-11 0.174243935653877E-040.235964900478605E-13-.158921691210278E-14 0.427286687073893E-13-.383875253964354E-130.209458122839295E-04 0.695114255617233E-15-.778936609739444E-12-.555263495967613E-13 0.178057460686566E-12-.931728111057866E-040.162193337546363E-14 0.192082021351027E-12-.338830504552759E-13-.259959064560709E-13 -.102908168635522E-040.119780901141838E-12-.705626182733349E-13 0.477777856036666E-13-.122188353215107E-120.628204494195552E-05 0.360502341905674E-12-.158458353411481E-12-.107460877005768E-12 -.543852067739607E-130.999832651169842E-050.223928511470390E-12 0.219031617335137E-130.683930191759728E-130.993011534250549E-13 0.421065904949251E-070.795593192526987E-130.200393330802057E-14 -.544643938855520E-14-.129085088280889E-130.307220157212393E-10 0.769647462983260E-13-.708645844756138E-130.190209280278036E-13 0.140249871726619E-15-.129729632851381E-080.200188825456105E-12 0.416378030603160E-130.430348021674659E-13-.704010864682257E-14 0.216263094106671E-080.146886604283455E-120.841533706518667E-13 -.661595658689806E-13-.941058011231196E-140.391430381205002E-05 -.756476598943381E-13-.606765392737815E-140.229242559524678E-13 -.319044605764485E-130.548350629631716E-050.695114303103693E-15 -.146061553715816E-12-.276900163448222E-130.327090370418689E-14 -.241110654148327E-040.497470124823223E-120.178190122707317E-13 -.335610877544072E-150.269804823123547E-15-.754610311602206E-14 0.504652984537124E-120.132811426043152E-130.276385428565550E-15 0.171095749713042E-15-.565706170888985E-090.495616483348267E-12 0.270460386923519E-140.213967823565366E-160.114116167083434E-15 -.307378214952379E-090.148059343055948E-120.704938251717327E-15 0.796554343080852E-160.134418545397471E-15-.214702302708836E-10 0.264143427774681E-13-.393383383587686E-15-.224429000369457E-15 -.166387009518229E-15-.956414562064006E-130.275728664863706E-13 -.252625379126553E-140.290067003721533E-16-.372943254642494E-16 -.292904363272568E-110.108669533011201E-12-.373828633891879E-14 -.135252686834076E-150.811516121004296E-16-.248539101337132E-10 0.179802895868020E-12-.101106161740470E-13-.776828549128017E-16 -.185243730945928E-15-.969762553748463E-090.132071717589703E-12 -.156903353468787E-14-.269565415329845E-15-.275066750336520E-16 -.168359295253083E-080.123035231649352E-12-.239352379930970E-14 -.225554746116851E-150.935226996093998E-16-.392547043891108E-14 Matrix/inst/external/lund_a.mtx0000644000176200001440000010575510275502035016325 0ustar liggesusers%%MatrixMarket matrix coordinate real symmetric 147 147 1298 1 1 7.5000000000000e+07 2 1 9.6153881000000e+05 8 1 -1.2179486000000e+07 9 1 -2.6175210000000e+06 10 1 2.8846144000000e+07 11 1 5.7692300000000e+06 2 2 7.5000000000000e+07 3 2 9.6153869000000e+05 9 2 -7.4786312000000e+04 10 2 9.6153840000000e+06 11 2 -1.2179486000000e+07 12 2 -2.6175210000000e+06 13 2 2.8846144000000e+07 14 2 5.7692300000000e+06 3 3 7.5000000000000e+07 4 3 9.6153844000000e+05 12 3 -7.4786375000000e+04 13 3 9.6153840000000e+06 14 3 -1.2179486000000e+07 15 3 -2.6175210000000e+06 16 3 2.8846144000000e+07 17 3 5.7692310000000e+06 4 4 7.5000000000000e+07 5 4 9.6153869000000e+05 15 4 -7.4786312000000e+04 16 4 9.6153840000000e+06 17 4 -1.2179487000000e+07 18 4 -2.6175210000000e+06 19 4 2.8846144000000e+07 20 4 5.7692300000000e+06 5 5 7.5000000000000e+07 6 5 9.6153894000000e+05 18 5 -7.4786375000000e+04 19 5 9.6153840000000e+06 20 5 -1.2179486000000e+07 21 5 -2.6175210000000e+06 22 5 2.8846160000000e+07 23 5 5.7692310000000e+06 6 6 7.5000000000000e+07 7 6 9.6153894000000e+05 21 6 -7.4786312000000e+04 22 6 9.6153850000000e+06 23 6 -1.2179488000000e+07 24 6 -2.6175220000000e+06 25 6 2.8846160000000e+07 26 6 5.7692310000000e+06 7 7 4.4230768000000e+07 24 7 -7.4786312000000e+04 25 7 9.6153850000000e+06 26 7 -1.2179488000000e+07 27 7 -1.5405980000000e+06 28 7 1.4423078000000e+07 8 8 7.5000000000000e+07 9 8 2.6175210000000e+06 10 8 5.7692300000000e+06 11 8 2.8846144000000e+07 29 8 9.6153831000000e+05 9 9 5.0256406000000e+05 10 9 7.8125000000000e-03 11 9 7.8125000000000e-03 12 9 -1.2564100000000e+05 13 9 7.4786312000000e+04 14 9 -2.6175210000000e+06 29 9 7.4786312000000e+04 30 9 -1.2564100000000e+05 31 9 2.6175210000000e+06 32 9 -7.4786312000000e+04 10 10 1.4999998000000e+08 11 10 1.2820510000000e+06 12 10 -7.4786312000000e+04 13 10 1.9230770000000e+06 14 10 5.7692310000000e+06 29 10 -1.2179486000000e+07 30 10 -2.6175210000000e+06 31 10 2.8846144000000e+07 32 10 5.7692300000000e+06 11 11 1.4999998000000e+08 12 11 2.6175210000000e+06 13 11 5.7692300000000e+06 14 11 2.8846144000000e+07 29 11 9.6153840000000e+06 30 11 7.4786312000000e+04 31 11 5.7692300000000e+06 32 11 1.9230770000000e+06 12 12 5.0256406000000e+05 13 12 -1.0937500000000e-01 14 12 5.4687500000000e-02 15 12 -1.2564100000000e+05 16 12 7.4786312000000e+04 17 12 -2.6175210000000e+06 30 12 -2.4414062000000e-04 31 12 7.4786375000000e+04 32 12 7.4786312000000e+04 33 12 -1.2564100000000e+05 34 12 2.6175210000000e+06 35 12 -7.4786250000000e+04 13 13 1.4999998000000e+08 14 13 1.2820520000000e+06 15 13 -7.4786312000000e+04 16 13 1.9230770000000e+06 17 13 5.7692300000000e+06 30 13 -7.4786312000000e+04 31 13 9.6153840000000e+06 32 13 -1.2179487000000e+07 33 13 -2.6175210000000e+06 34 13 2.8846144000000e+07 35 13 5.7692300000000e+06 14 14 1.4999998000000e+08 15 14 2.6175210000000e+06 16 14 5.7692300000000e+06 17 14 2.8846144000000e+07 30 14 -7.4786375000000e+04 31 14 -1.2179486000000e+07 32 14 9.6153840000000e+06 33 14 7.4786312000000e+04 34 14 5.7692310000000e+06 35 14 1.9230770000000e+06 15 15 5.0256406000000e+05 16 15 1.4843750000000e-01 17 15 -1.1718750000000e-01 18 15 -1.2564100000000e+05 19 15 7.4786312000000e+04 20 15 -2.6175210000000e+06 33 15 -3.6621094000000e-04 34 15 7.4786375000000e+04 35 15 7.4786250000000e+04 36 15 -1.2564100000000e+05 37 15 2.6175210000000e+06 38 15 -7.4786312000000e+04 16 16 1.4999998000000e+08 17 16 1.2820510000000e+06 18 16 -7.4786312000000e+04 19 16 1.9230770000000e+06 20 16 5.7692310000000e+06 33 16 -7.4786250000000e+04 34 16 9.6153840000000e+06 35 16 -1.2179488000000e+07 36 16 -2.6175210000000e+06 37 16 2.8846160000000e+07 38 16 5.7692310000000e+06 17 17 1.4999998000000e+08 18 17 2.6175210000000e+06 19 17 5.7692310000000e+06 20 17 2.8846144000000e+07 33 17 -7.4786375000000e+04 34 17 -1.2179485000000e+07 35 17 9.6153830000000e+06 36 17 7.4786375000000e+04 37 17 5.7692300000000e+06 38 17 1.9230770000000e+06 18 18 5.0256406000000e+05 19 18 -1.3281250000000e-01 20 18 1.7187500000000e-01 21 18 -1.2564100000000e+05 22 18 7.4786312000000e+04 23 18 -2.6175210000000e+06 36 18 4.8828125000000e-04 37 18 7.4786312000000e+04 38 18 7.4786312000000e+04 39 18 -1.2564100000000e+05 40 18 2.6175210000000e+06 41 18 -7.4786250000000e+04 19 19 1.4999998000000e+08 20 19 1.2820510000000e+06 21 19 -7.4786375000000e+04 22 19 1.9230770000000e+06 23 19 5.7692300000000e+06 36 19 -7.4786250000000e+04 37 19 9.6153840000000e+06 38 19 -1.2179488000000e+07 39 19 -2.6175210000000e+06 40 19 2.8846144000000e+07 41 19 5.7692300000000e+06 20 20 1.4999998000000e+08 21 20 2.6175210000000e+06 22 20 5.7692300000000e+06 23 20 2.8846144000000e+07 36 20 -7.4786375000000e+04 37 20 -1.2179487000000e+07 38 20 9.6153850000000e+06 39 20 7.4786375000000e+04 40 20 5.7692310000000e+06 41 20 1.9230760000000e+06 21 21 5.0256412000000e+05 22 21 3.2031250000000e-01 23 21 -6.8750000000000e-01 24 21 -1.2564106000000e+05 25 21 7.4786375000000e+04 26 21 -2.6175220000000e+06 39 21 -1.2207031000000e-04 40 21 7.4786437000000e+04 41 21 7.4786187000000e+04 42 21 -1.2564106000000e+05 43 21 2.6175220000000e+06 44 21 -7.4786375000000e+04 22 22 1.5000002000000e+08 23 22 1.2820520000000e+06 24 22 -7.4786312000000e+04 25 22 1.9230770000000e+06 26 22 5.7692320000000e+06 39 22 -7.4786250000000e+04 40 22 9.6153840000000e+06 41 22 -1.2179490000000e+07 42 22 -2.6175220000000e+06 43 22 2.8846160000000e+07 44 22 5.7692320000000e+06 23 23 1.5000000000000e+08 24 23 2.6175220000000e+06 25 23 5.7692320000000e+06 26 23 2.8846160000000e+07 39 23 -7.4786437000000e+04 40 23 -1.2179483000000e+07 41 23 9.6153830000000e+06 42 23 7.4786312000000e+04 43 23 5.7692320000000e+06 44 23 1.9230770000000e+06 24 24 5.0256419000000e+05 25 24 4.1406250000000e-01 26 24 8.5937500000000e-02 27 24 -1.2564106000000e+05 28 24 7.4786375000000e+04 42 24 3.6621094000000e-04 43 24 7.4786312000000e+04 44 24 7.4786375000000e+04 45 24 -1.2564106000000e+05 46 24 2.6175220000000e+06 47 24 -7.4786375000000e+04 25 25 1.5000002000000e+08 26 25 1.2820510000000e+06 27 25 -7.4786312000000e+04 28 25 1.9230770000000e+06 42 25 -7.4786312000000e+04 43 25 9.6153860000000e+06 44 25 -1.2179491000000e+07 45 25 -2.6175220000000e+06 46 25 2.8846160000000e+07 47 25 5.7692320000000e+06 26 26 1.5000002000000e+08 27 26 2.6175220000000e+06 28 26 5.7692320000000e+06 42 26 -7.4786375000000e+04 43 26 -1.2179491000000e+07 44 26 9.6153880000000e+06 45 26 7.4786375000000e+04 46 26 5.7692320000000e+06 47 26 1.9230770000000e+06 27 27 2.5128206000000e+05 28 27 4.6367550000000e+05 45 27 3.6621094000000e-04 46 27 7.4786312000000e+04 47 27 7.4786375000000e+04 48 27 -6.2820531000000e+04 49 27 1.0769230000000e+06 28 28 7.5000016000000e+07 45 28 -7.4786312000000e+04 46 28 9.6153860000000e+06 47 28 -1.2179491000000e+07 48 28 -1.5405990000000e+06 49 28 1.4423080000000e+07 29 29 7.5000000000000e+07 30 29 2.6175210000000e+06 31 29 5.7692300000000e+06 32 29 2.8846144000000e+07 50 29 9.6153831000000e+05 30 30 5.0256406000000e+05 31 30 -1.0937500000000e-01 32 30 5.4687500000000e-02 33 30 -1.2564100000000e+05 34 30 7.4786250000000e+04 35 30 -2.6175210000000e+06 50 30 7.4786312000000e+04 51 30 -1.2564100000000e+05 52 30 2.6175210000000e+06 53 30 -7.4786312000000e+04 31 31 1.4999998000000e+08 32 31 1.2820520000000e+06 33 31 -7.4786312000000e+04 34 31 1.9230770000000e+06 35 31 5.7692310000000e+06 50 31 -1.2179486000000e+07 51 31 -2.6175210000000e+06 52 31 2.8846144000000e+07 53 31 5.7692300000000e+06 32 32 1.4999998000000e+08 33 32 2.6175210000000e+06 34 32 5.7692300000000e+06 35 32 2.8846144000000e+07 50 32 9.6153840000000e+06 51 32 7.4786312000000e+04 52 32 5.7692300000000e+06 53 32 1.9230770000000e+06 33 33 5.0256412000000e+05 34 33 2.4218750000000e-01 35 33 -3.8281250000000e-01 36 33 -1.2564106000000e+05 37 33 7.4786375000000e+04 38 33 -2.6175220000000e+06 51 33 -4.8828125000000e-04 52 33 7.4786312000000e+04 53 33 7.4786312000000e+04 54 33 -1.2564100000000e+05 55 33 2.6175210000000e+06 56 33 -7.4786375000000e+04 34 34 1.4999998000000e+08 35 34 1.2820510000000e+06 36 34 -7.4786312000000e+04 37 34 1.9230770000000e+06 38 34 5.7692310000000e+06 51 34 -7.4786250000000e+04 52 34 9.6153820000000e+06 53 34 -1.2179487000000e+07 54 34 -2.6175210000000e+06 55 34 2.8846160000000e+07 56 34 5.7692300000000e+06 35 35 1.4999998000000e+08 36 35 2.6175220000000e+06 37 35 5.7692310000000e+06 38 35 2.8846160000000e+07 51 35 -7.4786375000000e+04 52 35 -1.2179485000000e+07 53 35 9.6153840000000e+06 54 35 7.4786312000000e+04 55 35 5.7692310000000e+06 56 35 1.9230770000000e+06 36 36 5.0256412000000e+05 37 36 -2.3437500000000e-02 38 36 3.4375000000000e-01 39 36 -1.2564100000000e+05 40 36 7.4786250000000e+04 41 36 -2.6175210000000e+06 54 36 2.4414062000000e-04 55 36 7.4786312000000e+04 56 36 7.4786312000000e+04 57 36 -1.2564100000000e+05 58 36 2.6175210000000e+06 59 36 -7.4786312000000e+04 37 37 1.5000000000000e+08 38 37 1.2820520000000e+06 39 37 -7.4786312000000e+04 40 37 1.9230770000000e+06 41 37 5.7692310000000e+06 54 37 -7.4786312000000e+04 55 37 9.6153850000000e+06 56 37 -1.2179488000000e+07 57 37 -2.6175210000000e+06 58 37 2.8846144000000e+07 59 37 5.7692300000000e+06 38 38 1.5000000000000e+08 39 38 2.6175210000000e+06 40 38 5.7692310000000e+06 41 38 2.8846144000000e+07 54 38 -7.4786312000000e+04 55 38 -1.2179488000000e+07 56 38 9.6153850000000e+06 57 38 7.4786375000000e+04 58 38 5.7692300000000e+06 59 38 1.9230770000000e+06 39 39 5.0256406000000e+05 40 39 1.9531250000000e-01 41 39 -2.7343750000000e-01 42 39 -1.2564100000000e+05 43 39 7.4786312000000e+04 44 39 -2.6175210000000e+06 57 39 4.8828125000000e-04 58 39 7.4786312000000e+04 59 39 7.4786250000000e+04 60 39 -1.2564100000000e+05 61 39 2.6175210000000e+06 62 39 -7.4786312000000e+04 40 40 1.4999998000000e+08 41 40 1.2820510000000e+06 42 40 -7.4786375000000e+04 43 40 1.9230770000000e+06 44 40 5.7692310000000e+06 57 40 -7.4786250000000e+04 58 40 9.6153820000000e+06 59 40 -1.2179488000000e+07 60 40 -2.6175210000000e+06 61 40 2.8846144000000e+07 62 40 5.7692300000000e+06 41 41 1.4999998000000e+08 42 41 2.6175210000000e+06 43 41 5.7692300000000e+06 44 41 2.8846160000000e+07 57 41 -7.4786375000000e+04 58 41 -1.2179485000000e+07 59 41 9.6153850000000e+06 60 41 7.4786375000000e+04 61 41 5.7692310000000e+06 62 41 1.9230770000000e+06 42 42 5.0256412000000e+05 43 42 -5.5468750000000e-01 44 42 -3.2812500000000e-01 45 42 -1.2564106000000e+05 46 42 7.4786250000000e+04 47 42 -2.6175220000000e+06 60 42 -2.4414062000000e-04 61 42 7.4786312000000e+04 62 42 7.4786312000000e+04 63 42 -1.2564100000000e+05 64 42 2.6175210000000e+06 65 42 -7.4786375000000e+04 43 43 1.5000002000000e+08 44 43 1.2820510000000e+06 45 43 -7.4786375000000e+04 46 43 1.9230770000000e+06 47 43 5.7692320000000e+06 60 43 -7.4786312000000e+04 61 43 9.6153830000000e+06 62 43 -1.2179486000000e+07 63 43 -2.6175210000000e+06 64 43 2.8846144000000e+07 65 43 5.7692310000000e+06 44 44 1.5000002000000e+08 45 44 2.6175220000000e+06 46 44 5.7692320000000e+06 47 44 2.8846160000000e+07 60 44 -7.4786312000000e+04 61 44 -1.2179486000000e+07 62 44 9.6153830000000e+06 63 44 7.4786312000000e+04 64 44 5.7692300000000e+06 65 44 1.9230760000000e+06 45 45 5.0256419000000e+05 46 45 5.3906250000000e-01 47 45 1.5625000000000e-02 48 45 -1.2564106000000e+05 49 45 7.4786250000000e+04 63 45 -7.3242187000000e-04 64 45 7.4786562000000e+04 65 45 7.4786125000000e+04 66 45 -1.2564106000000e+05 67 45 2.6175220000000e+06 68 45 -7.4786250000000e+04 46 46 1.5000005000000e+08 47 46 1.2820520000000e+06 48 46 -7.4786375000000e+04 49 46 1.9230770000000e+06 63 46 -7.4786125000000e+04 64 46 9.6153870000000e+06 65 46 -1.2179498000000e+07 66 46 -2.6175230000000e+06 67 46 2.8846160000000e+07 68 46 5.7692320000000e+06 47 47 1.5000002000000e+08 48 47 2.6175220000000e+06 49 47 5.7692320000000e+06 63 47 -7.4786625000000e+04 64 47 -1.2179486000000e+07 65 47 9.6153900000000e+06 66 47 7.4786500000000e+04 67 47 5.7692330000000e+06 68 47 1.9230770000000e+06 48 48 2.5128206000000e+05 49 48 4.6367500000000e+05 66 48 -6.1035156000000e-04 67 48 7.4786312000000e+04 68 48 7.4786375000000e+04 69 48 -6.2820516000000e+04 70 48 1.0769230000000e+06 49 49 7.5000000000000e+07 66 49 -7.4786312000000e+04 67 49 9.6153830000000e+06 68 49 -1.2179487000000e+07 69 49 -1.5405980000000e+06 70 49 1.4423077000000e+07 50 50 7.5000000000000e+07 51 50 2.6175210000000e+06 52 50 5.7692310000000e+06 53 50 2.8846144000000e+07 71 50 9.6153856000000e+05 51 51 5.0256406000000e+05 52 51 1.8750000000000e-01 53 51 2.3437500000000e-02 54 51 -1.2564100000000e+05 55 51 7.4786312000000e+04 56 51 -2.6175210000000e+06 71 51 7.4786312000000e+04 72 51 -1.2564100000000e+05 73 51 2.6175210000000e+06 74 51 -7.4786312000000e+04 52 52 1.4999998000000e+08 53 52 1.2820510000000e+06 54 52 -7.4786312000000e+04 55 52 1.9230770000000e+06 56 52 5.7692300000000e+06 71 52 -1.2179487000000e+07 72 52 -2.6175210000000e+06 73 52 2.8846160000000e+07 74 52 5.7692310000000e+06 53 53 1.4999998000000e+08 54 53 2.6175210000000e+06 55 53 5.7692310000000e+06 56 53 2.8846144000000e+07 71 53 9.6153830000000e+06 72 53 7.4786312000000e+04 73 53 5.7692310000000e+06 74 53 1.9230770000000e+06 54 54 5.0256406000000e+05 55 54 -2.4218750000000e-01 56 54 -6.2500000000000e-02 57 54 -1.2564100000000e+05 58 54 7.4786250000000e+04 59 54 -2.6175210000000e+06 73 54 7.4786375000000e+04 74 54 7.4786250000000e+04 75 54 -1.2564100000000e+05 76 54 2.6175210000000e+06 77 54 -7.4786250000000e+04 55 55 1.5000000000000e+08 56 55 1.2820510000000e+06 57 55 -7.4786437000000e+04 58 55 1.9230760000000e+06 59 55 5.7692290000000e+06 72 55 -7.4786312000000e+04 73 55 9.6153850000000e+06 74 55 -1.2179488000000e+07 75 55 -2.6175210000000e+06 76 55 2.8846144000000e+07 77 55 5.7692300000000e+06 56 56 1.4999998000000e+08 57 56 2.6175210000000e+06 58 56 5.7692300000000e+06 59 56 2.8846144000000e+07 72 56 -7.4786375000000e+04 73 56 -1.2179487000000e+07 74 56 9.6153840000000e+06 75 56 7.4786375000000e+04 76 56 5.7692310000000e+06 77 56 1.9230770000000e+06 57 57 5.0256412000000e+05 58 57 2.0312500000000e-01 59 57 -2.4218750000000e-01 60 57 -1.2564100000000e+05 61 57 7.4786312000000e+04 62 57 -2.6175210000000e+06 75 57 8.5449219000000e-04 76 57 7.4786375000000e+04 77 57 7.4786250000000e+04 78 57 -1.2564100000000e+05 79 57 2.6175210000000e+06 80 57 -7.4786312000000e+04 58 58 1.4999998000000e+08 59 58 1.2820510000000e+06 60 58 -7.4786312000000e+04 61 58 1.9230770000000e+06 62 58 5.7692310000000e+06 75 58 -7.4786250000000e+04 76 58 9.6153850000000e+06 77 58 -1.2179488000000e+07 78 58 -2.6175210000000e+06 79 58 2.8846160000000e+07 80 58 5.7692320000000e+06 59 59 1.5000000000000e+08 60 59 2.6175210000000e+06 61 59 5.7692320000000e+06 62 59 2.8846160000000e+07 75 59 -7.4786312000000e+04 76 59 -1.2179485000000e+07 77 59 9.6153820000000e+06 78 59 7.4786312000000e+04 79 59 5.7692310000000e+06 80 59 1.9230770000000e+06 60 60 5.0256412000000e+05 61 60 2.2656250000000e-01 62 60 2.5000000000000e-01 63 60 -1.2564100000000e+05 64 60 7.4786375000000e+04 65 60 -2.6175210000000e+06 78 60 2.4414062000000e-04 79 60 7.4786312000000e+04 80 60 7.4786312000000e+04 81 60 -1.2564100000000e+05 82 60 2.6175210000000e+06 83 60 -7.4786312000000e+04 61 61 1.5000000000000e+08 62 61 1.2820510000000e+06 63 61 -7.4786312000000e+04 64 61 1.9230770000000e+06 65 61 5.7692300000000e+06 78 61 -7.4786312000000e+04 79 61 9.6153850000000e+06 80 61 -1.2179489000000e+07 81 61 -2.6175210000000e+06 82 61 2.8846160000000e+07 83 61 5.7692310000000e+06 62 62 1.5000000000000e+08 63 62 2.6175210000000e+06 64 62 5.7692310000000e+06 65 62 2.8846144000000e+07 78 62 -7.4786312000000e+04 79 62 -1.2179489000000e+07 80 62 9.6153860000000e+06 81 62 7.4786312000000e+04 82 62 5.7692320000000e+06 83 62 1.9230770000000e+06 63 63 5.0256412000000e+05 64 63 1.8750000000000e-01 65 63 -8.2031250000000e-01 66 63 -1.2564106000000e+05 67 63 7.4786125000000e+04 68 63 -2.6175220000000e+06 81 63 3.6621094000000e-04 82 63 7.4786500000000e+04 83 63 7.4786187000000e+04 84 63 -1.2564100000000e+05 85 63 2.6175210000000e+06 86 63 -7.4786187000000e+04 64 64 1.5000002000000e+08 65 64 1.2820520000000e+06 66 64 -7.4786500000000e+04 67 64 1.9230780000000e+06 68 64 5.7692330000000e+06 81 64 -7.4786250000000e+04 82 64 9.6153880000000e+06 83 64 -1.2179493000000e+07 84 64 -2.6175220000000e+06 85 64 2.8846160000000e+07 86 64 5.7692310000000e+06 65 65 1.5000002000000e+08 66 65 2.6175220000000e+06 67 65 5.7692330000000e+06 68 65 2.8846160000000e+07 81 65 -7.4786437000000e+04 82 65 -1.2179487000000e+07 83 65 9.6153850000000e+06 84 65 7.4786437000000e+04 85 65 5.7692310000000e+06 86 65 1.9230770000000e+06 66 66 5.0256425000000e+05 67 66 -6.9531250000000e-01 68 66 -1.5625000000000e-01 69 66 -1.2564106000000e+05 70 66 7.4786437000000e+04 84 66 -8.5449219000000e-04 85 66 7.4786312000000e+04 86 66 7.4786312000000e+04 87 66 -1.2564106000000e+05 88 66 2.6175220000000e+06 89 66 -7.4786500000000e+04 67 67 1.5000003000000e+08 68 67 1.2820520000000e+06 69 67 -7.4786250000000e+04 70 67 1.9230770000000e+06 84 67 -7.4786312000000e+04 85 67 9.6153820000000e+06 86 67 -1.2179484000000e+07 87 67 -2.6175210000000e+06 88 67 2.8846160000000e+07 89 67 5.7692320000000e+06 68 68 1.5000003000000e+08 69 68 2.6175220000000e+06 70 68 5.7692330000000e+06 84 68 -7.4786312000000e+04 85 68 -1.2179484000000e+07 86 68 9.6153820000000e+06 87 68 7.4786187000000e+04 88 68 5.7692310000000e+06 89 68 1.9230770000000e+06 69 69 2.5128212000000e+05 70 69 4.6367594000000e+05 87 69 9.7656250000000e-04 88 69 7.4786375000000e+04 89 69 7.4786375000000e+04 90 69 -6.2820547000000e+04 91 69 1.0769240000000e+06 70 70 7.5000016000000e+07 87 70 -7.4786375000000e+04 88 70 9.6153890000000e+06 89 70 -1.2179494000000e+07 90 70 -1.5405990000000e+06 91 70 1.4423084000000e+07 71 71 7.5000000000000e+07 72 71 2.6175210000000e+06 73 71 5.7692300000000e+06 74 71 2.8846144000000e+07 92 71 9.6153831000000e+05 72 72 5.0256406000000e+05 73 72 -1.5625000000000e-01 74 72 7.0312500000000e-02 75 72 -1.2564100000000e+05 76 72 7.4786250000000e+04 77 72 -2.6175210000000e+06 92 72 7.4786312000000e+04 93 72 -1.2564100000000e+05 94 72 2.6175210000000e+06 95 72 -7.4786312000000e+04 73 73 1.4999998000000e+08 74 73 1.2820520000000e+06 75 73 -7.4786375000000e+04 76 73 1.9230770000000e+06 77 73 5.7692310000000e+06 92 73 -1.2179486000000e+07 93 73 -2.6175210000000e+06 94 73 2.8846144000000e+07 95 73 5.7692300000000e+06 74 74 1.4999998000000e+08 75 74 2.6175210000000e+06 76 74 5.7692300000000e+06 77 74 2.8846144000000e+07 92 74 9.6153840000000e+06 93 74 7.4786375000000e+04 94 74 5.7692300000000e+06 95 74 1.9230760000000e+06 75 75 5.0256406000000e+05 76 75 7.0312500000000e-02 77 75 -1.4843750000000e-01 78 75 -1.2564100000000e+05 79 75 7.4786312000000e+04 80 75 -2.6175210000000e+06 93 75 -8.5449219000000e-04 94 75 7.4786375000000e+04 95 75 7.4786250000000e+04 96 75 -1.2564100000000e+05 97 75 2.6175210000000e+06 98 75 -7.4786312000000e+04 76 76 1.4999998000000e+08 77 76 1.2820510000000e+06 78 76 -7.4786375000000e+04 79 76 1.9230770000000e+06 80 76 5.7692310000000e+06 93 76 -7.4786250000000e+04 94 76 9.6153820000000e+06 95 76 -1.2179487000000e+07 96 76 -2.6175210000000e+06 97 76 2.8846144000000e+07 98 76 5.7692300000000e+06 77 77 1.4999998000000e+08 78 77 2.6175210000000e+06 79 77 5.7692300000000e+06 80 77 2.8846144000000e+07 93 77 -7.4786375000000e+04 94 77 -1.2179484000000e+07 95 77 9.6153830000000e+06 96 77 7.4786312000000e+04 97 77 5.7692300000000e+06 98 77 1.9230770000000e+06 78 78 5.0256412000000e+05 79 78 -2.4218750000000e-01 80 78 -2.5000000000000e-01 81 78 -1.2564100000000e+05 82 78 7.4786312000000e+04 83 78 -2.6175210000000e+06 96 78 -2.4414062000000e-04 97 78 7.4786312000000e+04 98 78 7.4786312000000e+04 99 78 -1.2564100000000e+05 100 78 2.6175210000000e+06 101 78 -7.4786375000000e+04 79 79 1.5000000000000e+08 80 79 1.2820510000000e+06 81 79 -7.4786312000000e+04 82 79 1.9230770000000e+06 83 79 5.7692320000000e+06 96 79 -7.4786312000000e+04 97 79 9.6153830000000e+06 98 79 -1.2179486000000e+07 99 79 -2.6175210000000e+06 100 79 2.8846144000000e+07 101 79 5.7692310000000e+06 80 80 1.5000000000000e+08 81 80 2.6175210000000e+06 82 80 5.7692310000000e+06 83 80 2.8846160000000e+07 96 80 -7.4786312000000e+04 97 80 -1.2179486000000e+07 98 80 9.6153830000000e+06 99 80 7.4786312000000e+04 100 80 5.7692300000000e+06 101 80 1.9230760000000e+06 81 81 5.0256419000000e+05 82 81 5.9375000000000e-01 83 81 -6.0937500000000e-01 84 81 -1.2564106000000e+05 85 81 7.4786375000000e+04 86 81 -2.6175220000000e+06 99 81 -7.3242187000000e-04 100 81 7.4786437000000e+04 101 81 7.4786250000000e+04 102 81 -1.2564106000000e+05 103 81 2.6175220000000e+06 104 81 -7.4786312000000e+04 82 82 1.5000003000000e+08 83 82 1.2820520000000e+06 84 82 -7.4786375000000e+04 85 82 1.9230770000000e+06 86 82 5.7692330000000e+06 99 82 -7.4786187000000e+04 100 82 9.6153850000000e+06 101 82 -1.2179493000000e+07 102 82 -2.6175220000000e+06 103 82 2.8846160000000e+07 104 82 5.7692320000000e+06 83 83 1.5000003000000e+08 84 83 2.6175220000000e+06 85 83 5.7692320000000e+06 86 83 2.8846160000000e+07 99 83 -7.4786500000000e+04 100 83 -1.2179487000000e+07 101 83 9.6153880000000e+06 102 83 7.4786375000000e+04 103 83 5.7692330000000e+06 104 83 1.9230770000000e+06 84 84 5.0256412000000e+05 85 84 8.5937500000000e-02 86 84 1.5781250000000e+00 87 84 -1.2564100000000e+05 88 84 7.4786250000000e+04 89 84 -2.6175200000000e+06 103 84 7.4786312000000e+04 104 84 7.4786312000000e+04 105 84 -1.2564100000000e+05 106 84 2.6175210000000e+06 107 84 -7.4786187000000e+04 85 85 1.5000000000000e+08 86 85 1.2820520000000e+06 87 85 -7.4786312000000e+04 88 85 1.9230770000000e+06 89 85 5.7692300000000e+06 102 85 -7.4786375000000e+04 103 85 9.6153870000000e+06 104 85 -1.2179490000000e+07 105 85 -2.6175210000000e+06 106 85 2.8846144000000e+07 107 85 5.7692300000000e+06 86 86 1.5000000000000e+08 87 86 2.6175200000000e+06 88 86 5.7692290000000e+06 89 86 2.8846144000000e+07 102 86 -7.4786375000000e+04 103 86 -1.2179490000000e+07 104 86 9.6153870000000e+06 105 86 7.4786437000000e+04 106 86 5.7692300000000e+06 107 86 1.9230770000000e+06 87 87 5.0256400000000e+05 88 87 -1.2890625000000e+00 89 87 -1.1250000000000e+00 90 87 -1.2564100000000e+05 91 87 7.4786187000000e+04 105 87 -8.5449219000000e-04 106 87 7.4786250000000e+04 107 87 7.4786312000000e+04 108 87 -1.2564100000000e+05 109 87 2.6175200000000e+06 110 87 -7.4786312000000e+04 88 88 1.4999998000000e+08 89 88 1.2820510000000e+06 90 88 -7.4786437000000e+04 91 88 1.9230770000000e+06 105 88 -7.4786312000000e+04 106 88 9.6153800000000e+06 107 88 -1.2179482000000e+07 108 88 -2.6175200000000e+06 109 88 2.8846144000000e+07 110 88 5.7692280000000e+06 89 89 1.4999998000000e+08 90 89 2.6175220000000e+06 91 89 5.7692310000000e+06 105 89 -7.4786375000000e+04 106 89 -1.2179482000000e+07 107 89 9.6153820000000e+06 108 89 7.4786312000000e+04 109 89 5.7692280000000e+06 110 89 1.9230760000000e+06 90 90 2.5128206000000e+05 91 90 4.6367419000000e+05 108 90 -8.5449219000000e-04 109 90 7.4786250000000e+04 110 90 7.4786312000000e+04 111 90 -6.2820488000000e+04 112 90 1.0769230000000e+06 91 91 7.5000000000000e+07 108 91 -7.4786312000000e+04 109 91 9.6153800000000e+06 110 91 -1.2179482000000e+07 111 91 -1.5405980000000e+06 112 91 1.4423071000000e+07 92 92 7.5000000000000e+07 93 92 2.6175210000000e+06 94 92 5.7692310000000e+06 95 92 2.8846160000000e+07 113 92 9.6153850000000e+05 93 93 5.0256412000000e+05 94 93 7.0312500000000e-01 95 93 -1.3281250000000e-01 96 93 -1.2564106000000e+05 97 93 7.4786375000000e+04 98 93 -2.6175220000000e+06 113 93 7.4786312000000e+04 114 93 -1.2564106000000e+05 115 93 2.6175220000000e+06 116 93 -7.4786375000000e+04 94 94 1.5000000000000e+08 95 94 1.2820510000000e+06 96 94 -7.4786250000000e+04 97 94 1.9230770000000e+06 98 94 5.7692310000000e+06 113 94 -1.2179488000000e+07 114 94 -2.6175220000000e+06 115 94 2.8846160000000e+07 116 94 5.7692320000000e+06 95 95 1.5000000000000e+08 96 95 2.6175220000000e+06 97 95 5.7692320000000e+06 98 95 2.8846160000000e+07 113 95 9.6153840000000e+06 114 95 7.4786250000000e+04 115 95 5.7692320000000e+06 116 95 1.9230770000000e+06 96 96 5.0256412000000e+05 97 96 2.8906250000000e-01 98 96 3.9843750000000e-01 99 96 -1.2564100000000e+05 100 96 7.4786375000000e+04 101 96 -2.6175210000000e+06 114 96 2.4414062000000e-04 115 96 7.4786250000000e+04 116 96 7.4786375000000e+04 117 96 -1.2564100000000e+05 118 96 2.6175210000000e+06 119 96 -7.4786312000000e+04 97 97 1.5000000000000e+08 98 97 1.2820510000000e+06 99 97 -7.4786312000000e+04 100 97 1.9230770000000e+06 101 97 5.7692300000000e+06 114 97 -7.4786437000000e+04 115 97 9.6153870000000e+06 116 97 -1.2179488000000e+07 117 97 -2.6175210000000e+06 118 97 2.8846160000000e+07 119 97 5.7692310000000e+06 98 98 1.5000000000000e+08 99 98 2.6175210000000e+06 100 98 5.7692310000000e+06 101 98 2.8846144000000e+07 114 98 -7.4786250000000e+04 115 98 -1.2179491000000e+07 116 98 9.6153850000000e+06 117 98 7.4786312000000e+04 118 98 5.7692310000000e+06 119 98 1.9230770000000e+06 99 99 5.0256412000000e+05 100 99 2.5000000000000e-01 101 99 -2.7343750000000e-01 102 99 -1.2564100000000e+05 103 99 7.4786187000000e+04 104 99 -2.6175210000000e+06 117 99 3.6621094000000e-04 118 99 7.4786500000000e+04 119 99 7.4786187000000e+04 120 99 -1.2564100000000e+05 121 99 2.6175210000000e+06 122 99 -7.4786187000000e+04 100 100 1.5000000000000e+08 101 100 1.2820520000000e+06 102 100 -7.4786437000000e+04 103 100 1.9230780000000e+06 104 100 5.7692310000000e+06 117 100 -7.4786250000000e+04 118 100 9.6153880000000e+06 119 100 -1.2179493000000e+07 120 100 -2.6175220000000e+06 121 100 2.8846160000000e+07 122 100 5.7692310000000e+06 101 101 1.5000000000000e+08 102 101 2.6175220000000e+06 103 101 5.7692320000000e+06 104 101 2.8846160000000e+07 117 101 -7.4786437000000e+04 118 101 -1.2179487000000e+07 119 101 9.6153850000000e+06 120 101 7.4786437000000e+04 121 101 5.7692310000000e+06 122 101 1.9230770000000e+06 102 102 5.0256412000000e+05 103 102 -1.5234375000000e+00 104 102 -7.8125000000000e-02 105 102 -1.2564100000000e+05 106 102 7.4786250000000e+04 107 102 -2.6175210000000e+06 120 102 -8.5449219000000e-04 121 102 7.4786312000000e+04 122 102 7.4786312000000e+04 123 102 -1.2564100000000e+05 124 102 2.6175200000000e+06 125 102 -7.4786250000000e+04 103 103 1.5000000000000e+08 104 103 1.2820520000000e+06 105 103 -7.4786437000000e+04 106 103 1.9230770000000e+06 107 103 5.7692300000000e+06 120 103 -7.4786312000000e+04 121 103 9.6153820000000e+06 122 103 -1.2179484000000e+07 123 103 -2.6175200000000e+06 124 103 2.8846144000000e+07 125 103 5.7692280000000e+06 104 104 1.5000000000000e+08 105 104 2.6175210000000e+06 106 104 5.7692300000000e+06 107 104 2.8846144000000e+07 120 104 -7.4786312000000e+04 121 104 -1.2179484000000e+07 122 104 9.6153820000000e+06 123 104 7.4786312000000e+04 124 104 5.7692300000000e+06 125 104 1.9230760000000e+06 105 105 5.0256419000000e+05 106 105 9.4531250000000e-01 107 105 -1.0156250000000e+00 108 105 -1.2564106000000e+05 109 105 7.4786625000000e+04 110 105 -2.6175230000000e+06 123 105 -1.2207031000000e-04 124 105 7.4786312000000e+04 125 105 7.4786250000000e+04 126 105 -1.2564106000000e+05 127 105 2.6175230000000e+06 128 105 -7.4786625000000e+04 106 106 1.5000002000000e+08 107 106 1.2820510000000e+06 108 106 -7.4786062000000e+04 109 106 1.9230780000000e+06 110 106 5.7692330000000e+06 123 106 -7.4786312000000e+04 124 106 9.6153820000000e+06 125 106 -1.2179482000000e+07 126 106 -2.6175220000000e+06 127 106 2.8846160000000e+07 128 106 5.7692340000000e+06 107 107 1.5000002000000e+08 108 107 2.6175220000000e+06 109 107 5.7692350000000e+06 110 107 2.8846160000000e+07 123 107 -7.4786250000000e+04 124 107 -1.2179482000000e+07 125 107 9.6153790000000e+06 126 107 7.4786062000000e+04 127 107 5.7692330000000e+06 128 107 1.9230780000000e+06 108 108 5.0256425000000e+05 109 108 4.2109375000000e+00 110 108 1.6250000000000e+00 111 108 -1.2564100000000e+05 112 108 7.4786500000000e+04 127 108 7.4786687000000e+04 128 108 7.4786250000000e+04 129 108 -1.2564119000000e+05 130 108 2.6175240000000e+06 131 108 -7.4786125000000e+04 109 109 1.5000006000000e+08 110 109 1.2820520000000e+06 111 109 -7.4786187000000e+04 112 109 1.9230770000000e+06 126 109 -7.4786250000000e+04 127 109 9.6154010000000e+06 128 109 -1.2179514000000e+07 129 109 -2.6175250000000e+06 130 109 2.8846192000000e+07 131 109 5.7692380000000e+06 110 110 1.5000005000000e+08 111 110 2.6175210000000e+06 112 110 5.7692320000000e+06 126 110 -7.4786687000000e+04 127 110 -1.2179502000000e+07 128 110 9.6154010000000e+06 129 110 7.4786687000000e+04 130 110 5.7692390000000e+06 131 110 1.9230790000000e+06 111 111 2.5128194000000e+05 112 111 4.6367419000000e+05 129 111 9.7656250000000e-04 130 111 7.4785812000000e+04 131 111 7.4786750000000e+04 132 111 -6.2820441000000e+04 133 111 1.0769220000000e+06 112 112 7.4999952000000e+07 129 112 -7.4786750000000e+04 130 112 9.6153810000000e+06 131 112 -1.2179472000000e+07 132 112 -1.5405970000000e+06 133 112 1.4423061000000e+07 113 113 7.5000000000000e+07 114 113 2.6175220000000e+06 115 113 5.7692310000000e+06 116 113 2.8846160000000e+07 134 113 9.6153850000000e+05 114 114 5.0256419000000e+05 115 114 -4.6875000000000e-02 116 114 -2.1093750000000e-01 117 114 -1.2564106000000e+05 118 114 7.4786375000000e+04 119 114 -2.6175220000000e+06 134 114 7.4786312000000e+04 135 114 -1.2564106000000e+05 136 114 -7.4786375000000e+04 115 115 1.5000002000000e+08 116 115 1.2820510000000e+06 117 115 -7.4786312000000e+04 118 115 1.9230770000000e+06 119 115 5.7692310000000e+06 134 115 -1.2179488000000e+07 135 115 -2.6175220000000e+06 136 115 5.7692320000000e+06 116 116 1.5000002000000e+08 117 116 2.6175220000000e+06 118 116 5.7692320000000e+06 119 116 2.8846160000000e+07 134 116 9.6153840000000e+06 135 116 7.4786250000000e+04 136 116 1.9230770000000e+06 117 117 5.0256419000000e+05 118 117 7.8125000000000e-03 119 117 -1.4843750000000e-01 120 117 -1.2564106000000e+05 121 117 7.4786312000000e+04 122 117 -2.6175220000000e+06 135 117 2.4414062000000e-04 136 117 7.4786375000000e+04 137 117 -1.2564100000000e+05 138 117 -7.4786312000000e+04 118 118 1.5000002000000e+08 119 118 1.2820510000000e+06 120 118 -7.4786437000000e+04 121 118 1.9230770000000e+06 122 118 5.7692310000000e+06 135 118 -7.4786437000000e+04 136 118 -1.2179488000000e+07 137 118 -2.6175210000000e+06 138 118 5.7692310000000e+06 119 119 1.5000002000000e+08 120 119 2.6175220000000e+06 121 119 5.7692310000000e+06 122 119 2.8846160000000e+07 135 119 -7.4786250000000e+04 136 119 9.6153850000000e+06 137 119 7.4786312000000e+04 138 119 1.9230770000000e+06 120 120 5.0256412000000e+05 121 120 2.3437500000000e-02 122 120 2.8125000000000e-01 123 120 -1.2564106000000e+05 124 120 7.4786500000000e+04 125 120 -2.6175220000000e+06 137 120 2.4414062000000e-04 138 120 7.4786375000000e+04 139 120 -1.2564100000000e+05 140 120 -7.4786500000000e+04 121 121 1.5000000000000e+08 122 121 1.2820510000000e+06 123 121 -7.4786187000000e+04 124 121 1.9230770000000e+06 125 121 5.7692310000000e+06 137 121 -7.4786437000000e+04 138 121 -1.2179482000000e+07 139 121 -2.6175210000000e+06 140 121 5.7692320000000e+06 122 122 1.5000002000000e+08 123 122 2.6175210000000e+06 124 122 5.7692320000000e+06 125 122 2.8846160000000e+07 137 122 -7.4786125000000e+04 138 122 9.6153810000000e+06 139 122 7.4786187000000e+04 140 122 1.9230770000000e+06 123 123 5.0256400000000e+05 124 123 1.1640625000000e+00 125 123 1.3359375000000e+00 126 123 -1.2564100000000e+05 127 123 7.4786312000000e+04 128 123 -2.6175200000000e+06 139 123 9.7656250000000e-04 140 123 7.4786375000000e+04 141 123 -1.2564100000000e+05 142 123 -7.4786187000000e+04 124 124 1.4999998000000e+08 125 124 1.2820510000000e+06 126 124 -7.4786312000000e+04 127 124 1.9230760000000e+06 128 124 5.7692280000000e+06 139 124 -7.4786375000000e+04 140 124 -1.2179494000000e+07 141 124 -2.6175220000000e+06 142 124 5.7692310000000e+06 125 125 1.4999998000000e+08 126 125 2.6175200000000e+06 127 125 5.7692280000000e+06 128 125 2.8846144000000e+07 139 125 -7.4786312000000e+04 140 125 9.6153890000000e+06 141 125 7.4786500000000e+04 142 125 1.9230770000000e+06 126 126 5.0256406000000e+05 127 126 -3.1093750000000e+00 128 126 -2.7187500000000e+00 129 126 -1.2564106000000e+05 130 126 7.4785812000000e+04 131 126 -2.6175220000000e+06 141 126 -1.2207031000000e-04 142 126 7.4786250000000e+04 143 126 -1.2564094000000e+05 144 126 -7.4786125000000e+04 127 127 1.5000000000000e+08 128 127 1.2820520000000e+06 129 127 -7.4786937000000e+04 130 127 1.9230780000000e+06 131 127 5.7692350000000e+06 141 127 -7.4786312000000e+04 142 127 -1.2179482000000e+07 143 127 -2.6175190000000e+06 144 127 5.7692270000000e+06 128 128 1.5000002000000e+08 129 128 2.6175230000000e+06 130 128 5.7692330000000e+06 131 128 2.8846160000000e+07 141 128 -7.4786250000000e+04 142 128 9.6153790000000e+06 143 128 7.4786375000000e+04 144 128 1.9230750000000e+06 129 129 5.0256425000000e+05 130 129 -3.5390625000000e+00 131 129 1.3046875000000e+00 132 129 -1.2564100000000e+05 133 129 7.4786562000000e+04 143 129 7.3242187000000e-04 144 129 7.4786250000000e+04 145 129 -1.2564100000000e+05 146 129 -7.4786562000000e+04 130 130 1.5000005000000e+08 131 130 1.2820500000000e+06 132 130 -7.4786062000000e+04 133 130 1.9230760000000e+06 143 130 -7.4786250000000e+04 144 130 -1.2179474000000e+07 145 130 -2.6175200000000e+06 146 130 5.7692300000000e+06 131 131 1.5000000000000e+08 132 131 2.6175200000000e+06 133 131 5.7692300000000e+06 143 131 -7.4786250000000e+04 144 131 9.6153740000000e+06 145 131 7.4786000000000e+04 146 131 1.9230760000000e+06 132 132 2.5128200000000e+05 133 132 4.6367700000000e+05 145 132 9.7656250000000e-04 146 132 7.4786375000000e+04 147 132 -6.2820547000000e+04 133 133 7.4999984000000e+07 145 133 -7.4786375000000e+04 146 133 -1.2179494000000e+07 147 133 -1.5405990000000e+06 134 134 4.4230768000000e+07 135 134 1.5405980000000e+06 136 134 1.4423078000000e+07 135 135 2.5128206000000e+05 136 135 -4.6367525000000e+05 137 135 -6.2820520000000e+04 138 135 -1.0769230000000e+06 136 136 7.5000000000000e+07 137 136 1.5405980000000e+06 138 136 1.4423078000000e+07 137 137 2.5128206000000e+05 138 137 -4.6367462000000e+05 139 137 -6.2820488000000e+04 140 137 -1.0769230000000e+06 138 138 7.4999984000000e+07 139 138 1.5405980000000e+06 140 138 1.4423071000000e+07 139 139 2.5128206000000e+05 140 139 -4.6367625000000e+05 141 139 -6.2820543000000e+04 142 139 -1.0769240000000e+06 140 140 7.5000016000000e+07 141 140 1.5405990000000e+06 142 140 1.4423084000000e+07 141 141 2.5128206000000e+05 142 141 -4.6367419000000e+05 143 141 -6.2820488000000e+04 144 141 -1.0769230000000e+06 142 142 7.5000000000000e+07 143 142 1.5405980000000e+06 144 142 1.4423071000000e+07 143 143 2.5128187000000e+05 144 143 -4.6367400000000e+05 145 143 -6.2820441000000e+04 146 143 -1.0769220000000e+06 144 144 7.4999936000000e+07 145 144 1.5405970000000e+06 146 144 1.4423061000000e+07 145 145 2.5128200000000e+05 146 145 -4.6367694000000e+05 147 145 -6.2820543000000e+04 146 146 7.4999984000000e+07 147 146 1.5405990000000e+06 147 147 1.2564106000000e+05 Matrix/inst/external/CAex_slots.rda0000644000176200001440000000321010464427703017054 0ustar liggesuserskXi:P I$9)PɤR%+l$eqQE(.j)PH'9r_w~uz};9@Y2~SsG_7EZ(x񸟫_m lk AcQod EH CNH !g-j8rA8@&2A5DHBnH""34CHtrGXI?B4Y#$B6h2F#}pkI:u Ѐ߃s0`=?.cs>h*Gh6 B(-BKP8@+*C(%$3@P ڇtteLNlt")GW5TQ HEkT͚~),? 3&vnX=z;HD_ߋ4s`yVw #/8h28hwdA=@'8I7,惽`FiKSQHrک7䑎̺.:n~?#a0Lޣ9P[hmͽu+p5z^lV=O´ּы-vh8,Xu+m0u`ˍ?pt$0Mg)* aJ]8!S?A⍟ƮyeJe'|[SUV8ڵe,XEtS.jtL8w57ulsEu#=:sbCI{l73(7zQ,Zr؉]1V<*ߎ7ܰBG>T9>nZurÊծ [)7vmeIwC(7 f{sC [kZұrJ_Nˬ Z]k)N(7DM) D_Ga"֍z5kSnXygPS`Q50rnX VK UKܰ2hזB͠O 3Iv#lj1T-&SnX빬owfHa'4A2kܸfŌ4Nhx^faYMatJٞ; N}CaE'J0&o(7Lqru,0a{c- 冽g~= y*^QPnlEx |srd' J^jSPn,Aկ ?2M}Ca^kRPnlX|9 0 4jQPn|}A7&SSk99ދrM>7nLɍsZ7$1=rӝOo(7L%|p7I T)N{+ s1 Matrix/inst/external/USCounties_slots.rda0000644000176200001440000007321310770571602020305 0ustar liggesusers},=On!&@$ <[p@[m՛oUWW̬/FQ9t% Ր+.1*jIΧa"6)[8*1rYP]ռ߮$#/x{Ȼwu =^I18ȣB}Q,LPk9ڗ ~<>uK$(mY|m/u|)ӓ+yEs:z#r' 6M#+"]+"ö:y?`GVvS>tէ^G Ę P.18BB#M%f~#NKowy.4ab6Cy!?C>^~9_̒ƉY1x!KLg= ye)^'\_ qQbQ_KKyG%V\Rlsl\[̦,^Z_%XڔcIKUk1u=$ZzLkPV؉yxɻ&ۼWe=Rw /jebw5)ŲJr:Nobb6,'a|O`O?!q)K捠w77K IHWb/˵dRqMbwx1NbON̂WB@,=bzM_~7lړ؟Gx_xH;.#CmdڼAǁNμrǘ8m=e13c{t ą ^D3xO>kOy`w^]aPOYϼsS&}9nCނ `*Xb1q(徎zZٳXϿԋx"q6v]##$Kb؈`<s\Gr8ۅ%x%qޤyzp8mQ$9חg]϶ODЕxulStr*y Ǩ?YLR)ƞ=3OkMذء=>?_&~WcYȁج{/;BlYŞ/Uu /׉׉Lr-}|c];ዘ/>Mw>]Y}8pajlGllXlqΟahhdlETUCʟMS-Oщ_~H},)냔S|'bgԩg3w,$$a1ke4*%N{ݠ~\<1+MP^>HYkO^Ϭ\«I^Ιog6~ƙ.ђے{0*(Oow 1Wq\r߈'+1b$bCϒ듫,45XUra \e%1_Rfy]m:\Mxˋ?f]{sk9\i?%{{)Թ딲\~L-b,/va{:َ/Lٷbg'.pr۲ϣM8`JESy][v"_ޞ^1I"&OnF,v`_F;Yëg_o1b ܃299m{|L~{ zXK;"~t-yE ֥KcuvicֱaGb&XDV$Ls8!I& [QfF~!iԱXjfY?zݚv`NaLbHblLG9GDؖ8DܒĸD X<|Og0A뿌]I9YןV"򹊲9z\H~z|$N6aEk{uqwKK]w{ŷ ^Q]k-rv;y oɇ`umԱQ?AG_X^=l{r򈭒!Nc36-r"Ƨy:;em KgXXz=?;Yd}>!>OFL\߹"b䳔Ip|xg]zm<=zO3&Kw;~BܙyYw*#bVė!FM%kG<|Āc[SCmhR]-88%1Z;|MO}z.#=SW1榳^/ȜX, |]O=E:iM= Qgȴ{C-q=g]N?]x FZ=Ӵlt@z2u1pOQg_uKJX#փyOp1uZ~Kc%߈?Ә3C'|&mYR_M|1ye]2j䱴Յ<2Wc)~r]${qli˺<ڠ/B^k, oI{-ݩ;.n](ԳZ1Ʀ&Nk3jӥm<0F˦#n{2:%^'Oˆ{\u9]I{7'i{z-uu+Yf wimJ]9qCcJz?4}x<&yg++d~kuy MbBJ=q̧҇zO`{-{9Gl^K۴1}>¦ ckr5}:KIceZZl {nq\qV`qhqat3ϳ^Q̹kiĤiĚiYGXM%Vø$k+Aõ1}=ӯ1u*濌en&t)@4ƌ]w1Va._ͺe ݻ~/yJn'vKf0n?"ߍ~r>sw9׆xd8~XAY%ƹ bb|a=3l,^ >U^YNHvԱ 'ü.u;_~L^[Kl˳ś1fgu1Õ)]ޓIʃ/3W43wM"-adg#.D=>-b,(g%#3:i),2v̬Nf؂<2KSco #,|O8"e'K.yوƴ^AY+2ۺ "yGoըc?^[Vڶlڹg梎k50Z=!O+P"t?;D6m{Ư23ۣg2,ĕ`Q^]F$mێ<$^;2]:ynn[ޔ weeB93gxq2-l,'G{2S,]m;$#F̖,3Kܶ+ycfО` ume0،o@|!K;aڵ7lF0[w%;KL|^Vi㦖u=OnG0eܟ6e!1OObt ~fehA9ޓɾqk1ށE?N GrLn}G[{6Bx߅+s@~Q#\"~ `N.<*Oh6,/ene224sl^G\2mkxwdJ9gĹW뭲_r%mqf5#󼇭AyfdE{3W3/Y;{m=:0ϱA|yu^um%u(F|KϞg^7S_יwt0a[ټػ-^"t|{?^ d>:}Rt1۳Wj3}Gv^L'w-_\KDϣ hGO7g3QgAٔg7Snνr/o~ inףل+ܶCkr%}_x~+9NJh_Fc'wUlofwc5dضf+6I0ExײAά rgg1f7bӘ>afǘ?f1|`ym5fw鈿s++簉˔}sF3l^^.+!t.i[l9ʚ$kdo䘽˔yNg'O}o7{1s-M>ļ˲G=~Oxe$?Wq{Ҟe>8Ҽc%{"̾z|/Y뒞EELg%io2c"Li_X#&.yauk/?g!2{=!GryPTu\0 1u9׹A]g]=|7̃ri0A[ʍ`_*#-7μ^YxiB>fI[ o9e=<=m,|d+I!F(/bĩ6&LE-Qe}Rn!꧟(^FY-&f,9cCNGR?Ƨb2<^ݞY;~w,u;w2M~#N˝ubxcգN[^V'FǃND{%8"I܇9oۓX/+"&!!!]jf״~by~%\k7bܟ49L+t =M޿m,W kswz^7yzt6t1"gMOr<;8.Rޗ1yb*󼢔A|5'eOd˝voIb˼.u[g{o8 )&0?!!>OR.Y[wiD=>SsyD%7YW e^(rA|mg6Oxgʲ+rK{XVλyH>oui0vX~)#yLk\+P_'/Z[26/_^ߦK~הu|:72?7o#,2=֦sʢ XZ^;І߇<O>km  Ɍ8 L_'M6!o3c]0ɽ!5y]~[ܓ}ϓe9{-;^u=1mX@,ߒ2msW~gY;`݊ v yoPVti u&zl?1ْ^>umyw߂eXʷ]'m{[_9F~3qyy><9GܬkGe KNy',+,~c?a{dsv+f<d^Ўy̧1~<~˜#m0iSP>Ke>"q)oe]P[/%ϬΉVo)1^ y6O!i2u!53'SlZ!ө^x-YffJ5s B ԽӼUM%fwM'w=|lqnaz|(K3K?esbP@(lߗ cRYݷSUw~!osf0=02O?߳o<s!@K~[KA8k#n,4lZaܢ0ofeyٳM9(!EI.VƯyda~::.1}^a@[++uGAa ֍Xur18u{6;Sgʳ e²V2L[ڦ;;0 ^[:p:V vnB6=(u';/hy(sŨId2rήf\2OLszCšxi ?`%w۬3`-M]ᱜ0x坟8JWr5X-kIb['d ]X^6GeDt/`Sږ-l4#dAGZ@Yݨv̏]#*~ߖy=A{Q#;oMݛ2rt,uݟʴ: RϾy Q&OCw,۷ Gq ?dwޏ1ޔwӮ3G+{xf~^~#m[Qތl'PW@xU؇uI=G|SqW}wuM7v Qؽg 2Fwg6~DXY{*ake3B‰kg穴؞<ŤcQ83j6=N؎iQ66gt>}a<3"jeጨA$ 暅ChQ>){6o7ŸyMƵ 䵗A<FI+/ -\L{gki{ؒ m32O_b.\82tUJd ➂p3d/mBX-0o+`SDA{ͼWB9- kd~ >k:nb9,h0)`.XYs3u< /Ŭ}8>Sܦp'!>i#o1]bl준yKeY ۶ k[YdM2 ^!oGy+<2f?2WO,&23mJzb[\;>r5ͽbQFPO1CE^oY~vi?ߓ:]y]BekźՃë_e }CL0*|E<`T%a1߱3SNaJal)|ѓ`PU8k@RwUx>[8'ՠLyGVDl\O>آnb7c)9غQ3utou16Oq1VRwq {B*.no_N;Y%Opzacbyi>"&b;8k1&:/'<>c!Nv FN^/IQۧ^:>M"rʺپ"bl;DVeqg{%k9?>(1ť;0x2_\ (Cw%5 )6̊Ul_)9TQkO}|{Q]M.оe?GiI<`ͩe=)˄}o!cKі$NNёK+bnUͿO~ ;`E_pY;2'$ӷ_v3]bUKhٻ+bSڻGRǏ@?`l=+`m7+[1W*JM"wqQGY/78")biߖkXht~TD]܏vY?ދoC/llBӷ|Q-kSLwd-D~mc1mv;2P7`}ag޽=MⲶmFҶCN<[1}K^V'2v~%v+b?h@;=_DWZƺ[)ӲVQ[_'H"khwbˋ㴁٭΋|'<Zu>n`""X~~ 脨=$o [\^ۏC;E F3[R>}O)/.uF؈;ֶWXȳc_s0~3WM|饙1}$siSGlE3x#cՈd\mǟEQ|y2["pųy݉֊''xM13<^yB{DۓE\GyC.䛒&zG,t`=/dK+wumc滖_[{~j6u[::ne7Tmum7l7:m#v]'/Xba0rr\wfWw00ɺYW YSٺJ'?!\+-oVtʋN%{e}P%ћ\$1y)elwsnxlfOf]d_>޻6m1k+5~h1(mFS4QF4szz8~@Vn)S)b<-=|A/yr`L. } J]H/ؤ5,k0iQy u&::y^~N[K)Lm*Sw<|,21re;sKfU¸W^J=܅ǜؑǮ~eq4u!+~B 6,M˛6/h1(-չ41ճ9HZ3v.7ؔ) iCܤ E[N)mal՝>"GG}<d:KK%̗Jkv:R%Xf'#&)!m!>,=_Wk/;;&~6t :Od[GͲGo5YǯY}X^7h7bp2xnYM;wuƲ{NNS:i[^`4G:;lۆ)b>x* s-[)yJ?X^?׍&|^ q~XI,֏%L^Ky 'kS˜Eߕf?w})]\ηy_'%{agߖi1wמӬFƄ_ٗ*T+G~.b]a+Z(.`"^@lNaڅ^~(]ѩ o[W,oӴ3tJ_t[c u-[mzH{%nXSUt(]as/uRlNtgY[0 1x3))xH'}ge,R'Mx1+' 39W]g3o2dplfiɜXvە{OIt/}Ⱦq\㵺~ʡ7u&yIe !oL ?f=w噧 Gٮ=yk2߿2<u;qu3oiJae}>+[:ʳEῄdĠ%t]p;w'š rZy/=v̷8|} 6шGĨ}o7hi&,|c.^y}̷wB?;ǵa =ol@B_1B1E144FIb^-3gNm`&**֩#}d|T#y=LЋtc¸c%HE_Dg,elMI.~'ަ$g ߏwço§oAVds9B/曆#AAݏ-AW\wlO?hoEHAbNhv|MPB;kGEE=Iз&ک$A 2;~))7o̷.!%yl|o|>< o 8p||O| z4(B?4ߓ̷0^oɞ5M=w'|/Hqxg;۽p/'@d1|e9ޛDjse~?4߄A?2Ɯ=~uKTmמҧEz|42-F7 $nG,]wcsvw=ΰS$ڸКueٷ1+YHo_1x`Osdߕ L̻uNnئy5p1XwT -s.nө E`M*Ⱦ/ZӼfposԧH_Oo]!杰2ǁ̻J0d`=I]I杷gKk fw"bܖwfks cM!_Gy:6\ƣYذyO$'2 }wA{w2ă~{נ6جyC:ɞnݲЇy5~Hxt+6nW$d<#vG7ͻ0_c~0 ~*'"{e;X|W9#,H r@CYx qjN1yRQD=,'; OռcGryٓ,iO{eߪywC9lރ!On'A>s`H{5rcj 4ͻw(84;dY<;d 4$\?K󬼬3;]y fSE3yЗ}!3}AlR$F<$ٛqO7ϓIItψ)"Ϝ!{?aTG {耱oٗ-{e le}>b ]8?j._=jsWvÐ= =A0|ǑrSy^QE9&_6,= r?HɺG77&侗sK${Kg*{̷̞">EHj~ٗ ?ny 7{G>/H>=!Ї }E$Ec>@@>ٟb=}`s}/-kS.,&eH=ar?oWɽ?%QJ| ~%`P%]^'3ڛ /{(例ܳ{V*VK ~X?lָd_ֳO"Y5nY5Evm1YGaֹ[Y[kcs =u&$kٵ|E%oiЮy[.L[-N˲q8 {,˺0./lx ;,˲[,ʰ2tQ-8WƜد 6YF<\]a=H?S $ {-^˿Wt"Q$ R=2|LESIsH_TF|S2A:-Ce6ee| s2Dz.#,_7ʈW_?[]e!e2Ɛ224eYxх1 AX}. eڅ҅ k!K.. ꂎwtt4˻#@8޵ }kwEa\|MӅVUtttO8uA/]Gi$. z_}tuA]W0>tA]At0Nwou.]#uBL؅إ 8w!nBO `\AlRA`|Wq}>S_Wg*' RqiS6'T+O*' IXW' TuVG*V?`_\A?T*VA ExW* \Wkv^W``ZAS<<q6\[V* b WUgquS\U*{co6[VecdZVaUiUU_xU!ۑKTwTOu0**IT`U*&WxUC*l ܪ *|}1b ܪU*&**b*첊إ ,U*l9KqdYUfxVUh3ݘt#/ ;ݰ {7nh7|A7nh7vWwn_7Xuc< u#6h7ލvw^uh_7֍uF1ucF\֍yB{nOI&_k8mA[{_`ۃ~փv=Zϧ$WWU/ Ջ~ E[{=C/ދv֋N#zE/b^7zaszas藽eHˑkDZz{acy/p]ًs^-Oz+{{{{1{awzac,&C:t v׋@/|^/Ɗ^\/|@U$_/|_/t{G7`^.t ы1p/Ɨ^YƗ^^Ezau:v]QzCu袎_AY_[h:CguK+:lzCOuꈏ#Oڐ֡:F}sN}x1_m}~SG

    T_1ա:Y_G#OGg:Cu};S}7u:SG_C/uu}>CzN0V-=Z#>>z胟>>z>`sIƾ>`ۇxx!}X!CЇ~,eNFn}}E}>vlcB`}z_ՇXE }o)}}?>}+3Cgg'OO~1D?~}~a|V?X~~ԏح~~`Ǹُqڏ9^???i?ƾ~f?ƹ~ڏ>T?b~~a?b~ OBz#ՏmbwAF?|? sma~e 7ƽ6OBoqlzf>s7}0- ^t }ls9m.пpn6`n `7ЇUG inЀ_EH$404 +i> 1i~o@@|hyc{|iؗ6?#cH O |j>Ҁ_m4[c4bƕ   Ħ Kh j Nm4? Dxx@Հ/-Bϣ(8 1 ]BGGF(]txQĚF(ơQ7gQ`6~0}xbE> ; F(((O.csQĚ`}bEGF_ݣh} 6;cc1lk mC팡ch16=sla >r Ц1~ }| :О1xcht;=Achƈ1a l ~l AocM~ڄcM&{M&Dj ͹IЦ&MD_i}M&zlMD_hBMŚ_cqCvބޚ[mlMM 55&M̷kMvzlMyƇ&l LS$&&NH`GI0N4M&C \&m">nKBDhbhҨ?-LDkvZO˜B|Y zhZ/-`BiR ~j쪅r >ӂMgZ7Zpoam!^ka--%-ނOin|H cH \[/-`f-N-ƑpjZ;-Ľ-`Ղ^alm/0[ cM 1J ص] J cO J _K0fgq̍ǁ8xxq8{81>Lx1>0|m8LOx{aǍq8!qZ$`v?ݏC}1\d{:?tG8t2>?~G㈥?O_ïc/3_ߏcG?hq86]CGqc};?1ǁ0zN`Lscp:ۜ]NO fXM$h1p9?8qs1F$}& `8 '`pb| rN ~o1OF/;'0vN b 7xsv?_2?211 '&`os 7&`Ӏ44`6 M-N;: }zj94AiЯoOn0^LNӀ42 41 }{i`44;qmgtƅx~:^%{\i{efoպn\nqo+vq6,~OΧsѥ߼LǬ<&wWն^];Γߤzuswt|.N^-Cu{Ck$;QZO:}rk i,ӏnwHICvʷq'^MU!{sG]_CImq(ݾS!td[[,g'Ofp_kǚGοsw|C?׸9Z?Zm\^ߐrr$$_vUh\ yH>ߴCT9~Oq*58'$~Ƶֶ#Luĵ_O˫>5.q94NOCqj8Jo\qW q#hsyG=y}=PcÕw͓NNw œݮ^w]厮~>둏;>,4}m'Bۭ;WG˥ehN5JZO!pqyN[ yT}hϵs8F۝g-҉ uqrL?~I/'o;ɧNo'=.yֿrN/:PҷύFk\W^q_ˣn{zoɣPA'34'[u|P\n<1Oz)</<uMӖ*Nи P|g<^pw^rG7}hlÃk~U}tVr_WqrG'gh].Qm:^rTOq\tzwq^G~N7y_i; Aߵ׵>٩8qJۛ:iߓ1߸xKnvмYۇwh?_;y9Nτ/U]w~U+~ߖ[us(}1nfR|i=jz~wC/eS}CB 5qG;;uGk`'Ou>ݹ_yDh~7Bߴyth 3Bq7K^qv~Rкr( ʇ'wj?ߠq?nqSzT}h%4؇1>5:>C6t_JB _C.n}_A#4^t<w=[ˡ}1z[?n էOcrqܡЍ:~UǛ=}j!BVxBQ=/ ݷ{qz]oǸ}5q5qACv2}'q'tzbh܎'ǁq;nJ۟r=w^׊/ 5[ ; 5dRtx8;&4._q,Ws}rq:~S5x_w~-B?wIԸ}!?磓8ZW7CshouvSMzh?ohiz\ymq|s:~hhߡ^xCZ(ɡ}vh7ƭCi'ွw}GZz<\wンP<:JS=]['q Ow ko)ԟ:PkyBOsaqg[hꧡC oIL1^BrpBAJum=kzvzߏήܡq G(dߡCNރߏ󐪧3^_jOH]`j>i ͅPܬ7}[rsO{h#BSG/qMu]y@A;Lڗ oCgU߉о2W.}C{cռIsSgup ww=zv=q5^__[珩qBCgu⣟ ţqwCݞ`K:;Oϗu\zv!|IzUC\珓/v=^}䯺яvgn^ g~[7;k14ǝi}~zOׯ~hX>~ޜ ==9Bu=.n\U/OGbuh;I^:f z=NcHq+[w}'4GL=S]N92>I=~➃׭&//H_t{Bϻ=ZlCTwch}<. o1#u=\./8?^+ޱ~Pyܸ4UŽn?}A'Ouqv1v=ZOyZpqG^mz<~jo!Bz.n|`~u딺|p '=?3PǍ[q<-4$.㈋CqTCGjy|Z\;>}_qGyC\KBTW뺥9~J({Bz>Eyn~Bb٩8oOu'ƽMǍqvS==ƭLu}$n[߸uIk%?&n$4NAzghH[ w10Ԕ׏z y7~7kqr١>4;řQC9Nb^qdh 1=/O;&3)wg_cz__r*q5nVg8fv{G}\'Wgh?'BCW:_m7^_G~ISۗ~/.W軦EtpN_OǫZql{١uu^U; unۇU=uMravyz߼],=}Bq뵁 ݟxcw:~>8?g4`/4)qw׮2hҺt!yB|:Y/V7Z o+敺ŽaҼ(6i~4ygz]#=tS}ڎB>קB*߅_M47Bq{q;^\; CϕIvx>m}cܺI}mq&׍9RXwGe:%֯~=Vƴ|:>=w 7^wyr/?{coq_?al#_XqzqpN}N|է5yu8Τ~;vi? =O/_i=CS#~NWOBrG= Gv:;}?0Lz(0tѸs3_VwjlRoG'y{hJoz'n^ˍj}AĽO4.8;1w?0<7C.ڟyB>|MG~Jic?K<Nf>=;eywϓl(>1GU{7{v?rϥ_>w +B|'t6byGPzfLg7NGW>kw߼"l>?=kyMl3?+zޟj8%Xyf&ך1?iAhZy_6ƯN2Y1{ۼ%pF=xW[Mޤޏz|uQN&J6O( SxXslL>Ӿ1dGqM_8FOfWO;eu Z^ho- 3G~~?7l[ĵx>n"sח krI>[P30z> 0_Շox/2ʟ2L1oy]8jܟN(c4Q:tozO;m"G_^sԟ{-/80zopIE \ֹ-}H2.h\r`[OkW~:)v:a yOL&͏~xv؟~,z6XD[_go_`4:*8/īLd啙jrfw0/, pVubwœ-ږC|,d8ɭ} }l= G;g19.Cfu_Yf0~ԎS}avZ{k Os+<\ }~6O:5Dqɢ_9.Fw-z/睖7N|C<=^ )G>¦o⼲/Iփ֝:-S-v>gdp ͮE.weݨ嗘dYϽ IƝB/|EOwuۯ~ZB}i֏|sY[ ^/k Ȱ>Ēg-v>G0cÝ_j7]l~8qGJ;}>2ߏaܑ3S~$^a_p'[(W|?=_ pS!by7cH;a]-LW}-٥Kޓі{'GvKz̑|D>ҏѽ~T^oMA-Z\)z'C:G x~J$j?J>WnujhS`7?e/$}|-jr g27xXaمYZ<)4U%ϧi0~cYeی޴||Ym/_q}[Ȗ?v~ߢUϑ>HӼS]/xh~^I,}/br0;t??YoZ%ϫ͏?,n#I: VtFMatrix/inst/external/test3comp.rda0000644000176200001440000001062110463734405016734 0ustar liggesusers{XL7SMM3SMRL(DH%d$%$"$"GŦrcKJR)Jݕ~ح>;9<;5k^ߵg}grwS(F*2h*z:uҥkVQ(tjo;n1"ex P%o:/L v}O\>ZtUo3}-YZ/[~], 1o^y=?xLΘei)].KevӾ{I*?M]-UK:ua//\Im5m9֫yҹ45Ch]V䌒kDcfIwMk APpBb`X(hڋa6Mа=nx{s<3 Ll{\\tN?pNcn?+zbRiBỊ|^raCdw[}w5 :/ vrqb=`ԭm_a]MCe,N٤ЛS^tNbqtky)I47^h~̶UQIS-d cB&niv@t2Hh;bZ n1aԂ[37њC -5d25 4$Gd!TIۀγBj`ymI{%ExoGH8{nGD 7˶cʈfo`o RiǨ>iYI@8C$4<07V{ ,b+O,@-,䘇HT SkH;%_#wyX7#v%0J'_ >N˕ty.n[Q0㪇ȹpVR?p#'4VB[if|-J0dӃ"-{<Lʋ~N@7uű;/rA.;" Բ?Q6fi͟rp~'Wc|zw`-~П DsaZ`au. m_2a 2Xt_+'޻f FjN6Sҹq_M`Hm&3pyVXk_HXOR}GJrwx21{rgNyC}eHg!X һXMB^&୴So1ʀv-{;ֹvFٶp&Xֈl>k Syg sf8zbԭ4,e9X}qąV/USdk^os/┿^;k'aܮDN{r-V Ws.m=c%9ᙩĜ]Tӧ7% fÁSVkTZ'Xb.0&!R8`Zd;QQ؇:]Wz#%: ׿]U'5/Vf"k}xk|'k OEMפ1R/@bE6W7!qCG#vҀG}cog:ؖb-BV^˝}K'NMY Ozђjz ڬ6e9PLqb fkLUVX.Yg+\7w9 NfܯStKφ\E'0WT\hوWnDuŵiV(;rbfmQ|~46yb(֪^T|{["t{$:RsMq@;U4Vgͳ#ioჱ"xK .K ϷmXE7L|mտFFy6i%{֜𔂝 1xЫ̢zld6@!RhZ?VpλXClniO!Uz_!@:yIl6Ķ?s,Gl 26IZnڄWM`>?nr!-Q ו'bXWX\^m9X[&uP,rdLÉOu |gGpۀi> h&Fl unbg\syYFs a//gIggZt@Ga`h9]Ou+|GnU,]j;߼6V8ڊļt>KWTi=m v}=W{=Wv{Koߝ,~>^}\<.&H?5y`}Al%DIN$+")$aHCB0$!! aHCBR0!% )aH CJR0d!# aCF20d!' 9a CNr0!' 9aXaXaXaXaXa(CA P0 a(CAJP0$ %a( CIJP5aX5aX5aX5aX5aXt%dQJFd"J2Ĥ&&51IMLjbRĤ&!5 IHMBjR$&!5 IIMJjRRԤ&%5)IIMJj2RdHMFj2R&'59IMNjrRԾ2uUIoO˫7!Matrix/inst/external/pores_1.mtx0000644000176200001440000001131210275433311016414 0ustar liggesusers%%MatrixMarket matrix coordinate real general 30 30 180 1 1 -9.4810113490000e+02 2 1 -7.1785016460000e+06 3 1 4.7312729960000e+00 4 1 3.5742618540000e+04 11 1 9.4625459920000e+02 12 1 7.1341308750000e+06 1 2 2.3349693090000e+04 2 2 -2.4613410870000e+07 3 2 -3.0051645960000e+03 4 2 1.2934346290000e+07 11 2 -3.6807151210000e+03 12 2 6.1495431850000e+06 1 3 4.7312729960000e+00 2 3 3.5670210950000e+04 3 3 -3.1208606780000e+03 4 3 -3.2500820450000e+06 5 3 1.5522075550000e+01 6 3 1.6287803340000e+04 13 3 3.1044151100000e+03 14 3 3.1914882100000e+06 3 4 2.9953986350000e+04 4 4 -1.0035133800000e+07 5 4 -7.8658863460000e+03 6 4 6.3330904920000e+06 13 4 -5.2284380090000e+03 14 4 -1.1610330070000e+06 3 5 1.5522075550000e+01 4 5 1.5956339430000e+04 5 5 -5.9720828860000e+03 6 5 -1.6395834630000e+06 7 5 2.9661271480000e+01 8 5 8.7000917550000e+03 15 5 5.9322542970000e+03 16 5 1.6097273710000e+06 5 6 1.7473258330000e+04 6 6 -4.1182170880000e+06 7 6 -2.7076007450000e+02 8 6 -7.3466724480000e+04 15 6 -4.0817635000000e+01 16 6 -1.1075258970000e+04 5 7 2.9661271480000e+01 6 7 8.0481454440000e+03 7 7 -5.9475459880000e+03 8 7 -1.3740635160000e+06 9 7 2.9419951740000e+01 10 7 6.7909579670000e+03 17 7 5.8839903490000e+03 18 7 1.3581915900000e+06 7 8 1.1788389530000e+01 8 8 -6.0472270900000e+03 10 8 7.0730320960000e+02 18 8 7.7968763160000e+01 7 9 2.9419951740000e+01 8 9 6.7909579510000e+03 9 9 -5.9713573530000e+03 10 9 -1.3323692060000e+06 19 9 5.9491819500000e+03 20 9 1.3189422360000e+06 9 10 1.8213815350000e+04 10 10 -2.5059847620000e+06 19 10 -2.4969274700000e+02 20 10 -5.5328319620000e+04 1 11 9.4625459920000e+02 2 11 7.1340421910000e+06 11 11 -2.7807437790000e+03 12 11 -7.7182097420000e+06 13 11 4.4060542710000e+00 14 11 1.4480734490000e+03 21 11 1.8358559460000e+03 22 11 5.7572487430000e+05 11 12 2.5797297290000e+04 12 12 -9.2407184210000e+06 13 12 -1.1588958390000e+02 14 12 2.3027380050000e+05 21 12 -6.8657039450000e+02 22 12 7.1253609460000e+05 3 13 3.1044151100000e+03 4 13 3.1912678870000e+06 11 13 4.4060542710000e+00 12 13 1.3807829320000e+03 13 13 -4.7848602210000e+03 14 13 -3.5808334290000e+06 15 13 3.9963378410000e+00 16 13 9.2558550540000e+02 23 13 1.6651407670000e+03 24 13 3.8566062220000e+05 13 14 1.8139423920000e+01 14 14 -8.4585448840000e+03 16 14 1.0738622860000e+02 24 14 2.6158080350000e+02 5 15 5.9322542970000e+03 6 15 1.6096290890000e+06 13 15 3.9963378410000e+00 14 15 9.2558549330000e+02 15 15 -7.6610458140000e+03 16 15 -2.0016469780000e+06 17 15 4.1131980110000e+00 18 15 9.3265571700000e+02 25 15 1.7138325050000e+03 26 15 3.8860654870000e+05 15 16 1.8316189080000e+01 16 16 -8.4066950400000e+03 18 16 1.0674546920000e+02 26 16 8.0723176430000e+01 7 17 5.8839903490000e+03 8 17 1.3581915900000e+06 15 17 4.1131980110000e+00 16 17 9.3265571690000e+02 17 17 -7.6966204670000e+03 18 17 -1.7682272950000e+06 19 17 4.3138675330000e+00 20 17 9.7583624590000e+02 27 17 1.7974448050000e+03 28 17 4.0659843580000e+05 17 18 1.8104876340000e+01 18 18 -8.2868969120000e+03 20 18 1.0561495530000e+02 28 18 5.1700319220000e+01 9 19 5.9491819500000e+03 10 19 1.3182531100000e+06 17 19 4.3138675330000e+00 18 19 9.7583624590000e+02 19 19 -7.8034482760000e+03 20 19 -1.7423949200000e+06 29 19 1.8608642830000e+03 30 19 4.1338216070000e+05 19 20 2.7213686810000e+04 20 20 -3.7862462010000e+06 29 20 -2.7268589770000e+02 30 20 -6.0465513710000e+04 11 21 1.8358559460000e+03 12 21 5.7532622180000e+05 21 21 -1.8730197800000e+03 22 21 -5.8390768360000e+05 23 21 2.5519125110000e+01 24 21 5.8925928100000e+03 21 22 3.0689873960000e+01 22 22 -1.4220855320000e+04 24 22 5.2041902550000e+02 13 23 1.6651407670000e+03 14 23 3.8566062220000e+05 21 23 2.5519125110000e+01 22 23 5.8925927520000e+03 23 23 -1.7282309830000e+03 24 23 -4.0006143080000e+05 25 23 2.5979289500000e+01 26 23 5.8831777310000e+03 23 24 3.1037943720000e+01 24 24 -1.4640445490000e+04 26 24 7.0608811070000e+02 15 25 1.7138325050000e+03 16 25 3.8860654870000e+05 23 25 2.5979289500000e+01 24 25 5.8831777300000e+03 25 25 -1.7785733520000e+03 26 25 -4.0325726390000e+05 27 25 2.7334717910000e+01 28 25 6.1828826750000e+03 25 26 3.0617826380000e+01 26 26 -1.4459345430000e+04 28 26 7.1015603570000e+02 17 27 1.7974448050000e+03 18 27 4.0659843580000e+05 25 27 2.7334717910000e+01 26 27 6.1828826750000e+03 27 27 -1.8647846840000e+03 28 27 -4.2182964720000e+05 29 27 2.8739153910000e+01 30 27 6.5001941810000e+03 27 28 3.0184152090000e+01 28 28 -1.4268956760000e+04 30 28 7.1493041500000e+02 19 29 1.8608642830000e+03 20 29 4.1262902020000e+05 27 29 2.8739153910000e+01 28 29 6.5001941810000e+03 29 29 -1.8714356470000e+03 30 29 -4.3693045430000e+05 29 30 4.4912526670000e+04 30 30 -6.3991790180000e+06 Matrix/inst/external/symW.rda0000644000176200001440000000251012214433704015742 0ustar liggesusersV PTe]ayc\ Dh9B#:?Fc>AN} O$y21F.Ð#6T&iTSE%b**$SOJ5#TjrJ=nBsY$gۃG ! bMKd w@~̞5u,HHб<\>& zqh{dG=]+ eߪ$mgGWZI`ud}/BzE~qbx'PW]tˀW5jp> `GxegO>R~EhX}9T2x]Z>4G5pݾ 0WwP!ylDF Ծw'/dG}(\,6@6lrn 4ku s_RdvfTNf3KZgwr=M< )>~c6ATsv1alSR7Mi7c)bޜѧLij/K)fr Matrix/inst/external/KNex_slots.rda0000644000176200001440000015620010464427703017111 0ustar liggesusers}XT:TFc/c9b{E#슢+v{=* b8$by;̝k3}ft:% "GLolpN]!G|hѶG{_ө+n3 M5~ E{po4 s\hxxߥ='8^K4+<zk4O^4;4\/g=s-Km5Z~h0( \p/^Eh=%J~ Zrxh*9 \+UB5V D_:Z 4셮6ZFh5jAchњ5go{w]zhߣzn Z3x/o؁5Z[x= '6h:R^ 3ZW~ '.hzx ߫yuG 7Z_c>h 븇c hCц C6m$ڏhSO9 m Xxcc&MD suzړIhS~B6gh3pƢfBs{6h:ƫ'mh<Жu.tжvB[`m=BTFݫ.=ulRY up_m=7;*=0m#&-6SJ}->`z‰/hvAۋC"?0U=*U GuOc4U{' D;vZ Y|z0݋Q0^@>X=a0Qh'NB;>TshhahE}v -cmu:520!/*lL% _C> Ld`GTآJD'& X8% 쩰_~S0e`H^dQ&|͓7tc|*:||=D\` @NTF;ȀaK:qC #D( uyˣwaF!谟:6:؈Cau1lG@ g1D@غ§ ⊀X`L >*| _! 3& vdKC*|" * $  *(79*I/qE@[6- &` PZ+{R`O*bU~]WTSOw~O| } N!{*⺊Ǹ~D/!. K@PuqJ@!^I' "SFd`Lƽep )dO*|x& Sb8%`^⛀&2,c}d`HdCuTTM@|@ 5XW1~Vk̻\H@ e}a20"X_@FqMl[dy!2A+iL|u11~v&Þdؓ {SdG'segY>2 ('i2|\)_"9|"' .Ⰰ8, &JaO24g.cme&#>2 b$`Z<(#Ȱ#Snq)ne+/[w lXF̒a{2Q˴OɰMlf0'S'S^;W26yɰ9lIXG,Q/*fe"1B =Sy=P~!g G*NOoG;J؈(/X{~Ph`TvT#ؼ`lW-*a b}gv*lPmW)O*DO؍x/!~Obk|=*^SlK Xo'!^֒ ' ~ *'HqZ@<`'!Is☄#!H|/KoabKc#;ؼ8. bx- @ ~C%/!KX# k*/Jb-!^Kb-!>Kb (<|5>p8 (xOx!zpۖ`SlJ I+ v$v$؃{Pz= XCc0.s  ؑ qF&$4 >MKo -H v.l]mKw +f%ئ`lWBH ^BL%` WB(/ )buM\6$y) =UC [wFA?T` % H> c(?R)\r 3A^HATQA!◄%!Hۗ?HD10"#|D8|P,`C{1 % 8 .a%zuzYV. (/  "⻈$ C/<= "M"ⰈBD~!"ÖE\$"ö{[&u^w<="0 —XKs19 0> "&-"DD BD1dzG~+ L(iW5"P&.c1n)zi[wD_"Q?{'b?dW_9z[ua#"!-R!_Ly|cz"YD."r8*R*0"<9\AM E"V~IX;v`h>ZV H;DD'"'"v" CDbNyѺ"K 1EDlD4lb D$`@"\ 戰cFX=PEVD lP"_쩈*<@_Hq &a/%3mWf*>ѓ"."ǒR^a"|KD~%$⧀'=I]"| "p"5"bH G=H#F(*qwzD' ՓƵ"bx#"(LGO~E\+"1fHy lQ%WEq?1w~@D$6%_C"HĺX_%ʏU_qY$_(/F\WE;"rQCB#"Oytz_ĸDK8 o*⹈{>yI{"(>A`D/#gг,QEQ1"G)GnTC"rz"lG=ϑ@n %>*8?"6PUJ,n)czw} gx`/UJy<ݛJ~*!H+u_XHc$ /H F,!HDO?O%R P/O%C T_W%C ~U[U؆%Y ~]lzϕ$ov%{ UB<$1 VB<$`2^c{+c}j=U=*CE,RWTGY*| KOy3|DN%rSlR)O%Lp*;2VƞXw(eآĹNYvb}U쇊U*q9`TJEk!/2lS  [8za*]%^{bOTW'*@=@L J'HLKS `a$;d؁Ɉ2bLZq2 !{d)#ʈ2 .Ï2| .2rrC&nBgnA_eZZkOd_ndlY*cV b)`. @!ؤ߫`< \K(W1^P Ư T)Y b*[v ~) Q! ` 8%`n `. RA^ F*XsS+)Xk3'lRORzN\( bB5 L)qvPL؉x`_0 F( Q("N* I916 p V*g  bؠ ) ( b;VHׂRzn"E_R_T](EQ9 SAS( 8bTQ\ cWw Q1WR*UPwĜU=PDzX7yQ1n4"HazG⑉[GIմF#D1,BI3tP I tC 1fH醤Ni/VAi9VD:郤FHl0K$1M$ tAI$-4?MBH34? II3胤 i}އ<ɠG|XcGrGZ|!~gizƳ<`6K#tEb`.EiښE:ԚH7BҎRuȠD:AkԄH!G{H!GwH1:hZ8F&K!}C'm"ҍ4%қ ZiVYS-*M!8G/퐆c~H/#r,=tNtCZ,ocI!M8c┉w&mgI!tbH{\BI=; QHC!-tEHKѴ<Azi^AYY@qԽt4⻉s4&@>qaO=oII4hk<4xM$x@  'GII??#8@ oF\S3` # 7p`wY\ q^ciY8,⦀?Eoঈo'~ 'oF|qS"> 7pR9/E3Y\qLg"^ 'n)^8-x,~$?O"7GY|q?gD=!~x!xe,n8d#7L\2o 47N7oII0pIq<C<q=gx?7?q8^87c!N$ \'C< 2čC| ŻD ,ע+ąǢc?qdx?k!N7*ğxQ$^܈Ɖh<ƍo8?$bg]3%~ǛbGRȍ4#I< oىG&_H#L<1q'O<8i ?qK<0ħfI%o+4-q.ij'8)|'ħJY~IZQO}_8#s7"N##g : w?1jc'7īS]ĥWjG8sƉ&N8pʼn'tYYM5ɤGi3FM6iS̀+T/ +? IS 4&fAiA@:՗i&T/E5UTsF5pTFuT7HZ=1S>30tޅδY:#BgK tփu;ΠgvFgt7 TGMj5jyz}fi3Tm IFN1vzvgjaXa8#@g*GF].Q+` 5"t: GqQ(e9M5uF٨sT1j&ՌH .BG-RǨ0BH.B:KcԨ47j*PTɡ7t4IZkU\Ig%UwZXzZfl 32tδzP=Sjjl0۠TK*o8@Lй:@tj9:Bgg3itδYC}=xQfP:pP ,T_Kzz :Q.jZ$֏jڨNM;2zC%TbcPK@=S \NP@T/A5ZՉP- ՊPzP]iꤣS}WP OTA+T[B#ZmՂO;tPePBP]P݀HA"ꩀCMoZRΊj^j.HZɡZC͞]Q R=%Lj-9R]#իR-աR.S2R4OSDw%lOt49E:sHg|UsMt΃Y1:GF5TSNutL;FsZ3G93G8s}3G7s}3Gfmh9fmh9fmh9fmh9iDtH#K[uRrf/jzi!ݗ=YMI3%ߊ%UX׺>`I{tWt_Io%tRCuyJz咞C߷w\I` KI&mXӅ)>P|%M4bMR%bM'E#';F6?mTyH$M٨%B%-t`)٦;J1ƤqZwq%F!7Fu7FI#%-t|3lOi~;T)ϧ:Mקg\7B@gݺZwAցjH$/;?ӜCn>{T_A1eR1`ȎC 1j[>j9^o|R~PLݯ)owR͇VO;TB+TB*'TժP a4f[z78Fj8ؤ ǤmмhݨV3i4vj/A\.3%/3VA19xMMRL&aj^%'Wj(EzZQ ab c}^jꗨFC$/&%3;񼔣_8_W^_H&-tdҐI;&ݘ4c҉!H!ޗt`H!텞kYMh4.!'4kҫItjҨI&-th#ލ8fz蹕4h(>6u Mc~_y$9I$)9SB\\ιs%9JrΕ+9Ws$wrΖ-9[s9[9[s$lI]]ْ%9gKrΖ-γ%8H$͒4IIW$ݐBI$=H#mt9Hk#M3H#݋-ҲH"݊4*ҢHo"$ҎH'"mtF8ZaHW!-=H !Hs }4'ޞyW_YU˪4y(#h䫍s8b⃉%XW3%Gg\dv8~"ȣEq`=/EN1?D=B| #e#[bʉ9{9_陓#y9yYfVUANY!ʘ0mʭ)\eʉ)Xc#)gܐr>(_l1,-CtP16'79=]! ?B P@qb1_(.Q<3V}F5F}7c#>5? e>׽5(kg3~?[z|=ƮsAW=c9qTOgTu=WOL\TJæc|zj=O`L_M06ز 0d?dq G1L&;"&  c3 ~ n V`M0F kl5M&k`c5XM& j}7MOL?L^+1ŸMMMMMShSeS)j<))(SNXkSy))ly))1-"W0ŚbNS6l l"VŽMM)1El4|Laf)f a}0>03333rE3fr>3 h71ͰfXO3` {olç#&cGaSK.a0Cn37hnUnm7; @zX-&X r =X ءcX` , `>Z`%k{ZbΖ=KľY,Z%|%UK>Y".,a{;K&,oY˖ KKvK`6e |ZV'+| oXa`3V Bkϵ½Z!Ya`VVw+غ 6aoWY=yƽa)Xk5g YVso?56j1Xc_5P|w`#0\k5 bblmžm+l"Nl1v[ر-1y-|cg0;vka '0;ثv;; ; vX;;v#;ر;*;;|ݫwe]=={{=8{=a7=>ص>?;U{ت=e=:F`#Upȃ9`l68 q;9#lcwsĞ;;a1fG%GXGV[GTG`pD>|pwq<1G%G{w>9a`kNrV':'` 6A'؆9' 'B'ؘ QN9' w0'l q:?/?V) rӂcAB OX ÖE_E΂zSǻO}iҲ̡&6^SW6晗?g|>nu֎>8?Fuu>5{?>?ucӧvl?>O#;n:gP@On:?)=savq}}),]]:*S?')އ_u=u.{X]ȮC'Cjgwv>~i>§F?Tq8R*OǎS[?Z?}|sŗ?d|nи?ȇϽ>>|>>s_\|K]Z/f:SO5Zs?]גw}T\ޗOn_J'eJ7Tvnj+^OpdOߗ>W/}S\RR<ǭL9D8|p.9}N/FY/s}@Ԡ=9Hbs~r?>ux8tFy9}N9}Ngϯlwa?r#Rlz;£}f_/*;U 51ێkoV,"DnxK7%Oo>UFes4!cK.s {xɳNpdAbU.ڥ+]ͻ?o::o}]"?jC.<kaJKCc%T{sK<9~\ExMz.3+/|~ymS y+[p>ٹ~klXXAyigYԽc<iI_H7b;sm=j%n/q璘*迢< n{Vˋ=;"xڌxꂨq#x|y ]ްQvy9[˅S͞uG,\o8ZYm̷ Ìf7O+{ԴQt|f:.xz)13.gR]kgjỹv>?֝cƟ݄G;,.?Xk%2[QEH-z]v,r+ξ.8ыExͬY#`IvÆ6:ƛUl=ĩ"z_hǎw.ᦓVWe-srعlgWhpI5ؕ[Wns]-J.֎Ùuf%{#NIB{+p_|hzZTUf6ݿYؽ~Y7Eu_Źw}&K_zo}C9xbJ7~#;m7<ж/ٶ>5A`Qd,ͣ,G/w 2}#u}/ŽF%F󀄾b6Z[NխZ:u>,ZA-ɓ dR£N.gvdZ2^ٕ>O_'oQ1Oj_fT嶴5iQeYc;߭q+}ѬVDzw孝"VשssKnJZ7]g?-cܘR)h ,F8Qij4ѽ2b O[^!Zm~ժbIzyعO *l\l݁_ΩQPο`vء[Wݮ6.Zz;{'߷sV2ry%KL=Oo%!<; ug2i@լ~]ɽkPv46BbksjE\{q?>W{K~,ЧW"c!FYlM- \4g&wkq00j#ʲw;:۴yt׋VU<-BO/b5aaңoc/|鷘]r/3|?2K[`Ğ,zc~mk?VX*(?N < co#.)P&=&<Ү^`^ӥCbg'S\wig׋XC~5tEؖq7xxʱW;zv4n,c^<ÿ.~_/;V" sߜVp]*{UFe4z1c yNykDɁ=Yi1\"4?+`?~j!AֱI6^{MϗEݹ?ڄk5t32j<-e^<~bcqRmّX&yHc7 ߶2ٰ]wvGOfuڷn)rF~YwIcQB,/oy)#n6pYvġBf>_~uCF#ZcV0A0zqϔ"?ݠ+{|I<Vfǔ\x{^VL"Ktdrv)cO%c].HX6ka0wth|߅ѡޓytdaWa+xYxaSƶ.^3#mx}YBN1b+)dVz*Oye[ =??,QVydjuncZ[gz :E9dm;iXr7RZ ;yFMjW\nIFHcԎ+S};cީ↡,n.5[6H}3l |N{ܚM kGzݪR흹'mO _\;O ?)i`~5GŶ>m0ym3,c#65ژ9v]~l<ȷ4?ш} C'=>?(=ҟ]pWvl:֎oѤB|S|t7y2eEN|FIws-Iԗ=T wµ̲姉no6X 8< 3ىwuv-Z?"ltUlJSw:}lܳykJWbëEflGN*1*;-`k:ve/[,ʸMإ %ǞˎԶqvɛE;#;}c~1϶&;t;zLvRYԹ;6p_ةRaɂk/XhԀOV >pp~,bggfu&2~Psaœ-$aׯ{oSwΎ[Y&r jlAalBxfҞi8~,:pttO἟Xc >ԇqUe|'g~IloؽaW a, ;>URwْ8;5q2 z]6s!mRXXrkJbnd> _WZw"r6cs,Ǹ v\cZw:bx1Fٵ>aNN8cj>uY-C;20EXގb{gs{gB^!(sZPbzmxgvMf#Ѐq3'*{N/Nfg&5 :;Seכ_Bu.;v)ZnaO{=yb~Z1)~j'I lp@!U5Nwsby~}Arp*8||OY}~Wo's1_oZ򛛾׆əy2B3=]/1eK]NڕfΡֳy޶"zls &]öa5;fvٍG6[]7~A5R D-/1/'C.b'ܨ /x# 4V,yU#O mP8~)d}ހpEug8laZtrk_U޶ ?Њ{z}X]콼z b,YӐGuMrxTg}Z(!W2Ct/ӊUޅo7SoOW)m:/Z G3Y y"Z|lzzcsYۏ,x"Z q-M6Ve #+n/Mh.?|`Q=j 'ȬO5]bqw~ ;c}|NBNMĥU2mQM}5per؅nv?]5%XHkT75ռ_$nL=~1t/mw4|{j1~.@\ڊT Rঞb+V:&~U{Ӊֱ\T}8?[v iձlkuq>E/~ưcsխf;^jqw/޽7f`SJ+βզsws|{LU;xv<]|hwv)n?pq~,q7XԴ m>]>BSU>3,֏ X]4zwυOu{j}ljͿ͕g ai߲}޵ {<eG\Y.RCVvG|去Ž$x>v_Bɽ>tOK]kF"ܻZ/{l~|} g JyngMkT.7[>В'sBQ-vT,I;a llYO-;'>{׬w^-X^Yo>{]uJWrtʷhY lG>0< u|Fcu泤>g6IiV;Yᇉ8q%3rϺ|FdG%e %'X3wӡ&w*'빾!w-vInkYn[C:z*[)݊l0kw,>kE>!ɮB8~nftMF%խ˧]̳V#رq|ZaŃf|j#'U˧,D;SzK);*3)þ1^O4Ѫ|19[ɵ/N_q1ړŏ}h,~WnFX:d?jZ?cHԺX|,~nj!k~a^,ߢ[æ-~1j23'qwaUukEA1@ B@AD2(P.Utt# b"b}w?ܗǽw]c9kXZk6Xݩ(ٻ_y.ⱡ2?,ȱg6.X8ȡ:BAg-DF<+{Ҕ9cLH0/W;ƈna k0|7V)a=U41x %פ`Kk1Tpc9?aڣEB&MIigQ+bܝяͿ!}kZ'գC/xk}rЋG;ofBA/wT6(=t&?"l8e/7@ڡ~&\1" ء#N%)o,]2.gwǐa)8tx3ڹS d͠6NԦhʴPSjT*O⁨acT M,+)qETxTe‹r'=nUWٛxy=-ofO؎9S}X\!s̀Ű@rJ="3 P/!mcO X_=L(搈p zpuY.QR'y"ܙ.~J8 l,{ rU½ %tLJ`UK4r C~rG͍:0.~_] |8 GYIVֈ<>ڻa _/3}_+`KR.x0^i^e(xo׃uB( 7C )9k(JM @!0itlOfz~A'LvX]} AjbTAn1YCPm 3 d9 dp}tC< Xv}|)S9}b)^m?D~+63.kQ}0L(Sz|y^֦Uة8Tx C 7 LA[R3q^=ɖZ>A#_;;*YR s֬]E {ߧKoD_#lJ:utK'E@| :v@ 8RAR`ȭRH-]IcWNC%A ѐuRnT27d#{_pvM}H8Cs1$ȪĸBY;~H~{W{V Ͷ6md ꒐Ð6tfh[%M;fBڦG }whjqU$ҥbVC5NMԐnl%!9%%=Q=tHZwK#1z(2;xU!C{a{Ȱ4yuԕ Mٱo(|_!%8 Du5jb M@t0r:Dެ@msb2]m) &V;oWAr*dSnCޙk@ɨurCG 9.q5֫>yWn&@vʕkg(Rk4wzA< &R| &TE:A~~^ b`=tlm :2&󴐜o$xb'g\),؇-TOܻAئ!Vb.nH=yXOȆE<.h!ܩn3᳏E%dm;G䊃ko[,g@d4 ba{\@ `ٜ4 .G틡kQ,Dhx%k4Ik˒A iL1\387v{\o]v1W.J\$ۏϤ}F6Sst`f4j ʼn<©Wi ^ 8\.[C9v%*o[/+H>~i- ͥj=Y|d-eбC6}!6Qf]DӱXt/66wm¦Th@f8t\<|^$7bc, g^xEoR E|.e5H1C]^l؞scj/)W&cV͠>L8 [8\_Ae:vykyD\9L܇ahc}HR'D~|;kX ~Րvm{d'd+6U iK7Tj^ ZWeƗ@aBʲPBlȳPͦ`z:窹Pr)P!D)Th|7[?u@圂2IR\ǐ 5 4B-o6JR1BC_dZz]\N^䤷`'Fpw1:̟~r: ZM$_|/95Jg#]^: ;a>qWg_6XwyozϯOSbs `ZmkaΦBt-P"v)bnPʝkM7Pe^]:-ېjZJ)W ŸwHXyk4RZ@r gyH>"&g|Gs{>dg%H]CIODBa}UH!X4 #n(aXS)lߵ2̶XЊ|[/)Mի9ftl1#\_a;#%x!f1dH `vq RYs{~#cI;f^so[ү YBUɬbŶ3tԳz5KL*9ኘPw\Pw!`d~aD%&-ä5;vϞγX%)Mr]PJ՘Dǹ U ,Gd1A"LyTJ?jgQ0dGƻ5XxS7Ka<_.Tl3utR}=RqaдSY;mKɭt8.k™w;:5a[ivyagx7.0Ks1l U=m~ڳ najCULM08};MWASAJcXMbQ7lHT8uH4#\Z)v %hi/hsݫlopg'JЌ-OZ *mwD44wz/"Y|$R\ՍƝeߡJ2k6j&3&$jڮK P!煿;뽭 ٛP80bo^f*\{[rY<,6 áVox#~*U:3ͽ!$|?w3E劂wGq>o"'{P `d<C`"^}ywvqF8!*}Z!pNCԦ};k fni'Īn gKhJ$ GK1Q;qs2|Uwg.LdQOy@s$Tcv8"킄@+m*exnR|x'@jO- v ]6i^+t jV*9>9>t&4?7_}x]ldNW.yR `GwG Lׅo2F[ p(sW%"HQ mɪ Wa,n6 Gjj.2m= $kMWMڔHN=S@}Kmt2PO e_ 2+ϳل#Y 4!ѩ-w06ttuǁܲF}VȣK B&NmZի вLrBn̕"/ $yK-VZSzm!TGU,}[7m~+-%O"QKk9s ]V\EA߂X5!oνJ(j(]!umt}Alw7n1BΠm0(wiR ]BmNYL>'=r߽|Nݫ߼ Z3#(O{-xo-imӕ|OqKwDI_ ]z6}qZ!7 b}ɴG$[[Yu\',b$[T?GmJ-sLW< VُG4Jh.헶Q:~wǫxn9ܡ < JO -kJ?kd4ufAk^eì{_Q_oc K_ z6g_R􏭲9si*jlZ.LJƆboSzwaۺ bWk%TꍬPb{W+**OŮ#3nej۶,ua7ŞڲLo+oZ>?׿%ZdJ(HѡFqumVe0x#uZ> [{k;+:\.qXBIۊܠ./mb04n_soP6>ȭg(AQբ]yoc[* #,ϡ`{7џ5W uH z*?z!bډ_ =,RV9VhƉ O>ٿqۯ*xQ'AڂXpXٟ o&^1[8{AN} yt3T3{?ZB}[̫&^\(u ,q-:ܼiKc Qmny|; OeRxw_@wш$U߅򡥏mo٦ɒq? _4i=mNt|ƛh{lՏ80quBYݑAEJ>\aAq2+p S3tF;proLJѿZ>u?hgqYe?Éx+>M'J(j[~V*a|VXO;WN1::d[G@eŮ{# ׸|g1[,ܺ v0W퉹;]r_/s֯6W+ ;qɬY![wpeVC G55cXU  O_4k#Q_T( a4Wr<[[#SwWbFS6~%rI_.D}Ms%;m_.=u~'ԮW I#D7^OkʇڼV? с+? 5kx ([{b&wbW{mscbvi*grï=a,z[j:֕UTOן]xn%*JW7df\Ξ{$ML^a?:<1/_IƵ/]%4pT3Ƨ #~IR7WBMLIbpM|^6>] 3i?40wLsBs$sAb$tTR`{?_O/G).څ9'u=ћrE;&Zp~Kg5Kf@v@ggV +]6KI`ߢwWXoz.7t9۟[wG]>xUКRwUS{3O^[sK~i~dN堁CBiz&R*^Yem/FWsLWh-P?6ʽtHI u"V%cK Ӛw^p况NCTQtiH7< g91umKF<~~h#G.]~$nϑ}KN\͓;$-z6_qPeG/V N!ΝHamq ~=px~FWcAnbMzfR`W]Vu!;CvZld \0n|F !?o4P\B sE ­=[Jդ]r[W3]On[B'gOCB)壾2B3o J=o6$w|}^vHZh#nb[_u?wBI !BnBm ?,e^,UQpB&OBz,4W_(Ww)AQTmrg/|Gw)gUey{(Ty+:uO>&xyIW?Y73"}]T?GYs' G|kʽ9+~S$1uá6;^HvM5TbsfSi-)ڥ'0GE9#\umb,y)*ckL_BdBuH-Lzr"  ZTNNLSyp i4vY`Bcơې=n{ҟ_J0c3h^K3ƙϯ|Iݳ>^Ÿ[UW.ƩUJ]ѳ5xGRW}{ =֦,+B^{We@liRiha)Ė-qڀmoR|s$?x(I>{wb:KwS$$7IVnpnJ;t GנNT 7c?I ='0:̊am8`}сK=4>cMG7j) J|};SE|1#Nŀ[^aJ{i]4_B , u7JM3+~J-Ђ$`ШK䩊:[ڔ_A ;ɪXSbGG!P^}Pqbzdܥg%^g-A{H~C Kq trOs/Bcu,KGOɹoRy@b{f-||"U1De8!?r޼CN.H\}L*k 0KPru.)-Đ<}KdU. ,PԐڮ:[(X=E3r8%`R-~@o , vKvDr=\= X~jӄ eh}ӧXS`A3fSIo6>:GzŒ lޛ|4_:bӳt$ 24#]ڲ?/lCb?4X"5dP95?❛(lOPb?իs[DN&t{TEd P$n~8Ϣ|p? ,ӯDڵg$7hV W + q"YpT;uT'``bke䟩.\H2 H\3d,w:а"F;'5F2H ډvM} Zĭ0A/;5&N^z_kI;uS G8zSB;drbw<3 ^s7N=BE+ @^rB;u>AE^,̒G KO2xC^[b%[6lw/(`e,l畇i%B!n9 (,n@1[W_랗>(P]&{P,nh_,y@BGmylW^yV=Mz{gN:BBvϼV *[tr!>,0 xuJp16R261c gu! yuw[f06ޚ~naގ!M!~N8HXXI$!a7+RsnۮzLU.xWm1հ1։ ?>b{ծ6>!#p0L \ /~q;sp+j`֚ s]SgC+twрۼy/ضkN+3 1[^^w),YR#ePLC/oB#[+42əH1$FYy/Rnq-N[OZb'c0!oؽ=!jޙ#tn;8p+ 3eR :M@*(b1`hǕ |ypҠ_|)lE & ' S|(dM17ի yӚt&fi+ }%wYA]|*mc>pdLj(71R8{ɟ6V|!EO x@RrmLp?|xC:#h"M%T]|͌,$JuCKF7,uڳs+{f]'8|zѲ$F *5yA:=R'19+GY.2=(Y~ @-b6c:8=z _ WJ E>%mC]'BB'7Π E>a YD? /\Ld:HB{Dڐ`u:>\l/<Gb3+e@fy=Fv1)\:皳K) .2g!$Nv-*CRQN-3u([{@a/*bNۉɧA07kKٹÂ1PAҼ7*C iHs%r6bgH>i mỶXW!ݚתbHKhu8~L'±,}2' xPKvI#eX=t^_,#n}`R. d=_@d8LQfsH2>1NkS%>]Be˻ӫR}^^IVKAs7)Ȼŵ`b)?NxߊxkcT># Q/w?SH}5 W?\cׯipNF#LI]x2D_bAI*gO3mCyw(M2"R1@6Yrp $yUkr $nktM!jϣu,5k!XmH/+k?mxyUFwjɷ WNPO.Ę+/oρBTᘴKȨڪ2u{#b?8IyGGW!]zիYHM-^*ŌoKC =ܮ&99tqٷtoڧ^E´{Ksr5wL X[ h͙pMe##7O 1Fx:@dJUP @+UZY& n^}sgFh첡=` Oe1+s-#`z44fyθ cvDDϊ'1]˻  RZVF46]1ygoЯRo,n۠?'eE frz;Odɲ4'!͓{d/$>δT(|K#6ar D.|GR5ܦVK0i1a-Ks>äaMfX8ȶ/+ɟ.xO.yY=gy̺L^Ƌ9dCf7{k^E d_v UfۃM܋q=;ܤ }lu?GM0} ]c?܎l]zI)A?Sco smM6'G^k ݲj&Nv:$wFEh[ehi!+>hGK||o;M དྷCkӦ%+#4j8Z/x5) =6oGJ4À7KjY84JY,r;]1njL4_~+^j޽c3 @[g7atqtR?U\5㾸G>:v,x221fZw cHaܣg:lw<ڎ=БO/rc WOIc,n}G8󬟽| hݽw|<;NR"Io$y 44*c7^W)sG~+:P%?^ĤUZhfƓ +=Nؤb'F(T|g;v̱3 DzLc9BwQr2h˜ؚF E9fGl_8*6)x>"&$Hʓ< }\/Cu3+C~ĤFW ` TVO֯NŤcH,Z&GJ -F$ kSC{!C}i󶣐|F .o^'*2.oBG ӊ(]S~|40o׀.]TL!$3H9 a W7E"a>|#,B4+X,aO˓־j2`[3 4w鈦P{N9ٜ5Rant#lRkn4oad\gF ()עw3_:$ClA˜qqvW?bq{NW1PIev|Jt %Ǐtc<.Wn|c?,ٛ1_G‘g!%3L)0Ny֒p|hSu:%FBm^w-;``Ѹ܇+C}1Ŏ5 ~礰c-7MC_ele;ߙStcǙu)ۜni]MKPg͉-V OFQXY 2CW(fTΞI8xdv<ř|^T{PI}ehޏ_9g-K ]x4xs8WeM%K+lLP|z!J0x 5߆漍^Bu*;Tj&Rqco] y_\FWA!2~'4Rb (|*U կ?>T#5q˯'RzJs=6,w]( ˶T=Pڹ۸%~%4lt"2J_d>ٗ PVPu: UIZkv]~ik#uRS̏pa&#,炲kW(tt'Fn®41߱+˰+aKFY3MhYW]?):{>Ѷ9!,6u zVbSr#P^5P򸄅nI9 _Iw%Y.,B| t9_p!kWuD(>rK&||[^*#TVm{*;Yy4Z(R$K>yO r2BQDZ*X#݉ĈH #,jO}k8|Br'H.^)h _˥ٸ뫿Aܑks|)e&Hnr-^UDXBrCrkh$wy@kK ?h9vzr0 _Ǟ_ >TBP5VCq"&mnA@r-m,YvȘ}џ9jT~EɧdOxP4"і ǜ.\G캻c|ۯkՏrI0[uN)!cIO>{⢱Ac׬6X9M#{֟X}RbGϷ-EeA(Me lar=15Ƀ,#B}_6Ym>9 [ٴGWf~7!c+͋a٦^E>{"E'zޢ dQ]tH>@}b!B99 ~ztLSUo^gx'mK~#NpݏѸ3Tg[,5t\+EBwf-A3[cB35ދCX뵨HEPne.Dl^+ξGAN]Wa~UĕyG&_cZYfJ_V,/QYs//=;v KP"aR~9CQ֝CLc8.ݕMQ~aA)[3z dA :XЃmRҽ*sr׀$HX"72w 1炪Li3 w?¸6az7uMVL=F5$x +B/c Aנ-fFL6c\RmQ2x~=UõyH>GJf|vBx GJQ%H9X=7S,総_d';rvTK̡4i%̌k>Q>Jod0B~݋EH!CYԕ05J>pj>,2:Ec"fa^A{uqz?vaݣPbg 6ԁ߬VO\rs{~pnW);:lgnnp$)#헑wd+ȖMV2|PJ %$ZF~_q>9}~Xص[B͖X^ę󰲻Ňb[Z |UX6Xyʠ,]$km|'hk<[pU8_Vn|C`Uo~*M]W^Xi,E05cj?] %]c1rS}L%S^fRxTKQVb,ϊQ`3.A-9 5p`^I`zzMXㅴm=Xťo~c&?*-gCv2}][O6~@k%')D <bɄIMc<-ʓv X%X곩汯;1mݰVkG`vkjLm-حIn اX>g' Rj)QM) ej Xܑ@\MVM,!p)Z3QOb?Ӛs~hg}w:ԝT>ݜ`]W&-e18WॎTX!,ۈ)Yn9͇v=3`%oΩ3bWvӮ7 ~Xc:|MK$!jwvSh vj=f],J׳8,8x\%4,]v+,%XsP~<t|k`(|W/3~M]ȴbX c_,}X輑smL9 Ƽy4ۇ nRRV<1 .ళ,UY-^v@e,I ?U,),`edURVt3^ӑ߼]OpW2?YۅW*8)!:=Rhg:~ҮQV@F],?ZMP$2X8yEsd[cQz-5?'ߺ[9o>y+klKVHX뺍r {އ}_fX~tE6 U]XO}Ex^R |'q^C}%u1k[$aCIse3<-hҐs%s]gMPi,R=wa-;B>(Nx?n-Nu_ q|+P_1':%p}HEoH+896סf0~ E6⒗ńg_ .KggWr)|kĉ?g㊌Yp?vo[K*^uoFy>ZW}}b656pL kh/N|x4X#KEtb.k[>OV=yMTkI P] qC^=wt/،ڇE %tmcw?&؝ n9Ny?I$VIsWe"/ޤ1G 7~YIH">ͱ4__ V&]v6prCIr`]Bk &Sa#ܾ 4]nI38gO4E"If`OS"굊^kF tx' פe44*OF~˯xl0e)\Tcӄ ~_KgV. P8"쎍ȥҴ|A?e6Av`﫰 Yu^WA;y'4-ުSQPڡJ`hǺ =FV~eU]U\7ϗM攇E[G/b=^5Hzt=*Njo>~.G0\%{.G7ߤidkZ-7+_9 {~oK(⹊oz3fV<ËB?>5F%xQTYqoo~5VPM&9۬ ۬%jMvZߢH.6<#{:pT^.fuXMH,I6TezW6db~Ӗ/cƛs/L7+(y20Pf`aɧ0.sѴ5/cqOڟN 'NOzR+ 2Kύ_K+ƍǨq72^Oy*C ixEٓg;CJuR)!rK/x _]x~tXj)vyR38Eڨ^ƻ`G37ԑuڼߌ)"zX[_ݫ:rX=b64^_ou>#~ r;OrVkc9JGadkc/LnbtݜvXeJC.>/5%U$A}oZT*mؙ~)7ҿ[(r-+wӎ͑6$wx5B zG!o-!22Jy0kI_`Ne {%旭w}c&J}0QSQJcz< pRnr\`HqJG`륧7N]q)y 4 Xu{duwuFA̸HEI|&@{pcwwM%|)/Hlg9,z?`mw|I~}-Y0=خR@&y~: EGN$7q |/.xF0y;] M0y3W;w}_m:4n)[WćSA2P 4O0Qn!`*l:҃ \Po Xzp~G5["%~W{@۹GrGKǁdGz^'Yܼ-%3@o(#AaAUB$(xr0vjv TULH)SU Rl>KWIwhLI\`4~80sg;ӇyACj?w8?A[[Р;;;ÉA*`W"nayLh].\(fyL?t/X$tӂ:UB{w^ Ews9Y1d`>G-ƂD~UUMh\EFtr n'UJ|@cNh% 489l4A ~Wc5zФ4 eS{yHn_! Z /+k׏S- .Wܟ1f*N{!f#a g: PYGשO$LC~gv[.0|񙥸w ߾n"uG~C/KjZrU(lebS)'ރҥ{eI |Z|OC.~doGFs`IhhO˶]V ڹT"fL`01Yf^clo:"e㺇\pbw%HyWH\7Y 6/BZh9U&if5¢FN_gw 78-UP^/`k׃ NL(pFF6=q:3p^XFv 4l<4xï^w{̣xV zv.{ˠJzQl~bAȨ߉S$- \:cB@Iɺ ()3gAC#n0nk%ŀ.t[o! r㨸xSPgE1 Ew ynj Mz )g{؎J.$vwcTdj1|̕^P(xh9 rAu4|Фjj+:%A I)Q~k GP;dRk˂ۖ1`Z /4 PDqH<HڞtR ҆E-KM{oiSn@ե(E;q|.OƢ@>*e->;,kԖܯ =8$#p; [RAM$Pod_RFUq83h>4-ZvAK@EO_K492O:jT͹r`XGu^VTpkު? "`}|r)%j^ϑ{UP[%Z#5]3KF pXpD~$ ۫Ak\ˠzx#gi9,LL3|R  Z`ty0J\wk='Gho)ߏ@Mf~RH? eܺ\+K0ĿHKDh'nFՖ3@"F' aV1S0p: ] p/Z& s`Fi5 dkyj(NdS&Lٗsq)V4TxL疳6sK|?]y|?tM?eu4 F0"9u<+,چz'&x/XGh> A 0zli'KTi>j]kD5&aM8)_9ځ癹'Ekř]ТuĦA+7/w̍E(G􎛉SgimTؘ0j{HQ!]:^ w)>`@XN-0yy`1~D' <Wҁjh&ARz+$M9/q+޾FWA̵䓂`)(?ꈁAA{l OjH])B;wD|P> b]6)L8{zͣi觾K  ֮5$ҡ.p62R{g_Xcs !SNh)KQnK78RJk)|,^rEzI qXKPd%κLhoG>78{ +0ulz@T|j[Mv΂w%<+8LLkܼ&K{X]-AyQO꣋Qd7@ŵ PcߕA| ؜;vc1﷪5Uˑj@[7op4Edt]mlHց*4?EFm0#SMHbzn^߫U!&P%zL}ι`~ʁs0ge\g/q-? exJ[2LjPC>P\: ͝ҠcDS0-fr癯Ҟ0"6ؼCuSPG+YL/mVg~`lȹ?>ˡgP1|h 2Rڴt@i/8Yf2nj>3KD롋}a>YLט :Gw&Κwc~0M)ZvCBs"hp,H*wkf :7^#zlTT78\3ѿHxhF=ָ#\\͏Q00~UbTwy8G#˚G?ҀS]*&8&LOK7I~@ꎷo!P-|xpnL^uZ> ~ Ѩ2lqO#YVBuW}1`2ofѻlkR:T`I@g3?ޯJX\`7d/bK^6+ϔJO AGLJk|Χ&(P$7 UU?"AsJTwd(A崃O/40 %!ꏟ1 Ni{Obw)'hQj/kpk&B_=Z-?S]SYvM0|ySO(S7 r 4h7T0a09&3FryJ#As`ud6h*|ȥpS\k2%dm}*[L{>tIm,@QߌףD~qUʗ1@q?A]kL'Z}AEku0U A\ɠ3Gt6itE$ \8p( t?:YwzV~u %FŘzڂt XM )MvA=$It1S>0`N0Lq򳀮\R &h, ]`U0;qrX$XD̃鰠*#WPI .(]~jm)Y%)y?&y{dAw7[ /4?ƫ@>HQ>G#t9K%#ow-|c+ABֶ3C hgĝ  MPF4 cy6vʹ%;h:> s^Mo `U"g[F*Qdːd?O]qO`3 G`xmgSW?o{c?Wʘ4oh .; "^Ŷ*FWߍ< LߡQ9 7pzwglFsc ``z'Yj %+:dPw ?S"=SKu2Vem`Jw3*$mu*Ztɳy灷5ӓr z2ȌٜgU= 7~nP%18KT#{d\9=0 f=kRZۜ  sѮ/&MopɹLhbj)ɉPuTMl`P hXXsF_ *\62 p`{h-U+0{a8K pl#4µS>N|i^}AC:3m]*db3!:XE0ZȭEh(I3[gf5YWL,L\韃lSR<Ӊii3-WƖ!4J԰Qﯽ) v.Wׁ!om+c.:K~Z 1fP] @1x#0r̨O_Brjv6="7v2@^:fwK%'+@3iN:C ]U'%6@:s?(3|T&&ojmT88Aɽns¾N/Rq{i/zp(a ipH-uO`wHZ~?D SkGrND 鼼ʢ$ʦ)tS:^ QotP6+]P6}|>lVuU4Ch&xupq+]B+#3gwaCwUP΁@W"x۫C򚜽/>`!{@s(ip"J.*gFܢʨx};V_OsʧĜh m1x!}o?!D%p4z=6G!KS".?Mg ~A ޶f#*slm1E~PFy"tgt*2!@t(% f'{(?<:°5axHª#!\NSv*u!z r;9iB?Oۦ<(o[<^慐ۋfֿhشs |W}dzZ̐bt  2{=FyJhO;+-]Fٳ7y <0|,E*Uo`y&#e52O`nӴ#Q ^:/Ͻ/gJA~+^꺳h?/}~$gAN?BzOfJKHBOмݝF$#4{KﲂO[ǣ~Z)e=ovp4<7KpcA8t4 G}CNQ:F{5A=8_D% .3\EupijAr/eG\)<}q{n3~a$8ɺ<ټ@(Qh,ZUiW끨L$DVQco8t莥 Kfsp!Zni.>hD\>0 S6/|\ #mU~q}` .cEGy<{}'}>p~J:~[]<̀99@ruq?k˯G[ .aq./$G<" ZlF\]o 0W 5w55pzWqEBP0и :t3nH]! *0GDցJ#g>F p9t=6:[\AL'nceK!^R q|MvWmP^38הœM"BNęϬ*mֽǾ26F nL*N ܒ> dp}VbqP0,TkA6(d;k6o_4/lOk]= Cz*QVshۮmk4m"vm.dzzp?)͝ uAfTF/(s=+Z; M8}L5 YF9euz^Z b [ @C3'Z'zr0=%\[xrҼ fqĚT`(ܫy#ttW-R1p i:4n6Z󟖂x%3jJӿWH2^ r=a>,K``P Cͯl@øΆK aplAM0 "d(,m7'۪pT%ЯnGk#o2#tz'6}׾}FۛxxS: 1{}{ s^IJ߀M1mLӘ06Sib<+hb,^k /mFZu9䩯x#=.D0)h.{am4OUi=&J@l]#xw^N﹍0vr qa.#(a(>-'J"j>aFHeS̽z@>WA>|:O{"dIk ;|v[Ȁٳ6F?(^374kjS v3.dc,w=l30&Ýw`2"hJ;;zg]6o͂w|DfSV3S<5 Aj/b ? RvVld)`JgwJX1{.~5" _4cA®) HgϙE=@ =Yf*q̲y*!r_/!E}3!4:T5Mn&H F}dIZ4 )5?;Ce6sXe5w |aSJ@v?ׄ/}!B$H)B8ꍄpVJ>k/՛A 5Voڷj<7mu2^ԃrjjo]fFgGq8թsȟ!8XnOSDHJǷ#7|*{[#aöBqF_N(mНF`ARP@9uk~~?PTvaqr~. KOHY y_m!(LzQGOG/, _]A*ҫlRB2-X+Xh)_]<5>BeE'G ɵSI^?$HR#RzIj4* i*6t 287'HBqSUOG?kҷK8v]~n,.i@y?yys"?ǷN#$kKpTq 8&T4 BMi:Ğ޻yat瑮 bO%; K&u?B=A ϱޏ&GhU=owozU@P;FȓVOȓ&vk= ʧW&%+k nR˥5F? mMBi ! %H-YvN>+4J*%>,f#^ t١:} 4&8%EopV'6гL+8GT@v m%FmqYB-鏉J;!_Y.8O ȱ< .a>傺V瞲^)2ȍ 9F;Sr@MÔD] -wy,MzCd|YW5I~w ^f nao>< ZvzVtUgToZL°X:x~z]s{4Z5r<<4K&/7>4pa*_e;V"zerlK_JMu^g 4oPw-”^a \}]m׵4d#9%1.W36WrV|5B3 LKJ~׿ aڳ# p0G%  S|]WѾlY[村iR/YH Cakuc2)dMA=`Fx՞_tK@ҙRI;Ԟ3!qHvb2XC ٛfB3xQ+d}s=8 Q;b]k0uxl5?=dQwKcĿȞ!7Z 1vR~%k;ܕj.;5g$YEppVAby5*F|HoԷܼSU|w!J8>;"ƜɃ{I@yzK+9}Fҡ(xjY wҊ#xoJopbMĦ5|sގOs!r:kO'fe>( AztO P{+ Lx- B,Arތ/(/lS׸*BʇAp.+Zv@ .0 AGVbN7 p:Ş >—fm|nQG|f&,Ȯn&#be2%gdE%oœ9mBy!pŏN"oʏܣgsqG9NuN!wV}ϊVz(.aRCP6fWZ-58Mww$Br']Ap$B|qHn89Gf0 EvBỎtoPX(&5FphX5b V\ Xx#yf>ȫաyMj${ɇJ{d-"~?ɢ!jOZZf"$,s~ܻmcEKB/ҿ!WKDQ-_#3/ѿSԁW~ }xzKT&>Fuvi[ ,ӌwaw, ’?ޫ[88+ߝ >#$Q O\OtJIqx3( B+iA6MTNruקD\ B yj&x#!O9:u)#LESLxԭN%a}NC! ۘ %?8'"q{g  .ք= |jA@7aӝ@XS̮$U ك i*Uf'C5#0c VL&cg ;CGݩ+8abtqlD35 fhvF5K8#k;Oz&Ҧx|4'7aNDlלŽ+K ҄=M{0an '{)5gnp/(6?Xي {|sׄcd핒+D^YB\7ۍ^gm9QiGXS˽6GXjO )!]R &ؙ^Ί汣]~ːtksž~wa&ȷg&pq+ф;K0wӳ:LO}+ʎ}#wGG;Ym‘7v > yOұ4]0IC&<AIASWxpc%lFFΔUjkC/cNZ0|cZLDL+"O$|*y@l7d8="<>DB~Ҫ%<ζ{!~ٔXygPЉ<ꯣZ0'n ,v>^>ZB>% h1c}h_w?jӗz!иo(X4;/>7)W6K֥zLҁ7 QxJ(TPbK.O%hXRI(g$LJt^IHVjxg&$2JfFZ-ZQJMc7D i05$$>z9y~9PŢ ݠ\H$-캊_šEΚوy! }5Oes"\i,Vi]~ W UG|`X:B!"QN4kKEEg4';kȱ~j^m~%6mht;KιN0fs):!p=fq E7` X@p I:k@MzfOXެ9rC#aMIS{3Á!o\R^ 8^wNG)Bk ;<ie;crjP uF4ˆ- cZ`==Yp"w^m׸V[1nI1),ᗚA< JL3qLwa.PA}6ۙN@|Y4psHN-iW% $o[%6>\*nn9/DJqEP&S4lMe~*/')#{)?>^538_TdA8?}h3a"ڗ9O1FgbfN!}޲;˜;% p+V[YHnVs] I@6P|onsnB^f_{tH{z@ʴqpLB늶VH[~LA8lRc)H{)Qߦ !V4Q=^/|= q}֌уCsA*8 Ʌ5m㑇 , *w}*v#lGѫ?^!B@<%Y/;!oi2hvaaV?9O4GV|08k̩sc΃[3F~|^X5BӱkDҎHj%+u0؇991wmHcfwq>bhy4 Y8NU8ʃ"Z|rY-|rdFW~I#%R_$j'h{u<_c6OhQ?sR[Ʃroϣ %?; Y^E _"7o lamĩt[`u;4om\XIsgd}(QTo4r{6寅lS3q^QձϮu\=Q}?,Cfg($qк5[#<?/(Ł,n}9@PU&J&V|vt&x,T /UA@Matrix/inst/external/jgl009.mtx0000644000176200001440000000040014037532666016062 0ustar liggesusers%%MatrixMarket matrix coordinate pattern general 9 9 50 1 1 2 1 4 1 5 1 6 1 7 1 8 1 9 1 2 2 3 2 8 2 9 2 2 3 3 3 4 3 5 3 6 3 7 3 8 3 9 3 4 4 5 4 6 4 7 4 8 4 9 4 4 5 5 5 6 5 7 5 8 5 9 5 4 6 5 6 6 6 7 6 8 6 9 6 1 7 2 7 3 7 8 7 9 7 8 8 9 8 1 9 2 9 3 9 8 9 9 9 Matrix/inst/external/symA.rda0000644000176200001440000000153712215114135015717 0ustar liggesusersmTiHTa}3c˨9-:iP RI%{n)ea4樥6e9DDK4HRAd?ȐH2"Z{{̢䠢 EQ̊bR>,LbqQ1 QS ֢gB|ϜalW_sP Ն ͕s"µo~ >Q9Y۪t˜vEj%f/m_LEH2zp,XM΍3p\΋o <4ǰX Q(lRm.l"a&udVղ<QY9lE݄E;H; tLHԶ$ j'3DTۘ?<|7ID-՟ꞟxY=)+b/ <v>B-n"u YO&?0_}?.7 Բ6HO3𦾢} Ro=50s#ÚMOD?[iǹQ~ ov'źQ?eƼCg-^xL hw;ꎡ18xW:h0`2x*PM~x1zzT_J{u&&huc/WSPp]ѬӄnȀ:z}'r3 G<7o?!0k{r}ں{Nr}G>G{OУ^4uI~[ A:~ù=E>ו L/sp_dfWM꿗@ 8,ko~=j"i77f9Z\βjg~P/Q<vMatrix/inst/external/lund_a.rsa0000644000176200001440000007024410275502035016274 0ustar liggesusers1SYMMETRIC MATRIX A OF LUND EIGENVALUE PROBLEM, MAY 1974 LUND A 352 10 82 260 0 RSA 147 147 1298 0 (16I5) (16I5) (5E16.8) 1 7 15 23 31 39 47 53 58 68 77 85 97 108 118 130 141 151 163 174 184 196 207 217 228 238 247 254 260 265 275 284 292 304 315 325 337 348 358 370 381 391 403 414 424 435 445 454 461 467 472 482 491 499 510 521 531 543 554 564 576 587 597 609 620 630 641 651 660 667 673 678 688 697 705 717 728 738 750 761 771 783 794 804 815 826 836 847 857 866 873 879 884 894 903 911 923 934 944 956 967 977 989 1000 1010 1022 1033 1043 1053 1063 1072 1079 1085 1090 1099 1107 1114 1124 1133 1141 1151 1160 1168 1178 1187 1195 1205 1214 1222 1231 1239 1246 1251 1255 1258 1262 1265 1269 1272 1276 1279 1283 1286 1290 1293 1296 1298 1299 1 2 8 9 10 11 2 3 9 10 11 12 13 14 3 4 12 13 14 15 16 17 4 5 15 16 17 18 19 20 5 6 18 19 20 21 22 23 6 7 21 22 23 24 25 26 7 24 25 26 27 28 8 9 10 11 29 9 10 11 12 13 14 29 30 31 32 10 11 12 13 14 29 30 31 32 11 12 13 14 29 30 31 32 12 13 14 15 16 17 30 31 32 33 34 35 13 14 15 16 17 30 31 32 33 34 35 14 15 16 17 30 31 32 33 34 35 15 16 17 18 19 20 33 34 35 36 37 38 16 17 18 19 20 33 34 35 36 37 38 17 18 19 20 33 34 35 36 37 38 18 19 20 21 22 23 36 37 38 39 40 41 19 20 21 22 23 36 37 38 39 40 41 20 21 22 23 36 37 38 39 40 41 21 22 23 24 25 26 39 40 41 42 43 44 22 23 24 25 26 39 40 41 42 43 44 23 24 25 26 39 40 41 42 43 44 24 25 26 27 28 42 43 44 45 46 47 25 26 27 28 42 43 44 45 46 47 26 27 28 42 43 44 45 46 47 27 28 45 46 47 48 49 28 45 46 47 48 49 29 30 31 32 50 30 31 32 33 34 35 50 51 52 53 31 32 33 34 35 50 51 52 53 32 33 34 35 50 51 52 53 33 34 35 36 37 38 51 52 53 54 55 56 34 35 36 37 38 51 52 53 54 55 56 35 36 37 38 51 52 53 54 55 56 36 37 38 39 40 41 54 55 56 57 58 59 37 38 39 40 41 54 55 56 57 58 59 38 39 40 41 54 55 56 57 58 59 39 40 41 42 43 44 57 58 59 60 61 62 40 41 42 43 44 57 58 59 60 61 62 41 42 43 44 57 58 59 60 61 62 42 43 44 45 46 47 60 61 62 63 64 65 43 44 45 46 47 60 61 62 63 64 65 44 45 46 47 60 61 62 63 64 65 45 46 47 48 49 63 64 65 66 67 68 46 47 48 49 63 64 65 66 67 68 47 48 49 63 64 65 66 67 68 48 49 66 67 68 69 70 49 66 67 68 69 70 50 51 52 53 71 51 52 53 54 55 56 71 72 73 74 52 53 54 55 56 71 72 73 74 53 54 55 56 71 72 73 74 54 55 56 57 58 59 73 74 75 76 77 55 56 57 58 59 72 73 74 75 76 77 56 57 58 59 72 73 74 75 76 77 57 58 59 60 61 62 75 76 77 78 79 80 58 59 60 61 62 75 76 77 78 79 80 59 60 61 62 75 76 77 78 79 80 60 61 62 63 64 65 78 79 80 81 82 83 61 62 63 64 65 78 79 80 81 82 83 62 63 64 65 78 79 80 81 82 83 63 64 65 66 67 68 81 82 83 84 85 86 64 65 66 67 68 81 82 83 84 85 86 65 66 67 68 81 82 83 84 85 86 66 67 68 69 70 84 85 86 87 88 89 67 68 69 70 84 85 86 87 88 89 68 69 70 84 85 86 87 88 89 69 70 87 88 89 90 91 70 87 88 89 90 91 71 72 73 74 92 72 73 74 75 76 77 92 93 94 95 73 74 75 76 77 92 93 94 95 74 75 76 77 92 93 94 95 75 76 77 78 79 80 93 94 95 96 97 98 76 77 78 79 80 93 94 95 96 97 98 77 78 79 80 93 94 95 96 97 98 78 79 80 81 82 83 96 97 98 99 100 101 79 80 81 82 83 96 97 98 99 100 101 80 81 82 83 96 97 98 99 100 101 81 82 83 84 85 86 99 100 101 102 103 104 82 83 84 85 86 99 100 101 102 103 104 83 84 85 86 99 100 101 102 103 104 84 85 86 87 88 89 103 104 105 106 107 85 86 87 88 89 102 103 104 105 106 107 86 87 88 89 102 103 104 105 106 107 87 88 89 90 91 105 106 107 108 109 110 88 89 90 91 105 106 107 108 109 110 89 90 91 105 106 107 108 109 110 90 91 108 109 110 111 112 91 108 109 110 111 112 92 93 94 95 113 93 94 95 96 97 98 113 114 115 116 94 95 96 97 98 113 114 115 116 95 96 97 98 113 114 115 116 96 97 98 99 100 101 114 115 116 117 118 119 97 98 99 100 101 114 115 116 117 118 119 98 99 100 101 114 115 116 117 118 119 99 100 101 102 103 104 117 118 119 120 121 122 100 101 102 103 104 117 118 119 120 121 122 101 102 103 104 117 118 119 120 121 122 102 103 104 105 106 107 120 121 122 123 124 125 103 104 105 106 107 120 121 122 123 124 125 104 105 106 107 120 121 122 123 124 125 105 106 107 108 109 110 123 124 125 126 127 128 106 107 108 109 110 123 124 125 126 127 128 107 108 109 110 123 124 125 126 127 128 108 109 110 111 112 127 128 129 130 131 109 110 111 112 126 127 128 129 130 131 110 111 112 126 127 128 129 130 131 111 112 129 130 131 132 133 112 129 130 131 132 133 113 114 115 116 134 114 115 116 117 118 119 134 135 136 115 116 117 118 119 134 135 136 116 117 118 119 134 135 136 117 118 119 120 121 122 135 136 137 138 118 119 120 121 122 135 136 137 138 119 120 121 122 135 136 137 138 120 121 122 123 124 125 137 138 139 140 121 122 123 124 125 137 138 139 140 122 123 124 125 137 138 139 140 123 124 125 126 127 128 139 140 141 142 124 125 126 127 128 139 140 141 142 125 126 127 128 139 140 141 142 126 127 128 129 130 131 141 142 143 144 127 128 129 130 131 141 142 143 144 128 129 130 131 141 142 143 144 129 130 131 132 133 143 144 145 146 130 131 132 133 143 144 145 146 131 132 133 143 144 145 146 132 133 145 146 147 133 145 146 147 134 135 136 135 136 137 138 136 137 138 137 138 139 140 138 139 140 139 140 141 142 140 141 142 141 142 143 144 142 143 144 143 144 145 146 144 145 146 145 146 147 146 147 147 0.75000000E+08 0.96153881E+06 -0.12179486E+08 -0.26175210E+07 0.28846144E+08 0.57692300E+07 0.75000000E+08 0.96153869E+06 -0.74786312E+05 0.96153840E+07 -0.12179486E+08 -0.26175210E+07 0.28846144E+08 0.57692300E+07 0.75000000E+08 0.96153844E+06 -0.74786375E+05 0.96153840E+07 -0.12179486E+08 -0.26175210E+07 0.28846144E+08 0.57692310E+07 0.75000000E+08 0.96153869E+06 -0.74786312E+05 0.96153840E+07 -0.12179487E+08 -0.26175210E+07 0.28846144E+08 0.57692300E+07 0.75000000E+08 0.96153894E+06 -0.74786375E+05 0.96153840E+07 -0.12179486E+08 -0.26175210E+07 0.28846160E+08 0.57692310E+07 0.75000000E+08 0.96153894E+06 -0.74786312E+05 0.96153850E+07 -0.12179488E+08 -0.26175220E+07 0.28846160E+08 0.57692310E+07 0.44230768E+08 -0.74786312E+05 0.96153850E+07 -0.12179488E+08 -0.15405980E+07 0.14423078E+08 0.75000000E+08 0.26175210E+07 0.57692300E+07 0.28846144E+08 0.96153831E+06 0.50256406E+06 0.78125000E-02 0.78125000E-02 -0.12564100E+06 0.74786312E+05 -0.26175210E+07 0.74786312E+05 -0.12564100E+06 0.26175210E+07 -0.74786312E+05 0.14999998E+09 0.12820510E+07 -0.74786312E+05 0.19230770E+07 0.57692310E+07 -0.12179486E+08 -0.26175210E+07 0.28846144E+08 0.57692300E+07 0.14999998E+09 0.26175210E+07 0.57692300E+07 0.28846144E+08 0.96153840E+07 0.74786312E+05 0.57692300E+07 0.19230770E+07 0.50256406E+06 -0.10937500E+00 0.54687500E-01 -0.12564100E+06 0.74786312E+05 -0.26175210E+07 -0.24414062E-03 0.74786375E+05 0.74786312E+05 -0.12564100E+06 0.26175210E+07 -0.74786250E+05 0.14999998E+09 0.12820520E+07 -0.74786312E+05 0.19230770E+07 0.57692300E+07 -0.74786312E+05 0.96153840E+07 -0.12179487E+08 -0.26175210E+07 0.28846144E+08 0.57692300E+07 0.14999998E+09 0.26175210E+07 0.57692300E+07 0.28846144E+08 -0.74786375E+05 -0.12179486E+08 0.96153840E+07 0.74786312E+05 0.57692310E+07 0.19230770E+07 0.50256406E+06 0.14843750E+00 -0.11718750E+00 -0.12564100E+06 0.74786312E+05 -0.26175210E+07 -0.36621094E-03 0.74786375E+05 0.74786250E+05 -0.12564100E+06 0.26175210E+07 -0.74786312E+05 0.14999998E+09 0.12820510E+07 -0.74786312E+05 0.19230770E+07 0.57692310E+07 -0.74786250E+05 0.96153840E+07 -0.12179488E+08 -0.26175210E+07 0.28846160E+08 0.57692310E+07 0.14999998E+09 0.26175210E+07 0.57692310E+07 0.28846144E+08 -0.74786375E+05 -0.12179485E+08 0.96153830E+07 0.74786375E+05 0.57692300E+07 0.19230770E+07 0.50256406E+06 -0.13281250E+00 0.17187500E+00 -0.12564100E+06 0.74786312E+05 -0.26175210E+07 0.48828125E-03 0.74786312E+05 0.74786312E+05 -0.12564100E+06 0.26175210E+07 -0.74786250E+05 0.14999998E+09 0.12820510E+07 -0.74786375E+05 0.19230770E+07 0.57692300E+07 -0.74786250E+05 0.96153840E+07 -0.12179488E+08 -0.26175210E+07 0.28846144E+08 0.57692300E+07 0.14999998E+09 0.26175210E+07 0.57692300E+07 0.28846144E+08 -0.74786375E+05 -0.12179487E+08 0.96153850E+07 0.74786375E+05 0.57692310E+07 0.19230760E+07 0.50256412E+06 0.32031250E+00 -0.68750000E+00 -0.12564106E+06 0.74786375E+05 -0.26175220E+07 -0.12207031E-03 0.74786437E+05 0.74786187E+05 -0.12564106E+06 0.26175220E+07 -0.74786375E+05 0.15000002E+09 0.12820520E+07 -0.74786312E+05 0.19230770E+07 0.57692320E+07 -0.74786250E+05 0.96153840E+07 -0.12179490E+08 -0.26175220E+07 0.28846160E+08 0.57692320E+07 0.15000000E+09 0.26175220E+07 0.57692320E+07 0.28846160E+08 -0.74786437E+05 -0.12179483E+08 0.96153830E+07 0.74786312E+05 0.57692320E+07 0.19230770E+07 0.50256419E+06 0.41406250E+00 0.85937500E-01 -0.12564106E+06 0.74786375E+05 0.36621094E-03 0.74786312E+05 0.74786375E+05 -0.12564106E+06 0.26175220E+07 -0.74786375E+05 0.15000002E+09 0.12820510E+07 -0.74786312E+05 0.19230770E+07 -0.74786312E+05 0.96153860E+07 -0.12179491E+08 -0.26175220E+07 0.28846160E+08 0.57692320E+07 0.15000002E+09 0.26175220E+07 0.57692320E+07 -0.74786375E+05 -0.12179491E+08 0.96153880E+07 0.74786375E+05 0.57692320E+07 0.19230770E+07 0.25128206E+06 0.46367550E+06 0.36621094E-03 0.74786312E+05 0.74786375E+05 -0.62820531E+05 0.10769230E+07 0.75000016E+08 -0.74786312E+05 0.96153860E+07 -0.12179491E+08 -0.15405990E+07 0.14423080E+08 0.75000000E+08 0.26175210E+07 0.57692300E+07 0.28846144E+08 0.96153831E+06 0.50256406E+06 -0.10937500E+00 0.54687500E-01 -0.12564100E+06 0.74786250E+05 -0.26175210E+07 0.74786312E+05 -0.12564100E+06 0.26175210E+07 -0.74786312E+05 0.14999998E+09 0.12820520E+07 -0.74786312E+05 0.19230770E+07 0.57692310E+07 -0.12179486E+08 -0.26175210E+07 0.28846144E+08 0.57692300E+07 0.14999998E+09 0.26175210E+07 0.57692300E+07 0.28846144E+08 0.96153840E+07 0.74786312E+05 0.57692300E+07 0.19230770E+07 0.50256412E+06 0.24218750E+00 -0.38281250E+00 -0.12564106E+06 0.74786375E+05 -0.26175220E+07 -0.48828125E-03 0.74786312E+05 0.74786312E+05 -0.12564100E+06 0.26175210E+07 -0.74786375E+05 0.14999998E+09 0.12820510E+07 -0.74786312E+05 0.19230770E+07 0.57692310E+07 -0.74786250E+05 0.96153820E+07 -0.12179487E+08 -0.26175210E+07 0.28846160E+08 0.57692300E+07 0.14999998E+09 0.26175220E+07 0.57692310E+07 0.28846160E+08 -0.74786375E+05 -0.12179485E+08 0.96153840E+07 0.74786312E+05 0.57692310E+07 0.19230770E+07 0.50256412E+06 -0.23437500E-01 0.34375000E+00 -0.12564100E+06 0.74786250E+05 -0.26175210E+07 0.24414062E-03 0.74786312E+05 0.74786312E+05 -0.12564100E+06 0.26175210E+07 -0.74786312E+05 0.15000000E+09 0.12820520E+07 -0.74786312E+05 0.19230770E+07 0.57692310E+07 -0.74786312E+05 0.96153850E+07 -0.12179488E+08 -0.26175210E+07 0.28846144E+08 0.57692300E+07 0.15000000E+09 0.26175210E+07 0.57692310E+07 0.28846144E+08 -0.74786312E+05 -0.12179488E+08 0.96153850E+07 0.74786375E+05 0.57692300E+07 0.19230770E+07 0.50256406E+06 0.19531250E+00 -0.27343750E+00 -0.12564100E+06 0.74786312E+05 -0.26175210E+07 0.48828125E-03 0.74786312E+05 0.74786250E+05 -0.12564100E+06 0.26175210E+07 -0.74786312E+05 0.14999998E+09 0.12820510E+07 -0.74786375E+05 0.19230770E+07 0.57692310E+07 -0.74786250E+05 0.96153820E+07 -0.12179488E+08 -0.26175210E+07 0.28846144E+08 0.57692300E+07 0.14999998E+09 0.26175210E+07 0.57692300E+07 0.28846160E+08 -0.74786375E+05 -0.12179485E+08 0.96153850E+07 0.74786375E+05 0.57692310E+07 0.19230770E+07 0.50256412E+06 -0.55468750E+00 -0.32812500E+00 -0.12564106E+06 0.74786250E+05 -0.26175220E+07 -0.24414062E-03 0.74786312E+05 0.74786312E+05 -0.12564100E+06 0.26175210E+07 -0.74786375E+05 0.15000002E+09 0.12820510E+07 -0.74786375E+05 0.19230770E+07 0.57692320E+07 -0.74786312E+05 0.96153830E+07 -0.12179486E+08 -0.26175210E+07 0.28846144E+08 0.57692310E+07 0.15000002E+09 0.26175220E+07 0.57692320E+07 0.28846160E+08 -0.74786312E+05 -0.12179486E+08 0.96153830E+07 0.74786312E+05 0.57692300E+07 0.19230760E+07 0.50256419E+06 0.53906250E+00 0.15625000E-01 -0.12564106E+06 0.74786250E+05 -0.73242187E-03 0.74786562E+05 0.74786125E+05 -0.12564106E+06 0.26175220E+07 -0.74786250E+05 0.15000005E+09 0.12820520E+07 -0.74786375E+05 0.19230770E+07 -0.74786125E+05 0.96153870E+07 -0.12179498E+08 -0.26175230E+07 0.28846160E+08 0.57692320E+07 0.15000002E+09 0.26175220E+07 0.57692320E+07 -0.74786625E+05 -0.12179486E+08 0.96153900E+07 0.74786500E+05 0.57692330E+07 0.19230770E+07 0.25128206E+06 0.46367500E+06 -0.61035156E-03 0.74786312E+05 0.74786375E+05 -0.62820516E+05 0.10769230E+07 0.75000000E+08 -0.74786312E+05 0.96153830E+07 -0.12179487E+08 -0.15405980E+07 0.14423077E+08 0.75000000E+08 0.26175210E+07 0.57692310E+07 0.28846144E+08 0.96153856E+06 0.50256406E+06 0.18750000E+00 0.23437500E-01 -0.12564100E+06 0.74786312E+05 -0.26175210E+07 0.74786312E+05 -0.12564100E+06 0.26175210E+07 -0.74786312E+05 0.14999998E+09 0.12820510E+07 -0.74786312E+05 0.19230770E+07 0.57692300E+07 -0.12179487E+08 -0.26175210E+07 0.28846160E+08 0.57692310E+07 0.14999998E+09 0.26175210E+07 0.57692310E+07 0.28846144E+08 0.96153830E+07 0.74786312E+05 0.57692310E+07 0.19230770E+07 0.50256406E+06 -0.24218750E+00 -0.62500000E-01 -0.12564100E+06 0.74786250E+05 -0.26175210E+07 0.74786375E+05 0.74786250E+05 -0.12564100E+06 0.26175210E+07 -0.74786250E+05 0.15000000E+09 0.12820510E+07 -0.74786437E+05 0.19230760E+07 0.57692290E+07 -0.74786312E+05 0.96153850E+07 -0.12179488E+08 -0.26175210E+07 0.28846144E+08 0.57692300E+07 0.14999998E+09 0.26175210E+07 0.57692300E+07 0.28846144E+08 -0.74786375E+05 -0.12179487E+08 0.96153840E+07 0.74786375E+05 0.57692310E+07 0.19230770E+07 0.50256412E+06 0.20312500E+00 -0.24218750E+00 -0.12564100E+06 0.74786312E+05 -0.26175210E+07 0.85449219E-03 0.74786375E+05 0.74786250E+05 -0.12564100E+06 0.26175210E+07 -0.74786312E+05 0.14999998E+09 0.12820510E+07 -0.74786312E+05 0.19230770E+07 0.57692310E+07 -0.74786250E+05 0.96153850E+07 -0.12179488E+08 -0.26175210E+07 0.28846160E+08 0.57692320E+07 0.15000000E+09 0.26175210E+07 0.57692320E+07 0.28846160E+08 -0.74786312E+05 -0.12179485E+08 0.96153820E+07 0.74786312E+05 0.57692310E+07 0.19230770E+07 0.50256412E+06 0.22656250E+00 0.25000000E+00 -0.12564100E+06 0.74786375E+05 -0.26175210E+07 0.24414062E-03 0.74786312E+05 0.74786312E+05 -0.12564100E+06 0.26175210E+07 -0.74786312E+05 0.15000000E+09 0.12820510E+07 -0.74786312E+05 0.19230770E+07 0.57692300E+07 -0.74786312E+05 0.96153850E+07 -0.12179489E+08 -0.26175210E+07 0.28846160E+08 0.57692310E+07 0.15000000E+09 0.26175210E+07 0.57692310E+07 0.28846144E+08 -0.74786312E+05 -0.12179489E+08 0.96153860E+07 0.74786312E+05 0.57692320E+07 0.19230770E+07 0.50256412E+06 0.18750000E+00 -0.82031250E+00 -0.12564106E+06 0.74786125E+05 -0.26175220E+07 0.36621094E-03 0.74786500E+05 0.74786187E+05 -0.12564100E+06 0.26175210E+07 -0.74786187E+05 0.15000002E+09 0.12820520E+07 -0.74786500E+05 0.19230780E+07 0.57692330E+07 -0.74786250E+05 0.96153880E+07 -0.12179493E+08 -0.26175220E+07 0.28846160E+08 0.57692310E+07 0.15000002E+09 0.26175220E+07 0.57692330E+07 0.28846160E+08 -0.74786437E+05 -0.12179487E+08 0.96153850E+07 0.74786437E+05 0.57692310E+07 0.19230770E+07 0.50256425E+06 -0.69531250E+00 -0.15625000E+00 -0.12564106E+06 0.74786437E+05 -0.85449219E-03 0.74786312E+05 0.74786312E+05 -0.12564106E+06 0.26175220E+07 -0.74786500E+05 0.15000003E+09 0.12820520E+07 -0.74786250E+05 0.19230770E+07 -0.74786312E+05 0.96153820E+07 -0.12179484E+08 -0.26175210E+07 0.28846160E+08 0.57692320E+07 0.15000003E+09 0.26175220E+07 0.57692330E+07 -0.74786312E+05 -0.12179484E+08 0.96153820E+07 0.74786187E+05 0.57692310E+07 0.19230770E+07 0.25128212E+06 0.46367594E+06 0.97656250E-03 0.74786375E+05 0.74786375E+05 -0.62820547E+05 0.10769240E+07 0.75000016E+08 -0.74786375E+05 0.96153890E+07 -0.12179494E+08 -0.15405990E+07 0.14423084E+08 0.75000000E+08 0.26175210E+07 0.57692300E+07 0.28846144E+08 0.96153831E+06 0.50256406E+06 -0.15625000E+00 0.70312500E-01 -0.12564100E+06 0.74786250E+05 -0.26175210E+07 0.74786312E+05 -0.12564100E+06 0.26175210E+07 -0.74786312E+05 0.14999998E+09 0.12820520E+07 -0.74786375E+05 0.19230770E+07 0.57692310E+07 -0.12179486E+08 -0.26175210E+07 0.28846144E+08 0.57692300E+07 0.14999998E+09 0.26175210E+07 0.57692300E+07 0.28846144E+08 0.96153840E+07 0.74786375E+05 0.57692300E+07 0.19230760E+07 0.50256406E+06 0.70312500E-01 -0.14843750E+00 -0.12564100E+06 0.74786312E+05 -0.26175210E+07 -0.85449219E-03 0.74786375E+05 0.74786250E+05 -0.12564100E+06 0.26175210E+07 -0.74786312E+05 0.14999998E+09 0.12820510E+07 -0.74786375E+05 0.19230770E+07 0.57692310E+07 -0.74786250E+05 0.96153820E+07 -0.12179487E+08 -0.26175210E+07 0.28846144E+08 0.57692300E+07 0.14999998E+09 0.26175210E+07 0.57692300E+07 0.28846144E+08 -0.74786375E+05 -0.12179484E+08 0.96153830E+07 0.74786312E+05 0.57692300E+07 0.19230770E+07 0.50256412E+06 -0.24218750E+00 -0.25000000E+00 -0.12564100E+06 0.74786312E+05 -0.26175210E+07 -0.24414062E-03 0.74786312E+05 0.74786312E+05 -0.12564100E+06 0.26175210E+07 -0.74786375E+05 0.15000000E+09 0.12820510E+07 -0.74786312E+05 0.19230770E+07 0.57692320E+07 -0.74786312E+05 0.96153830E+07 -0.12179486E+08 -0.26175210E+07 0.28846144E+08 0.57692310E+07 0.15000000E+09 0.26175210E+07 0.57692310E+07 0.28846160E+08 -0.74786312E+05 -0.12179486E+08 0.96153830E+07 0.74786312E+05 0.57692300E+07 0.19230760E+07 0.50256419E+06 0.59375000E+00 -0.60937500E+00 -0.12564106E+06 0.74786375E+05 -0.26175220E+07 -0.73242187E-03 0.74786437E+05 0.74786250E+05 -0.12564106E+06 0.26175220E+07 -0.74786312E+05 0.15000003E+09 0.12820520E+07 -0.74786375E+05 0.19230770E+07 0.57692330E+07 -0.74786187E+05 0.96153850E+07 -0.12179493E+08 -0.26175220E+07 0.28846160E+08 0.57692320E+07 0.15000003E+09 0.26175220E+07 0.57692320E+07 0.28846160E+08 -0.74786500E+05 -0.12179487E+08 0.96153880E+07 0.74786375E+05 0.57692330E+07 0.19230770E+07 0.50256412E+06 0.85937500E-01 0.15781250E+01 -0.12564100E+06 0.74786250E+05 -0.26175200E+07 0.74786312E+05 0.74786312E+05 -0.12564100E+06 0.26175210E+07 -0.74786187E+05 0.15000000E+09 0.12820520E+07 -0.74786312E+05 0.19230770E+07 0.57692300E+07 -0.74786375E+05 0.96153870E+07 -0.12179490E+08 -0.26175210E+07 0.28846144E+08 0.57692300E+07 0.15000000E+09 0.26175200E+07 0.57692290E+07 0.28846144E+08 -0.74786375E+05 -0.12179490E+08 0.96153870E+07 0.74786437E+05 0.57692300E+07 0.19230770E+07 0.50256400E+06 -0.12890625E+01 -0.11250000E+01 -0.12564100E+06 0.74786187E+05 -0.85449219E-03 0.74786250E+05 0.74786312E+05 -0.12564100E+06 0.26175200E+07 -0.74786312E+05 0.14999998E+09 0.12820510E+07 -0.74786437E+05 0.19230770E+07 -0.74786312E+05 0.96153800E+07 -0.12179482E+08 -0.26175200E+07 0.28846144E+08 0.57692280E+07 0.14999998E+09 0.26175220E+07 0.57692310E+07 -0.74786375E+05 -0.12179482E+08 0.96153820E+07 0.74786312E+05 0.57692280E+07 0.19230760E+07 0.25128206E+06 0.46367419E+06 -0.85449219E-03 0.74786250E+05 0.74786312E+05 -0.62820488E+05 0.10769230E+07 0.75000000E+08 -0.74786312E+05 0.96153800E+07 -0.12179482E+08 -0.15405980E+07 0.14423071E+08 0.75000000E+08 0.26175210E+07 0.57692310E+07 0.28846160E+08 0.96153850E+06 0.50256412E+06 0.70312500E+00 -0.13281250E+00 -0.12564106E+06 0.74786375E+05 -0.26175220E+07 0.74786312E+05 -0.12564106E+06 0.26175220E+07 -0.74786375E+05 0.15000000E+09 0.12820510E+07 -0.74786250E+05 0.19230770E+07 0.57692310E+07 -0.12179488E+08 -0.26175220E+07 0.28846160E+08 0.57692320E+07 0.15000000E+09 0.26175220E+07 0.57692320E+07 0.28846160E+08 0.96153840E+07 0.74786250E+05 0.57692320E+07 0.19230770E+07 0.50256412E+06 0.28906250E+00 0.39843750E+00 -0.12564100E+06 0.74786375E+05 -0.26175210E+07 0.24414062E-03 0.74786250E+05 0.74786375E+05 -0.12564100E+06 0.26175210E+07 -0.74786312E+05 0.15000000E+09 0.12820510E+07 -0.74786312E+05 0.19230770E+07 0.57692300E+07 -0.74786437E+05 0.96153870E+07 -0.12179488E+08 -0.26175210E+07 0.28846160E+08 0.57692310E+07 0.15000000E+09 0.26175210E+07 0.57692310E+07 0.28846144E+08 -0.74786250E+05 -0.12179491E+08 0.96153850E+07 0.74786312E+05 0.57692310E+07 0.19230770E+07 0.50256412E+06 0.25000000E+00 -0.27343750E+00 -0.12564100E+06 0.74786187E+05 -0.26175210E+07 0.36621094E-03 0.74786500E+05 0.74786187E+05 -0.12564100E+06 0.26175210E+07 -0.74786187E+05 0.15000000E+09 0.12820520E+07 -0.74786437E+05 0.19230780E+07 0.57692310E+07 -0.74786250E+05 0.96153880E+07 -0.12179493E+08 -0.26175220E+07 0.28846160E+08 0.57692310E+07 0.15000000E+09 0.26175220E+07 0.57692320E+07 0.28846160E+08 -0.74786437E+05 -0.12179487E+08 0.96153850E+07 0.74786437E+05 0.57692310E+07 0.19230770E+07 0.50256412E+06 -0.15234375E+01 -0.78125000E-01 -0.12564100E+06 0.74786250E+05 -0.26175210E+07 -0.85449219E-03 0.74786312E+05 0.74786312E+05 -0.12564100E+06 0.26175200E+07 -0.74786250E+05 0.15000000E+09 0.12820520E+07 -0.74786437E+05 0.19230770E+07 0.57692300E+07 -0.74786312E+05 0.96153820E+07 -0.12179484E+08 -0.26175200E+07 0.28846144E+08 0.57692280E+07 0.15000000E+09 0.26175210E+07 0.57692300E+07 0.28846144E+08 -0.74786312E+05 -0.12179484E+08 0.96153820E+07 0.74786312E+05 0.57692300E+07 0.19230760E+07 0.50256419E+06 0.94531250E+00 -0.10156250E+01 -0.12564106E+06 0.74786625E+05 -0.26175230E+07 -0.12207031E-03 0.74786312E+05 0.74786250E+05 -0.12564106E+06 0.26175230E+07 -0.74786625E+05 0.15000002E+09 0.12820510E+07 -0.74786062E+05 0.19230780E+07 0.57692330E+07 -0.74786312E+05 0.96153820E+07 -0.12179482E+08 -0.26175220E+07 0.28846160E+08 0.57692340E+07 0.15000002E+09 0.26175220E+07 0.57692350E+07 0.28846160E+08 -0.74786250E+05 -0.12179482E+08 0.96153790E+07 0.74786062E+05 0.57692330E+07 0.19230780E+07 0.50256425E+06 0.42109375E+01 0.16250000E+01 -0.12564100E+06 0.74786500E+05 0.74786687E+05 0.74786250E+05 -0.12564119E+06 0.26175240E+07 -0.74786125E+05 0.15000006E+09 0.12820520E+07 -0.74786187E+05 0.19230770E+07 -0.74786250E+05 0.96154010E+07 -0.12179514E+08 -0.26175250E+07 0.28846192E+08 0.57692380E+07 0.15000005E+09 0.26175210E+07 0.57692320E+07 -0.74786687E+05 -0.12179502E+08 0.96154010E+07 0.74786687E+05 0.57692390E+07 0.19230790E+07 0.25128194E+06 0.46367419E+06 0.97656250E-03 0.74785812E+05 0.74786750E+05 -0.62820441E+05 0.10769220E+07 0.74999952E+08 -0.74786750E+05 0.96153810E+07 -0.12179472E+08 -0.15405970E+07 0.14423061E+08 0.75000000E+08 0.26175220E+07 0.57692310E+07 0.28846160E+08 0.96153850E+06 0.50256419E+06 -0.46875000E-01 -0.21093750E+00 -0.12564106E+06 0.74786375E+05 -0.26175220E+07 0.74786312E+05 -0.12564106E+06 -0.74786375E+05 0.15000002E+09 0.12820510E+07 -0.74786312E+05 0.19230770E+07 0.57692310E+07 -0.12179488E+08 -0.26175220E+07 0.57692320E+07 0.15000002E+09 0.26175220E+07 0.57692320E+07 0.28846160E+08 0.96153840E+07 0.74786250E+05 0.19230770E+07 0.50256419E+06 0.78125000E-02 -0.14843750E+00 -0.12564106E+06 0.74786312E+05 -0.26175220E+07 0.24414062E-03 0.74786375E+05 -0.12564100E+06 -0.74786312E+05 0.15000002E+09 0.12820510E+07 -0.74786437E+05 0.19230770E+07 0.57692310E+07 -0.74786437E+05 -0.12179488E+08 -0.26175210E+07 0.57692310E+07 0.15000002E+09 0.26175220E+07 0.57692310E+07 0.28846160E+08 -0.74786250E+05 0.96153850E+07 0.74786312E+05 0.19230770E+07 0.50256412E+06 0.23437500E-01 0.28125000E+00 -0.12564106E+06 0.74786500E+05 -0.26175220E+07 0.24414062E-03 0.74786375E+05 -0.12564100E+06 -0.74786500E+05 0.15000000E+09 0.12820510E+07 -0.74786187E+05 0.19230770E+07 0.57692310E+07 -0.74786437E+05 -0.12179482E+08 -0.26175210E+07 0.57692320E+07 0.15000002E+09 0.26175210E+07 0.57692320E+07 0.28846160E+08 -0.74786125E+05 0.96153810E+07 0.74786187E+05 0.19230770E+07 0.50256400E+06 0.11640625E+01 0.13359375E+01 -0.12564100E+06 0.74786312E+05 -0.26175200E+07 0.97656250E-03 0.74786375E+05 -0.12564100E+06 -0.74786187E+05 0.14999998E+09 0.12820510E+07 -0.74786312E+05 0.19230760E+07 0.57692280E+07 -0.74786375E+05 -0.12179494E+08 -0.26175220E+07 0.57692310E+07 0.14999998E+09 0.26175200E+07 0.57692280E+07 0.28846144E+08 -0.74786312E+05 0.96153890E+07 0.74786500E+05 0.19230770E+07 0.50256406E+06 -0.31093750E+01 -0.27187500E+01 -0.12564106E+06 0.74785812E+05 -0.26175220E+07 -0.12207031E-03 0.74786250E+05 -0.12564094E+06 -0.74786125E+05 0.15000000E+09 0.12820520E+07 -0.74786937E+05 0.19230780E+07 0.57692350E+07 -0.74786312E+05 -0.12179482E+08 -0.26175190E+07 0.57692270E+07 0.15000002E+09 0.26175230E+07 0.57692330E+07 0.28846160E+08 -0.74786250E+05 0.96153790E+07 0.74786375E+05 0.19230750E+07 0.50256425E+06 -0.35390625E+01 0.13046875E+01 -0.12564100E+06 0.74786562E+05 0.73242187E-03 0.74786250E+05 -0.12564100E+06 -0.74786562E+05 0.15000005E+09 0.12820500E+07 -0.74786062E+05 0.19230760E+07 -0.74786250E+05 -0.12179474E+08 -0.26175200E+07 0.57692300E+07 0.15000000E+09 0.26175200E+07 0.57692300E+07 -0.74786250E+05 0.96153740E+07 0.74786000E+05 0.19230760E+07 0.25128200E+06 0.46367700E+06 0.97656250E-03 0.74786375E+05 -0.62820547E+05 0.74999984E+08 -0.74786375E+05 -0.12179494E+08 -0.15405990E+07 0.44230768E+08 0.15405980E+07 0.14423078E+08 0.25128206E+06 -0.46367525E+06 -0.62820520E+05 -0.10769230E+07 0.75000000E+08 0.15405980E+07 0.14423078E+08 0.25128206E+06 -0.46367462E+06 -0.62820488E+05 -0.10769230E+07 0.74999984E+08 0.15405980E+07 0.14423071E+08 0.25128206E+06 -0.46367625E+06 -0.62820543E+05 -0.10769240E+07 0.75000016E+08 0.15405990E+07 0.14423084E+08 0.25128206E+06 -0.46367419E+06 -0.62820488E+05 -0.10769230E+07 0.75000000E+08 0.15405980E+07 0.14423071E+08 0.25128187E+06 -0.46367400E+06 -0.62820441E+05 -0.10769220E+07 0.74999936E+08 0.15405970E+07 0.14423061E+08 0.25128200E+06 -0.46367694E+06 -0.62820543E+05 0.74999984E+08 0.15405990E+07 0.12564106E+06 Matrix/inst/external/Z_NA_rnk.rds0000644000176200001440000001303013507406613016472 0ustar liggesusersUFww'wN$H2;33;38{_.=럵޼SյKns)FIO0Y[O#6rށѨ^Fvo4!j<<Ƌa̶B4x&ǘφxN0x.2k‹ 72^OϱxA֟xQx %9vaRIc_`DkKOh<:Ӱ023Ƌ|Jcmx9xFᙌY6013^0@xUyX|k m<;'+_m\6?5x|#cklxܘk1nckwכ_s41kŇk1cA}cS9Wos/7c̹hbܹ^ecƖƌU͗3V5e|2V4?벽 ~va o`cF^/1> xce,x#?a|<˷4>xjh^fgÍ/Yr]_?_ xu 4'd||1aC;/8Ɨ{_ l||;m|k6ߘχ)_81σ816Nc̱_ c\?sK/3f 7x錹_Ϸ81Zј{)d̹3soYlda\ߚ?e}<-7zksŵ9q#͍0[/p=]πw5>͘/ne|4ɘ{?3ގ;so{/D-{wN5f<_n|=|D}ˏ4>&ƌhK}K~ƌ%qccx1g<*.Xr8Xc8cxmg[3& bИX)\dL.6& ? _n|]}]wçltcbp Ħcbp1uΘX<\o*|kg? m|cbp1J՘&fNj|$g;n̳*aL4~ܘ,&O?i31_˘\*mL1~x4ƿ{?7&w +2 ~wy;S1^rxix"^2&/Og]G~>7 ˜<|iLl2ژ|8bL^5& ׍gMcqm<T7[cbx;|o<6x[ÏK'cջ~ xA4^2^xQxcW1Vs곿쭒^ 83^xxbeIɵs=sp05&'7/grqAcr1P\٘\(bL.W5&ՍE"qMc~k qcr1`\̘\0.ṉKťqCcb1KԘ&nbL76&ufǍ;_N2& obՌ9aec򽰃1Q8e (6Ɩa cbpUĮPcr0Ҙ\$lL,FA2a1P8֘cw?r0И?W8ژ\3ḵ C¶cr1MØX>fLFݍÉBa/cbp1pXxxEcrp1HcƧz63ޅ9͟bƌga~c]5=,j̵4w˘s5\̘Y01~k/,\a6'5sœƜ˰D_0]x|Ϙ~372fh>kܹS5m7ɘ\ >h'wKoĖE[Nnr>}=^۞rmorxO_5&+"[X_=ac5o̶y]\$>bLn/6&7sƣGuƸӌɍ?߇1VPȎ=\akGQͪ/`̵ך?_۞G~ձm ?ܞO:f1؟|U̘sX[}M:F n*V(y>mw6c,ƚ/zxpjVdƚXƊ&7޺}~kVnk.kNcŲ`1VVbu5W7rEu-niar-{oocF +X: +V[Xuo 6V컖bemks1cvkXf-64Vl1Z+Yz2V.6Xƺ?ھkV쾹rdwucb+w[X 6V켐ru`+)[X:۵LJ5jd cBkkdnS}^mVmibi;1js>56XύOƪ=6UyfC}c|֬Z]o{ǻxYU[Me^j3&ǟOjƪ Nlz''c}elxD;^Y4mޥ/ԼS^z>5֎wxd~OPc%۷~|Y]Wt5w7|5녙4J0t5^ j׋"z9B/袗?^ЋzA/$%yP * *ΪўHQ *W5IZ*\ P\ ךQԀ&*52YI AjQ#i԰O5B /jBQ@&5~B jJĽ&5!I^Mkr\ܚd_jUS5Y OM"j"PeӤ&4aI:M|i2K jTc &J5"O rjrS㞚Ԡ/UVADErT"K +QCIQ%Jd)S2^E%J@hFk߾&ҍS zhAZ" T*Pp@A/=*R N7 2zi@tTd׋"zYE/^ы` [ЋKzJ/84᠗x4q4$“&הi]ajV5+5%Mi2H/5kIj8SӠl85qLdj IDjRԌ5D$jQW, jBBo%>D[W-JoMkGEA߫ RUt{( VЍY{ÿW>=TĿW^{ſWB*H߫[%5ѭ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))~{o|t=F1fĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿĿWWW@\TOIO9żz}?;o;z_ˈzF!J˯1xԈخ4x(bOpdMAMatrix/inst/external/wrong.mtx0000644000176200001440000000010311204272304016170 0ustar liggesusers%%MatrixMarket matrix coordinate integer general 2 3 2 0 1 1 1 3 4 Matrix/inst/external/wrld_1deg_slots.rda0000644000176200001440000035070210770571602020115 0ustar liggesusers\lՕ޸ !xp%wwwww^U|s7!vz|,li:kؿ[:a]1w)~[Z?oٓ~Ҟʞڞƞ{3ƴg,{ƶg{Ƶg<{Ʒg{&Y?'2ᆴ)~5N3ԃu{g:{g{fg&{fg{ך}1Xganw?ysw?~ ~ ~a,wޖ}M8xO,cϲg=+س=ٳ`]ybϟY՞Yݞ5Zu{r^{Nj_+u|c=g>;dž|F6r泲3?Ck 5ڤ59۴5۬5ۼ5YyV{tʞm֞ޞўŞ]=ٳ[y3:[Lg_|&p33ɽgog>8י~|&| .eAl!Ж>??n fh ~l j v}3cg>85'Nl I왓78wNuf:ݙ=t3{LgYs3{gйC;.pf]ș=t3{gХ˜C;pڞ+W횖ݵ=x]kx?^ޛ7s=;Þ;˞{מߞyGiϣΏ yž'yʞyƞg[3ޙə3g-C^~ݙ_g7o9vf/^~י3{}g9?vf/^ԙ3{sgΧ3{+go:sf/^3{'g_˿:_gr-vOf/eu;Xf=Nex;mf:̓nfncϲOs~mڻmf6>n-2{=̞n/2{=̞nO,^_׶msYf_mfmS42=nO' 2=n$3,2=n&۳2=n%s<2=n'ew{^Pfew{^Tfew{ g[K:ۿr^wOζ8n/{wԶ;nlJζ+;n<׶kWfc{vc:}^b/>> >퍝}s>M>͝>->>m>>>;翽}ۻ8翽}p{7gwg>r3=og>8י~|w3g9jV櫶Tm6;m^jیԶ9mO敶5o{gc>ڼѶ=s`e\~ԙr3rg+/W9_vf\~֙r3zg /79_nvf~ՙr3vg;/w9_vf~יr3~g/9_vf<~yԙ3qg'/O9_vf<~y֙=3{YY`i`e7X{;>pf~̞5??n OZ5?wi`eaaava^aFa.a9ݞ3/3o[{惎1~N)챹=o>tWޯm뛎n=[fwƑqexg<=_fw& exg"=ޙXfw&Iex2{3L.;SΔ2{3L-;δ2{3L/;3Ό2{3,;ά2{3.;sΜ2{3-:8;Xmls!ζ;:>lsοmwp}9ҙ9Qζ;G;>lsqζ;;>ls 5낎uAfw9ͽ}mб>Xtl|߱cso/nfڽn>\X׭9s9p3Μw9s9p3Μ9s93Μ9s<93Μ9s<93ΜO9s<93Μ9s<93Μ/9s9`}p6X5:ǜܻܭܧܡ;^kxߙ3g΍97>rؙsg΍O97>sܙs g΍/97rڙsg΍o97sޙsg΍97~rٙsgί2cVvtk 5@fyԍ[R7i QTeΜjҵZtm.Ztζud1X7ccmѵkJcg`wB;̹؝5tFv'i I[Cggs;ܹ~=搮]76ctm2;ܝ5zwg;ۯgve2̶;G)wsݝ5twm ]{[O.5FW:=>{;+w{tunbK+wѻ{uo*[]YWk{jcjwVFgkMa[Y[S9>X]۝vWknl۽Ǚ;85vut{c݇>lXQgǺ9=}vut{cݧ>lXYgǺ9=} vu_t{cݗlXUgǺ9=ֵ3xrgq/qm0xcC+wwwڧѻqϝ~l\KgW7vqǍvuuo~l[Ggߺ?9/vuu޹b?s2K3[+sz2[/z֋d^,soL~2[z֫d^-s7"sƐzcod2[o7O~/s&zod2[o;7]ܵM<`{cٛjN=Xc9{+wfo:c>_K{3ܥYdެ2jo6;7{k{{s]\sVwzv~ٽҳgE=#zv/y߳3gz=lݯ-+ss{ܹdފrZʃ2 Z{ V;{ܽ7ڰ[G+s֓{ͽ dކ2so#;ܵ~oZ`ye~حvW{սmev2wuo{]Q$sW.sWv{ս]e?dn2wu2wuow/]S%wkqrZGVN{F!rZwa3;C=;F+w-{9s}:x(s#sN{'Sdީr׺wywFe)3 Βzgsdf޹2@gz;,{fރ6 rYG u ǝmf=lCIg!zO9,{f36[umlFEg5z/9۬{f+6k^uYםmי gf7[[Nkxfy5<eo 5g}{97|V|s`~߹cѹ,XSf> ֒ӂe/2s[+3o2s\Ll(u76 -g`+{7|&hh8ڜ"]_+#jb{eNd6]m. =e`/1[fF }ef`?1_fF ef 18XfF Cef018\fF -3#G̈23bp̌-3#̈23bp̌/3#'̈23b18IfF NSdfT18MfF N3dfL18KfF Ζsdf\18OfF Η dfB1HfF .KdfR1LfF .+dfJ1JfF kdfZ1NfF dfF1IfF n[dfV1MfF n;dfN1KfF {df^1OfF dfA1xHfF GdQ1xLYs;?_/'[sfܳv~fwj <7XٜWZCkrkh ^i ʹ6x54=ko V~6#WY9f#gmV>qY9f3g/;ۼ|33WylMkx5 `2 >$`2 >"`2 >&a2->!c2=>%d2m>#h2>'l2 o2$o2"o2&o2 W7d.|5x[ ߖw5ah=ݴ8n ?c ?S ?s K k [ { G g WV[2]uZCu[Cd1 d1 e:2dz2e2Jd2Je2d2e2*d2*e2d2e2jd2h ƌƔih,n 5h4LFh4LFˡp46&ꯡΓ Vk4s'M1XG#4֍7#k2J~+M"{G:_hڟlMIg-iCV>icV>iSV>isViKVik^[k t`#ňF{̭}m^;2wez9rrrrrrrrr\r\r\r\rr<"2)X2-82+x2/2O(D2O,$2O*dz9Lez9Bcc|O-ӻ42O+ӽt2O/ 2=jx&9;yJ/dzW9M[C-xPcsz;5<m 5y<J W=^Pd=^XEd=^TȾxq%+m/_x)t=MO/+r2// 2վxeU_L u.=xվx fהix-fזi/2#2'2o 2o$2Uɑ}1 c_kLǛɴ|L[ȴ|L[ɴ|Lȴ|L35Ѳվx{.wxG.wrd_G.Z1?'.xhx6ix/6ix6ix?6i6i 6i6i06i2m!2m%GG;_|`iAzW:>>Ie:>>ESe:>>Me:>>C3e:>>Ke:>>Gse:>>Oe:>@ e:>He:>DKe:>Le:>B+e:>Je:>Fke:>Ne:>Ae:>Ie:>E[e:>Me:>C;e:>Ke:>G{e:>Oe:>~@e:>~He:>~DGe:>~Le:>~B'e:>~Je:>~Fge:>~Ne:>~Ae:>~Ie:>~EWe:>~Me:>Lot|Lot|Lt|Lt|Lt|Lt|Lǟt|Lǟt|L_t|L_t|Lt|Lt|L?t|L?t|Lǿt|L'-O2td:>t|ғ$$$4<>$2-OP'lIJ gk:/KξdJ'ct2L't2L't2L't2L't2L't2L'd2O&d Od*OdOd:OdOfd&OfdOfd6OfdOd.Od9U2|Zj?dOd!OdOd1Od wɒ2d$K˼H$ YF@;d9w2d$+ʼHVy,> YE}@gɪ2d$˼H֐y)N YK@v~{sXέ}'ɴ~L'ȱ}ɆW?'=uV:Md=Tߓd=\ߓ-d=Rߓd=Zߓmd=M91^L„Ftו&?eZ<]œɴxL'{ʴxL'{vkp׻L'wrL'wrL'˴xr[':6XZ~6ɑvOihOXOxONDO#I2,)2*i2.2)Y2-92+y2/2-\(E2M\,%2}\*e2͟\.2ݟ\)U2ݟ\-52ݟ\+u2ݟ\/ 2ݟ(M2ݟ,-2ݟ*m2ݟ.2ݟ)]2ݟ-=2ݟ+}2ݟ/2ݟ<(C2ݟ<,#2ݟ<*c2ݟ<.2ݟ<)S2ݟ<-32ݟ<+s2ݟi#O>iO>i3O>i Oi+OiOi;OiO~i'O~iO~i%i[ӎL]O{222F22&22f2222V22624~:Lc4~:Lc4~:L4~:^izZGWRwtbO'itJޣ}-d2ݝN.2ݝN)T2ݝN-42ݝN+t2ݝN/ 2ݝ(L2ݝ,,2ݝ*l2ݝ.2ݝ)\2ݝ-<2ݝ+|2ݝ/e;]@e;]HӅe;]DEe;]Le<]BNkKt^jZlyLee<]Ne<]Ae<]Iӕe<]E?tyLtyLktyLktyLt.Oוt=.Oחt.O7t#.O72]Mt9%yҗԚ1NL SkZ߭};tzL;zw9#yJz|/ j_oLtNOt/NOt9A35=5遭Oj ~zpkCľPgz[{O-2)Q2-12+'t} OO?2$2"2& =]]@z#=J&= =WAz̻|w2 eɼ;H/yw^" TAz̻rw2+eWɼ;Hyw^# VAz̻zw 2e7ɼ;Hoyw" UAz̻vw2;ewɼ;Hyw# WAz̻~w2eɼ;Hyw>" }TA̻qw2'eOɼ;Hyw># }VA̻yw 2e/ɼ;H_yw" }UA̻uweoȼ;Hߔyw% }[A̻]w{2eȼ;H?yw~$ XA̻Swg2e_ȼ;Hyw~% ZA̻[ww2e?ȼ;Hyw$'Lv!!kɼCh0~n>ul'> dd,y2D}@ʼ2Y.> +ddy2F}@6"> C}@6l,2qddʼƓy/> @}@6l"2Iddʼ > L}@6l ٔ2ddS˼ȦyM+> N}@6l9U6L5Y6`eҏ|oվlv~lN~ln~l^~l~~(2-(B2-,"2-*b2-.2-)R2--ٟd=[F߳ee=[N߳e=[A߳e=[I߳e=[E߳?{Lg4|Lgkt}Lgk4~Lgil֕il=֗il6il#6i2Mil6il36il ϶il+϶il϶il;϶ilvil'huk٭e֓475/-ilil/ilil?SsF_Ґt5afkJ'ZeW:8;\3g:8s3g:8s3|Nˎi8͎ig6ZtZe'lvLfȴmvLftnvLfgtnvLfgtnvLftnvLftnvLftnvLftnvLftnvLftnvLfWtnvLfWtnvLftnvLftnvLf7tnvLf7tnvLftnvLftnvLfwtnvLfwtnvLftnvLftnvLftnLftnLftnLftnLfOtnLfOtnLftnLftnLf/tnLf/tnLftnLftnLf ޔ-ޖޕ=ޗ>#>>3> ;+;;i;;w~p~t~ryvu[ޒi߼-ӾyG}L=C#cS3s K+kGd7C}1e7K}e7G}qe7O}e7@} e7H}e7D}I+K뎮րd2O.ӹ2O)ӹT2O-ӹ42O+ӻt2ݛO/ӿ rf <`៥ +]!2]%2]#2]'2]Qd8_Pd8_XEd8_Td8_\%d8_Rd8_Z?tqLtqLtqL+tqL+tqL|U.W|u.א|M.ג|m.":2]+z2]/2]o(F2]o,_e8L'&2]o*f2]o.2]o)V2]o-62]o+v2]o/2](N2]]ά{w.ݛӿiGWk|w%ӳ2=)ӳ^2==5ڲ|i@i`iP9su6?Bm#:8?Jg'6?Nme6?Ame6Oki:6?YcSd:6?Ucd:6?]c3d:6?Scd:6?[csd:6?Wcd:6?_c d:6Pcd:6XcKd:6Tcd:6\c+d:6Rcd:6Zckd:6Vcd:6^cd:6Qcd:6Yc[d:6Ucd:6]c;d:6Scd:6[c{d:6Wcd:6_cd:6Pcd:6XcGd:6Tcd:6\c'd:6Rcd:6Zcgd:6Vcd:6^cd:6Qcd:6YcWd:6Ucd:6]ctlLotlLotlLtlLtlLtlLtlLtlLtlL_tlL_4mY౮Ϳwptrvqu-Z2][etmѕڢ'ӵE ӵE(ӵE$ӵE,ӵE"ӵE*ӵE&ӵE.ӵE!ӵE)ӵE%ӵE-ӵE#ӵňLY40;[Q vc-Z#ӢŸ2-Z'Ӣ2-ZL Ӣń2-ZL$Ӣ_Ϭў,&2mYL&Ӗ2mYL!ӖŔ2mYL%Ӗ2mYL#ӖŴ2mYL'Ӗ2mY ӖŌ2mY$Ӗ2mY"ӖŬ2mY&Ӗ2mY!ӖŜ2mY%Ӗ2mY#Ӗż2mY'Ӗ2mYQ-dڲXP-dڲXX-EdڲXT-dڲX\-%dڲXR-dڲXZ-?ɴeL[ʴeL[˴eL[+ʴeL[,HqZbUN,VbuN,֐bMN,֒bmN,"Ӊ:2X+Ӊz2X/Ӊ2Xl(ӉF2Xl,ӌuva?~&?~&|t!=8Z [ʴ`L [˹ud3'[ezAezI`L`Lskb7V~G kb6,b/N,skbg~֌t"-H'i-گ8}A2W,}!2W*}a2W.}ſe8B#e8Je8Fce8Ne8AeL't_qLt_qLt_qLgt_qLgt_qLt_qLt_qLt_qLt_qLt_qLt_qLWt_qLWt_qLt_qLt_qL7t_qL7t_qLt_qLt_qLwt_qLwt_qLt_qLt_qLt_Lt_Lt_Lt_LOt_LOt_Lt_Lt_L/t_L/t_Lt_Lt_zxCέ'7t_vwdxWdx_dٚٚٚٚٚٚٚٚҙʙڙƙ֙Ιޙљəٙřg5ె+2 Wvd4\ٓi2i2i}Fce"ce*ce&ce.ce!ce)ce%ce-ce#cLcWZ]ʱdګRZtNZWtU9LWtU9LWtU9LWtU9LWtU*'rr*rJ*rj*rZ*rz*grF*grf*grV*grv,psߙV9Oye:Oe:Lg tVLg tVLgtVLgtVLgKtVLgKtVLg ӒkrP˷ڬ\A.EW]n;Z35wp5VLck4VLckW]ʿTLSʴU\Xo;3-iHkZؿV~3믴RL/RL/RL/[RL/[RL/RL/RL/;RL/rg^*wrW^*!Kn2TSezL/{RL/{RL/RL/RL/RyL/RyL/RyL/RyL/^*(^*J+GQyL˴QyL'ʴQ6*Oid6*OiT6*Oit6*ϐiL6*ϒil6*ϑi\6*ϓi|6*/iB6*/ib6*/iR6*/ir6*iJ6*ij6*iZ6*iz6*oiF6*oif6*oiV,osIF*.V*^*>^*^*!^*^*1^* ^*)^*^*9^*^*_쯿n6*_igȒτ5R߽ MB _*t)r)v)q)u)sέ?hf}f#gˏm/?q>u>s>wžpžtžržvžqžužsžwGg'ggg_m/ujU[f:2Օi'U U(U$U,U"U*U&U.U!U)U%U-U#ՈLTc4@5LTcɥZ58z]mƓe@ eH.ɪmT|i5j5_M)Z{kڬ_M#3Wt2~}S8XLۼ__YdjVfijvijNijnij^ij~(2-P-(B2-P-,"2-P-*b2-P-.2-P-)R2-P--՟dZZFeeZZNeZZAeZZIeZZE?˴@L Tɴ@L Tkȴ@L Tkɴ@L Tij֕ij=֗ij6tި&*+=@6Wզ2_m.3W[Ֆ2_m-3Wն2_m/3W;Վ2_]fv]djW_&3We_2_)3W{2_+3W2u_(3W2uLTt@uL T˴@oiHihiXixNiD#I2-P,)2-P*i2-PWlޮ쯥5U~`Nf6~ϭ6 WȥuNu3ٗyS|[]_mpͲE2lu,[]"3V̲e2lu,[]!3VW̲U2lu,[]#3V̲u6V;,[lluͲM6V7;,[lluͲm6VVc]GW[;mnrg&{mnsg[mnrzg]Gǵ1gx)g_m~qz9gf睭_/c[YU+`fWUfMg-gXVf=g]mv>pٵf#g]iOiOiϜiϝi/i/iiioioiiiiiii_i_mv[2kݖ]Zwef׺'3ցZ2k̮u,3։Z2k̮u.3օZ2k]̮u-3֍Z̮2k=Z%3c̮82k=Z'3̯23l=[O$3˕u^=Ce'gez yRfgezyVfgezyQfggezyUfggezySf璙gezyWf瓙ge2l<[/(3 ̳2l<[/*3֋̳2l<[/)3K̳2l'y^Ffgdzyy^AfWgdzey^Ef,3̳֫j2l<[!3k̳Z2l\Y՜'6Wz=ޫw`rNЄt F]VC̡ddz9Tf7Cez 9RfCez9VfCez9QfwC˕uX.޵2Gd2h\f-3G̦2sj}\b>[_edfx~Op>q߰^ee}ۭ֜μyg ln}ve֭ϑusef_f֭/u ef"YXf֭/uKef2Y\f֭u+ef*YZf֭ukef:Y^f֭ouef&gu뛝m֭oqYf6gu۝m֭pYf.gu뻝m֭qYf>gum֭pY~f!gF뇝m֭qY~f1guǝm֭pY~f)gu망m֭qY~f9gum֭_pY~f%gw뗝m_q~5g{םmlsoͽ6o9[lsoͽ69[lsoͽ69[lsoͽ6֟9[lsoͽ6_9[lsoͽ69[lsoͽ6?9[lsoͽ66-i̽MGfm2soӓ{@fmBd&{DfmRd&{BfmJdަ{FfmFdf Sfmƒ{eކbc3o3ی/36̿̈́rmL̹`ܰigzjn3̬L.36S̺͔2n3̬L-36̺ʹ2n3̬L/363̺͌2n3̬,36̺ͬ2n3̼.36s̽͜2so3-36̽ͼ2so3/36{dfAYHfm{EdfQYLfm%dfInr^zrepLܬ 37+J23qLܬ"37Uef5Y]f>n֐5eff-nvs)Zu+{FO<6G7Yll,3;7&2sl&3;72sl%3;7[62sl'3;72s$3;7effٹUfvn!3;7?effwٹ!3;7{^2s#3;7~2s 3;7A2ss"3;7a2ss[fvn#ef(ٹ9Zfvncef8ٹ9^fvnNef?2ssܜ,3;7ͩ2ssܜ.3;7g͙2ssܜ-3;7͹2ssܜ/3;7ͅ2ss\,3;7ͥ2ss\.3;7W͕2ss\-3;7͵2ss\/3;77͍2ss,3;78lss6;7w8lss6;78lss6;78:}ukg7o9[wNl>:}ugg/_9[~wNd:=MӃe:=CӃ1e:=KӃe:=GӃqe:=OӃe:=@Ӄ e:=HӃe:=DӃIe:=LӃLLLLLLLLLLLLLLLLL#d:=\Ӄ)d:=RӃd:=ZӃid:=VӃd:=^Ӄd:=QӃd:=L3tz0LtzWNf`vN`NNo2-<2]Ӄye:=OӃe:=X@Ӄe:=XHӃe:=XDӃEe:=XLئy?>2},%2},#2},'2} 2}$2}"2}&2}!2}%2}#2}'2}l l:c]w1]ݵn6` vkl-62l+v2l/2(N2,.2*n2.2)^2->2+~2/2(A2,!2*a2>޷k)Q2-12+q2/ 2(I2 <NSi|giw1wՃ3eZ=8KՃeZ=8GՃseZ=8OՃeZ=@Ճ eZ=HՃeZ=DՃKeZ=LՃez=Bۃ+e>J~vf{Шnol7;2|w.{e!shVnӆӞӶd6H $2$xDf1]<.K2$xBfO)]<-KgdvI. %2$xvI%g%ζKWm:. ^s]l$xvI-g%ζKwm:. s]l$vI#g%|l$vIsg%ζK/m_9. v]|l$vI{g%ζKm?9. ~v]l$vIwg%. G%2$Cfcp,]-KqdvI8. Ǔ%2$@fp"]N,KIdvI8. '%@f. C]F2$evI0%a&K\f. K]V2$evI쒰%a'~e]N.K)dvI8. %2$Ffp:]N/KdvI8. g%_dvI8. g%2$. g%2$Cfsp.]Mfslp]fi iDŽiӄ i߄ ʁp!Gw.];!!6{[wmKp).-_edK~ /2%\Af+p%,_UdK~ W/2%\Cfkp--_udK~ ד/2%@fr`;:ș]}Ulpcn"UMeJV 7*2[%Rf[lpkn#Wm6v37YN w)N2;%YfpW&SevJN )^2;%[fp_'SevJxN *A2%#ge6Pmyg@ ζm/9 _v l(|6Pmug@ζ7mo9 v l(|6Pm}g@ζm9?Tmg@ζϜm; p ~l(6Pmg@ζm; N G l? _;ζw_տ:sfWl{';h2{']fDchL%weN4މƕ;x2{'_fDhBM$weN4މ&;d2{'(;Q(wHfDމ2{'d6Ol3y ݈m̨k[&jeLl2-M.e)dL4̖22[&FfDlh:-M/edL4̖f2_dL4̖f2Ѭ2[&̖f22[&CfDsh.9-ygyeL4̞32{&ZPfD ha=-"gEeL̞4rh:ZywkeevM̮5 2&ZQfD+he]"kUevM̮V52&ZSfDkhm]#kuevM̮֗6rh9Й8766owvI&6$f2$\fD[lhKMm%Ie6I&$v2$^fD;lhGM$Ie6I&v$n2$]fD{lhOM%Ie6I&$~2$_fDl@M$Ie6It&$a2$:\fDGlHM%Ie6It&$q2$:^fD'lDM$Ie6It&N$i2$:]fDglLM%Ie6It&Ε$y2$:_fDlBM]$Ie6It&.$e2$\fDWlJM]%Ie6It&$u2$^fD7lFM$Ie6It&n$m2$]fDwlNM%Ie6It&$}2$_fDl?2$zPfDlaM="IGp×m#/[%zBfDOl)=-UgmD:Vs=l[%zٶJm%g*ζUWmD:V^sl[%zٶJm-g*ζUwmD:Vsl[%ٶJE9V>v}l[%ٶJmsg__Y?>K";g!ζCmD?:~rl;$ř-3[7gζC!&CevH<ǔ!X2;$[fx\'CevH<'!D2[$XfēȑmxRF^6J<y'q OPfđ>c}'2$NeI8'q!ORfĕ>k72[%nvs9×xO!])eKHfl*Qd6J|F(2%>JfGl+Qd6J|FO(2%>If'l*Qd6J|Fϐ(2;%>Kfg+]dK|v/.2%Hfl_*]dK|v.2%JfWl_+]dK|vo.2%If7l*]dK|v.2%Kfwl+_d6L|پp{Ow=󽻶_GF?OV*2[%V'U'mO:Vr?l[%~ٶJm9g*ζUm/:V_rl[%~ٶJm5g*ζU7mo:^rl%~vK=gwl%vKcg-'ζ[Omğ9n?wl%vKmkg07ζeom9۞w=l{&Lgg3/ζg_߿9w= d4=.gIHyx2;#_fg$dBL$3evF2H&d2;#$I(3Hfg$H2;#dvF쌤I)3Jfg$H2;#dvFdH&2;#Rfg$SdjL#3ievF2H 2;#Qfg$3/2;#Yfg$dVUfg$dv!39evF2H&3evF2H.3yevF2H2;#YPfg$ da,"3EevFH2;#YRfg$Kdi,#3eevFH 2;#YQfg$+de"3UevFHV2;#YSfg$kdm#3uevFH֗2;#Pfg$F2;#H%3dcl"3MevFH62;#Rfg$[dkl#3mevFH2;#Qfg$;dg"3]evFHv2;#Sfg${do#3}evFH2;#9Pfg$`"3CevFrH2;#9Rfg$Gh#3ceFrfNw=]_wmG$4.#3dvDr̎HΒ2;"9GfG$</# dvDr̎H.2;"DfG$2\.#+dvDr̎H2;"FfG$:\/#dvDr̎Hn2;"EfG$䶑 񕻶;d6CrfH 2!Gf3$l>͐/d6C͐<(d6Cmg ɣζǜm3$1?7X _30|mo$/:H^rl{#yF5gζ77mo$o:Hrl{#yF=gGMw|l{#Fcg'ζ7Omo$9H>w|l{#Fkg7ζ7omo$9Hwl{#Fgg/ζ7_mo$9wt4.71dF:Hǒ2{#Gfotl->l->l->l->l0s K+k[;:uӏӏٞ8=?uf{~ܙ3KgWlϯٞ8=uf{~ޙ3GgOlϟٞ8=uf{ٺ;l4Fl Ɣl,Ɩlƕl<Ɨl&l"&l&l22ݝ2ݝ2ݝE2ݝ2ݝ%2ݝ2ݝe2ݝ2ݝrj3+ꑗZ:z9;ٚkM)T2M-42M+t2M/ 2(L2Eez;EYez;Logv6Logsv6Logsv7l.ټ2'2- ق2-$!y[?dc͝-!ْ2͝-%2͝-#ٲ2͝-'2͝ ي2͝$2͝"٪2흭&2!E5=?ٜk-'2-m ن2-CdZ:LKgi2-m,&2-m*f2-m.2-m)V2-m-62-m+v2-m/2-(N2-,.2-*n2-.O3٫lܵw8G}e8Oe8;@e8;H3ֺ١2&Ӻ2!Ӻ4.]ֱ2#ӱٱ2'ӱ2 ӱى2$ӱ2"ӱ٩rj;3;yLΒlΑ\Γ|.B.b.R.rͮJͮjͮZͮznFg&gfggVg6gvggNg.gngg^g>g~gg?ֳكֳCֳֳ#ֳ٣ֳcֳֳg9?|lll5mummmmmm܌willlllllllllllllllllllllllllll3'ggg6/ο_o× _6,u9wY1d5SYd5[Yqd5WYd5_Y d5PYd5X_Ih>dސލֱy,ӱy"ӱy*ӱy&ӱy.ӱy!ӱy)ӱy%ӱy-ӱy#ӱy+ӱy'ӱ9o]֤2MO!Ӥ2MO%Ӥ2MO#Ӥ2MO'Ӥ2M Ӥ2M$g7s޺9o>k2-&Ӣ2-!Ӣ2-%Ӣ6e>3ui>K4i>L 4i٦yؘcݵi|Qi|q̗i|I̗i|i̗|Y̗|yW|EW|eW|UW|uא|Mג|mב|]ד|}7|C!ӟF2S?go7|7|37| ̷|+̷|̷|;̷|w|'w|w|7w||/||? 09fѡkݙ#ӝ2ݙ'ӝ2ݙ ӝ2ݙ$ӝ2ݙ"ӝ2ݙ&ӝ2ݙ!ӝ2ݙ%ӝ2ݙ#ӝ2ݙ'ӝ2ݙ_ ӝ2ݙ_$ӝ2ݙ_"ӝ2ݙ_&ӝ2ݙ_!ӝ2_%ӟ2 _l_l=_l7-㽲AQך3ٚ3ٚ3ٚ3ٚ3ٚ3ٚ3ٚ3ٚ3ٚ3ٚ3ٺ3o{y9Q33򇝭1G1G1ǜ1ǝ1s'kI1×fG]kigkgkYgk9gkygkgkEgk%gkegkgۘфt 7Zo8[o:[o9[o;[86u].G]kgkCgk#gkcgۃ'Ο_ ޝE?օօW¯ o o     ٞ?;=qf{͙ua1$Ӆh2]X.Ӆ2]X)ӅX2]X-Ӆ82]X+Ӆx2]X/Ӆ2]XL(ӅD2]XL,Ӆ$2]XL*Ӆd2]X ddedeHdHede(d(edehdhede!Ӆ2]XL!ӅŔ2]XL%Ӆ2]XL#ӅŴ2]XL'Ӆ2]X ӅŌ2]X$Ӆ_dY YdU ta1Lta1Lsta1ۮ-x7)N֋4k}X/Ӈ2}X,(ӇB2}X,,Ӈ"2}X,*Ӈb2}X,.Ӈ2}X,)ӇR2}X,-Ӈ22}X,+Ӈr2}X,/Ӈ 2}X(ӇJ2}X,Ӈ*2}X*Ӈj2}X.Ӈ2}X)ӇZ2}X-Ӈ:2}X+Ӈz2}X/ӇrnЙw~Iͳ~,6yiǂwF p:Le:B-e:Mlgc]WQ?yN#/W,x.2W*xn2WlSŞ×7>ɞsG}eOe8@e8HÊ`BsYok]U&U2mU!#7MPű2U'S2mU ݊Oyi䑗*NT*Nt*ΐL*Βl*Α\*Γ|*.Bg"gbggRg2grg gJg*gjggZg:gzggFg&gfggVg6gvggNg.gnggSlUlUlUF+irF+ir!F+irF+ir1F+ir F+ir)F+irF+ir9F+irF+Wir%F+WirF+Wir5F+Wir F+הir-F+זirF+וir=F+חirF+7i2Vn$h?eLircF+7irSF+7irsF+irKF+irkF+ir[F+ir{F+wirGF+wirgF+wirWF+wirwF+irOF+iroF+ir_F+irF+i6hܵ*iP*ip*iH*ih*iX*ix*OiD*Oid*OiT*Oit*ϐiL*ϒil*q*u*s*w*/p*/t*/r*/v*/q*/uZ^kEgYZ%uU9ڪfZ_:[c9[c;[c78[c7:[c79-oYըk]UlUUU]UU=U%op3SʹfF]k!gkagkgk&WFHζ'ysmgaP ||||Z|yn}c菶cMUlMUlMUlMUlMUlMUlMU~lMU~lMU~lMU~lMU~lMU~lMU~lMU~lMU~lMU~lMU~lMU~lMU~lMU~lMU~lMU~lMUlMUlMUlMUlMUlMUlMUlMUlMU 4U5LSU4U5LSUc4U5LSUc4U5LSU4U5LSU4U5LSU4U5LSU4U5LSU4U5LSUB"bR2r J*jZ:zF4U5-E?LR5L/USR5L/UȥmjZg`v*Pwe:ItR5L'UtR5L'Uj6NfjNj.N&I2T#Ie:Wd:_d:ZPd:ZXEd:ZTd:Z\%d:ZRd:ZZed:ZV6i #/T8MJriZykljMU>T2MU)TZ2MU-T:2MU+T)tK2Tm(K?dzHR/Yۙ7JDk Tm& +G~*MDkj둗>ij[Fj{^vijǡ?uTПyO}U"Yծ2U&Z2U!Z՞2U%Z2U#]վri۱⭤hwܵƪi@ƪi`ƪiPƪipƪiHƪihƪiXƪixƪNiDƪNidƪNiTƪNitƪΐiLƪrƪvƪqƪuƪsƪwƪ.pƪ.tƪ.rƪ.vƪ.qƪ.uƪ.sƪ.wƪpƪtƪrƪvƪqƪuƪsƪwƪnpƪntƪnrƪnvƪnqƪnuƪnsƪnwpX՝X]XX=XսX}XSv,}Ǻzp菞Q׺wa[mD#GG9[UO8[UO:[UO9[UO;[U8[U:[U9[U;[U/8[U/:[U/9[U/;[U8[U:[U9[U;[Uo8[Uo:[Uo9[Uo;[U8[U:[U9[U;[U8[U:[U9[U;[U8[U:[#U9['U;[+U_8[+U_:[/U_9M_;[CU8[KU:[OU9[OU;[pfnə3gvμl ݵdZMeZC1ezKlc;VO٤[ּ=EKR2-UO(RD2-UO,R$2-UO*Rd2-UdZdZeZdZeZNdZNeZdZeZ.dZ.eZvg];6Itde!P2 UO!P2 UO%P2 UO#P2 UO'P2 U P2 U$P_dYYdU4T=LCճ4T=LCs4T=LCizni2 U+P|2 U/P2 U/(PB2 U/,P"2 U/*Pb2 U/.P2 U/)PR2 U/-P22 U/+Pr2 U//P 2 U(PJ2 U,P*2 U*Pj2 U.P2 U)PZ2 U-P:2 U+P5o>}ntcșwfuQo.7z.7z3.7z .z+.z.z;.z.wz'.wz.wz7.wz.z/.z.z?.. ..0..(..8.y"۰t3Z'9[';[ԧ8[ԧ:[ԧ9[ԧ;Nkz|wy}QZ>ZZZZZZZZZZZZZZZZc78[7:or歷wF]kVgk6gkvgkgkNgk.gkngkgk^gk>gk~gkgk?::C::#::c::u9[O8[O:[O9[O;[8[:[9[;[/8[/:[/9[/;[ԯ8[ԯ:[ԯ9[ԯ;[o8[o:[o9[o;[8[:[9[;[8[:[9[;[ԟ8[ԟ:[ԟ9[ԟ;[_8[_:[_9[_;[8[:[9֭wau T_CtШk۶7˾]kftiƐifLiƒifliƑif\iƓif|i&ifBi&ifbi&ifRi&if 8M 8M(8M$8M,8M"8M*8M&8M.8M!8M)8M%8M-8M#8M+8M'8M/8i&if iif*iifiif:ik 3m 9]kffififV]oEcco~c|co{{N'k=]GyezOGezY@GezYHGezYDGEezYLGezYBG%ezYJGeYFmg6:/7|nxiܵ6iVife6iVifU6iVifu6i֐ifM6i֒ifm6i֑if]6i֓if}6i6ifC6i!&F2mSMɴIo6i6if6i6if36i6if 6iif+6iif6iif;6iif6ivif'6ivif6ivif76ivif6iif/6iif6iif?6ii6ii 6ii6ii06ii6i(Nii |[ۮm4omNr7iNuӝyۭohQz9z9z9z9z9z9zzzzzzzzzzzzzzzzzzzzzc6:[49[4;[4w8[4w:[4w9[4w;[48[4:[49[4;[48[4qitiriviq<.؆mO_:!Cng9ym6#41Zs4/:[s4/9[s4/;[s48[s4:[s49[s4;[s4o8[s4o:[w4o9o;[48~lu~o[4_#gcggSg3gsg gKg+gkgg[g;g{ggGg'ggg6/'ͯ'o''LI;LcI;LcI;LI;LI;LI;LI;LI;LI;66666666银银银银银银银银vLI;LSI;LS4J;LJ;myϭWIyiܵ~igiv}Vghsܵfigivfiiv.fi&,2#,eWYd_Yd]PYڅd]XYEd]TYd]\Y%d]RYڥd]ZYed]VYd]^Yd]QYڕd]YYUd]UYd]]Y5d]SYڵd][Yud]WYd]_nl߶8oMk'[an<4wMdTd\-d:Rڭd:Zmn3 KZ;OL;OLOLOL{OL{4PL tQL4R{L#4R{L#4R{L#4R{L#4R{L#G4R{L#G4R{L#4R{L#4R{L#'4R{L#'4R{L#:[#9[#;[#g8[#g:[#g9[#g;[#8[#:[#9[#;[#8[#:[#9[#;[#8[#:[#9[#;[#W8[#W:[#W9[#W;[#8[#:[#9[#;[#78[#7:[#79[#7;[#8[#:6gkvgkgkNgk.gkngkgk^gk>gk~gkgk?Hζy[~Wh ~'=&j;|h cF]kIgk)gkigkgkYgk9gkygkgkEgk%gkegkgkUgk5gkugk gkMgk-gkmgkgk]gk=gk}gkgkCgk#gkcgkgkSgk3gksgk gkKgk+gkkgkgk[gk;gk{gkgkGg:'g- o~s6iwdMeC1eKeGqeOe:@nm#w:󶳗wrDIeLLuLuLuLuLuLuLuLuLuLuLuLuLuLuLuLuLu#d\)dRdZidVd^dQdLu34P7Lu4PWfinvinNio2 -@<2 ]yeOe[@e[He[DEe[Le[B%e[Je[Fee[Ne[Ae[Ie[EUe[Me[C5e[Ke[Gue[OnmCw;o0|=:hm8ݿeXqMdTqd\q-dRqdZqmdVqd^qdQqdYq]dUqd]q=dSqd[q}dWqd_qd;Pqd;XqCd;Tqd;\q:~_~XtG4Mw5Mw5Mw5Mw5Mw5Mw5Mw5Mw5Mw5Mw5Mw5Mw5Mw5MwuMwm,糇/-2ZZZZZZZZZZZZZZZZZپM::-:ݭ:m:::ݝ:]::=:ݽ:}:::uuuuGuGuǜuǝu:[tsptrvqusw^p^t^r^v^q^u^s^wptrvqusw>p>t>r>v>q>u>s>wptrvqusw~pMo/C4Pg7tmCόߝe!Gi~tǐi~Lǒi~lǑi~\Ǔi~|'i~B'i~b'i~R'i~ 2} 2}(2}$2},2}"2}*2}&2}.2}!2})2}%2}-2}#2}+2}'2}/w{~_XSȴL?LSɴL?LȴL?LɴL?L3ȴL?L3ɴLgi~gi2=&521;\qO?߆~z~.X# 4RL#4RL#4RL#K4RL#K4RL#4RL#4RL#+4RL#+4RL#4RL#4RL#k4RL#k4RL#4RL#4RL#4RL#i~#F)HdL#4RL#4RL#4RL#[4RL#[4RL#4RL#4RL#;4RL#;4RL#4RL#4RL#{4RL#{4RL#4RL#4RL#4RL#4RL#4RL#4RL#G4RL#G4RL#4RL#4RL''ʝm$g~;(nD#E5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q5Q}ۜ۝msnXCPPPPPPPPgkAgk!gkagkgkQgk1gkqgkB''颧gm[:?7|wk?:/=Пڪuk×w7w7ښZ8[:[9[;[8[:[9[;[_8[_:[_9[_;[8[:[9[;[?8[?:[?9[?;[8[:[9[;[؈ezl2=6bL1L[F#c#ƕ؈ezl2=6bB1LXFL"c#&؈LdzlD(c#"؈DF2=6"L(dzlD)c#*QDž=KrO?m'۶mض7mvm;vr?8;w>WuǂYd`V{,M cA s=D2XcA"s=d2XcA!s-{,(e-s{,dǂF 2XГǂA{,] 搹ǂ9e`.{,[ 摹ɂya3p n/n Een`1+X\ %en`)+XZ een`9+X^ Ven`%+XY VUen`5+X] ֐5en`-+X[ ֑uen`=+X_ 6<`*X 6Men`3*\ -en`+*Z men`;*^ ven`'*Y v]en`7*] Z]^0|k{/Xߨ;,_ łen ,8x?[-8d?-8t?.8l?{.8|?.8b?;/8R en/8V en/8Q Nen/8U Nen`!szw؋=-ss2\p=oƞ .0c炋sf3\p{.̌=\nƞ 0cW炫sf3\p{.Ό=\oƞ n0c7炛sf3\p{.͌=nƞ 0cw炻sf3\p{.ό=oƞ 0c炇5crflK3\[.ڌ-|cƖ 5cߙrflG3\[.ٌ-bƖ ~5crfl]47{y#{l?p4+] ǐ1ep,+[ Ǒqep<+_ ' ep"+X 'Iep2+\ )ep*+Z iep:,^ gep&,Y. gYep6,&s]2wYea,s]2wYea.s]d¶]vdZ. ,eaO. epv,C. |se3n2,W 瓹enp,\P …enp,\T enp ,\R ¥enp,\V enp,\Q W•enp,\U Wenp ,\S גµenp,\W דenp,P 7enp,T 7enp ,R ­enp,V enp,Q wenp,U wenp, )s{`27X +sa2Xx9 4gbo[2Vx̽.soG[2Vx̽-so[2Vx̽/so'[2VsazCl=n 3Cf,3Px{(<nj=k 3c盱 Cf"3Px{(Č=^j /3c+Cf*3Px{(ƌ=^k 3cכCf&3Px{(Ō=j o3c&Ì=i 2cw{Cf>3Px{(|=>h B?C/O'|Ԍ>f 7cO}'>Sfli3O'|֌9zy—2cD}b]&z;fK3vG#ڌ}c5cwDߙ= f|F?yϰ71^W3i3w3i0O3i2o3i1_3E< s_ģ2E<})s_c2E<}+s_2E<}O(s_2E<}O*s_ē2E<}O)s_S2E<}O+s_2E<}(s_32E<}*s_ij0"d8/H澈c"Nd8/L澈s".d%s_ĥ}e#s_ĕ}2EqW=*{'9dxN{"K枈疹'ydx^{"O枈痹)ߺ/mzc.n;ƈ1%dnxI#^Jƈ1ednxY#^Nƈ1dnxE#^IƈW1UdnxU#^MƈW15dnxM#^Kƈז1udnx]#^Oƈח1 dnxC#Hƈ71MdnxS#Lƈ71-dnxK#Jƈ1mdnx[#Nƈ1dnxG#Iƈw3]/owbg3=ex/;#[Έ3}ex?;#_Έ5AGc6l 7~}0Gq̸f3{|=>Όo}O0'q̸f3{|=>͌n}q3̸f,3{|=>njk}3q ̸f"3{|=Č_j}/3Ǘq+̸f#2Wqk̸f:3{|=h}o27q[̸f63{|=Ìؘp:o9Ћg7vq͸Cfa3ww<~Ԍј7nnu:~Ҍ[?eƭ6VϘqg͸sfy3nu:~ь[dƭ_6VǯqW͸kfx:~݌[aƭ4Voq͸;f]3nu:~ߌ[`ƭ?4Vq͸'fS3nu:܌[aƭ4V_q͸7f[3nu:ތ[`ƭ4V?qvo_vo zߨߨqw:MNFy1ddL:K-m& &n{27Ʒi2w7h{qIddR7;LN&y)ddJ7;JNyiddZ7;NNyddF7;INfyYddV7;MNɼI f'̛D2ov˼I"f'̛d2ov˼I!f'-7;)e-f'7;d줖yFN2ovғyA7;]Ny9ed.7;[Nyyed>9wjV~V>?`/q{,"'ʼb2q{,!L4>mNyeed99Y^mNVyed%9YYmNVyUed59Y]mN֐y5ed-9Y[mN֑yued=9Y_mN6y ed#9XmN6yMed39\mNy-ed+9ZmNymed;9^mNvyed'9YmNvy]ed79]mNyɼɞ2os-1ygyy799hMN2&'qC̸ɡf03nrrw99|h3wr7<9֌;gnr;ۋ{>w{NN5n'q͸p3vrw;9ӌeN6n'qs͸yf|3vrw;Ќ\dN.6n'qK͸efr3%Wq+͸Ufj3vrw;֌\gN7n'7q͸Mff3vrw;ՌfNn7n'wq;͸]fn3vrw;׌gN78N-{ͻ<&'qG̸ɣf13rfjc`l7:yΌ3F'q/̸ɗf+3nt7:ƌ|kƍN3F'ߛq̸ɏf'3nt7:ŌjƍN~3F'q?̸ɟf/3nt7:nj;kƽNh/,:KNǖyqdt\:ONǗy dtB:HN'yIdtR:LN'y)dtJwft_3h߫fVTѡ74=Ȍl M1ㆦqC̸f3nhz74=ʌm M1ㆦǚqC̸f3nhzw4=Ɍ{lwkʛ7sŽLO7^͸fL3ez2=ی{cƽL5^q/ǒ^`ƽL/4^C/_z/Ԍ^fK/7Wq+͸Ufܿj3_z/֌^gK7Ӹsmg]WC/nUz*Ō[jƭJo3^ݘa1w,oЋ>dJ6~qG͸_cfܯq3W+}Ҍ>eJ6~Ϙqg͸_sfܯy3W+}ьdJ_6~qW͸_kfܯt+}݌aJ4~oqҷ͸_;fܯ]3W+}ߌ~`J?4~qҏ͸_'fܯS3W+܌~aJ4~_qү͸_7fܯ[3W{3fޯͼ_?y~60śuQy0Fi73oԿfܨl@Fyeިl 7*Sƒyeިl9ŷ`ƛ4^ܢl|(@-&ydޢlb(D-&ydޢlr(B-ʦS|eSyyx.w'Vɦyweޝlw'Qfyweޝlw'UfS|f.佹^ܗ,y_X}%Keޘ,yk\NfEvޏzPoV_tީ]z2R6(.e˼K2R6̻%.es˼K<2R6̻'.e˼K2R̻-$.e ˼K"2R̻-&.e˼K2R̻-%.eK˼K22R̻-'.e˼K 2R̻$.e+˼K*2R̻&.e˼K2R̻%.ek˼K:2R̻'.e˼K2R̻m$.e˼K&2R̻m&6e)#-Q؋m-&eȼIٶ2oR̛moMv0&e;q̸Ifܤl3nR7)͌nM0;27i=6eq}͸G~fܣl3Qv(;Ќ{d=6eq2 ޙ7&;܌aƍɎ4dGqc͸11fܘX3nLvߍfM[2d#;ՌےfmN7d05psxg^|Kf瘹/!p_xS^ܓb3Iv$Ԍ{]f=.7dWqO+͸'Ufܓj3Iv$֌{]g=ɮ7d7qO͸'Mfܓf3Iv$Ռ{f=n7dwqO;͸']fܓn3Iv$׌{g=7dqO͸'Cfܓa3I${Ԍ{=f=7dOqO'͸'Sfܓi3I${֌{=g=ɞ7d/qO͸'Kfܓe3I7%{Ռ5[›2doqO͸';fޓwͼ'yO7|`={c3'fޓOͼ)!˛7K3oWfތͼߘy35f|g̛ߢ7>l}73fއ?̼y#2[o?"N-`ۋcl~>c'_ yq G Dro|b3މK]'y)dޅ|Jw!J]ȧyidޅ|Zw!N]ȧydޅ|Fw!I]gyYdޅ|Vw!M]ȇɼ y .̻G2B˼ y".̻g2B˼ y!.-w!/eޅ-.w!dޅyF]Ȼ2BޓyAw!]]y9eޅ|.w![]yyeޅ|>w!_]yeޅ|!w!_X]yEeވ|1"_\/ax^܆|i!_Fmȗydކ|y!_AmWydކ|e!_Es_6|e/.2)Z2-:2+g̹-_E F#[h{̶l{̶{bf75n-0?֧/]e#3ϛV-^4cl'{Om^U3[-af _![x dž[Vcf5㛯~cةSe>0K٥fv3].}nf0K_٥fv3].}of~0K?٥fv3].nf0K٥OeSk@fZSkt}j!O1e5>Ɩ٧82WfZSk|}jM O e5>&٧$2ԚTfZSkr}jM!O)e5>٧42՚VfZlUkzjq˱M ?d65\۱-Fvmy^|Q/ GJ+ |b3¦g/Z;-^ՖَVGf;Zvjh52lG'Ah.9d5vَ2њGf;ZlGk>h/dvَ2ZDf;ZlGk1h-.%d̆2#Hk3:Z֌3#Hk3:ZьV2#Hk3:ZՌV3#Hk 3:Zӌ2#Hk3:Z׌3#Hk3:Ќ62#Hk3:Ԍ63㛰y}kawveESZۛ}7"¦%C/ZŌv5'ka%lHe/W [}ŎЋV0hE 3Z:،V1ChE03Z:܌V0#hE(3Z:ڌV1chE83Z:ތVN0hE$3Z:ٌVN1ShE43Z:݌Vي3lřf,3[q8Vkf+3ي lŅf"3[qV\jf+.3ي+lŕf*3[qV\kf+3כيlōf&3[qnjw]6;k@{ݹnjoֽf>6h{ٝkq<01 [nicm{siך{z\^ka׸Ѹءew^5;ٝfvu3yefw6;ٝw{fv}3|dfw>6;ٝOgfvs3|efw6;ߘٝowfv{3dfw~6;ٝ_ofvw3efw6;ٝN9 ;h2S.;2S);X2S-;82S+;x2S/;2SN(AD2{TN,K$2TN*Md2TN.Or ߟfn:}zHo-oP~wGO+J쫒]z^&Xp6Ѩm*c**Ӂӱ2OBnᛳlrیcF؋̞̞]=+{2{VY9̞sY9̞sY9̞Y9̞Y9̞ Y̞ Y̞Y̞Y̞KY̞KY̞Y̞Y̞+Y̞+Y̞Y̞Y̞kѳrM3zVeFʵY=+5gzf\ߌѳrC3zVndFʍY=+75gff܌[ѳrK3zVneFʭY=+5ivf|ft?lr6YMV{ܭbٹ~Jlߒ[WEʽ[+5s~ftߌΕѹ@3:WdFʃ\yClaf<܌۫bAoEc^y+7{ ft<ь'ѽd3WbFS^y+O7{p3WaF3^y+6{9ft<׌ѽ|3W^`F ^y+/6{%ftԌѽr3W^aF+^y+6{5ft֌יѽz3W`fn4{7ٽ-fvV3wݻaf4{wٽ=fv^3wݻ=`f4{ٽ#fvQ3ߤ%d/620lr{{=gf7u/ٺlKfe3[{ֽffFٺlfM3{{c7g;-d}hf>2wٻOݧf33{}if5\{ٮol׷f;3vhf~2]?ٮ_lׯf73vif2]ٮl׿f= ]d=vǐٮ2KfclW{j+]d=v'ٮ2՞HflW{jO*]d=vٮ2՞JfSlW{7i{Z373ߪ7){Ѣ2[ԞMfdlQ;٢v$EXfډS-jg2[e]lQ%ERfmcc/v]{Mb>idv-Ǿ)&|g/ОSfsl@{n h#ye6=ـ2^Pf l@{a h/"Ee67%h@{I3^ʌ6eh@{Y3^Ό7h@{E3^ɌW6Uh@{U3^͌W75h@{M3^ˌ6uh@{]3^ό7 @{C3pm촑m/61-_l?4hokF#ۙшf4hhF#;шf4hjF#ڻшf4H3=D{/3{hcƷ`{_~;mƞkcõfۇnn}fGnm}fǙ> fO4w}]bT3ק>p3g>Yf6w}s]g|3Ef/6w}K]_fr3WF7aon/ךFohWێo;{[fo3~;io.3w[f3~?ho!3{f6ుቁvI3Oz#Vn/mx6`f^4 /نl+fU3maf^7 oن7l[fm3mx6gf7 نlGfc3m6|ff>7 _ن/lWfk3m6|gf7۰ͽN\>e؅.>ff~737-?o3}׌>td3>tFه2Sf:cCgl}#qe3>tƗه2ЙPf:Cgb}L"Ie3>t&و2[љRn3ZљVf+:lEgz e3Vtfي,2[љUf+:lEgبwd'޲]2ЉdvB'مN* Lf:.t ]dvSB- .t*]2idvӕمNOf:2Й]f:sBgN];vd~E:z6g΂2YHn{zYLf:уf=,eF:Kу2f=,gF:˛у f=dF:+у*f=fF:уf=eF:kу:fMgƷfg}3(;6 Bg#3،.t61 MBg33܌.t0 -/ ݺm/Z֌t3hAg3Zьtv2hAg3ZՌtv3ogw3ZÌtgF :{т^f-cF :т~f-`حl{0[so6k۔шΑf4smF':ǘ-9|\`g#lЋntN6ٍSifvt31naf74gٍ9fv\3q8n\`f7.4ٍ%fvR3qݸn\af74W-۹|Mٓe?77ُMff3q߻[ͷ_˞afS4)wٔl=f6^3rM̦<`fS4)ٔl 7)[~e/{񘙽x^3ٍ/Ɨfv+3n|kf73ߛٍƏfv'3vjfC~3[Ýʆ`/fmf31эj@f;d]f?1dSf?d[f?qdWf?d_f? dPf?dX۵ʎ4I٤l'f6S3YeN|if2?_ٟoϷf;3hf~2Q?WmZϸF^o3}׌>2T&O2T!O2T%O2T#O2T'O2TO O2TO$Q2;UO"U2[UO&U2[UO!U2[UO%Urz3wV=h/C^ˑ%)ٗhK=먗mg٘zSr:2;NFPP]Pݒ١١-CuGfJfZfFf=ev]f9dvSfF#z?^Of{e^@f{e^Hf{e^Df{Ee^Lf{e^Bf{%e^JmX/m^f6 5^n?+|+WZ5nW5Sjft^݌NkѩzM3:UeFT5Szft^ߌNѩzC3:UodFTItT^4̌&՛Ѥz 3ToiFhR]1۰bآzF{j|5 2'NfٌԻٖ]L~=/6X=C/SmFw}Nݩ3;fc0;ft>Ȍѝ3SjFwN}ݩ0;>|TE/:TcFchQ}-7E f>ь'Ѣd3ZTbFShQ}-O7Ep3ZTaF3Q}M6K9ft>׌.Ѧ|3u/4{|qcF6^23{u^]if2WW٫kյf:3{u^hfn2W7Xbc6Naf4Sw٩=f| vgW{ٙ̃f!3yČoQcv٥}e6CϘ١gsfvy3;zdf^6C١Wkfvh-zaf4Io٤l;f6]3Mz&}`f>4I٤l'f6S3M&}af4I_٤l7f6[3M&`f~4O?Xlrr[Naf4S٩?fv_3: T3N5T3N5cT3N5clU3\<ިj[2L([D2L,[$2L*]drofr3^M`5n wƎ=d/ [͌2$]2"mf5s e׳WM WM(WM$WM,WM"WM*WM&WM.WM!WMKfRf^5j*jjjj2{d٫fvj٫fNj٫fnj٫f^j٫f~j٫fAj٫faj٫fQj٫fqj٫fIj٬fijٱfYjMcjV٭f%jV6[*ftYՌn5ѭfu3լaF5Vj6[:fY׌~5Ѱf}3l'լj62WfČ^5٬Fm67c6eFʼuk5lEǚXkv4cNkٻKFd.jEhUjgF=hUj6U>f׌V5Ѫf3Z`FdFhUsj5Uaf9܌V5GѪH3ZeFhUsj5Uqf9ތV5'ѪD3Z՜dFhUsjN5Uif9݌V5hUsj4UYf9یV5ѫ\3Y؆[5SͅftN]lf.1S٩fv 3;uN]mf1Sך٩Vm7٬/{u^bfn5W٬vm0srq߱ENcg9){ˆ4!ِl'f6S3 ̆|afG4Ȧ\d/ ̆|ofC~0!?ِlf63 ̆nfC0!ّlf3{=Iw4=.'1d;̦tǒ|Sv6؝Gur hFwN*d6;ftٌ2ѝJf3SlFwN+d6;ftgٌ2ѝIf33lFw*d6;Lf3ftCF2эe6lF7ٌn&\f3ft[2-e6ٌۖnGf3ftk62lF'A.7Nr+l ݹd;6tن2НOflCwm.( ݅d6tن2]Lfцfm.eFKц2wQ-zтrf4߁+ߕF zbjfaZfkczfn`FfnbffnaVf[ncvfۛ`Nf;b`nw4[>C/~}w5όzw3~w4=Ȍz`3~Cw5=̌zp3~#io(3G[?ƌoflבo3'{?Ɍo.6ktoz3]i,3g>f3w} ]_h"3f/3w}+]_i*3Wf3w}]h&37fo3w};]i.3w}ڽnj:7?7m?doa3ۏ~cf7'm?eoi3Ϙ~sf7ߦܾh/ۯ~Ռk; x⻴˽ʍԑ]8^vC3;|bf>5فfvK3;|cf5ߙفfvG3;bf~5فfvO3;cf5&ev7ƔفX2; zܫ'_o7~oBD2e{&M&ߛ\o7~oJT2e{M'ߛ^77noF3.[f*.k{ܸoqϾC+z^22+.g{-3zܥ [hGَ^#vz2َ2ћCf;zslGo.-yd7vَ2[@f;z lGo!-,Edvَ2[Bf;zKlGo)-mF;z˘ю޲f-oF;z+юފflƷnoz† Gou3[Ì~4Gom3[nj~5Go}3~64Goc3Č~65Gos3Œ4㛹yIo[3zΌ7)nhvekF᛹;vآl MoO3zˌ6-*{؝=lM6zќAflFszќޡf4wnFszGќޑf4wmFszǘќޱf4woFsz'ќމf4wlFszќީf4wnFszhN 3;efs69ٜslyf6|3s͹\dƷtb3a/s͹\afs49Wٜl5f6Z3s͹`fsn497ٜl-f6V3s͹af{4?wٟ=f^3s ߌ)[N=d&ݽ.=j7r1zQO٨l3f|/5?/ٮe^4[;b}z>ffF٧fM3}z>cf5O٧fC3}>}bf>5O٧fK3}>}cf5Oߙ٧fG3ٌo/fnOr{٧fO3}>cf5O248> .Oc248> -O248> /O248> N,O248w v $58ըZxp3#h 258v $_3,258~ &adl0{& QF&d^m sr u{ѳ̞ V2{6X`#g]=̞ .gs2{68̞ -?J "DHK&O;u=O{کu|oggg9{kӕϬ3khᙵk3Zxf-<YugVh4Zxf-<YF Ϭg֩3h2ZxfYF Ӭ%J>(|z3F Ϭk-aha Xa8aJw0CJ >0#J >0cJ >0J >0SJ >03J >0sJ >p J pKJ +J kJ 4weJ˾(\>V=}RZm}QZ]}SZ}}?PZC}?RZc}?QZS}?SZs}PZK}RZk}QZ[}SZ{}PZJ OJ /Js?J=qWZw¸(-¸) 8;h01Zg-!qv8;l0Ύ-F 8{ha7Zg'I-¸+ikvhUZ9q8{ha=f0-ǍF Iqvha=e0Ξ6Zg-F Yq8{ha]2Zg/-KF eq9{hnm(z:{hamή--umvٮ:3ZXgW5u:{hag7ZXg-F :i>4ZXg-'F Su:en-ύ eo]0ξ8F k* k) k+ ( * ) + ( * ) + ( * ) + [( [*׾;a'|/UٷU};!mDPg>.J>J>nJ>J>J>J>^J>J>>J>J>~J>J>2aa@a a`aaPa0a}Ұ~Ұ~~G) G+ͽ~ҏIa'\4\4 d?Qih?Iih?Yih?Eih?Uih?Mih?]ih?Cih?Sih?Kih_4\4\4\4\4\Sih?_ih@ihPihHihXihDihTihLih\i+foN ~(-,|)-,|7(-,|7)-,|·(-,|·)-,|w(-,|w)-,|(=~ҲG^a&^pJseV~(`aQZQSZqPZIRZiQZYSZy_PZE_RZe_QZU_SZuPZ?J ?[J ?;J ?{J CJs׶'p'J GpgJ GpJ GpWJ Gp7J GpwJ GpJ GWiIi蟕Ei_Miߕ^pJ Gp_JQ'` mswd?F=gp -tn:aNh5ZČn:F 7M'apI-tRF 7ANhᦓ1Zdn:CF ;amNNi W'tƌ~:ymθҲ ~?p)-\u:F WNh3kpՙ3Z-\uJF W΢Ugh᪳lpY1Z-\u֌:F W Nh᪳ip2Zl-\u*F Whc-\ukp:UNh᪳cp5Zmsv>|yܟ'u:GF ccΉXhasf0i-uF csNhasXjF c-ua0ֹXZF ck-uc0ֹXzF c-un`0ֹ0ֹ0ֹ0ֹ^`p:7W:P:T:R:V:Q:* S* S) S+ S;( S;* S;) S;+ S( S* S) W+}۹~X᪰:V{sԋOx_ix\4IiFW-J-nJ-J-J-J-^J-J->J-J-~J-J-2@ `P0{p}p}p}p}4hX8J-J- J-J-IJ-J-)J.J0iJsu4;Lv g) +__s_s__*-z¯(-z¯)-z¯(-z¯)-z¯W(-z¯W)- {g]3a­puJ ^p J ިpMJ ެp-J ުpmJ ޮpJ ީp]J ޭ4w\=J^*f]=QSZ~QW*-¨*-oQRZaQQZQQSZqQPZIQRZiQQZYQSZyQ_PZEQ_RZeQ_QZUQ_SZuQPZ?J 0[J 0;J p{Jsu¬+S#Q?VZQ?UZ3Q?WZ QTZ+QVZQUZ;QWZQ0J 0J]/JN+zz RZQTZ/a0ZFy=F ^Q^(/d07Z免FyS^h{';0 $/a0K-LRF AI^ha1Ze&yCF aI^ha7b05Z-LF qIބ$ohaW0ZM-L&y3F $oha7g0ɛ7Z䕌&y F EIޒ$ohab0[5Z-L֍.yFܱҲ?6ZU6y&6Z9F yF ]؞)a?y-aVyJ"4,.QyWSyWWyPyTyRyVyQw ,s.>w}wwCw#wcwwSw3wsw wKw+wkwwƻƻƻƻƻƻƻƻƻƻƻƻƻƻƻƻƻƻƻ0ǻLif {7{Ұ{Ұ{40awҰ{Ұ{Ұ{Ұ{Ұ{Ұ{Ұ{Ұ{ҰaxaaDa$ad{aŧpiJ WpJ WpYJ WPZl+QZ\+SZJsqLz C^0EJ C^0%J C^0eJ C^0J C^0UJ C^05J C^0uJ C^0 J Cި0MJ Cެ0-J Cު0mJ Cޮ0J Cީ0]J Cޭ0=J Cޫ0俔Oia\0J G>4weᅰ]|DiG|LiǕ|Bi'|Jiȧ|Fig|Ni|Ai|Iiȗ|EiW|MiוW"yz 7p[J 7p;J 7p{J 7pJ 7~4wcˍp'J '~pgJ '~pJ '~pWJ '~p7J '~pwJ '~pB]0)=GUZzoJK]iTZz_JՀՠ竽FKWq׭WXQ1FKWFKWFKWFKWSFKWޯޯfޯfޯ-_6Zz3Zz:b~uhռqF{oKK=i׫3FKWFKWg^-^7ZzZ2.[=XzIoWޮ.-]]1Zzjvuh eJ_J/E={Պ{Uh齪m^1Zz-WUjMiz4WUޫ)MUJ{պ_4wjBI]|o#[Diz4V=S~ߪm[4VDiz5ՕߪP~^Siz-굕ߪQ~^WiUvg7鱋Oz 7RXizM7S{fYKz~Riz+ꭕQ~^4TS]YzGEzBNJꝕ^ wUZznJK/]i{(-pO½^^8VO_dJKdAJKd!JKdaJK/WZp%PZH%RZh%QZX7VُzJd;N~~܇Sw識7(-J{y^ެ(-J{y^ޮw(͝N<'VZ{w^Nާ+-J|@iy'TZ+-CJ;]QS|ߨ'?x)O+-^FiJןSZ__PQO+J_UZו?JTZ])-_i@~?VZ|Os_(-^RiȎe>ViwJϿWZ|*->QiOJVZ|_w竔]|O{s37N;?o^ -"FKR{-f^0Zjōk Zh2Zj -FK__gmHi 5J]TQjJSSmLij啦ڸTPjJSS45զڴߛUZ9WZw-(-עw-)-ײw(͝4w~]9mJ(-mU?kJO[JTZCo9RZcN>ZK)Ku5w]]i}PݾvM 7\+-J︡;n+^{Λ);^ҷ{+ZiQZ~Jュ]kugQiYwRZ~֝uoϹw{(-?Jϸs4w}s艹s.SZ~@g=HiVD!|zx3.WZ~Õ3SG+-cJsO=w<^ig4~?A=ykOw>QQ{ j2G/Oas\_ZY`~YT ~AN`,`=fM`Y/s?`0.w6ρm:p,(0'cp"@=W~ 99 9^* ~!}xw~: ^s ܙ܃mW3;x=:^` Gv{]=-~Y氛ba cثNNyAa]y'AsdAKd.y?A`9y/AEAAAwAGA A;H  >6H w  Kw[S0A< ~?P=< ;v:]u9Ȯd?{H8Ak4d k2>d qCO?=L}Co=L=܃=xþу=ڃ=ڃ=ڃ=ڃ=ڃ=ڃ=ڃ=ڃ=ڃ=ڃ=ڃ=ڃ=ڃ=ڃ=ڃ=ڃ=ڃ=ڃ=YK=xý{z;Zw2C{\G/'0nŠޜ]/ˆ^K{B/\ 䯗…^~ z^v^z~ev2{oa2{{̮^fP/3P Ͻv/K/ýз/弒Z9{rr]rW%sI{w~?-{z\/^^2K/ým/=KzO}0>xڇ?}ǮGO3c> `;X}>_}>`_cK3C~ϳCyL[80|a߫jk?}dye{7}r>q_#}t>ѷ}ed#}dLdLdLd<`;Kȁ!Z߇C̣3(b1gB!;e0%RУ!rCφewb ѿ!2b >B4DWB"!( 1wBs&s; wCx5z5!< !fQ1Bzyy1B !U6?oCd=DCp!KC37Cp37Cp3 ]>~aA?|~~~~~~< ̄|~z6y?l 6Æ~O~x?>m?g?l W~Y?É~8B?>S?>S?>S?>S?>_ua SƧ0>)Oa| SƧ0>)Oa| SfjY)a| È0 _f/ga| 3_̗0 3_̗0%| 3_̗0|Ã0% 1L/L_*&03'Vucy<3L&d2~m!a|s\d0\0+arr`r&_aWf ;azYa_""KRaVEx9aGx9aGx9aG?#d5r=?xaG?C"0$?"d7BV#!=)("p!"p!"p!"p!"p!#p BG;g"xE._<EiFiY0"5gX"̲?8l~F`oFaoDaoFaoFqQ<(.ZG̿(/Jޣ9Z2 (GtNGtGauwQz Jx(^G:Qux(^G:Qux(^G:Qux(^GjxQfWlF/4Q4Q|wxeo7b 1{C!^b÷{C!W17b 1{Cb2co7`i v`f9co7b 1{C fƞó,ƾ1Xc~/܊|,=ûi bx+_11<12#1||1}>>>>>>>>>>>>>>:pvy4̤f3i <~6=li,Y dq,8@74wx7@; x6@O^8ǣ8o)N8S)N8S)NO8=b^QƙCqz2e978g3hhӣqz4N&7qfR(N/WƙU+qrgvřq8s,qg?8~ƙMqfR|5ά8>N>̝883?̏383d2N&d2N&d2I  r r r r r r r r rLMOyx'$!I|HAy$I2$cIr$SI2$SIORԟ$'?IIOR_簷$oqK$KQ%ZG$K$3;ɜN2.IR,o)YK_ 8=S.)v{h 5U4E.SxbGJh*{j?6ŻH1SP)v;T*bJ1SPeSR)K}6>bMnR&cS)8bMMYM_S4KS)X))>lJh5Ů⮔I)z?ŻJ+ÜOR̪H H1Ş.;J^R̥!{H H1S8;I_!)S{A†Af j4{= y?AA|0b ; wA + rdOɃx. „Ax0u ,dF 2Qܛ7 rovAf ~4]`?ȌAķA9>\dA>H psi 1tR?ƃ4 M,])MiOSԟ4?MiOSԟ4?MiOSL4{P=(iz?i?ii8i8i8iHÁ49KKu if1|c3 ̰sgع33C/fY/Kedxŷ,¶,߲,39LYϲ̙,ewaNg=Y2.YfvefgY5=aF9#0gF6Bo#6Bo#6Bo#6Bo#6Bo#o#6Bo#6Bo#6Bo#6Bo#6BQ|%_j~%Kg~FQ23Jofތ›Qx3 oF(7fR(R(R(R(R(R(R(R(R(R(R(R(R(R(R(R(R(R(R(R(R(QQ1zi^#cx1F&#cdbL121F&#cdbL1sh94c1ƘCc̡1cDcDcGr?cAcAcAcAcAcAcAcc0g 13s`9c0g 1cG1zdcV1ǘcGaN$'y2LJ<ȓ)Oy|8>Ïq1?8y'+de8Y'+deq88qivǧqr3Nngggggggggofofofofo8\puq:/df/b/b/b/&b/&b/&b/&b/&b/&b/&b/&bo&aLPOPOPOPOPOPOPOPOPOPOPOPOPOPOPOPOPOPOPOPOPOPO=gd>OrOd.OpċIg;$$x;$=4,dO2'Óc< $Izg2ܝddddddddddddddddddddNL’II|dddddddd'$2?j;$wIPܡ&a&PXR]`g)0a'),pHH pG p@H|=XR#fMYS`5fMYS`5>RxMS`?)U ErT GrT GrT GrT GrT`R,R d@ d@ p ]\`N`Ng v;`}R`_)`O`\M)r5Eyb"CSdh M)24wSdh M)24Em Ϧ"CSdh M)24E£)|"CSdh M)24E"CSdh M)hy4s`^L)꟢)꟢)꟢)꟢)꟢)ꟺmLi3 v80v4|~=Mn=gdelLNNNNNNNNNNsw?B`/b/b/b/b/b/b/b,̓y00000000000000000000000O J_CJ0OKpCJP_(((((ҹ`F;p Ɩ`G oJxS›ޔ7%QŸ?%)----1oJ0ļ)ļ)1oJ̛ļ)1oJ̛ļ)ļ)1oJ̛ľVb_+Z}m}mYY`,0kfYY( tYY`,0kffYYffYY`,0k5 ̚ffY@ Կ@ Կ@ Կ@ Կ@ Կ@ Կ@ Կ@ Կ@ Կ@ Կ@ Կ@ Կ@ Կ@ Կ@ Կ@ Կ@ԿH̘E2}f,'"}H,Ed>YOEd>YOEd\,'da,,EH"9X$`,Ed>YOEdaaaaaawE"}///////K/Kb\,%rD.X"Kb\,%rD.X"Kb\,%rD.X"Kb\,%rD.X"Kb\,~,~,~,~,~,~,X"KԿDKԿDKKc{>,,,,,,%!!dd=d,Ðe ?ر ;2X&c?2,2,2,2e3g,sY>̮}f2we.Wy牜ryleeeeeeee2L.//ǖǖd}l/b/b/b/VaVaVaVaVaV9v+V׭0WWعVطVZ}nWWWWWWWWWWWWWWWrB.V X!+ yX/VbX/VJ_*}J_*}J_*}J_*ŠUrJV*9X%`X7V*J*J*J*J*J*J*JkkkkkFYX# kkda,5FYX# kda,5v\c_#kxF>X#kc=| _e _e _e _e _e _;w5555r?gv50YisY.NԿNԿNԿNԿNԿAԿAԿAԿAԿAԿAԿAԿAl0W79 < < < < < < < < < < < < <؀A6C7C7%K~)/eYeYeYeY_K~)/eL2R_P_K~)/eL2RWG(ezeQf(#e(G?QƏ2~e(G?xQƋ2^e(E(Î2}QeQfL6xR!eQ&eQ&eloo{mwmwm‘M|děMM S6h6h6h6h6h6h6h6h6h6h6h6h~l&e|dl2_6/̗M&eIN6a&e|dl2_7M&ؤ_6M<٤_6c?6c?6c~٢_-e~٢_-e -e~-e~ق[b ^l-ze^٢W-ze^٢W-ze^٢W-zel+[[s ` ` ` ` ` ` ` ` ` `cllclclcll?Clklkl/6Mlm2Mlo3kmf6;6;6sv9 ;m6sv9͌fn3c̖m63v͌ݦ_x,fl3K%̒mf6dY,fl3cmf63vMl'x 76ئOm 7 fffI~/BT 3rRaV?zBT RW*J^+zBT RW*J^+zBT RW*J^+zBTITITITITITITITITITBN*BN*Jo*RaG?*aEF,2bXd"#Xx`၅Xx`၅Xx`၅Xx`၅Xx`၅Xx`၅Xx`၅Xx`၅Xx`၅Xx`၅Xx`၅Xx`  Zxa3=c Xdb,f}fl2a}̆6b+6b+6b+6b+6b+6bㅍ6^xaㅍ6^xaㅍ6^xaㅍ6^Ob3_l|/6~-_7YcC6'c3slf!_6~e㗍W6'lb&/yqȋC^{NzxvtrqNonm<~5uGoƣ.Q=x>`^^\Z~,~t'tt3t t~Pt?]w;$III{I;II;II;I{I`j{`j;`j`j{`j;`j`j;`j2ަ.|9~/~tt;\tÇ~y~ y~ y~ y~ˏC$/*? ~o~t??SIEEsEsEo|w}.|~:Y9k$'3 '3&3&3ϼƣgRQsxLe<~1u?c ]<~϶g1Kt?~+=LTzL3E*=O~&t?oK7χěg3g/RćA3JgQwl:~^w?F7g},kfרV|)~~w?ÉD5~w?+Dǃt?!#Ϝ/r\'o aRË^5E /jxQË^5E /jxQË^5E /jxQËed=u_vEvEvF9;;g;UNSv;v՝s\޺sm퐓ś]%'KNv.9%'d쒓]rKNv.9%'d쒓]|%'ԿKԿKԿKԿKԿKԿKԿKԿKԿKԿKԿKԿKԿKԿKԿKԿKԿKԿKԿKԿKԿKԿG{ԿG{ԿG{ԿG{ԿG{a<쑇=G\p#{b\ry# {ܘss,ݻNq8<3=d9̖=f 9/弒Ì{#筜wr˹Þ1Χ8ﱳﱏ1cvu{w=2{̗=1/>}v}}zd_1x?2n>}wxϬ~n~~Os~n9ns~|~nn>>>swlln}l]l=l=l=l>w}|u}|Ǐ}Ǐ}Ǐ}Ǐ8888~{8 dlq@68 dlq@68 dlsp;O>9OxPg稳sahQg稳sCQg稳s9uv:F7`uv:VguH]Vg`uv:;XU^[^[gwչֹA밢uPw_N6dN6dN6dN6dN6dN6dN6dN6d.Vou@4ݷA~p fP,5Ax S Pk0pwpwpsoooooooooAdAdAdAdAdAxjjjjjjjpkpksՅjqMp9ܤ&7IMoRߤ&7IMoRߤ&7IMoRd4&}դU4J4J4J4J4J4R4N4N4N4N4i&^4Q62$SM2$SMiMo(+p7xs7xs7xs7xs7xs7xs7xs7xs9ěC9ěC9ěC9ěC9ěCz^;Cz^;Cz^;Cz^;ˇxs7xs7xs7xs7xs7xs7xsH_!!!}u0{ߡxA_OGqD?Gxr3#Xt`,:EG#Xt`|{q>>|}#G܇#2r}#G܇O?a1 9c?c?c?c?c?c?c?c?c?c?c?c?c?c?c?c?c?c?w18~Ïcq ?18~Ïcz瘞9~Ïcz|_ucO =rBN =rB#' ''''f |l>a60O'f |l>a60O'f 9!'0rCN` 9!'p,pBN Y8! 'd,pBN Y8a=8888#)^)^)^)^‹S|8<)>ŒS8px 7N)~)~)~)~)~)~)~)~)~)~)8pnSq 7N)8pnSq 7N)8pnSq<>eW;c1wϘgz\=cW;cW;cW;cW;cW;cW;#gpgxpFy8#gFgFgFgFgFgFgFgFgFgFgFgFgFgFgFgFgFgFg9rgxpgxpgxp-'Ct}ҡO:I>'Ct}ҡO:I>'XсCtYCtѡ?:|谇wxavfiYavfiYavfiYavCt=ҡG:H#zzzzp ^\%xq ^\aBr` B4`L$B @QQqz^{kz5 ((9(*DFIM bg3^ĺbXC!~u?ĺbXC!~u?ĺbv"NډX;k'bDv"Nډ>ߐo7-|6"vw;|7ߋ/}X>wD,&\K{"+buWĺ7c3;c3;c3X888888888888888888888888888,838qqqq!a   $D~$G~$G~$G~$G~$G~$G~$G~$G? ߏK34K34K34K34C33C62"/2"/2"/2"/2"/2"/2"?33?3lJoffoffoffoffKfF\dggeg&fg&fgx㑏G>x㐏A>cA{{{{{{L>cA>cA>cA>cA>cA>cEX`PA`PA`PA㓋-kmmm<mQGxQGxt~n)K K K V?N)>pl`T` o *;U` 8Nة;UY]MXMnMMM!M!M!M!M!M!MNM!rM!f|[ȷ|[ȷ|[ȷxmm!m!m!m!NbTQ!FbS(;|[K!8m!m!m!bP_c +Rhw NڞB~)B~)rEn"7~ѿ;En"\۾m_-ESĹE';Eo"w\E~IE~\$E~HQERCH>](ҧ";]ddHVq|"("("("7LH1E:USE:UM?VaTQFE"wL1so1so1so1so1so1c1S1S1S1S1S1SS:US:US:US:UOSKcS1ŘsLK1NK1K1K1J1QE1XcP/R/2R/?YX K K K K K Kx `P"#%2RC`QE %X`QE %X`QE %X`QE %X`QE %X`QE %X`QE %X`QE %X`QE %X`QE %X`QE %X`QRX)XbQ+P*P*P*P*xK)oQʷnR-R-R-R-uۖmKݶnR[-u痺kKݳR})š;JTWJ;J;J;J;J;J;J;J;J;KT/J;K;K;˸;˸;˸;˸;˸;˸;˸ 2,2,2,2,2,2,2,2,2,2,2,àM_NeQ&eQeQeQeQ/{>}_H{̭VV+>([geYƟeYΟYΟ2QΟYΟYΟYΟY.YΟQYΟYΟXE^E^EEy'帔H9G|G|XK9&~rm,;֖XΡZΡZΡZΡzR.Q.Q.Q.Q.Q.Q!Q!Q!Q!Q!Q!Q!Q!Q!Q!Q!TG|TG|TG|TGQ!Q!QrQQQQQQQQA\T7|T`QxTQaO*lm#vŽTؑ ;RiG*H#QQQQvҍVQQQQQQQQ2Q)2Q)2Q)Y7p%&TbRI?L%VI%NSU%VXUbUU%VXUrITSM%6R)+R)+R)+Rl?^%3U2S%3U2S%3U2S%3U2S%3U2S%3U2S%3U2S%3U2S%3U2S%3U2S%3U2S%3U2S%3U2S%3U2S%3U2S%3U2S%3U2S%3U2S%3U2SO>UTSKU8TPCU8TPCU8TPCU8TPCU8TPCT{Tۗj mLݭƣZfmo5&՘TcRI5&՘TcRI5&՘TcRI5&՘TcRI5&՘TcRI5&՘TcRI5&՘TcRI5&՘TcRI5&՘TcRI5&՘TcRI5&՘TcRI5&՘Tw6<[?j=֣j=֣j=6;jlp F5SK{H{=R÷5TKޭޭޭޭwkZnq8jܭ5wk ָ[kܭ5aqSݩ;5vP؝ScwjNݩ;5v_jx,jNݩ;5v؝ScwjtڝZSkwjeڝZSkwjN-vkk9SjdQ+Q+Rk{jmO=ڞZSkojdnZ7Y׺jyֺjdnZ7Y-ԺjdnZ7YMV&uk[kdnZ7YMV&Zy :yc\qlRǵu2R'#u2R'#u2R'#un:٨sֹYO>u[ǹu[ǹuqnqnqn֑XPqnqnqn:;\gpuZgpuv:TLKwuR+uR+uRgslNۜz>9xPosۜzSosۜzS__________?H=\R/+:S'|R'|R'|R'|R'|R'|R'|R'|R#[[ϱ[ϱ[ϱ[ϱ `cA>lL6ؘ>m>mh>m>mhЙiЙiNmNmNmNmNmNm;0i;;;;;;;;;;;;;;Q_u;;;;;Q7FlFlFlFlFlFlFlFlFoFoFoFoFoFoFoFoFoFoFhĠFhFhFhFhFӰ&h&h%M<M<M<M<M<M~6mğM~6=l߳MĝMĝMĝMĝMĝM:ğMğMѤMğMğMğMğMğMğMX4D^4ߏOi¦I6pi¥I6dI6dI6dI6dI6eY6eY6eY6eY6eY6eY6eY6eY6eY6eY6eY6eY6eY6eY6eY6eY6eY6eY6eY6eY6eY6eY6eY6eY6hƠ[[[~8g|G|G|G|G|G|G|G|G|G|G|G|GlFlFlFlFlFlFlF ih"-žI}m-:Ң#-:Ң#-:Ң#-:Ң#a:Ҫ#xڑVlť՞bӪ3vG[mK+6նږVj[ZmKmi-նږVj[ZmKmi-նږVj[ZmKҶMmiVjOZmkmmնVj[[mk+.նViնVնVj[[mkmmmͶ6LڰhàۼۼۼۼۼۼۼۼۼۼdMOHi#mv͎mmfKli-mm͖6[fKli-mmfKli6[fKli-mm͖6[fK3  g@?Џ~#G@?Џ~#G+8i3xC@# F7 '> )SN8p )SN8p )SN8p )SN8pjws9hוv.iws9nv7Ghws9vF{ݽhwohwo7v,GjvovovovovovovovovovovoוvNmחv}ivivivi* 됕Y鐕Y鐕Y鐕Y鐕Y鐕Y鐕Y鐕Y鐕Y鐕Y鐕Y鐕:p:p:p:p:p:p:p3:lKotivivi8tЁC8t@[a8tЉC'8tЉC'8tЉC'8tЉC}ӾvNi_;ktJ}i_;uS/:ӾvNi_;k}ӾvNi_;k}ӾvN :k}i_;k}ӾvNi_k}']vˆt.r_t/].E}]]]]% ]e[lkm.]< ]e[lkm]˶v.e[lkm]ˮv%]6 .څG]xtхG]xtхG]xtхG]xtэG7xtэG7xtэG7xtэG7xtэG7xtэGC>C>C>C>C>^Չ^Չ>Ӊ>tO'tO'tO'tO'tO'tO'tO'tO'tO'tO'tO'tO'tO'tO'tO'tO'tO'tO'tO't#8#88> 0à> 0à> 0à_ ЯzѯzѯzѯzѯzѯzяCۡ~C~w?e?W~o7f췛vn~o7f췛vn~vn~ϓv_7~C~w?O~yw?uCl6s@'tb@'tb@'tb@'tb@Ћ,pAAԉAԉAԉAԉA`P'ݑz1tKà,  ,  ,  , W0ȗ21ș9ș9ș9ș9ș9ș9ș9ș9ș9ș9ș9ș|9ȗ|9ȗ|9ȗ|9ȗ|9ȗ|9ȗ|9(C|9ėC6cH7tcH7tcH7tcH7db!<bHaHaHaHa(!!!!!!!!!!!!!!r? }>{r=9rO'ܓC!{r+ܓCIQ ֍a֍a֍a֍a֍auc^ Ű^ ۋa{1l/Űb~c1ú121ú1ú1ú18 İL Ȱ Ȱ Ȱ Ȱ Ȱ Ȱ Ȱ Ȱ Ȱ Ȱ Ȱ Ȱ Ȱ Ȱ ȈȈȈȈȈȈLĈLĈLĈLĈ~1##:2##21##:2—#1—#|9—#|9#&#:2LjȈȈȈȈȈȈȈȈȈȈȈȈȈȈȨȨȨȨȨڏQ1ʙc~ڏQwըj]5QQQQQQ=QQQQQQQQQQQQQQQQ111111111c 1<ưӓ1w;s̝9Ɲc9ƙc9c1gȘcx1cx1cx1cx1cx1cx1cx1cx18x18x18x18x1Ǹs8&1/1.qqqqqLc\6Ʊbq,Ʊbq,Ʊbq,Ʊbq,Ʊbq,Ʊbq,Ʊbq,Ʊbq,&b ,&b ,&b ,&G'c <&cžLؓ {2#:2#:2L`0LLȄ\L`1<:ޚpoM&[ ք{k½5ޚpoM&[ ք{k½5ޚpoM&[ ք{k½5ޚpoM&[6G|?3?sK>,&XL3&2ΘIɸߏK'qԛIԛIԛIԛIƤ[cI$N$N$N$N$N$N$N$N$N$N$N$N$N$N$N$NNNNNN)L씝);;eg씮LɔLɔLɔLɔLȔ;cʝ1S1ÔLŧb ),b ),b ),b ),S)Ɣ{cʽ1ޘroL7S)Ɣ{cʽ1ޘroL72lڽ1ޘvoL7cZ>cZ>cZ>+Lʹ16fLۘiiNii٘i٘i٘i٘dZ6ci3,>3,>3,>3,>b3,6b3,6b3,6b3˧|:˧|:˧|:˧|:˧|:˧|:ͬb33:33:33:33xb03:33:339 0`9 0`9 0`9 d?c?c?c?dd?c?cNWl̜1s6fCcζ9,^{e9K,᳄>K,᳄ϒ ^K6x/%dlϒY%Ld %}KzGKz-ђ-ʒ,ʒ,ʒ,ʒ,.q~ _v/ʲ,ɲ,se,M-Ӗiz̳<̳<̳<_cen] n nd <6c <6c <6bo' Ȇ{d=Æl~ݰvxo N 9b ,6pn,ܰ5flؚ [ak6lٰ͆5flؚ 7ۆmͶXl`Xl`&Xl7ueo?W|vf٘Mɯ6flژMic6m̦bMnMnݔMyaS6aS6aS6#MȦ{dMnM^ԙMؔNtm~lⲉ&.lⲉ&.lⲉ&.lⲉ&.lⲉ&.lᲅ˖lȖlȖlȖlȖlȖlȖlȖl'gwb| _/͖llƖllƖlla&[l᱅[ .[6gKN8eS8eKoxeKwtgKwtgKwp-7N[V[XmaV[XmaV[XmaVAX b*U VAX b*U VAX b*U VAX b*U VAX b*CAl:u(h97(3A[EA[ .AӮ>̞>Ӟ>Ӟʞʞʞ᳇{Þ>Ӟ>Ӟ>Ӟ>Ӟ>Ӟ>Ӟ ۓ=,aݷ۳{=wߞoݷ{{{vk}{=wmeO^eO^eO^eO^eO^eO^b},b},b},b},b},b},b},b}n}yؗ}Yؗ}Yؗ}Yؗ}Yؗ}Y`_~?/c>&con}w ﻅ;iwv_>qe}\8-|>w΁;s9ps9zt%zs3r9ps9w΁;s9ps92r9w΁{;pz}s9p`qpq)r`p9r`_@^@^@^@^@^~9~9C~9C\݀rs5!!!!!!!!!!!!!!!!!!!F|rh9dC9C|9C|9C|9C|909#<8ҧ#9#L09#L09#L09#L09#L09#L09#L09#L09ˑ :#Y9#=:#]:ҥ#]:H5G~?tG~[evyرѱȱѱ1ztGztGx1&ǘcr1&ǘcr1&ǘcr3Ӿ/-{6 m->====LN ǜ .'r .'r .'r .'r .'r &'x=p=љ ʉʉʉ￟>9Wͩܜͩܜͩܜͩܜͩܜͩܜ̜ͩ)sʿ{ʿ{ʿ2s^9S9եS]:TNuTN9ѧ<|ç<|ç<|ç<|ç<|ç~-rOtʹr*/r).r*+SY9S7˩StjNѩ=:gǜqǜqǜqǜq˙>ҙ.ҙ.ҙ.ҙ.r&gar&gn& 3w˙rn9s[-g3}n9Ig6˙>3^939ӡ3y9ӡ3L09sÝqǙϙ|ar&#g2u92r.#2r9\v1:s1:s1:s1:s1:s1:s9s>s>׫s9\~\~\~\~&ۤs9.u.?sչυ\`uV޻½w޻O l.|so~tN8]tN8]tN8]tN8]tN8]tN l. l..d y .肋.肋.xB.dB.dB.d .0 .0 ar 6!NSHB܄&MHnB{8! a$I/p qs(On V! C~Cx;wTC~G _HBҿ/$S! _HBҿ/!E qR-rlYȎ8;!!tC< }yBn' y.9钏.R.1K.1K]KK.KK\.1ҭ|)G\K7<]ڳK{vחҞ]bs)Sw%o_%o_%o_%o_%F]bt%F]btѥ]ӥ=K.qKvQtO+ҹ+J߮8_+;vsW]ݕ]Օ\]uw֕YW~g]++W +W2sϕ\̕\̕\.W\&WvoWvoWvoWvoW\ܕ]']q']q']asIWtIWtIW|t%7W2skW+lQ߰klZ׮95.ھ_kzvm߯}Z\'dek8bpwap;wsΝw~?wN^NN;ӥ;L0;L0;L0;L0;L0;L0;L0;L0;>;Y;Y;Y;Y;Awzs'N˰{>{L1{L1O{q{ݹ?|r~to=.{ϻ{ϻ{ϻ{ϻtomV{[}o=ޭ|Vw+ʽʽʽʽʽʽʽ<ʃ<ʃ<.))) #)<d'/ / / / / / / / / / / / / / /fypy7Gɣ}>yG3'yҙ'yҙ'xҙ'yҙ'yҙ'y 'px 'px 'px 'px 'px'yx'YxF~?x'x'x'x'x'x'x'x'x'x'x'x'x'x'xgxgxgxgxgxg3&ϘyvyqO^'/.y.y.y >/ >/ >/ >/ >/n7ʋϋɋ Ǿp Ǿp Ǿ Ͼ 6/ؼ` 6/ؼ` 6/ؼ` 6/ؼ` 6/ؼ`+6ؼb+6ؼb+6ؼb+.˫yůnW;j_~ïv޼W;j_ܼ+.+.b+r+r+8ʫbKU^1yWL^1yWzAؼr+׼r+׼r+׼r+׼r Uq׼q׼q׼q׼q׼q͛}~o͝Nys(o7ovo\߈oؼ7[fssl-~ӣ7[&+oؼɛɛț-~ox7[fl-~o8Ǽɛ7yox?*km;߼;߼̻߇~}}{+>7MYefywY,w7ʻ};&c;&c;&cn9S9S9S]V]Fe]Fe]F]6wto>o>o>o>o>o>&胋?oЩ|>|>|>|>Cn>Cn>d.}إyKv.}إOYSN>Oi>ҧ]K6s?mɧ|ɧ|'X|Ч}Ч}Ч}*}Fs|˧|r'x|ǧ}r'|r'|˧IOw˧)O.O.O.OԝO%_\%'_r%_\%_x|ȗ|ȗ|ȗ|_x|_X|͗|͗|͗|͗|͗|~q~a%_X|a_X|Ɨl|Ɨl|Ɨl|Ɨl|Ɨl|Ɨl|Ɨl|Η|Η||a_XQ7X|c7X|cͫ߼ͫ߼ͫ߼ͫ߼+:ͫ߼ͫ2-2-2msy|ۜomsqo196fv}پlno{mk7~᷇|<|sL|ķL|ķL|ķL|78|a?8?8?8Ïď <~<~<~GG~tGG~tGG~tGG~tGG~k?nڏOncg~̏3?v<~;cg~u.'&@t LT(HTPA$D̑ĉC&HLk߫v]l9//xfJ7]O5o֪w]U߆ӟvկ.^Yzn #|=G>bL|{}FЩ&@w @6f d3lcd d2L2@&d d2L2@&d d2`` 0N'dq28` dq28` ` `````` CСt:t:`@.셇  !!0ĺ2ĺ2ĺ2Bg 3C!t:c1Bg !!BCb ?C!c1B ?ztuwuwuw[d:-2b 1F#C!cd12b 1F#C!c1Bw !!!cd12al`{```````0WFWGWGWGXcGX[GX[GXOFA#bq1¸a\0.F#se2\a0WF+#̕rA#a9 ֓֓֓֓֓c1A#tc1Aw;F/Pc1tc1c~1?Ƙc̏1c1c}cl!1d1Ccc y!11<ƐCcc y!11<ƐCcc y!1tcuuuudddddd e8Əc=c=c=c=cL1&c1cb11Ƙc`j@b[cy2<`L0O&'̓ dy2<`L0O&dy2`m`m`m`m`nL07&̍ sc1ܘ`nL07&̍ sc1ܘ`nL @bq1`LL0&& cb11`LL0&& cb11`LL0&'戀6rBoNasMasMasMacLasMasMasMLasMasM1&{)rS妐rBSMbmbmbmbmbmbmBoN3ЙS)t:s 9Μb~L3ЙS)t:s 9ΜBgN3ЙS)t:s 9ΜBgN3ЙS)rbLL1&S zb=1AO̠'f3 zb=1AO̠'f3̋ zb=1üa^0/f3̋ by1üa^0/f3̋ by1üa^ 0f rA3a9 0f rA3a9 0f rA3acc{{{{0Xc,1 s9ca̡#rCsa9!90r9֌9!sC؇̱c2>d}9!s̋9a0xCsa9!90rCsa9!90~Cs9t:b1CG̡#s9a0xc<,0 axX`<,0rX@ a9, 䰀rX@ a9, 䰀~X`^,0/ ̋byX@ a9, 䰀rX@ a9, 䰀Г rX@ `, d 2X@ `, lɻ%zr5c5c5c5c5c5c5cĚĚĚĚMZZZĜXbN,1'K̉%sb9ĜXbN,1'K̉%sb9ĜXbN,!%zr =\b\b\b\b\†X†X†X†X†X†X†X†X†X†X\\\BG.!%a =\Bw+a9 䰂V rXA+a90V+ axXa<0V+ a¼Xa^0/V+̋ by| a+V؃[al= { ca90V XA+d,V XA+++++5l5l5l55555䰆֐rXc<1k5axXc<1~ VV1'֘k̉5sb9ƜXcN1'֘k̉5a9ƜXcN1'֘k̉5sb9nXC7 k5t:r \CG#טk` !5d ֐2@`l d 666666666X37X37X37X37X37X372@`l dvvvv`Nl0'6̉ sb9`Nl0'6 `q8`l06 2@`l drbNl1'[̉-sbXb,l1 [-caXb,l1 [-ŜbNl1'[̉-sb9ŜbNl1'[-a --- xb s|9@>dslv9@>c1sĘ9ba{a{a{a{a{!##s|9B>G!#sq5:8B[-G#tY[XsWGGGGGGGGGgCOG!Gyaa###G]WGz|>BvGٝ ֢wN ;A~'u9AN?' zO't y0N :A^'y  6 :A^'ywN :a|NC'N'n'1;8~d.ug~O?7 o~_V0._[_}?w~/s}cW׃}+~W77Co׋>;+C{p{˹o}fV{].E~ωsx \z3u=>-{uje>?>xo^^/S8G~<8 3~_qzː[Wq&WwJmmMT|_&.;mxy֑y5?ۚfs^WBu#>W\~#n.'2c ^.{x8?ޏ-]4M3źy~j?Cz&_~XϾGc#Ko}7qʎ/A/V;/}^w){- EWbT~ЯoH_>i8.ߓbb} ~/4M,W#~TOn|ޗLy1z^oT>N0/֥X7y?$kerkf l8z*<۲^!g{iTy㸕e}Z^]sv;No70o}W^Y|NJob9vA>\Wba^ */z>'ϿR~+Hك"?~הI>$}y\(y.U'sw:#cƏU<ױuh< z["cS}`xs|n3GAK*M~KC;TvfX^7wյ?;>]yۖq-.}:w}N׹\~rU|]re>?8\9_Scyc#Lž˾GsUWmW/S>bq3U'TM {,~/Շ7K_[!cq_-Vl]Ta}|4M,cj}uw*4c'Qtyu#߫/w~ܾlF?>ۙ*?)W~>Z)8 ngyWR~*N}zU<+ryK3ťΏ'fDzK~qPN|j (}+R^{~a{H]msU<i{i_fyu}>m;O?_Rv"x]R>~ @Tz>j O庒ѿT (RSƩzuϳ|?8';"7฾]N͕z]ʎS~kj~Tyoo9DJMcoij>nߓ[[!^/|/qλz=z[כ:&Szu~uo~sqTvuWp^SWWug@Ui<.U}i:)/!oe\4Z,SzQye*.ڮNEmϟlq~9QCMx[*]A*4M4M6v/Uw\y}U ur5>Ǻ~'z,]S~#Տ*^#pPybj|ݚǑ0 S~@>TTg?[#U\oazki7,J?vM4vXw}I_y?~2WwWV5u'w/ous76M^'m=~ޫ_G|Bkr?Q]7y{"ǏYNsP _r9_P+5O9R35u:橼uw=?M4>2Mϥr=e,]7?jA>0\/{/m?yo6寖}i|Ȇs넣>ʃ|8Z1祟 2/`Gxz\6=ĸc>Awr}Ru*;گK奤;mݟz'_I!'9y5#G~oa[vEߕ۷>ii}CS~W+3W~ U|Sѷq|4Δ=/K/s\,⬹)||>꼃JŎ*r&}䩞J}ͷ*_80RYS:uL\S[N]W罨y4M4M4{}c9l\l}LyVLu'>'SӏڮGPrU} C]>}뙦i?aZ~fL*hu~>s]g_+#nr>(3<[f\OUa;77?T$@uMT7giižөzc׹խ}l̦[DsMzݶT|2|^v߰vo\F虦Y_cvQnܑ󭸿G r\N'z/ۨ|>틦UjqRexPS}y^벎F}i(|4MQWS\j v?W/5y?~IJOO-WU,*Ec`:*n?K2_9}'1Kr5^量.3K=SWŪ娮+yj~=yuljGQ'NJH*牚i>'s5Uu4g-㥩: >*,i>=>=ύ%}e7tul*Ozc:-Ggz?ǺtUW~|~aGUϵ4MӬö WS=~ti34;u~>#}Ծ_}cpl<Ƕ?_xq{(e|[5[ȍםZwRy|:OWsOz5b}sz}sii>"fi7 ]?S5'y:?ӹwnc>?_uU~Y/RsM9T s"}QX.xA;c=M+4M4MS3WsC,_#6<}WV}"θ|i>/u_ϰz opݏM4M4>1S\~+3/yq~|/_[}u(Oyʦ_:|~~XGoCsT?'{5qy1{?a7qky>C~KM4M4M _wI=]4ۘWXOa>y>s׭}Oy7m5/5gߍ>:D|N߄=|d*Anpg/ov˺crQ#ʮsZ3ޗu=s _e;*~׃\T܃;^aiiT~W08??BE)vg y;ss]kz>I6yܲ]y'-ʼn.?4M4M4Ro:S42Ws##:"0x̫`6SU8 ί>fljzHnu꼳o-'Mջp_GU4M4M4b>l,&8N Fk5>&|Tfg'(?/:8n΋x׉竛iiiͿ}}@"_5|T:r*׿4Ms,Ώ|=^>RdiԹg5M4>H>^k?G1ǡ `9 k>4S?VT}B\:xוcscx]*=ϜB,oS)^UgY?}'u增B(4MӼK R^G ZMU+Fy~s~ Mw}ZgRzy*P篛yf(;F_Sm}[{g-Sc_iO<\ܟ%GS|2E߆su.go:㾞`/!b8\ܿ-ّ_P7~Ր׽ΏOX<};4M4Mu\n.sL|\m{.}ib+=i?[is~=A1y`+g[[M#2Pp?fCYK֏xG_ٯxcy<6M4MٷMؿq~OqWɗ1M~͇ }z.b][z:=E>T}cs̓{++u-|Sa1744M4MS<<u7׏>q~-4" 7~qx}<~_ZITbr<ܷ7U~{#Cs/^L4M4ǺorWo ~Ͼo1M;GWozߔO/y}ߔ"ˣ}}Ϫs[LTU>`aܗEMGU^z]N5oyDsܹ$#׹ii6Ϧ9Ogx&9ߋ J]4îOWmߛ5귞Ϳu#Kg%ߗǙ\czyni@?Rq>gyN[s=D_ie\wC;%"_VD]կ3z7 r)~܍)W9:gi+0e׫z墨γ)}qW}TM4͟0wP~3p>*'Uڇ#}M?c]̭Uq8(? 4M+䞳f-~L_> lg*ŸtҮi棰0[y)g TėuZ׉9%eQvii>K문~/!J+r{Wng9C:z|L4[ڨ<}S~T%՗7/NRu+W3fifG> #`+ '8O84ge ~j 6'Du>-2M4M4K!-sh&Y8QP(,+މ`i^_:A%~4M4M6\w-C}?iR ){7ƛ^Hé7d7~L4M4MK͇?*P;R!Q4Mb?[M[]o?s>74W̶h=U_-Eu>[3M4M٘[} {g{ȺՏzxwߋA֘̾{usږG~f]?~jMux:4M4Ɣ}v-~g>)Oߔ~__?VټRS~~>LKr~~>]Gos4M4T~ 5_Iԭr~ϕ:.@ {s_ॎFi2ywzochEM4MS}_ai q>_3Q(/`?L4ۥTͰ4Ourks 4MSqg]~?~s*64`.^aʯ}qxsoiT(=}t;ޞjy]{\?:0wTD})L4~1~.st< ߿}5M|l9UՓ0Kis{5~\:짿վr4~~^:4M]_ K|uݾ_ۋTe -//=/(f/=?S]ۣjݟί7Wp4M5V?^պo>8OۊE]c_ctqmO{6vQϫk?;.u|Poymi%֝}Wo*n:g:J{4ѩ9S'7?eGߧڷ$RŸ1M43s2eK,|9_UV﫚azoǰ/ze<'gMM~q_[ifpb<֍g^w0M4`> ᇏބp'nT3>Qt2xGkW+s^WSʿ㪯+_~|W}hY}hGU$7x5M4__V~>d}GSyF}=mG]k]8W~m#U|ω/+>י?i'Ͽwܹm{<W7eﲿ[q.K~vhylfLsoh6Z9z:ar| ?o7eGzkni}sESߨ7d5eع/6**?ل]z}/S Ou=7ncҪ)c}zO8KZoK|^?üWYSz/Nݏ'n}=띔~fqTHS맪 Q}ݠ)}Rjp}Oɍϲܕֿ^O}i_*&3M3=?>cݎr2Rqİ>NXl/ٿc?3t;w_)|il+_d8s·T&}NNe??O+#p>s?\Չ|8Q_W|*>xiiuT,Ϊ<#횰 `IU)q_;SNJ#?!+u}Pg>ysv!۵>4M4g.Oc><;}Þ㸛{f]PJ_=|VSEU]QsU|¾jLųf\_ {ǜ~8ef7k_r^T@oٵWu|~=MۦƋi<_W>wfn|'8OlWpe0*;+)W,,Vẽ˹Hy/M1ާs}{NvL?afxk߀G/:67Y?KۮW/?qTz>]~YN+XQÔ_k(}V|Ϧy^Pוgd{&Ʀ>.WYZUCp&םs] 9~D{^/<=?e[WߩA]{~n_NezQ= w`*_c"^Fp{WoίL[+ٱTΔsrǫ5Y7ey<~u'|ʸ*%Oҗ\:Sq燘_^);vFT}u^>~]]}yhܚGu3Z11?V>|-/xxK?܏-as8bg3e|sK]o>:'qp?uf,=HrܦoʛS9>#z[6 =q0WꝹ_ڏzhT]MC'i> exxq:m|م>sߩƕx>*W2_<8z"Wij]Tn=~b*zfnP^V~8єb,y[:|gq1/5UXS˔^o?:l_s[W}GU?TΫܺG7+wߗ?c?:948:%bֿsAASso ?_ +qj \M4usuXC L>32er=^*4MͦH=6_G65̰gT2MOCSyAU}LyϪϙq>OҰ6VOU|XUuV翰}vku=7~G|<ͯq_AXjrQn)/Kq0E%>}q0[SכR|ǿH,=dʏC#Ӧz=ߋn\k|%rџɝ?e=\y˜Oq\]J#si,Tvi6?/o&sVlǖuYQ}c4p?жfXMod;VKalc<7wx4KY7"h+lc~s̒qYs:/}x,4f_ݽO6T>kN]6M)In|s8yG/y &s`unM4벩>cWp\9xk]_=4MmN쒩8V<|&|c6M̵%mM0}A:l}Yj?y oiv\;T=j:Q,5Vq f<>7?X̵g{i_' ɳ.q˳i@_} dܻهq׳w|.|7WIun}>%ˣ^zyf˺z=!:oQ},O2/~8svY/C\C*֔'l/]V멺ek]_O؎}Us2cu`̳omlڿWzϠ%we9>con7=bC*}, "sparseMatrix")} no longer fails %% when \code{prod(dim(.))} is larger than \eqn{2^{31} - 1}. % \section{Changes in version 1.4-0 (2021-12-08 r3419)}{ \subsection{Bug Fixes}{ \itemize{ \item Update many \file{src/*.c} preventing integer overflow in \dQuote{pointer} and index computations for large (dense) matrices; prompted by Dario Strbenac's post to R-devel.% June 7, "dgTMatrix Segmentation Fault" \item \code{sparse.model.matrix(.., contrasts.arg = <.. ddiMatrix ..>)} now works correctly, fixing R-forge Matrix bug #6673 by Davor Josipovic. \item \code{sparse.model.matrix(..)} now also works in cases the contrast matrix has become a \code{"denseMatrix"}; e.g., in a case using \code{poly(.)} in the formula; now works correctly, fixing R-forge Matrix bug #6657 and useful suggestions by Nick Hanewinckel. \item Fixed the internal \code{attr.all_Mat()} auxiliary for \code{all.equal()}, notably for the case when exactly one of the matrices is a base \code{matrix}. \item Fixed long-standing bug in the \code{rbind2()} method for logical dense matrices, specifically \code{"lgeMatrix"}, thanks to the notice by Aaron Lun. \item fix leak in C-level \code{Csparse_to_dense()} thanks to Bill Dunlap in \R's \PR{18204} and \code{install_lu()} called from \code{solve()} in \PR{18206}. \item fix leak in crossprod(), thanks to report and patch in \PR{18205} by Bill Dunlap. \item \code{band(M, k1, k2)} now also works when \code{k1 * k2} is larger than 2^31-1, the maximal integer, fixing R-forge Matrix bug 6743 by Ariel Paulson. Further, it works when \code{M} is a sparse \code{"symmetricMatrix"} but the band is not symmetric, \code{k1 != -k2}. \item fix leak in C-level code for \code{cbind(m1,m2)} or \code{rbind(*)} when \code{m1} is \code{"n.Csparse"} and \code{m2} is not, thanks to Bill Dunlap's diagnosis and patch in \R's \PR{18210}. \item \code{sparseVector(i=integer(), length=2^33)} now does show/print, after fixing a bug in the \code{head()} method for \emph{empty} sparseVectors. Reported by David Cortes as Matrix bug #6745. \item inverting or solving \code{dsCMatrix} no longer catches C level warnings too early which would not free, but rather leak memory; thanks to Bill Dunlap's analysis and patch in \R's \PR{18214}. Additionally, such warnings and error are \code{message()}d when \code{getOption("Matrix.verbose")} is \code{ >= 1}. \item \file{test-tools-1.R}: \code{Sys.memGB()} can no longer use \code{memory.limit()} on Windows; no returns \code{NA.value = 2.10201} in such cases. \item \code{ss <- [i]} gave an invalid sparseVector \code{ss} as \code{ss@i} was not necessarily sorted; thanks to a report by Quran Wu. \item \code{as(, "generalMatrix")} and similar, sometimes did \emph{not} use (C-level) \code{symmetric_Dimnames()} etc; report (to \R's \PR{18250} by Mikael Jagan); fixed all on C level. As a consequence, you will now see \emph{more} preserved dimnames after matrix transformations or operations which involved symmetric matrices. \item \code{as(, "matrix")} no longer loses dimnames, thanks to Mikael Jagan's report as Matrix bug #6751. } } \subsection{Misc}{ \itemize{ \item No longer include \file{Rdefines.h} as it is somewhat deprecated. } } } \section{Changes in version 1.3-4 (2021-05-24 r3392)}{ \subsection{Misc}{ \itemize{ \item Update \code{matrix(, n,m)} in \file{tests/*} to work with \command{R-devel CMD check --as-cran} } } } \section{Changes in version 1.3-3 (2021-05-01 r3390)}{ \subsection{Deprecated and Defunct}{ \itemize{ \item \code{cBind()} and \code{rBind()} are now defunct: simply use \code{cbind()} and \code{rbind()} instead. } } \subsection{Dependency}{ \itemize{ \item For now revert to \code{R (>= 3.5.0)} dependency to accomodate users on older R installations. } } \subsection{Bug Fixes}{ \itemize{ \item Fixed a thinko (in 1.3-2): Now direct coercion from \code{"ddiMatrix"} to \code{"dgCMatrix"}, and hence, e.g., \code{as(Matrix(1, sparse=TRUE), "dgCMatrix") now works.} \item Fixed error message in multiplication. \item Fixed long-standing bug in \code{R[,j] <- v} when \code{R} is "Rsparse*", R-forge Matrix bug #6709 by David Cortes. \item \file{./include/cholmod.h} and \file{./include/Matrix_stubs.h} needed updating from SparseSuite update; R-forge Matrix bug #6714 by Kasper Kristensen (TMB pkg). \item \code{as.matrix()} and \code{as.array()} now work for \code{"sparseVector"}s as expected; see Matrix bug #6708. \item \code{M[,]} (and similar) now work as in base \R; ; R-forge Matrix bug #6720 by David Cortes. \item \code{-S} now works also when \code{S} has no `factors` slot. It signalled an error, e.g., for sparse triangular matrices \code{S}; R-forge Matrix bug #6656, reported by Chun Fung (Jackson) Kwok. \item \code{M*2} and similar no longer keep cached factorizations (in `factors` slot), but drop them via internal new \code{.empty.factors()}. R-forge Matrix bug #6606, reported by Tomas Lumley. \item removed the nowhere used (and unexported but still active) class union \code{"Mnumeric"} which actually trickled into many base classes properties. Notably would it break validity of \code{factor} with a proposed change in validity checking, as factors were also \code{"Mnumeric"} but did not fulfill its validity method. Similarly removed (disabled) unused class union \code{"numericVector"}. \item removed a few duplicated \code{.alias{.}} from \file{man/*.Rd}. } } \subsection{Misc}{ \itemize{ \item translation updates (of outlines only); finally added Italian (by Daniele Medri) to svn; updated French (by Philippe Grosjean), forgotten (R part of) Korean. New Lithuanian translations by Gabriele Stupuriene & Rimantas Zakauskas. \item In internal \code{diagOdiag()} method, no longer use \code{matrix(x, n,n)} when \code{x} is longer than n*n. \item Update tests/*.R to future \code{matrix(x, n,k)} warning in more mismatch cases. \item Eliminating the need for \file{ftp://*}, add the very small \code{jgl009} MatrixMarket example to our \file{external/} files. } } } \section{Changes in version 1.3-2 (2021-01-05 r3362)}{ \subsection{Bug Fixes}{ \itemize{ \item \code{rankMatrix()} tweaks for the singular values based methods, notably \code{method = "maybeGrad"}. \item \code{as(new("dtCMatrix", diag="U"), "matrix")} now works, as C-level \code{diagU2N()} now also works for 0-dimensional triangular matrices; this also fixes a subsetting (\dQuote{indexing}) bug of such 0-dimensional matrices, thanks to a report by Aaron Lun. \item logical subsetting of 0-dim. (diagonal/triangular) matrices fixes. \item The new \code{FCONE} macros added for newer Fortran/C compiler combinations are now defined back compatibly with R >= 3.6.0. \item \code{chol()} now works. \item \file{rchk}: fix potentially un\code{PROTECT}ed vars in \file{src/dsyMatrix.c} } } } \section{Changes in version 1.3-1 (2020-12-23 r3352)}{ \subsection{Bug Fixes}{ \itemize{ \item \code{rankMatrix(, method="qr.R")} no longer assumes non-negative diagonal entries of the \eqn{R} matrix. } } } \section{Changes in version 1.3-0 (2020-12-15 r3351)}{ \subsection{Significant User-Visible Change}{ \itemize{ \item \code{Matrix(*, doDiag=TRUE)} where \code{doDiag=TRUE} has always been the \emph{default} is now obeyed also in the sparse case, as all \code{"diagonalMatrix"} are also \code{"sparseMatrix"}. \code{Matrix(0, 3,3)} returns a \code{"ddiMatrix"} instead of a \code{"dsCMatrix"} previously. The latter is still returned from \code{Matrix(0, 3,3, doDiag=FALSE)}, and e.g., \code{.symDiagonal(3,pi)}. Also a triangular matrix, e.g., \code{"dtrMatrix"} is detected now in cases with \code{NA}s. This is both a bug fix \emph{and} an API change which breaks code that assumes \code{Matrix(.)} to return a \code{"CsparseMatrix"} in cases where it now returns a \code{"diagonalMatrix"} (which does extend \code{"sparseMatrix"}). } } \subsection{New Features}{ \itemize{ \item Subassignment to \code{"diagonalMatrix"} now returns sparse \code{"triangularMatrix"} more often; also (sparse) \code{"symmetricMatrix"}. \item \code{nearPD()} gets new option: If \code{base.matrix = TRUE}, the resulting \code{mat} component is a \pkg{base} \code{matrix}, as often used desired when \code{nearPD()} is used outside the \pkg{Matrix} package context. \item Factored out new \code{qr2rankMatrix()} utility from \code{rankMatrix()}. \item New \code{BunchKaufman()} method. \item Added \code{wrld_1deg} sparse matrix example to \emph{distributed} version of \pkg{Matrix} (no longer excluding it via \file{.Rbuildignore}). \item New (simple) \code{mat2triplet()} function to be used instead of \code{summary()} in code. \item Internal \code{.diag2tT()} gains new option \code{drop0 = TRUE} and hence now by default drops zero diagonal entries. Consequently, e.g., \code{as(, "CsparseMatrix")} now drops such zeros, too. \item Updated the crucial underlying C libraries from SuiteSparse, from 4.2.1 to 5.7.1 (from 2020-02-20), visible in \code{.SuiteSparse_version()} . \item \code{sparseMatrix()} gets new argument \code{repr = "C"}, superseding the (now deprecated) \code{giveCsparse = TRUE}. Allows to return \code{"RsparseMatrix"} matrices. Similarly, \code{rsparsematrix()}, \code{fac2sparse()} and \code{fac2Sparse()} get the new \code{repr} argument and their \code{giveCsparse} is deprecated, sometimes only informally for now.% no deprecation warning yet \item \code{sparse.model.matrix()} gets option \code{sep = ""}, with, e.g., \code{sep = ":"} allowing to get easier column names; from R-forge Matrix (non-)bug #6581, by Vitalie Spinu. } } \subsection{Bug Fixes}{ \itemize{ \item \code{rankMatrix(, method="qr")} now returns \code{NA} (or \code{NaN}) instead of signalling an error in the case the sparse \eqn{Q R} decomposition gave \code{NA}s in \code{diag(R)}. \item Coercion (\code{as(., .)}) from e.g., \code{"lsyMatrix"} to \code{"CsparseMatrix"} silently made asymmetric dimnames symmetric, as did the \emph{internal} \code{forceCspSymmetric(*, dimNames)} which may be called from \code{forceSymmetric()}. \item Adapt code to new Fortran requirements of passing length of character arguments, thanks to Brian Ripley. \item (R-forge Matrix bug #6659, reported by Georg Kindermann): \code{[i] <- val} bug fixed. \item (R-forge Matrix bug #6666, reported by Ezra Tucker): \code{which(, array.ind=TRUE)} thinko fixed. \item For R-devel Dec 4, 2020: adapt all.equal() check of sparse matrix images (which contain panel functions with environments ..). \item tried fixing warning \emph{'cholmod_factorize_p' accessing 16 bytes in a region of size 8 [-Wstringop-overflow=]} in \file{src/dsCMatrix.c} (in two places); seen by pre-release-gcc11 compilation. } } } % \section{Changes in version 1.2-18 (2019-11-26, manually picked from svn)}{ \subsection{Bug Fixes}{ \itemize{ \item Fix last(?) \code{PROTECT()} warning found by \command{rchk} in \file{src/dense.c}'s \code{ddense_skewpart()}. \item \code{as(m, "dgTMatrix")} does not lose \code{dimnames} anymore when \code{m} is a (traditional) \code{matrix}. \item \code{M[logical(0), ]} now has dimension \eqn{0 x k} for sparse \code{M} as for base matrices. \item \code{log(M, base)} (the 2-argument version of \code{log()}) wrongly gave the result for \code{base = exp(1)}, i.e., the 1-argument default. \item \file{test-tools-Matrix.R}: \code{Qidentical()} no longer assumes \code{class()} to be of length 1. \item \file{test-tools-1.R}: provide bug-fixed \code{canCoerce()} in old R versions. } } } \section{Changes in version 1.2-17 (2019-03-20, svn r3294)}{ \subsection{New Features}{ \itemize{ \item (none) } } \subsection{Bug Fixes}{ \itemize{ \item Fix new \code{PROTECT()} warnings (bugs?) found by \command{rchk}. \item Provide \code{isFALSE()} for \R < 3.5.0 as now need it for sparseMatrix printing. } } } \section{Changes in version 1.2-16 (2019-03-04, svn r3291)}{ \subsection{New Features}{ \itemize{ \item regression tests depending on \code{sample()} now are future proof reproducible, via \code{RNGversion(.)}. \item give information about #{rows} and #{columns} that are suppressed in print()ing if the matrix is larger than `max.print`. } } \subsection{Bug Fixes}{ \itemize{ \item \code{data()} no longer attaches \pkg{Matrix} to the search path. \item \code{"Ops"} group methods, i.e., "Arith", "Compare" & "Logic", now should all work with 0-extent matrices as well, thanks to bug reports by Aaron Lun, University of Cambridge. \item when printing and formatting sparse matrices, see \code{formatSpMatrix()}, the \code{maxp} option, e.g., from \code{getOption("max.print")}, is \dQuote{rounded up} to 100, as very small values are very rarely appropriate. } } } \section{Changes in version 1.2-15 (2018-08-20, svn r3283)}{ \subsection{New Features}{ \itemize{ \item \code{image()} gets new optional argument \code{border.color}. } } \subsection{Bug Fixes}{ \itemize{ \item \code{image(Matrix(0, n,m))} now works. } } } \section{Changes in version 1.2-14 (2018-04-08, svn r3278)}{ \subsection{New Features}{ \itemize{ \item German translation updates. } } \subsection{Bug Fixes}{ \itemize{ \item one more \code{PROTECT()}. } } } \section{Changes in version 1.2-13 (2018-03-25, svn r3275)}{ \subsection{New Features}{ \itemize{ \item Faster \code{as(, "sparseMatrix")} and coercion \code{"dgCMatrix"}, \code{"ngCMatrix"}, etc, via new direct C \code{matrix_to_Csparse()} which does \emph{not} go via \code{"dgeMatrix"}. This also works for large matrices \code{m}, i.e., when \code{length(m) >= .Machine$integer.max}. Also provide low-level \R functions \code{.m2dgC()}, \code{.m2lgC()}, and \code{.m2ngC()} for these. } } \subsection{Bug Fixes}{ \itemize{ \item \code{cbind(NULL,)} no longer return \code{NULL}; analogously for \code{rbind()}, \code{rbind2()}, \code{cbind2()}, fixing very long standing typo in the corresponsing \code{cbind2()} and \code{rbind2()} methods. \item The deprecation warning (once per session) for \code{cBind()} and \code{rBind()} finally works (fixing a simple thinko). \item \code{cbind()} and \code{rbind()} for largish sparse matrices no longer gives an error because of integer overflow (in the default case where \code{sparse} is not been specified hence is chosen by a \code{nnzero()} based heuristic). \item \code{.symDiagonal(5, 5:1)} and \code{.trDiagonal(x = 4:1)} now work as expected. \item \code{Sp[i]} now is much more efficient for large sparse matrices \code{Sp}, notably when the result is short. \item \code{[ ]} now also gives the correct answer when the result is \dQuote{empty}, i.e., all zero or false. \item large \code{"dspMatrix"} and \code{"dtpMatrix"} objects can now be constructed via \code{new(*, Dim = *, x = *)} also when \code{length(x)} is larger than 2^31 (as the C internal validation method no longer suffers from integer overflow). \item More \samp{PROTECT()}ing to be \dQuote{rather safe than sorry} thanks to Tomas Kalibera's check tools. } } } \section{Changes in version 1.2-12 (2017-11-10, svn r3239)}{ \subsection{New Features}{ \itemize{ \item \code{crossprod(x,y)} and \code{kronecker(x,y)} have become considerably more efficient for large \code{"indMatrix"} objects \code{x, y}, thanks to private nudging by Boris Vaillant. } } \subsection{Bug Fixes}{ \itemize{ \item (R-forge Matrix bug #6185): \code{c < 0} now also works for derived sparse Matrices (which only \emph{contain} Matrix classes); via improving hidden \code{MatrixClass()}. Part of such derived matrices only work in R >= 3.5.0. \item using \code{Authors@R} in \file{../DESCRIPTION} to list all contributors. \item \code{solve(-m)} no longer should use a cached Cholesky factorization (of \code{m}). } } } \section{Changes in version 1.2-11 (2017-08-10, svn r3225)}{ \subsection{New Features}{ \itemize{ \item S4 method dispatch no longer emits ambiguity notes (by default) for everybody, apart from the package maintainer. You can reactivate them by \code{options(Matrix.ambiguityNotes = TRUE)} } } \subsection{Bug Fixes}{ \itemize{ \item \code{rankMatrix()} now gives zero for all methods, as it should be. \item no longer calling \code{length(NULL) <- } which has been deprecated in R-devel since July. \item \code{qr.coef(, y)} now finally has correct (row) names (from pivot back permutation). \item \code{.trDiagonal()} utility is now exported. } } } \section{Changes in version 1.2-10 (2017-04-19, svn r3216)}{ \subsection{Bug Fixes}{ \itemize{ \item quite a collection of new \code{PROTECT(.)}'s thanks to Tomas Kalibera's \sQuote{rprotect} analysis. } } } \section{Changes in version 1.2-9 (2017-03-08, svn r3211)}{ \subsection{New Features}{ \itemize{ \item \code{"Ops"} between "table", "xtabs", and our matrices now work. \item \code{as(matrix(diag(3), 3, dimnames=rep(list(c("A","b","c")),2)), "diagonalMatrix")@x} is no longer named. \item \code{norm(x, "2")} now works as well (and equivalently to \code{base::norm}). \item \code{sparseVector()} now also works without \code{x} argument. \item \code{c.sparseVector()} method for \code{c()} of sparseVectors (and available as regular function on purpose). } } \subsection{Bug Fixes}{ \itemize{ \item \code{as(Diagonal(3), "denseMatrix")} no longer returns a non-dense \code{"ddiMatrix"}. \item \code{S[sel,] <- value} and similar no longer segfault, but give a \code{"not (yet?) supported"} error for sparse matrices \code{S} and logical \code{sel} when \code{sel} contains \code{NA}s. The same error (instead of a low-level one) is signalled for \emph{indexing} (with NA-containing logical \code{sel}), i.e., \code{S[sel,]}. %% from in ../TODO : %% \item \code{S[sel,]}, \code{S[,sel] <- value} and similar now also work for %% sparse matrices \code{S} and logical \code{sel} when \code{sel} contains \code{NA}s. \item \code{which(x, arr.ind=TRUE, *)} (when \code{x} is a \code{"lMatrix"} or \code{"nMatrix"}) now works the same as \code{base::which}, obeying an optional \code{useNames} argument which defaults to \code{TRUE}. Previously, the resulting two-column matrix typically had empty \code{dimnames}. } } } \section{Changes in version 1.2-8 (2017-01-16, svn r3201)}{ \subsection{New Features}{ \itemize{ \item 0-length matrix \code{"Ops"} (binary operations) are now compatible to R-devel (to be \R 3.4.0). \item C-API: \code{SuiteSparse_long} is now defined as \code{int64_t} on all platforms, and we now include (C99) \file{inttypes.h} } } \subsection{Bug Fixes}{ \itemize{ \item \code{x[.] <- value} now also works for \code{"sparseVector"}'s, both as \code{x} and as \code{value}. \item \code{x[FALSE] <- value} now also works for \code{"sparseVector"}'s. \item \code{rep(x, *)} now works for \code{"sparseVector"}s and sparse and dense \code{"Matrix"}-classed matrices \code{x}. \item \code{solve()} no gives an error in some cases of singular matrices, where before the C code accessed illegal memory locations. } } } \section{Changes in version 1.2-7.1 (2016-08-29, svn r3187)}{ \itemize{ \item in C code, protect _POSIX_C_SOURCE by #ifdef __GLIBC__ } } \section{Changes in version 1.2-7 (2016-08-27, svn r3185)}{ \subsection{New Features}{ \itemize{ \item \code{cBind()} and \code{rBind()} have been almost silently deprecated in \R \code{>= 3.2.0} and now give a warning, \dQuote{once per session} only. \item \code{bandSparse(*, k=k, *)} now returns matrices inheriting from \code{"triangularMatrix"} when obvious from the diagonal indices \code{k}. } } \subsection{Bug Fixes}{ \itemize{ \item \code{KhatriRao(X,Y)} now also works when \code{X} or \code{Y} is completely zero. } } } \section{Changes in version 1.2-6 (2016-04-27, svn r3175)}{ \subsection{Bug Fixes}{ \itemize{ \item The 0-dim. Matrix multiplication fix in 1.2-5 did trigger wrong warnings in other diagonal matrix multiplications. } } } \section{Changes in version 1.2-5 (2016-04-14, svn r3170)}{ \subsection{New Features}{ \itemize{ \item \code{isSymmetric(m)} now also works for \code{"indMatrix"} \code{m}. \item \code{isSymmetric(m)} is faster for large dense asymmetric matrices. } } \subsection{Bug Fixes}{ \itemize{ \item Matrix multiplications (\code{A \%*\% B}) now work correctly when one of the matrices is diagonal and the other has a zero dimension. } } } \section{Changes in version 1.2-4 (2016-02-29, svn r3162)}{ \subsection{New Features}{ \itemize{ \item \code{sparseMatrix()} gets new argument \code{triangular} and a smarter default for \code{dims} when \code{symmetric} or \code{triangular} is true. \item \code{as(, "denseMatrix")} now works in more cases when \code{prod(dim(.))} is larger than \eqn{2^{31} - 1}. Hence, e.g., \code{!S} now works for much larger sparse matrices \code{S}. } } \subsection{Bug Fixes}{ \itemize{ \item creating very large dense matrices, e.g., by \code{as(, "matrix")} would segfault (in case it could allocate enough storage). } } } \section{Changes in version 1.2-3 (2015-11-19, svn r3155)}{ \subsection{New Features}{ \itemize{ \item \code{MatrixClass()} is exported now. \item More exports of semi-internal functions (for speed, named \code{"."}, i.e., inofficial API), such as \code{.solve.dgC.lu()}. \item more Korean translations } } \subsection{Bug Fixes}{ \itemize{ \item Packages \emph{linking} to \pkg{Matrix} (\code{LinkingTo:} in \file{DESCRIPTION}) now find \samp{alloca} properly defined in \file{Matrix.h} even for non-GNU compilation environments such as on Solaris or AIX. \item extended "n?CMatrix" classes (e.g., from \code{setClass(., contains="ngCMatrix")}) now can be coerced via \code{as(.)} to \code{"d.CMatrix"}. \item The printing of largish sparse matrices is improved, notably in the case where columns are suppressed, via new \code{fitWidth = TRUE} option in \code{printSpMatrix2()}. %%% FIXME __ EXAMPLES __ \item \code{cbind2()} and \code{rbind2()} no longer fail to determine \code{sparse} when it is unspecified and hence \code{NA}, fixing R-forge bug #6259. } } } \section{Changes in version 1.2-2 (2015-07-03, svn r3131)}{ \subsection{New Features}{ \itemize{ \item Explicitly import from \dQuote{base} packages such as \code{"stats"}. } } \subsection{Bug Fixes}{ \itemize{ \item Our \code{colSums(x)}, \code{rowMeans(y)}, \dots, methods now \dQuote{keep names}, i.e., if the result is a numeric vector, and the matrix \code{x} has column or row names, these become the \code{names(.)} of the result, fixing R-forge bug #6018. } } } \section{Changes in version 1.2-1 (2015-05-30, svn r3127)}{ \subsection{New Features}{ \itemize{ \item \code{"Matrix"} now has an \code{initialization()} method coercing 0-length dimnames components to \code{NULL} and other non-\code{NULL} dimnames to \code{character}. Before, e.g., numeric dimnames components partially worked, even though it has always been documented that non-\code{NULL} dimnames should be \code{character}. \item For \code{symmetricMatrix} objects which have symmetrical dimnames by definition, it is allowed to only set one half of the \code{dimnames} to save storage, e.g., \code{list(NULL, nms)} is \emph{semantically} equivalent to \code{list(nms, nms)}. \item \code{as.vector()} etc, now work, too. \item \code{lu(\emph{})} now keeps \code{dimnames}. \item better \file{NEWS.Rd} (which pleases Kurt and \command{tidy} ;-) } } \subsection{Bug Fixes}{ \itemize{ \item \code{S[] <- T} and \code{S[] <- spV} now work (in more cases) for sparse matrices S, T and sparseVector \code{spV}. \item Huge dense matrix multiplication did lead to segfaults, see R-help, \dQuote{does segfault mean (always) a bug?}, May 5, 2015. Fixed by using C's Alloca() only in smallish cases. \item Optional arguments in \code{image()}, e.g., \code{main= <..>)} now also work for \code{lgCMatrix}, \code{nMatrix} etc; thanks to a 4.5 years old report by Mstislav Elagin. \item \code{dimnames(A) <- val} now resets the \code{factors} slot to empty, as the factorizations now keep dimnames more often. \item \code{crossprod(, Diagonal())} works again (and these are tested more systematically). \item Matrix products (\code{\%*\%}, \code{crossprod}, and \code{tcrossprod}) for \code{"dtrMatrix"} are correct in all cases, including keeping dimnames. \item \code{Matrix(d)} (and other coercions to \code{"Matrix"}) now correctly keeps \code{dimnames} also when \code{d} is a traditional \emph{diagonal} \code{"matrix"}. } } } \section{Changes in version 1.2-0 (2015-04-03, svn r3096)}{ \subsection{New Features}{ \itemize{ \item New \code{\%&\%} for \dQuote{boolean arithmetic} matrix product. \item New argument \code{boolArith = NA} in \code{crossprod()} and \code{tcrossprod()}. \code{boolArith = TRUE} now forces boolean arithmetic, where \code{boolArith = FALSE} forces numeric one. Several of these products are more efficient thanks to new C functionality based on our new \code{chm_transpose_dense()}, and others based on \code{geMatrix_crossprod}, \code{geMatrix_matrix_mm}, etc. \item Most dense matrix products, also for non-\code{dgeMatrix}, including \code{"l..Matrix"} and \code{"n..Matrix"} ones are now directly handled by new \code{.Call()}s. \item \code{"dMatrix"} (numeric) and \code{"lMatrix"} (logical) matrices can now be coerced to \code{"nMatrix"} (non-zero pattern or \dQuote{boolean}) even when they contain \code{NA}s, which then become \code{TRUE}s. \item More thorough checking of \code{cbind2()} and \code{rbind2()} methods, notably as they are called from \code{cbind()} and \code{rbind()} from \R version 3.2.0 on. \code{rbind2(, )} is faster, being based on new C code. \item symmetric Matrices (i.e., inheriting from \code{"symmetricMatrix"}) are allowed to have \code{dimnames} of the form \code{list(NULL, )} \emph{and} now print correctly and get correctly coerced to general matrices. \item \code{indMatrix} object (\dQuote{index matrices}) no longer need to be \dQuote{skinny}. \item \code{rsparseMatrix()} now accepts \code{rand.x = NULL} and then creates a random \emph{patter\bold{n}} matrix (\code{"nsparseMatrix"}). \item \code{anyDuplicatedT()} and \code{uniqTsparse()} low level utilities are exported now. \item Partial Korean translations of messages. } } \subsection{Deprecation}{ \itemize{ \item For \eqn{R \ge 3.2.0}, \code{cBind()} and \code{rBind()} are deprecated, as they are no longer needed since \code{cbind()} and \code{rbind()} do work automatically. } } \subsection{Bug Fixes}{ \itemize{ \item Fix some \code{rbind2()} methods. \item \code{t()} now transposes the dimnames even for symmetric matrices. \item \code{diag(M) <- val} did not always recycle \code{val} to full length, e.g., when \code{M} was a \code{"dtrMatrix"}. \item \code{crossprod()} was wrong in cases where the matrix had all-zero columns. \item Matrix products (\code{\%*\%}, \code{crossprod}, and \code{tcrossprod}) with one sparse and one dense argument now return \emph{numeric} (a \code{"dMatrix"}) when they should, i.e., unless the new setting \code{boolArith = TRUE} is applied. } } } \section{Changes in version 1.1-5 (2015-01-18, svn r3037)}{ \subsection{New Features}{ \itemize{ \item More use of \code{anyNA()} (for speedup). \item Matrix products (\code{\%*\%}, \code{crossprod}, \code{tcrossprod}) now behave compatibly to \R 3.2.0, i.e., more lenient in matching dimensions for matrix - vector products. \item \code{isTriangular()} gets new optional argument \code{upper = NA}. } } \subsection{Bug Fixes}{ \itemize{ \item \code{crossprod()} and \code{tcrossprod()} fixes for several o combinations. \item \code{rowMeans(, na.rm=TRUE)} was wrong sometimes. \item fix and speedup of coercions (\code{as(., .)}) from and to symmetric or triangular matrices. \item \code{invPerm()} coercion to integer \item \code{dimnames( solve(.,.) )} fix [r3036] \item \code{tril()} and \code{triu()} now return correct \code{uplo}. \item \code{names(dimnames(.))} now preserved, e.g. in \code{symmpart()} or subsetting (\code{A[i,j]}). } } } \section{Changes in version 1.1-4 (2014-06-14, svn r2994)}{ \subsection{New Features}{ \itemize{ \item new \code{rsparsematrix()} for random sparse Matrices. \item improved warnings, notably for unused arguments previously swallowed into \code{...}. } } \subsection{Bug Fixes}{ \itemize{ \item \code{crossprod(, )} fixed. \item \code{crossprod()} and \code{kronecker()} fixes for some cases. } } } \section{Changes in version 1.1-3 (2014-03-30, svn r2982)}{ \subsection{New Features}{ \itemize{ \item \code{\%*\%} and \code{crossprod()} now also work with \code{sparseVector}s. \item speedup of \code{crossprod(v, )}, thanks to nudge by Niels Richard Hansen. \item new help page for all such matrix products (\file{../man/matrix-products.Rd}). } } \subsection{Bug Fixes}{ \itemize{ \item \code{image()} now gets correct \code{ylim} again. \item More consistent matrix products. } } } \section{Changes in version 1.1-2-2 (2014-03-04, svn r2966)}{ \subsection{Bug Fixes}{ \itemize{ \item correct adaption to \R 3.1.0 \item using \code{tolerance} (and not \sQuote{tol}) in \code{all.equal()} } } } \section{Changes in version 1.1-2 (2014-01-28, svn r2962)}{ \subsection{New Features}{ \itemize{ \item export fast power-user coercion utilities \code{.dsy2mat()}, \code{.dxC2mat()}, \code{.T2Cmat()}, \code{..2dge()}. } } \subsection{Bug Fixes}{ \itemize{ \item matrix products now (mostly) work with \code{sparseVector}s; and correctly in some more cases. } } } \section{Changes in version 1.1-1.1 (2013-12-30, svn r2957)}{ \itemize{ \item Testing code's \code{assertWarning()} adapted for \eqn{R \le 3.0.1}. \item \code{Depends: R >= 2.15.2} eases checking. } } \section{Changes in version 1.1-1 (2013-12-28)}{ \subsection{New Features}{ \itemize{ \item \code{image(.., xlim, ylim)}: nicer defaults %% ../R/dgTMatrix.R for the axis limits, and \code{ylim} is sorted decreasingly; not strictly back-compatible but should never harm. \item \code{rankMatrix(*, method="qr")} now using \code{tol} \item \code{T2graph()} and \code{graph2T()} export old functionality explicitly. Tweaks in conversions between \code{"graph"} and \code{"sparseMatrix"} objects. Notably, \code{as(, )} now more often returns a (0/1 pattern) "n..Matrix". \item \code{sparseMatrix()}: new \code{use.last.ij} argument. } } \subsection{Bug Fixes}{ \itemize{ \item \code{KhatriRao()}: fix rownames (X <-> Y) \item \code{qr.coef()}, \code{qr.fitted}, and \code{qr.resid} now also work with \emph{sparse} RHS \code{y}. \item sparse matrix \dQuote{sub assignments}, e.g., \code{M[ii] <- v}, speedup and fixes. \item bug fixes also in \code{M[negative indices] <- value} and \code{[cbind(i,j)]}. } } } \section{Changes in version 1.1-0 (2013-10-21, svn r2930)}{ \subsection{New Features}{ \itemize{ \item \code{fac2sparse} and \code{fac2Sparse} now exported, with a new \code{giveCsparse} option. \item Update to latest \command{SuiteSparse} C library by Tim Davis, U. Florida. \item ensuing \dQuote{C API changes} \item new \code{.SuiteSparse_version()} function \item Many \sQuote{Imports:} instead of \sQuote{Depends:}. } } \subsection{Bug Fixes}{ \itemize{ \item fixed long lasting undetected \code{solve(, *)} bug. \item Our \code{all.equal()} methods no longer sometimes return \code{c("TRUE", "....difference..")}. \item \code{rankMatrix()}: fix the internal \code{x.dense} definition. } } } \section{Changes in version 1.0-14 (2013-09-12, svn r2907)}{ \subsection{Bug Fixes}{ \itemize{ \item Revert some wrong changes to \code{solve(, *)} from 1.0-13 (\dQuote{stop gap fix} for \R 3.0.2). } } } \section{Changes in version 1.0-13 (2013-09-10, svn r2904)}{ \subsection{New Features}{ \itemize{ \item New (efficient) \code{KhatriRao()} function by Michael Cysouw \item New \code{"indMatrix"} class of \dQuote{index matrices}, a generalization of \code{"pMatrix"}, the permutation matrices, many methods generalized from pMatrix to indMatrix. All (initial) functionality contributed by Fabian Scheibl, Univ.\sspace{} Munich. \item Export and document \code{isDiagonal()} and \code{isTriangular()} as they are useful outside of \pkg{Matrix}. \item \code{rankMatrix(M, method="qr")} no longer needs \code{sval} which makes it considerably more useful for large sparse \code{M}. \item Start providing \code{anyNA} methods for \eqn{R >= 3.1.0}. \item \code{solve( a, b)}: if \code{a} is symmetric, now compute \emph{sparse} result. \item \code{nearPD()} gets new option \code{conv.norm.type = "I"}. \item \code{determinant()} now uses \code{chol()}, and hence also an existing (\sQuote{cached}) Cholesky factor. \item 3 new \code{C -> R} utilities (including hidden \R function \code{.set.factors()} for caching also from \R, not just in C). } } \subsection{Bug Fixes}{ \itemize{ \item \code{M[] <- v} for unitriangular \code{M} now correct. \item \code{lu(.)} no longer sometimes returns unsorted columns. } } } \section{Changes in version 1.0-12 (2013-03-26, svn r2872)}{ \subsection{New Features}{ \itemize{ \item . } } \subsection{Bug Fixes}{ \itemize{ \item . } } } \section{Changes in version 1.0-11 (2013-02-02)}{ \subsection{New Features}{ \itemize{ \item . } } \subsection{Bug Fixes}{ \itemize{ \item \code{as(, "dgCMatrix")} (from package \CRANpkg{SparseM}) now works again. \item . } } } \section{Changes in version 1.0-10 (2012-10-22)}{ \subsection{New Features}{ \itemize{ \item \code{.sparseDiagonal()}: new \code{unitri} argument, and more flexibility; \item new \code{solve(, )} via efficient C code. } } \subsection{Bug Fixes}{ \itemize{ \item . } } } \section{Changes in version 1.0-9 (2012-09-05)}{ \subsection{New Features}{ \itemize{ \item new \code{sparseVector()} constructor function. \item \code{is.finite()} \code{is.infinite()} now work for our matrices and "*sparseVector" objects. \item \code{diag(.) <- V} now preserves symmetricity, triangularity and even uni-triangularity sometimes. } } \subsection{Bug Fixes}{ \itemize{ \item Quite a few fixes for \code{Ops} (arithmetic, logic, etc) group methods. \item Ditto for \code{diagonalMatrix} methods. } } } \section{Changes in version 1.0-6 (2012-03-16, publ. 2012-06-18)}{ \subsection{New Features}{ \itemize{ \item . } } \subsection{Bug Fixes}{ \itemize{ \item . } } } \section{Changes in version 1.0-5 (2012-03-15)}{ \subsection{New Features}{ \itemize{ \item . } } \subsection{Bug Fixes}{ \itemize{ \item . } } } \section{Changes in version 1.0-4 (2012-02-21)}{ \subsection{New Features}{ \itemize{ \item . } } \subsection{Bug Fixes}{ \itemize{ \item . } } } \section{Changes in version 1.0-3 (2012-01-13)}{ \subsection{New Features}{ \itemize{ \item . } } \subsection{Bug Fixes}{ \itemize{ \item . } } } \section{Changes in version 1.0-2 (2011-11-19)}{ \subsection{New Features}{ \itemize{ \item . } } \subsection{Bug Fixes}{ \itemize{ \item . } } } \section{Changes in version 1.0-1 (2011-10-18)}{ \subsection{New Features}{ \itemize{ \item . } } \subsection{Bug Fixes}{ \itemize{ \item . } } } \section{Changes in version 1.0-0 (2011-10-04)}{ \subsection{New Features}{ \itemize{ \item . } } \subsection{Bug Fixes}{ \itemize{ \item . } } } \section{Changes in version 0.9996875-3 (2011-08-13)}{ \subsection{New Features}{ \itemize{ \item . } } \subsection{Bug Fixes}{ \itemize{ \item . } } } \section{Changes in version 0.9996875-2 (2011-08-09)}{ \subsection{New Features}{ \itemize{ \item . } } \subsection{Bug Fixes}{ \itemize{ \item . } } } \section{Changes in version 0.9996875-1 (2011-08-08)}{ \subsection{New Features}{ \itemize{ \item . } } \subsection{Bug Fixes}{ \itemize{ \item . } } } \section{Changes in version 0.999375-50 (2011-04-08)}{ \subsection{New Features}{ \itemize{ \item . } } \subsection{Bug Fixes}{ \itemize{ \item . } } } % How can I add vertical space ? % \preformatted{} is not allowed, nor is \cr %--------------- start of DB+MM history: ------------------------ \section{Changes in version 0.95-1 (2005-02-18, svn r561)}{ \subsection{Authorship}{ \itemize{ \item During Doug Bates' sabbatical in Zurich, Martin Maechler becomes co-author of the \pkg{Matrix} package. } } \subsection{New Features}{ \itemize{ \item Beginning of class reorganization with a more systematic naming scheme. } } \subsection{Bug Fixes}{ \itemize{ \item More (correct) coercions \code{as(, )}. } } } \section{Changes in version 0.9-1 (2005-01-24, svn r451)}{ \subsection{New Features}{ \itemize{ \item lme4 / lmer specific R code moved out to \CRANpkg{lme4} package. } } \subsection{Bug Fixes}{ \itemize{ \item . } } } % How can I add vertical space ? ( \preformatted{} is not allowed, nor is \cr ) %--------------- pre-pre-history: ------------------------ \section{Changes in version 0.8-2 (2004-04-06, svn r51)}{ \subsection{Authorship}{ \itemize{ \item Doug Bates (only) } } \subsection{New Features}{ \itemize{ \item Sparse matrices, classes and methods, partly via \item Interface to LDL, TAUCS, Metis and UMFPACK C libraries } } } % How can I add vertical space ? ................................. \section{Version 0.2-4}{ \subsection{..., 0.3-1, 0.3-n (n=3,5,...,26): 22 more CRAN releases}{ \itemize{ \item ............................................. } }} % How can I add vertical space ? % \preformatted{} is not allowed, nor is \cr \section{Version 0.2-1 (2000-07-15)}{ The first CRAN release of the \pkg{Matrix} package, titled \dQuote{A Matrix library for R} authored by Douglas Bates (maintainer, principal author) and Saikat DebRoy. \subsection{Features}{ \itemize{ \item \code{Matrix()} constructor for \R objects of class \code{Matrix}. \item \code{Matrix.class()} returning informal subclasses such as \code{"Hermitian"}, \code{"LowerTriangular"} \item \code{is.Orthonormal()}, \code{is.Hermitian()} , \code{is.UpperTriangular()} functions. \item \code{SVD()}, \code{lu()}, and \code{schur()} decomposition generics with \code{"Matrix"} methods. \item \code{rcond()}, \code{norm()}, \code{det()}; \code{expand()} and \code{facmul()}. \item C++ interface to LAPACK } } } Matrix/inst/Doxyfile0000644000176200001440000033744014076277635014235 0ustar liggesusers# Doxyfile 1.9.1 # This file describes the settings to be used by the documentation system # doxygen (www.doxygen.org) for a project. # # All text after a double hash (##) is considered a comment and is placed in # front of the TAG it is preceding. # # All text after a single hash (#) is considered a comment and will be ignored. # The format is: # TAG = value [value, ...] # For lists, items can also be appended using: # TAG += value [value, ...] # Values that contain spaces should be placed between quotes (\" \"). #--------------------------------------------------------------------------- # Project related configuration options #--------------------------------------------------------------------------- # This tag specifies the encoding used for all characters in the configuration # file that follow. The default is UTF-8 which is also the encoding used for all # text before the first occurrence of this tag. Doxygen uses libiconv (or the # iconv built into libc) for the transcoding. See # https://www.gnu.org/software/libiconv/ for the list of possible encodings. # The default value is: UTF-8. DOXYFILE_ENCODING = UTF-8 # The PROJECT_NAME tag is a single word (or a sequence of words surrounded by # double-quotes, unless you are using Doxywizard) that should identify the # project for which the documentation is generated. This name is used in the # title of most generated pages and in a few other places. # The default value is: My Project. PROJECT_NAME = Matrix # The PROJECT_NUMBER tag can be used to enter a project or revision number. This # could be handy for archiving the generated documentation or if some version # control system is used. PROJECT_NUMBER = "$Rev: 3397 $ at $LastChangedDate: 2021-07-22 16:24:29 +0200 (Thu, 22 Jul 2021) $" # Using the PROJECT_BRIEF tag one can provide an optional one line description # for a project that appears at the top of each page and should give viewer a # quick idea about the purpose of the project. Keep the description short. PROJECT_BRIEF = # With the PROJECT_LOGO tag one can specify a logo or an icon that is included # in the documentation. The maximum height of the logo should not exceed 55 # pixels and the maximum width should not exceed 200 pixels. Doxygen will copy # the logo to the output directory. PROJECT_LOGO = # The OUTPUT_DIRECTORY tag is used to specify the (relative or absolute) path # into which the generated documentation will be written. If a relative path is # entered, it will be relative to the location where doxygen was started. If # left blank the current directory will be used. OUTPUT_DIRECTORY = ../../../www/doxygen # If the CREATE_SUBDIRS tag is set to YES then doxygen will create 4096 sub- # directories (in 2 levels) under the output directory of each output format and # will distribute the generated files over these directories. Enabling this # option can be useful when feeding doxygen a huge amount of source files, where # putting all generated files in the same directory would otherwise causes # performance problems for the file system. # The default value is: NO. CREATE_SUBDIRS = NO # If the ALLOW_UNICODE_NAMES tag is set to YES, doxygen will allow non-ASCII # characters to appear in the names of generated files. If set to NO, non-ASCII # characters will be escaped, for example _xE3_x81_x84 will be used for Unicode # U+3044. # The default value is: NO. ALLOW_UNICODE_NAMES = NO # The OUTPUT_LANGUAGE tag is used to specify the language in which all # documentation generated by doxygen is written. Doxygen will use this # information to generate all constant output in the proper language. # Possible values are: Afrikaans, Arabic, Armenian, Brazilian, Catalan, Chinese, # Chinese-Traditional, Croatian, Czech, Danish, Dutch, English (United States), # Esperanto, Farsi (Persian), Finnish, French, German, Greek, Hungarian, # Indonesian, Italian, Japanese, Japanese-en (Japanese with English messages), # Korean, Korean-en (Korean with English messages), Latvian, Lithuanian, # Macedonian, Norwegian, Persian (Farsi), Polish, Portuguese, Romanian, Russian, # Serbian, Serbian-Cyrillic, Slovak, Slovene, Spanish, Swedish, Turkish, # Ukrainian and Vietnamese. # The default value is: English. OUTPUT_LANGUAGE = English # The OUTPUT_TEXT_DIRECTION tag is used to specify the direction in which all # documentation generated by doxygen is written. Doxygen will use this # information to generate all generated output in the proper direction. # Possible values are: None, LTR, RTL and Context. # The default value is: None. OUTPUT_TEXT_DIRECTION = None # If the BRIEF_MEMBER_DESC tag is set to YES, doxygen will include brief member # descriptions after the members that are listed in the file and class # documentation (similar to Javadoc). Set to NO to disable this. # The default value is: YES. BRIEF_MEMBER_DESC = YES # If the REPEAT_BRIEF tag is set to YES, doxygen will prepend the brief # description of a member or function before the detailed description # # Note: If both HIDE_UNDOC_MEMBERS and BRIEF_MEMBER_DESC are set to NO, the # brief descriptions will be completely suppressed. # The default value is: YES. REPEAT_BRIEF = YES # This tag implements a quasi-intelligent brief description abbreviator that is # used to form the text in various listings. Each string in this list, if found # as the leading text of the brief description, will be stripped from the text # and the result, after processing the whole list, is used as the annotated # text. Otherwise, the brief description is used as-is. If left blank, the # following values are used ($name is automatically replaced with the name of # the entity):The $name class, The $name widget, The $name file, is, provides, # specifies, contains, represents, a, an and the. ABBREVIATE_BRIEF = # If the ALWAYS_DETAILED_SEC and REPEAT_BRIEF tags are both set to YES then # doxygen will generate a detailed section even if there is only a brief # description. # The default value is: NO. ALWAYS_DETAILED_SEC = YES # If the INLINE_INHERITED_MEMB tag is set to YES, doxygen will show all # inherited members of a class in the documentation of that class as if those # members were ordinary class members. Constructors, destructors and assignment # operators of the base classes will not be shown. # The default value is: NO. INLINE_INHERITED_MEMB = NO # If the FULL_PATH_NAMES tag is set to YES, doxygen will prepend the full path # before files name in the file list and in the header files. If set to NO the # shortest path that makes the file name unique will be used # The default value is: YES. FULL_PATH_NAMES = NO # The STRIP_FROM_PATH tag can be used to strip a user-defined part of the path. # Stripping is only done if one of the specified strings matches the left-hand # part of the path. The tag can be used to show relative paths in the file list. # If left blank the directory from which doxygen is run is used as the path to # strip. # # Note that you can specify absolute paths here, but also relative paths, which # will be relative from the directory where doxygen is started. # This tag requires that the tag FULL_PATH_NAMES is set to YES. STRIP_FROM_PATH = # The STRIP_FROM_INC_PATH tag can be used to strip a user-defined part of the # path mentioned in the documentation of a class, which tells the reader which # header file to include in order to use a class. If left blank only the name of # the header file containing the class definition is used. Otherwise one should # specify the list of include paths that are normally passed to the compiler # using the -I flag. STRIP_FROM_INC_PATH = # If the SHORT_NAMES tag is set to YES, doxygen will generate much shorter (but # less readable) file names. This can be useful is your file systems doesn't # support long names like on DOS, Mac, or CD-ROM. # The default value is: NO. SHORT_NAMES = NO # If the JAVADOC_AUTOBRIEF tag is set to YES then doxygen will interpret the # first line (until the first dot) of a Javadoc-style comment as the brief # description. If set to NO, the Javadoc-style will behave just like regular Qt- # style comments (thus requiring an explicit @brief command for a brief # description.) # The default value is: NO. JAVADOC_AUTOBRIEF = YES # If the JAVADOC_BANNER tag is set to YES then doxygen will interpret a line # such as # /*************** # as being the beginning of a Javadoc-style comment "banner". If set to NO, the # Javadoc-style will behave just like regular comments and it will not be # interpreted by doxygen. # The default value is: NO. JAVADOC_BANNER = NO # If the QT_AUTOBRIEF tag is set to YES then doxygen will interpret the first # line (until the first dot) of a Qt-style comment as the brief description. If # set to NO, the Qt-style will behave just like regular Qt-style comments (thus # requiring an explicit \brief command for a brief description.) # The default value is: NO. QT_AUTOBRIEF = NO # The MULTILINE_CPP_IS_BRIEF tag can be set to YES to make doxygen treat a # multi-line C++ special comment block (i.e. a block of //! or /// comments) as # a brief description. This used to be the default behavior. The new default is # to treat a multi-line C++ comment block as a detailed description. Set this # tag to YES if you prefer the old behavior instead. # # Note that setting this tag to YES also means that rational rose comments are # not recognized any more. # The default value is: NO. MULTILINE_CPP_IS_BRIEF = NO # By default Python docstrings are displayed as preformatted text and doxygen's # special commands cannot be used. By setting PYTHON_DOCSTRING to NO the # doxygen's special commands can be used and the contents of the docstring # documentation blocks is shown as doxygen documentation. # The default value is: YES. PYTHON_DOCSTRING = YES # If the INHERIT_DOCS tag is set to YES then an undocumented member inherits the # documentation from any documented member that it re-implements. # The default value is: YES. INHERIT_DOCS = YES # If the SEPARATE_MEMBER_PAGES tag is set to YES then doxygen will produce a new # page for each member. If set to NO, the documentation of a member will be part # of the file/class/namespace that contains it. # The default value is: NO. SEPARATE_MEMBER_PAGES = NO # The TAB_SIZE tag can be used to set the number of spaces in a tab. Doxygen # uses this value to replace tabs by spaces in code fragments. # Minimum value: 1, maximum value: 16, default value: 4. TAB_SIZE = 8 # This tag can be used to specify a number of aliases that act as commands in # the documentation. An alias has the form: # name=value # For example adding # "sideeffect=@par Side Effects:\n" # will allow you to put the command \sideeffect (or @sideeffect) in the # documentation, which will result in a user-defined paragraph with heading # "Side Effects:". You can put \n's in the value part of an alias to insert # newlines (in the resulting output). You can put ^^ in the value part of an # alias to insert a newline as if a physical newline was in the original file. # When you need a literal { or } or , in the value part of an alias you have to # escape them by means of a backslash (\), this can lead to conflicts with the # commands \{ and \} for these it is advised to use the version @{ and @} or use # a double escape (\\{ and \\}) ALIASES = # Set the OPTIMIZE_OUTPUT_FOR_C tag to YES if your project consists of C sources # only. Doxygen will then generate output that is more tailored for C. For # instance, some of the names that are used will be different. The list of all # members will be omitted, etc. # The default value is: NO. OPTIMIZE_OUTPUT_FOR_C = YES # Set the OPTIMIZE_OUTPUT_JAVA tag to YES if your project consists of Java or # Python sources only. Doxygen will then generate output that is more tailored # for that language. For instance, namespaces will be presented as packages, # qualified scopes will look different, etc. # The default value is: NO. OPTIMIZE_OUTPUT_JAVA = NO # Set the OPTIMIZE_FOR_FORTRAN tag to YES if your project consists of Fortran # sources. Doxygen will then generate output that is tailored for Fortran. # The default value is: NO. OPTIMIZE_FOR_FORTRAN = NO # Set the OPTIMIZE_OUTPUT_VHDL tag to YES if your project consists of VHDL # sources. Doxygen will then generate output that is tailored for VHDL. # The default value is: NO. OPTIMIZE_OUTPUT_VHDL = NO # Set the OPTIMIZE_OUTPUT_SLICE tag to YES if your project consists of Slice # sources only. Doxygen will then generate output that is more tailored for that # language. For instance, namespaces will be presented as modules, types will be # separated into more groups, etc. # The default value is: NO. OPTIMIZE_OUTPUT_SLICE = NO # Doxygen selects the parser to use depending on the extension of the files it # parses. With this tag you can assign which parser to use for a given # extension. Doxygen has a built-in mapping, but you can override or extend it # using this tag. The format is ext=language, where ext is a file extension, and # language is one of the parsers supported by doxygen: IDL, Java, JavaScript, # Csharp (C#), C, C++, D, PHP, md (Markdown), Objective-C, Python, Slice, VHDL, # Fortran (fixed format Fortran: FortranFixed, free formatted Fortran: # FortranFree, unknown formatted Fortran: Fortran. In the later case the parser # tries to guess whether the code is fixed or free formatted code, this is the # default for Fortran type files). For instance to make doxygen treat .inc files # as Fortran files (default is PHP), and .f files as C (default is Fortran), # use: inc=Fortran f=C. # # Note: For files without extension you can use no_extension as a placeholder. # # Note that for custom extensions you also need to set FILE_PATTERNS otherwise # the files are not read by doxygen. When specifying no_extension you should add # * to the FILE_PATTERNS. # # Note see also the list of default file extension mappings. EXTENSION_MAPPING = # If the MARKDOWN_SUPPORT tag is enabled then doxygen pre-processes all comments # according to the Markdown format, which allows for more readable # documentation. See https://daringfireball.net/projects/markdown/ for details. # The output of markdown processing is further processed by doxygen, so you can # mix doxygen, HTML, and XML commands with Markdown formatting. Disable only in # case of backward compatibilities issues. # The default value is: YES. MARKDOWN_SUPPORT = YES # When the TOC_INCLUDE_HEADINGS tag is set to a non-zero value, all headings up # to that level are automatically included in the table of contents, even if # they do not have an id attribute. # Note: This feature currently applies only to Markdown headings. # Minimum value: 0, maximum value: 99, default value: 5. # This tag requires that the tag MARKDOWN_SUPPORT is set to YES. TOC_INCLUDE_HEADINGS = 5 # When enabled doxygen tries to link words that correspond to documented # classes, or namespaces to their corresponding documentation. Such a link can # be prevented in individual cases by putting a % sign in front of the word or # globally by setting AUTOLINK_SUPPORT to NO. # The default value is: YES. AUTOLINK_SUPPORT = YES # If you use STL classes (i.e. std::string, std::vector, etc.) but do not want # to include (a tag file for) the STL sources as input, then you should set this # tag to YES in order to let doxygen match functions declarations and # definitions whose arguments contain STL classes (e.g. func(std::string); # versus func(std::string) {}). This also make the inheritance and collaboration # diagrams that involve STL classes more complete and accurate. # The default value is: NO. BUILTIN_STL_SUPPORT = NO # If you use Microsoft's C++/CLI language, you should set this option to YES to # enable parsing support. # The default value is: NO. CPP_CLI_SUPPORT = NO # Set the SIP_SUPPORT tag to YES if your project consists of sip (see: # https://www.riverbankcomputing.com/software/sip/intro) sources only. Doxygen # will parse them like normal C++ but will assume all classes use public instead # of private inheritance when no explicit protection keyword is present. # The default value is: NO. SIP_SUPPORT = NO # For Microsoft's IDL there are propget and propput attributes to indicate # getter and setter methods for a property. Setting this option to YES will make # doxygen to replace the get and set methods by a property in the documentation. # This will only work if the methods are indeed getting or setting a simple # type. If this is not the case, or you want to show the methods anyway, you # should set this option to NO. # The default value is: YES. IDL_PROPERTY_SUPPORT = YES # If member grouping is used in the documentation and the DISTRIBUTE_GROUP_DOC # tag is set to YES then doxygen will reuse the documentation of the first # member in the group (if any) for the other members of the group. By default # all members of a group must be documented explicitly. # The default value is: NO. DISTRIBUTE_GROUP_DOC = NO # If one adds a struct or class to a group and this option is enabled, then also # any nested class or struct is added to the same group. By default this option # is disabled and one has to add nested compounds explicitly via \ingroup. # The default value is: NO. GROUP_NESTED_COMPOUNDS = NO # Set the SUBGROUPING tag to YES to allow class member groups of the same type # (for instance a group of public functions) to be put as a subgroup of that # type (e.g. under the Public Functions section). Set it to NO to prevent # subgrouping. Alternatively, this can be done per class using the # \nosubgrouping command. # The default value is: YES. SUBGROUPING = YES # When the INLINE_GROUPED_CLASSES tag is set to YES, classes, structs and unions # are shown inside the group in which they are included (e.g. using \ingroup) # instead of on a separate page (for HTML and Man pages) or section (for LaTeX # and RTF). # # Note that this feature does not work in combination with # SEPARATE_MEMBER_PAGES. # The default value is: NO. INLINE_GROUPED_CLASSES = NO # When the INLINE_SIMPLE_STRUCTS tag is set to YES, structs, classes, and unions # with only public data fields or simple typedef fields will be shown inline in # the documentation of the scope in which they are defined (i.e. file, # namespace, or group documentation), provided this scope is documented. If set # to NO, structs, classes, and unions are shown on a separate page (for HTML and # Man pages) or section (for LaTeX and RTF). # The default value is: NO. INLINE_SIMPLE_STRUCTS = NO # When TYPEDEF_HIDES_STRUCT tag is enabled, a typedef of a struct, union, or # enum is documented as struct, union, or enum with the name of the typedef. So # typedef struct TypeS {} TypeT, will appear in the documentation as a struct # with name TypeT. When disabled the typedef will appear as a member of a file, # namespace, or class. And the struct will be named TypeS. This can typically be # useful for C code in case the coding convention dictates that all compound # types are typedef'ed and only the typedef is referenced, never the tag name. # The default value is: NO. TYPEDEF_HIDES_STRUCT = NO # The size of the symbol lookup cache can be set using LOOKUP_CACHE_SIZE. This # cache is used to resolve symbols given their name and scope. Since this can be # an expensive process and often the same symbol appears multiple times in the # code, doxygen keeps a cache of pre-resolved symbols. If the cache is too small # doxygen will become slower. If the cache is too large, memory is wasted. The # cache size is given by this formula: 2^(16+LOOKUP_CACHE_SIZE). The valid range # is 0..9, the default is 0, corresponding to a cache size of 2^16=65536 # symbols. At the end of a run doxygen will report the cache usage and suggest # the optimal cache size from a speed point of view. # Minimum value: 0, maximum value: 9, default value: 0. LOOKUP_CACHE_SIZE = 0 # The NUM_PROC_THREADS specifies the number threads doxygen is allowed to use # during processing. When set to 0 doxygen will based this on the number of # cores available in the system. You can set it explicitly to a value larger # than 0 to get more control over the balance between CPU load and processing # speed. At this moment only the input processing can be done using multiple # threads. Since this is still an experimental feature the default is set to 1, # which efficively disables parallel processing. Please report any issues you # encounter. Generating dot graphs in parallel is controlled by the # DOT_NUM_THREADS setting. # Minimum value: 0, maximum value: 32, default value: 1. NUM_PROC_THREADS = 1 #--------------------------------------------------------------------------- # Build related configuration options #--------------------------------------------------------------------------- # If the EXTRACT_ALL tag is set to YES, doxygen will assume all entities in # documentation are documented, even if no documentation was available. Private # class members and static file members will be hidden unless the # EXTRACT_PRIVATE respectively EXTRACT_STATIC tags are set to YES. # Note: This will also disable the warnings about undocumented members that are # normally produced when WARNINGS is set to YES. # The default value is: NO. EXTRACT_ALL = YES # If the EXTRACT_PRIVATE tag is set to YES, all private members of a class will # be included in the documentation. # The default value is: NO. EXTRACT_PRIVATE = NO # If the EXTRACT_PRIV_VIRTUAL tag is set to YES, documented private virtual # methods of a class will be included in the documentation. # The default value is: NO. EXTRACT_PRIV_VIRTUAL = NO # If the EXTRACT_PACKAGE tag is set to YES, all members with package or internal # scope will be included in the documentation. # The default value is: NO. EXTRACT_PACKAGE = NO # If the EXTRACT_STATIC tag is set to YES, all static members of a file will be # included in the documentation. # The default value is: NO. EXTRACT_STATIC = YES # If the EXTRACT_LOCAL_CLASSES tag is set to YES, classes (and structs) defined # locally in source files will be included in the documentation. If set to NO, # only classes defined in header files are included. Does not have any effect # for Java sources. # The default value is: YES. EXTRACT_LOCAL_CLASSES = YES # This flag is only useful for Objective-C code. If set to YES, local methods, # which are defined in the implementation section but not in the interface are # included in the documentation. If set to NO, only methods in the interface are # included. # The default value is: NO. EXTRACT_LOCAL_METHODS = NO # If this flag is set to YES, the members of anonymous namespaces will be # extracted and appear in the documentation as a namespace called # 'anonymous_namespace{file}', where file will be replaced with the base name of # the file that contains the anonymous namespace. By default anonymous namespace # are hidden. # The default value is: NO. EXTRACT_ANON_NSPACES = NO # If this flag is set to YES, the name of an unnamed parameter in a declaration # will be determined by the corresponding definition. By default unnamed # parameters remain unnamed in the output. # The default value is: YES. RESOLVE_UNNAMED_PARAMS = YES # If the HIDE_UNDOC_MEMBERS tag is set to YES, doxygen will hide all # undocumented members inside documented classes or files. If set to NO these # members will be included in the various overviews, but no documentation # section is generated. This option has no effect if EXTRACT_ALL is enabled. # The default value is: NO. HIDE_UNDOC_MEMBERS = NO # If the HIDE_UNDOC_CLASSES tag is set to YES, doxygen will hide all # undocumented classes that are normally visible in the class hierarchy. If set # to NO, these classes will be included in the various overviews. This option # has no effect if EXTRACT_ALL is enabled. # The default value is: NO. HIDE_UNDOC_CLASSES = NO # If the HIDE_FRIEND_COMPOUNDS tag is set to YES, doxygen will hide all friend # declarations. If set to NO, these declarations will be included in the # documentation. # The default value is: NO. HIDE_FRIEND_COMPOUNDS = NO # If the HIDE_IN_BODY_DOCS tag is set to YES, doxygen will hide any # documentation blocks found inside the body of a function. If set to NO, these # blocks will be appended to the function's detailed documentation block. # The default value is: NO. HIDE_IN_BODY_DOCS = NO # The INTERNAL_DOCS tag determines if documentation that is typed after a # \internal command is included. If the tag is set to NO then the documentation # will be excluded. Set it to YES to include the internal documentation. # The default value is: NO. INTERNAL_DOCS = NO # With the correct setting of option CASE_SENSE_NAMES doxygen will better be # able to match the capabilities of the underlying filesystem. In case the # filesystem is case sensitive (i.e. it supports files in the same directory # whose names only differ in casing), the option must be set to YES to properly # deal with such files in case they appear in the input. For filesystems that # are not case sensitive the option should be be set to NO to properly deal with # output files written for symbols that only differ in casing, such as for two # classes, one named CLASS and the other named Class, and to also support # references to files without having to specify the exact matching casing. On # Windows (including Cygwin) and MacOS, users should typically set this option # to NO, whereas on Linux or other Unix flavors it should typically be set to # YES. # The default value is: system dependent. CASE_SENSE_NAMES = YES # If the HIDE_SCOPE_NAMES tag is set to NO then doxygen will show members with # their full class and namespace scopes in the documentation. If set to YES, the # scope will be hidden. # The default value is: NO. HIDE_SCOPE_NAMES = NO # If the HIDE_COMPOUND_REFERENCE tag is set to NO (default) then doxygen will # append additional text to a page's title, such as Class Reference. If set to # YES the compound reference will be hidden. # The default value is: NO. HIDE_COMPOUND_REFERENCE= NO # If the SHOW_INCLUDE_FILES tag is set to YES then doxygen will put a list of # the files that are included by a file in the documentation of that file. # The default value is: YES. SHOW_INCLUDE_FILES = YES # If the SHOW_GROUPED_MEMB_INC tag is set to YES then Doxygen will add for each # grouped member an include statement to the documentation, telling the reader # which file to include in order to use the member. # The default value is: NO. SHOW_GROUPED_MEMB_INC = NO # If the FORCE_LOCAL_INCLUDES tag is set to YES then doxygen will list include # files with double quotes in the documentation rather than with sharp brackets. # The default value is: NO. FORCE_LOCAL_INCLUDES = NO # If the INLINE_INFO tag is set to YES then a tag [inline] is inserted in the # documentation for inline members. # The default value is: YES. INLINE_INFO = YES # If the SORT_MEMBER_DOCS tag is set to YES then doxygen will sort the # (detailed) documentation of file and class members alphabetically by member # name. If set to NO, the members will appear in declaration order. # The default value is: YES. SORT_MEMBER_DOCS = YES # If the SORT_BRIEF_DOCS tag is set to YES then doxygen will sort the brief # descriptions of file, namespace and class members alphabetically by member # name. If set to NO, the members will appear in declaration order. Note that # this will also influence the order of the classes in the class list. # The default value is: NO. SORT_BRIEF_DOCS = YES # If the SORT_MEMBERS_CTORS_1ST tag is set to YES then doxygen will sort the # (brief and detailed) documentation of class members so that constructors and # destructors are listed first. If set to NO the constructors will appear in the # respective orders defined by SORT_BRIEF_DOCS and SORT_MEMBER_DOCS. # Note: If SORT_BRIEF_DOCS is set to NO this option is ignored for sorting brief # member documentation. # Note: If SORT_MEMBER_DOCS is set to NO this option is ignored for sorting # detailed member documentation. # The default value is: NO. SORT_MEMBERS_CTORS_1ST = NO # If the SORT_GROUP_NAMES tag is set to YES then doxygen will sort the hierarchy # of group names into alphabetical order. If set to NO the group names will # appear in their defined order. # The default value is: NO. SORT_GROUP_NAMES = NO # If the SORT_BY_SCOPE_NAME tag is set to YES, the class list will be sorted by # fully-qualified names, including namespaces. If set to NO, the class list will # be sorted only by class name, not including the namespace part. # Note: This option is not very useful if HIDE_SCOPE_NAMES is set to YES. # Note: This option applies only to the class list, not to the alphabetical # list. # The default value is: NO. SORT_BY_SCOPE_NAME = NO # If the STRICT_PROTO_MATCHING option is enabled and doxygen fails to do proper # type resolution of all parameters of a function it will reject a match between # the prototype and the implementation of a member function even if there is # only one candidate or it is obvious which candidate to choose by doing a # simple string match. By disabling STRICT_PROTO_MATCHING doxygen will still # accept a match between prototype and implementation in such cases. # The default value is: NO. STRICT_PROTO_MATCHING = NO # The GENERATE_TODOLIST tag can be used to enable (YES) or disable (NO) the todo # list. This list is created by putting \todo commands in the documentation. # The default value is: YES. GENERATE_TODOLIST = YES # The GENERATE_TESTLIST tag can be used to enable (YES) or disable (NO) the test # list. This list is created by putting \test commands in the documentation. # The default value is: YES. GENERATE_TESTLIST = YES # The GENERATE_BUGLIST tag can be used to enable (YES) or disable (NO) the bug # list. This list is created by putting \bug commands in the documentation. # The default value is: YES. GENERATE_BUGLIST = YES # The GENERATE_DEPRECATEDLIST tag can be used to enable (YES) or disable (NO) # the deprecated list. This list is created by putting \deprecated commands in # the documentation. # The default value is: YES. GENERATE_DEPRECATEDLIST= YES # The ENABLED_SECTIONS tag can be used to enable conditional documentation # sections, marked by \if ... \endif and \cond # ... \endcond blocks. ENABLED_SECTIONS = # The MAX_INITIALIZER_LINES tag determines the maximum number of lines that the # initial value of a variable or macro / define can have for it to appear in the # documentation. If the initializer consists of more lines than specified here # it will be hidden. Use a value of 0 to hide initializers completely. The # appearance of the value of individual variables and macros / defines can be # controlled using \showinitializer or \hideinitializer command in the # documentation regardless of this setting. # Minimum value: 0, maximum value: 10000, default value: 30. MAX_INITIALIZER_LINES = 30 # Set the SHOW_USED_FILES tag to NO to disable the list of files generated at # the bottom of the documentation of classes and structs. If set to YES, the # list will mention the files that were used to generate the documentation. # The default value is: YES. SHOW_USED_FILES = YES # Set the SHOW_FILES tag to NO to disable the generation of the Files page. This # will remove the Files entry from the Quick Index and from the Folder Tree View # (if specified). # The default value is: YES. SHOW_FILES = YES # Set the SHOW_NAMESPACES tag to NO to disable the generation of the Namespaces # page. This will remove the Namespaces entry from the Quick Index and from the # Folder Tree View (if specified). # The default value is: YES. SHOW_NAMESPACES = YES # The FILE_VERSION_FILTER tag can be used to specify a program or script that # doxygen should invoke to get the current version for each file (typically from # the version control system). Doxygen will invoke the program by executing (via # popen()) the command command input-file, where command is the value of the # FILE_VERSION_FILTER tag, and input-file is the name of an input file provided # by doxygen. Whatever the program writes to standard output is used as the file # version. For an example see the documentation. FILE_VERSION_FILTER = # The LAYOUT_FILE tag can be used to specify a layout file which will be parsed # by doxygen. The layout file controls the global structure of the generated # output files in an output format independent way. To create the layout file # that represents doxygen's defaults, run doxygen with the -l option. You can # optionally specify a file name after the option, if omitted DoxygenLayout.xml # will be used as the name of the layout file. # # Note that if you run doxygen from a directory containing a file called # DoxygenLayout.xml, doxygen will parse it automatically even if the LAYOUT_FILE # tag is left empty. LAYOUT_FILE = # The CITE_BIB_FILES tag can be used to specify one or more bib files containing # the reference definitions. This must be a list of .bib files. The .bib # extension is automatically appended if omitted. This requires the bibtex tool # to be installed. See also https://en.wikipedia.org/wiki/BibTeX for more info. # For LaTeX the style of the bibliography can be controlled using # LATEX_BIB_STYLE. To use this feature you need bibtex and perl available in the # search path. See also \cite for info how to create references. CITE_BIB_FILES = #--------------------------------------------------------------------------- # Configuration options related to warning and progress messages #--------------------------------------------------------------------------- # The QUIET tag can be used to turn on/off the messages that are generated to # standard output by doxygen. If QUIET is set to YES this implies that the # messages are off. # The default value is: NO. QUIET = NO # The WARNINGS tag can be used to turn on/off the warning messages that are # generated to standard error (stderr) by doxygen. If WARNINGS is set to YES # this implies that the warnings are on. # # Tip: Turn warnings on while writing the documentation. # The default value is: YES. WARNINGS = YES # If the WARN_IF_UNDOCUMENTED tag is set to YES then doxygen will generate # warnings for undocumented members. If EXTRACT_ALL is set to YES then this flag # will automatically be disabled. # The default value is: YES. WARN_IF_UNDOCUMENTED = YES # If the WARN_IF_DOC_ERROR tag is set to YES, doxygen will generate warnings for # potential errors in the documentation, such as not documenting some parameters # in a documented function, or documenting parameters that don't exist or using # markup commands wrongly. # The default value is: YES. WARN_IF_DOC_ERROR = YES # This WARN_NO_PARAMDOC option can be enabled to get warnings for functions that # are documented, but have no documentation for their parameters or return # value. If set to NO, doxygen will only warn about wrong or incomplete # parameter documentation, but not about the absence of documentation. If # EXTRACT_ALL is set to YES then this flag will automatically be disabled. # The default value is: NO. WARN_NO_PARAMDOC = NO # If the WARN_AS_ERROR tag is set to YES then doxygen will immediately stop when # a warning is encountered. If the WARN_AS_ERROR tag is set to FAIL_ON_WARNINGS # then doxygen will continue running as if WARN_AS_ERROR tag is set to NO, but # at the end of the doxygen process doxygen will return with a non-zero status. # Possible values are: NO, YES and FAIL_ON_WARNINGS. # The default value is: NO. WARN_AS_ERROR = NO # The WARN_FORMAT tag determines the format of the warning messages that doxygen # can produce. The string should contain the $file, $line, and $text tags, which # will be replaced by the file and line number from which the warning originated # and the warning text. Optionally the format may contain $version, which will # be replaced by the version of the file (if it could be obtained via # FILE_VERSION_FILTER) # The default value is: $file:$line: $text. WARN_FORMAT = "$file:$line: $text" # The WARN_LOGFILE tag can be used to specify a file to which warning and error # messages should be written. If left blank the output is written to standard # error (stderr). WARN_LOGFILE = #--------------------------------------------------------------------------- # Configuration options related to the input files #--------------------------------------------------------------------------- # The INPUT tag is used to specify the files and/or directories that contain # documented source files. You may enter file names like myfile.cpp or # directories like /usr/src/myproject. Separate the files or directories with # spaces. See also FILE_PATTERNS and EXTENSION_MAPPING # Note: If this tag is empty the current directory is searched. INPUT = ../src # This tag can be used to specify the character encoding of the source files # that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses # libiconv (or the iconv built into libc) for the transcoding. See the libiconv # documentation (see: # https://www.gnu.org/software/libiconv/) for the list of possible encodings. # The default value is: UTF-8. INPUT_ENCODING = UTF-8 # If the value of the INPUT tag contains directories, you can use the # FILE_PATTERNS tag to specify one or more wildcard patterns (like *.cpp and # *.h) to filter out the source-files in the directories. # # Note that for custom extensions or not directly supported extensions you also # need to set EXTENSION_MAPPING for the extension otherwise the files are not # read by doxygen. # # Note the list of default checked file patterns might differ from the list of # default file extension mappings. # # If left blank the following patterns are tested:*.c, *.cc, *.cxx, *.cpp, # *.c++, *.java, *.ii, *.ixx, *.ipp, *.i++, *.inl, *.idl, *.ddl, *.odl, *.h, # *.hh, *.hxx, *.hpp, *.h++, *.cs, *.d, *.php, *.php4, *.php5, *.phtml, *.inc, # *.m, *.markdown, *.md, *.mm, *.dox (to be provided as doxygen C comment), # *.py, *.pyw, *.f90, *.f95, *.f03, *.f08, *.f18, *.f, *.for, *.vhd, *.vhdl, # *.ucf, *.qsf and *.ice. FILE_PATTERNS = # The RECURSIVE tag can be used to specify whether or not subdirectories should # be searched for input files as well. # The default value is: NO. RECURSIVE = NO # The EXCLUDE tag can be used to specify files and/or directories that should be # excluded from the INPUT source files. This way you can easily exclude a # subdirectory from a directory tree whose root is specified with the INPUT tag. # # Note that relative paths are relative to the directory from which doxygen is # run. EXCLUDE = # The EXCLUDE_SYMLINKS tag can be used to select whether or not files or # directories that are symbolic links (a Unix file system feature) are excluded # from the input. # The default value is: NO. EXCLUDE_SYMLINKS = NO # If the value of the INPUT tag contains directories, you can use the # EXCLUDE_PATTERNS tag to specify one or more wildcard patterns to exclude # certain files from those directories. # # Note that the wildcards are matched against the file with absolute path, so to # exclude all test directories for example use the pattern */test/* EXCLUDE_PATTERNS = # The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names # (namespaces, classes, functions, etc.) that should be excluded from the # output. The symbol name can be a fully qualified name, a word, or if the # wildcard * is used, a substring. Examples: ANamespace, AClass, # AClass::ANamespace, ANamespace::*Test # # Note that the wildcards are matched against the file with absolute path, so to # exclude all test directories use the pattern */test/* EXCLUDE_SYMBOLS = # The EXAMPLE_PATH tag can be used to specify one or more files or directories # that contain example code fragments that are included (see the \include # command). EXAMPLE_PATH = # If the value of the EXAMPLE_PATH tag contains directories, you can use the # EXAMPLE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp and # *.h) to filter out the source-files in the directories. If left blank all # files are included. EXAMPLE_PATTERNS = # If the EXAMPLE_RECURSIVE tag is set to YES then subdirectories will be # searched for input files to be used with the \include or \dontinclude commands # irrespective of the value of the RECURSIVE tag. # The default value is: NO. EXAMPLE_RECURSIVE = NO # The IMAGE_PATH tag can be used to specify one or more files or directories # that contain images that are to be included in the documentation (see the # \image command). IMAGE_PATH = # The INPUT_FILTER tag can be used to specify a program that doxygen should # invoke to filter for each input file. Doxygen will invoke the filter program # by executing (via popen()) the command: # # # # where is the value of the INPUT_FILTER tag, and is the # name of an input file. Doxygen will then use the output that the filter # program writes to standard output. If FILTER_PATTERNS is specified, this tag # will be ignored. # # Note that the filter must not add or remove lines; it is applied before the # code is scanned, but not when the output code is generated. If lines are added # or removed, the anchors will not be placed correctly. # # Note that for custom extensions or not directly supported extensions you also # need to set EXTENSION_MAPPING for the extension otherwise the files are not # properly processed by doxygen. INPUT_FILTER = # The FILTER_PATTERNS tag can be used to specify filters on a per file pattern # basis. Doxygen will compare the file name with each pattern and apply the # filter if there is a match. The filters are a list of the form: pattern=filter # (like *.cpp=my_cpp_filter). See INPUT_FILTER for further information on how # filters are used. If the FILTER_PATTERNS tag is empty or if none of the # patterns match the file name, INPUT_FILTER is applied. # # Note that for custom extensions or not directly supported extensions you also # need to set EXTENSION_MAPPING for the extension otherwise the files are not # properly processed by doxygen. FILTER_PATTERNS = # If the FILTER_SOURCE_FILES tag is set to YES, the input filter (if set using # INPUT_FILTER) will also be used to filter the input files that are used for # producing the source files to browse (i.e. when SOURCE_BROWSER is set to YES). # The default value is: NO. FILTER_SOURCE_FILES = NO # The FILTER_SOURCE_PATTERNS tag can be used to specify source filters per file # pattern. A pattern will override the setting for FILTER_PATTERN (if any) and # it is also possible to disable source filtering for a specific pattern using # *.ext= (so without naming a filter). # This tag requires that the tag FILTER_SOURCE_FILES is set to YES. FILTER_SOURCE_PATTERNS = # If the USE_MDFILE_AS_MAINPAGE tag refers to the name of a markdown file that # is part of the input, its contents will be placed on the main page # (index.html). This can be useful if you have a project on for instance GitHub # and want to reuse the introduction page also for the doxygen output. USE_MDFILE_AS_MAINPAGE = #--------------------------------------------------------------------------- # Configuration options related to source browsing #--------------------------------------------------------------------------- # If the SOURCE_BROWSER tag is set to YES then a list of source files will be # generated. Documented entities will be cross-referenced with these sources. # # Note: To get rid of all source code in the generated output, make sure that # also VERBATIM_HEADERS is set to NO. # The default value is: NO. SOURCE_BROWSER = YES # Setting the INLINE_SOURCES tag to YES will include the body of functions, # classes and enums directly into the documentation. # The default value is: NO. INLINE_SOURCES = NO # Setting the STRIP_CODE_COMMENTS tag to YES will instruct doxygen to hide any # special comment blocks from generated source code fragments. Normal C, C++ and # Fortran comments will always remain visible. # The default value is: YES. STRIP_CODE_COMMENTS = YES # If the REFERENCED_BY_RELATION tag is set to YES then for each documented # entity all documented functions referencing it will be listed. # The default value is: NO. REFERENCED_BY_RELATION = YES # If the REFERENCES_RELATION tag is set to YES then for each documented function # all documented entities called/used by that function will be listed. # The default value is: NO. REFERENCES_RELATION = YES # If the REFERENCES_LINK_SOURCE tag is set to YES and SOURCE_BROWSER tag is set # to YES then the hyperlinks from functions in REFERENCES_RELATION and # REFERENCED_BY_RELATION lists will link to the source code. Otherwise they will # link to the documentation. # The default value is: YES. REFERENCES_LINK_SOURCE = YES # If SOURCE_TOOLTIPS is enabled (the default) then hovering a hyperlink in the # source code will show a tooltip with additional information such as prototype, # brief description and links to the definition and documentation. Since this # will make the HTML file larger and loading of large files a bit slower, you # can opt to disable this feature. # The default value is: YES. # This tag requires that the tag SOURCE_BROWSER is set to YES. SOURCE_TOOLTIPS = YES # If the USE_HTAGS tag is set to YES then the references to source code will # point to the HTML generated by the htags(1) tool instead of doxygen built-in # source browser. The htags tool is part of GNU's global source tagging system # (see https://www.gnu.org/software/global/global.html). You will need version # 4.8.6 or higher. # # To use it do the following: # - Install the latest version of global # - Enable SOURCE_BROWSER and USE_HTAGS in the configuration file # - Make sure the INPUT points to the root of the source tree # - Run doxygen as normal # # Doxygen will invoke htags (and that will in turn invoke gtags), so these # tools must be available from the command line (i.e. in the search path). # # The result: instead of the source browser generated by doxygen, the links to # source code will now point to the output of htags. # The default value is: NO. # This tag requires that the tag SOURCE_BROWSER is set to YES. USE_HTAGS = NO # If the VERBATIM_HEADERS tag is set the YES then doxygen will generate a # verbatim copy of the header file for each class for which an include is # specified. Set to NO to disable this. # See also: Section \class. # The default value is: YES. VERBATIM_HEADERS = YES # If the CLANG_ASSISTED_PARSING tag is set to YES then doxygen will use the # clang parser (see: # http://clang.llvm.org/) for more accurate parsing at the cost of reduced # performance. This can be particularly helpful with template rich C++ code for # which doxygen's built-in parser lacks the necessary type information. # Note: The availability of this option depends on whether or not doxygen was # generated with the -Duse_libclang=ON option for CMake. # The default value is: NO. CLANG_ASSISTED_PARSING = NO # If clang assisted parsing is enabled and the CLANG_ADD_INC_PATHS tag is set to # YES then doxygen will add the directory of each input to the include path. # The default value is: YES. CLANG_ADD_INC_PATHS = YES # If clang assisted parsing is enabled you can provide the compiler with command # line options that you would normally use when invoking the compiler. Note that # the include paths will already be set by doxygen for the files and directories # specified with INPUT and INCLUDE_PATH. # This tag requires that the tag CLANG_ASSISTED_PARSING is set to YES. CLANG_OPTIONS = # If clang assisted parsing is enabled you can provide the clang parser with the # path to the directory containing a file called compile_commands.json. This # file is the compilation database (see: # http://clang.llvm.org/docs/HowToSetupToolingForLLVM.html) containing the # options used when the source files were built. This is equivalent to # specifying the -p option to a clang tool, such as clang-check. These options # will then be passed to the parser. Any options specified with CLANG_OPTIONS # will be added as well. # Note: The availability of this option depends on whether or not doxygen was # generated with the -Duse_libclang=ON option for CMake. CLANG_DATABASE_PATH = #--------------------------------------------------------------------------- # Configuration options related to the alphabetical class index #--------------------------------------------------------------------------- # If the ALPHABETICAL_INDEX tag is set to YES, an alphabetical index of all # compounds will be generated. Enable this if the project contains a lot of # classes, structs, unions or interfaces. # The default value is: YES. ALPHABETICAL_INDEX = NO # In case all classes in a project start with a common prefix, all classes will # be put under the same header in the alphabetical index. The IGNORE_PREFIX tag # can be used to specify a prefix (or a list of prefixes) that should be ignored # while generating the index headers. # This tag requires that the tag ALPHABETICAL_INDEX is set to YES. IGNORE_PREFIX = #--------------------------------------------------------------------------- # Configuration options related to the HTML output #--------------------------------------------------------------------------- # If the GENERATE_HTML tag is set to YES, doxygen will generate HTML output # The default value is: YES. GENERATE_HTML = YES # The HTML_OUTPUT tag is used to specify where the HTML docs will be put. If a # relative path is entered the value of OUTPUT_DIRECTORY will be put in front of # it. # The default directory is: html. # This tag requires that the tag GENERATE_HTML is set to YES. HTML_OUTPUT = . # The HTML_FILE_EXTENSION tag can be used to specify the file extension for each # generated HTML page (for example: .htm, .php, .asp). # The default value is: .html. # This tag requires that the tag GENERATE_HTML is set to YES. HTML_FILE_EXTENSION = .html # The HTML_HEADER tag can be used to specify a user-defined HTML header file for # each generated HTML page. If the tag is left blank doxygen will generate a # standard header. # # To get valid HTML the header file that includes any scripts and style sheets # that doxygen needs, which is dependent on the configuration options used (e.g. # the setting GENERATE_TREEVIEW). It is highly recommended to start with a # default header using # doxygen -w html new_header.html new_footer.html new_stylesheet.css # YourConfigFile # and then modify the file new_header.html. See also section "Doxygen usage" # for information on how to generate the default header that doxygen normally # uses. # Note: The header is subject to change so you typically have to regenerate the # default header when upgrading to a newer version of doxygen. For a description # of the possible markers and block names see the documentation. # This tag requires that the tag GENERATE_HTML is set to YES. HTML_HEADER = # The HTML_FOOTER tag can be used to specify a user-defined HTML footer for each # generated HTML page. If the tag is left blank doxygen will generate a standard # footer. See HTML_HEADER for more information on how to generate a default # footer and what special commands can be used inside the footer. See also # section "Doxygen usage" for information on how to generate the default footer # that doxygen normally uses. # This tag requires that the tag GENERATE_HTML is set to YES. HTML_FOOTER = # The HTML_STYLESHEET tag can be used to specify a user-defined cascading style # sheet that is used by each HTML page. It can be used to fine-tune the look of # the HTML output. If left blank doxygen will generate a default style sheet. # See also section "Doxygen usage" for information on how to generate the style # sheet that doxygen normally uses. # Note: It is recommended to use HTML_EXTRA_STYLESHEET instead of this tag, as # it is more robust and this tag (HTML_STYLESHEET) will in the future become # obsolete. # This tag requires that the tag GENERATE_HTML is set to YES. HTML_STYLESHEET = # The HTML_EXTRA_STYLESHEET tag can be used to specify additional user-defined # cascading style sheets that are included after the standard style sheets # created by doxygen. Using this option one can overrule certain style aspects. # This is preferred over using HTML_STYLESHEET since it does not replace the # standard style sheet and is therefore more robust against future updates. # Doxygen will copy the style sheet files to the output directory. # Note: The order of the extra style sheet files is of importance (e.g. the last # style sheet in the list overrules the setting of the previous ones in the # list). For an example see the documentation. # This tag requires that the tag GENERATE_HTML is set to YES. HTML_EXTRA_STYLESHEET = # The HTML_EXTRA_FILES tag can be used to specify one or more extra images or # other source files which should be copied to the HTML output directory. Note # that these files will be copied to the base HTML output directory. Use the # $relpath^ marker in the HTML_HEADER and/or HTML_FOOTER files to load these # files. In the HTML_STYLESHEET file, use the file name only. Also note that the # files will be copied as-is; there are no commands or markers available. # This tag requires that the tag GENERATE_HTML is set to YES. HTML_EXTRA_FILES = # The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. Doxygen # will adjust the colors in the style sheet and background images according to # this color. Hue is specified as an angle on a colorwheel, see # https://en.wikipedia.org/wiki/Hue for more information. For instance the value # 0 represents red, 60 is yellow, 120 is green, 180 is cyan, 240 is blue, 300 # purple, and 360 is red again. # Minimum value: 0, maximum value: 359, default value: 220. # This tag requires that the tag GENERATE_HTML is set to YES. HTML_COLORSTYLE_HUE = 220 # The HTML_COLORSTYLE_SAT tag controls the purity (or saturation) of the colors # in the HTML output. For a value of 0 the output will use grayscales only. A # value of 255 will produce the most vivid colors. # Minimum value: 0, maximum value: 255, default value: 100. # This tag requires that the tag GENERATE_HTML is set to YES. HTML_COLORSTYLE_SAT = 100 # The HTML_COLORSTYLE_GAMMA tag controls the gamma correction applied to the # luminance component of the colors in the HTML output. Values below 100 # gradually make the output lighter, whereas values above 100 make the output # darker. The value divided by 100 is the actual gamma applied, so 80 represents # a gamma of 0.8, The value 220 represents a gamma of 2.2, and 100 does not # change the gamma. # Minimum value: 40, maximum value: 240, default value: 80. # This tag requires that the tag GENERATE_HTML is set to YES. HTML_COLORSTYLE_GAMMA = 80 # If the HTML_TIMESTAMP tag is set to YES then the footer of each generated HTML # page will contain the date and time when the page was generated. Setting this # to YES can help to show when doxygen was last run and thus if the # documentation is up to date. # The default value is: NO. # This tag requires that the tag GENERATE_HTML is set to YES. HTML_TIMESTAMP = YES # If the HTML_DYNAMIC_MENUS tag is set to YES then the generated HTML # documentation will contain a main index with vertical navigation menus that # are dynamically created via JavaScript. If disabled, the navigation index will # consists of multiple levels of tabs that are statically embedded in every HTML # page. Disable this option to support browsers that do not have JavaScript, # like the Qt help browser. # The default value is: YES. # This tag requires that the tag GENERATE_HTML is set to YES. HTML_DYNAMIC_MENUS = YES # If the HTML_DYNAMIC_SECTIONS tag is set to YES then the generated HTML # documentation will contain sections that can be hidden and shown after the # page has loaded. # The default value is: NO. # This tag requires that the tag GENERATE_HTML is set to YES. HTML_DYNAMIC_SECTIONS = NO # With HTML_INDEX_NUM_ENTRIES one can control the preferred number of entries # shown in the various tree structured indices initially; the user can expand # and collapse entries dynamically later on. Doxygen will expand the tree to # such a level that at most the specified number of entries are visible (unless # a fully collapsed tree already exceeds this amount). So setting the number of # entries 1 will produce a full collapsed tree by default. 0 is a special value # representing an infinite number of entries and will result in a full expanded # tree by default. # Minimum value: 0, maximum value: 9999, default value: 100. # This tag requires that the tag GENERATE_HTML is set to YES. HTML_INDEX_NUM_ENTRIES = 100 # If the GENERATE_DOCSET tag is set to YES, additional index files will be # generated that can be used as input for Apple's Xcode 3 integrated development # environment (see: # https://developer.apple.com/xcode/), introduced with OSX 10.5 (Leopard). To # create a documentation set, doxygen will generate a Makefile in the HTML # output directory. Running make will produce the docset in that directory and # running make install will install the docset in # ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find it at # startup. See https://developer.apple.com/library/archive/featuredarticles/Doxy # genXcode/_index.html for more information. # The default value is: NO. # This tag requires that the tag GENERATE_HTML is set to YES. GENERATE_DOCSET = NO # This tag determines the name of the docset feed. A documentation feed provides # an umbrella under which multiple documentation sets from a single provider # (such as a company or product suite) can be grouped. # The default value is: Doxygen generated docs. # This tag requires that the tag GENERATE_DOCSET is set to YES. DOCSET_FEEDNAME = "Doxygen generated docs" # This tag specifies a string that should uniquely identify the documentation # set bundle. This should be a reverse domain-name style string, e.g. # com.mycompany.MyDocSet. Doxygen will append .docset to the name. # The default value is: org.doxygen.Project. # This tag requires that the tag GENERATE_DOCSET is set to YES. DOCSET_BUNDLE_ID = org.doxygen.Project # The DOCSET_PUBLISHER_ID tag specifies a string that should uniquely identify # the documentation publisher. This should be a reverse domain-name style # string, e.g. com.mycompany.MyDocSet.documentation. # The default value is: org.doxygen.Publisher. # This tag requires that the tag GENERATE_DOCSET is set to YES. DOCSET_PUBLISHER_ID = org.doxygen.Publisher # The DOCSET_PUBLISHER_NAME tag identifies the documentation publisher. # The default value is: Publisher. # This tag requires that the tag GENERATE_DOCSET is set to YES. DOCSET_PUBLISHER_NAME = Publisher # If the GENERATE_HTMLHELP tag is set to YES then doxygen generates three # additional HTML index files: index.hhp, index.hhc, and index.hhk. The # index.hhp is a project file that can be read by Microsoft's HTML Help Workshop # (see: # https://www.microsoft.com/en-us/download/details.aspx?id=21138) on Windows. # # The HTML Help Workshop contains a compiler that can convert all HTML output # generated by doxygen into a single compiled HTML file (.chm). Compiled HTML # files are now used as the Windows 98 help format, and will replace the old # Windows help format (.hlp) on all Windows platforms in the future. Compressed # HTML files also contain an index, a table of contents, and you can search for # words in the documentation. The HTML workshop also contains a viewer for # compressed HTML files. # The default value is: NO. # This tag requires that the tag GENERATE_HTML is set to YES. GENERATE_HTMLHELP = NO # The CHM_FILE tag can be used to specify the file name of the resulting .chm # file. You can add a path in front of the file if the result should not be # written to the html output directory. # This tag requires that the tag GENERATE_HTMLHELP is set to YES. CHM_FILE = # The HHC_LOCATION tag can be used to specify the location (absolute path # including file name) of the HTML help compiler (hhc.exe). If non-empty, # doxygen will try to run the HTML help compiler on the generated index.hhp. # The file has to be specified with full path. # This tag requires that the tag GENERATE_HTMLHELP is set to YES. HHC_LOCATION = # The GENERATE_CHI flag controls if a separate .chi index file is generated # (YES) or that it should be included in the main .chm file (NO). # The default value is: NO. # This tag requires that the tag GENERATE_HTMLHELP is set to YES. GENERATE_CHI = NO # The CHM_INDEX_ENCODING is used to encode HtmlHelp index (hhk), content (hhc) # and project file content. # This tag requires that the tag GENERATE_HTMLHELP is set to YES. CHM_INDEX_ENCODING = # The BINARY_TOC flag controls whether a binary table of contents is generated # (YES) or a normal table of contents (NO) in the .chm file. Furthermore it # enables the Previous and Next buttons. # The default value is: NO. # This tag requires that the tag GENERATE_HTMLHELP is set to YES. BINARY_TOC = NO # The TOC_EXPAND flag can be set to YES to add extra items for group members to # the table of contents of the HTML help documentation and to the tree view. # The default value is: NO. # This tag requires that the tag GENERATE_HTMLHELP is set to YES. TOC_EXPAND = NO # If the GENERATE_QHP tag is set to YES and both QHP_NAMESPACE and # QHP_VIRTUAL_FOLDER are set, an additional index file will be generated that # can be used as input for Qt's qhelpgenerator to generate a Qt Compressed Help # (.qch) of the generated HTML documentation. # The default value is: NO. # This tag requires that the tag GENERATE_HTML is set to YES. GENERATE_QHP = NO # If the QHG_LOCATION tag is specified, the QCH_FILE tag can be used to specify # the file name of the resulting .qch file. The path specified is relative to # the HTML output folder. # This tag requires that the tag GENERATE_QHP is set to YES. QCH_FILE = # The QHP_NAMESPACE tag specifies the namespace to use when generating Qt Help # Project output. For more information please see Qt Help Project / Namespace # (see: # https://doc.qt.io/archives/qt-4.8/qthelpproject.html#namespace). # The default value is: org.doxygen.Project. # This tag requires that the tag GENERATE_QHP is set to YES. QHP_NAMESPACE = # The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating Qt # Help Project output. For more information please see Qt Help Project / Virtual # Folders (see: # https://doc.qt.io/archives/qt-4.8/qthelpproject.html#virtual-folders). # The default value is: doc. # This tag requires that the tag GENERATE_QHP is set to YES. QHP_VIRTUAL_FOLDER = doc # If the QHP_CUST_FILTER_NAME tag is set, it specifies the name of a custom # filter to add. For more information please see Qt Help Project / Custom # Filters (see: # https://doc.qt.io/archives/qt-4.8/qthelpproject.html#custom-filters). # This tag requires that the tag GENERATE_QHP is set to YES. QHP_CUST_FILTER_NAME = # The QHP_CUST_FILTER_ATTRS tag specifies the list of the attributes of the # custom filter to add. For more information please see Qt Help Project / Custom # Filters (see: # https://doc.qt.io/archives/qt-4.8/qthelpproject.html#custom-filters). # This tag requires that the tag GENERATE_QHP is set to YES. QHP_CUST_FILTER_ATTRS = # The QHP_SECT_FILTER_ATTRS tag specifies the list of the attributes this # project's filter section matches. Qt Help Project / Filter Attributes (see: # https://doc.qt.io/archives/qt-4.8/qthelpproject.html#filter-attributes). # This tag requires that the tag GENERATE_QHP is set to YES. QHP_SECT_FILTER_ATTRS = # The QHG_LOCATION tag can be used to specify the location (absolute path # including file name) of Qt's qhelpgenerator. If non-empty doxygen will try to # run qhelpgenerator on the generated .qhp file. # This tag requires that the tag GENERATE_QHP is set to YES. QHG_LOCATION = # If the GENERATE_ECLIPSEHELP tag is set to YES, additional index files will be # generated, together with the HTML files, they form an Eclipse help plugin. To # install this plugin and make it available under the help contents menu in # Eclipse, the contents of the directory containing the HTML and XML files needs # to be copied into the plugins directory of eclipse. The name of the directory # within the plugins directory should be the same as the ECLIPSE_DOC_ID value. # After copying Eclipse needs to be restarted before the help appears. # The default value is: NO. # This tag requires that the tag GENERATE_HTML is set to YES. GENERATE_ECLIPSEHELP = NO # A unique identifier for the Eclipse help plugin. When installing the plugin # the directory name containing the HTML and XML files should also have this # name. Each documentation set should have its own identifier. # The default value is: org.doxygen.Project. # This tag requires that the tag GENERATE_ECLIPSEHELP is set to YES. ECLIPSE_DOC_ID = org.doxygen.Project # If you want full control over the layout of the generated HTML pages it might # be necessary to disable the index and replace it with your own. The # DISABLE_INDEX tag can be used to turn on/off the condensed index (tabs) at top # of each HTML page. A value of NO enables the index and the value YES disables # it. Since the tabs in the index contain the same information as the navigation # tree, you can set this option to YES if you also set GENERATE_TREEVIEW to YES. # The default value is: NO. # This tag requires that the tag GENERATE_HTML is set to YES. DISABLE_INDEX = NO # The GENERATE_TREEVIEW tag is used to specify whether a tree-like index # structure should be generated to display hierarchical information. If the tag # value is set to YES, a side panel will be generated containing a tree-like # index structure (just like the one that is generated for HTML Help). For this # to work a browser that supports JavaScript, DHTML, CSS and frames is required # (i.e. any modern browser). Windows users are probably better off using the # HTML help feature. Via custom style sheets (see HTML_EXTRA_STYLESHEET) one can # further fine-tune the look of the index. As an example, the default style # sheet generated by doxygen has an example that shows how to put an image at # the root of the tree instead of the PROJECT_NAME. Since the tree basically has # the same information as the tab index, you could consider setting # DISABLE_INDEX to YES when enabling this option. # The default value is: NO. # This tag requires that the tag GENERATE_HTML is set to YES. GENERATE_TREEVIEW = YES # The ENUM_VALUES_PER_LINE tag can be used to set the number of enum values that # doxygen will group on one line in the generated HTML documentation. # # Note that a value of 0 will completely suppress the enum values from appearing # in the overview section. # Minimum value: 0, maximum value: 20, default value: 4. # This tag requires that the tag GENERATE_HTML is set to YES. ENUM_VALUES_PER_LINE = 8 # If the treeview is enabled (see GENERATE_TREEVIEW) then this tag can be used # to set the initial width (in pixels) of the frame in which the tree is shown. # Minimum value: 0, maximum value: 1500, default value: 250. # This tag requires that the tag GENERATE_HTML is set to YES. TREEVIEW_WIDTH = 250 # If the EXT_LINKS_IN_WINDOW option is set to YES, doxygen will open links to # external symbols imported via tag files in a separate window. # The default value is: NO. # This tag requires that the tag GENERATE_HTML is set to YES. EXT_LINKS_IN_WINDOW = NO # If the HTML_FORMULA_FORMAT option is set to svg, doxygen will use the pdf2svg # tool (see https://github.com/dawbarton/pdf2svg) or inkscape (see # https://inkscape.org) to generate formulas as SVG images instead of PNGs for # the HTML output. These images will generally look nicer at scaled resolutions. # Possible values are: png (the default) and svg (looks nicer but requires the # pdf2svg or inkscape tool). # The default value is: png. # This tag requires that the tag GENERATE_HTML is set to YES. HTML_FORMULA_FORMAT = png # Use this tag to change the font size of LaTeX formulas included as images in # the HTML documentation. When you change the font size after a successful # doxygen run you need to manually remove any form_*.png images from the HTML # output directory to force them to be regenerated. # Minimum value: 8, maximum value: 50, default value: 10. # This tag requires that the tag GENERATE_HTML is set to YES. FORMULA_FONTSIZE = 10 # Use the FORMULA_TRANSPARENT tag to determine whether or not the images # generated for formulas are transparent PNGs. Transparent PNGs are not # supported properly for IE 6.0, but are supported on all modern browsers. # # Note that when changing this option you need to delete any form_*.png files in # the HTML output directory before the changes have effect. # The default value is: YES. # This tag requires that the tag GENERATE_HTML is set to YES. FORMULA_TRANSPARENT = YES # The FORMULA_MACROFILE can contain LaTeX \newcommand and \renewcommand commands # to create new LaTeX commands to be used in formulas as building blocks. See # the section "Including formulas" for details. FORMULA_MACROFILE = # Enable the USE_MATHJAX option to render LaTeX formulas using MathJax (see # https://www.mathjax.org) which uses client side JavaScript for the rendering # instead of using pre-rendered bitmaps. Use this if you do not have LaTeX # installed or if you want to formulas look prettier in the HTML output. When # enabled you may also need to install MathJax separately and configure the path # to it using the MATHJAX_RELPATH option. # The default value is: NO. # This tag requires that the tag GENERATE_HTML is set to YES. USE_MATHJAX = NO # When MathJax is enabled you can set the default output format to be used for # the MathJax output. See the MathJax site (see: # http://docs.mathjax.org/en/v2.7-latest/output.html) for more details. # Possible values are: HTML-CSS (which is slower, but has the best # compatibility), NativeMML (i.e. MathML) and SVG. # The default value is: HTML-CSS. # This tag requires that the tag USE_MATHJAX is set to YES. MATHJAX_FORMAT = HTML-CSS # When MathJax is enabled you need to specify the location relative to the HTML # output directory using the MATHJAX_RELPATH option. The destination directory # should contain the MathJax.js script. For instance, if the mathjax directory # is located at the same level as the HTML output directory, then # MATHJAX_RELPATH should be ../mathjax. The default value points to the MathJax # Content Delivery Network so you can quickly see the result without installing # MathJax. However, it is strongly recommended to install a local copy of # MathJax from https://www.mathjax.org before deployment. # The default value is: https://cdn.jsdelivr.net/npm/mathjax@2. # This tag requires that the tag USE_MATHJAX is set to YES. MATHJAX_RELPATH = http://www.mathjax.org/mathjax # The MATHJAX_EXTENSIONS tag can be used to specify one or more MathJax # extension names that should be enabled during MathJax rendering. For example # MATHJAX_EXTENSIONS = TeX/AMSmath TeX/AMSsymbols # This tag requires that the tag USE_MATHJAX is set to YES. MATHJAX_EXTENSIONS = # The MATHJAX_CODEFILE tag can be used to specify a file with javascript pieces # of code that will be used on startup of the MathJax code. See the MathJax site # (see: # http://docs.mathjax.org/en/v2.7-latest/output.html) for more details. For an # example see the documentation. # This tag requires that the tag USE_MATHJAX is set to YES. MATHJAX_CODEFILE = # When the SEARCHENGINE tag is enabled doxygen will generate a search box for # the HTML output. The underlying search engine uses javascript and DHTML and # should work on any modern browser. Note that when using HTML help # (GENERATE_HTMLHELP), Qt help (GENERATE_QHP), or docsets (GENERATE_DOCSET) # there is already a search function so this one should typically be disabled. # For large projects the javascript based search engine can be slow, then # enabling SERVER_BASED_SEARCH may provide a better solution. It is possible to # search using the keyboard; to jump to the search box use + S # (what the is depends on the OS and browser, but it is typically # , /